Commit 855e17c9 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Switch to scoped file reading rather than lazy readFile

parent 32432f3f
......@@ -81,7 +81,8 @@ import Distribution.Compiler (CompilerFlavor(..))
import Distribution.PackageDescription.Configuration (parseCondition, freeVars)
import Distribution.Simple.Utils
( die, dieWithLocation, warn, intercalate, lowercase, cabalVersion
, readUTF8File, writeUTF8File )
, withFileContents, withUTF8FileContents
, writeFileAtomic, writeUTF8File )
-- -----------------------------------------------------------------------------
......@@ -288,15 +289,14 @@ flagFieldDescrs =
-- | Given a parser and a filename, return the parse of the file,
-- after checking if the file exists.
readAndParseFile :: (FilePath -> IO String)
readAndParseFile :: (FilePath -> (String -> IO a) -> IO a)
-> (String -> ParseResult a)
-> Verbosity
-> FilePath -> IO a
readAndParseFile readFile' parser verbosity fpath = do
readAndParseFile withFileContents' parser verbosity fpath = do
exists <- doesFileExist fpath
when (not exists) (die $ "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue.")
str <- readFile' fpath
case parser str of
withFileContents' fpath $ \str -> case parser str of
ParseFailed e -> do
let (line, message) = locatedErrorMsg e
dieWithLocation fpath line message
......@@ -306,12 +306,12 @@ readAndParseFile readFile' parser verbosity fpath = do
readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
readHookedBuildInfo =
readAndParseFile readFile parseHookedBuildInfo
readAndParseFile withFileContents parseHookedBuildInfo
-- |Parse the given package file.
readPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
readPackageDescription =
readAndParseFile readUTF8File parsePackageDescription
readAndParseFile withUTF8FileContents parsePackageDescription
stanzas :: [Field] -> [[Field]]
stanzas [] = []
......
......@@ -93,7 +93,8 @@ import Distribution.Simple.LocalBuildInfo
, prefixRelativeInstallDirs )
import Distribution.Simple.Utils
( die, warn, info, setupMessage, createDirectoryIfMissingVerbose
, intercalate, comparing, cabalVersion, cabalBootstrapping )
, intercalate, comparing, cabalVersion, cabalBootstrapping
, withFileContents, writeFileAtomic )
import Distribution.Simple.Register
( removeInstalledConfig )
import Distribution.System
......@@ -127,7 +128,7 @@ import System.FilePath
import qualified System.Info
( compilerName, compilerVersion )
import System.IO
( hPutStrLn, stderr, hGetContents, openFile, hClose, IOMode(ReadMode) )
( hPutStrLn, stderr )
import Distribution.Text
( Text(disp), display, simpleParse )
import Text.PrettyPrint.HughesPJ
......@@ -140,21 +141,15 @@ tryGetConfigStateFile filename = do
exists <- doesFileExist filename
if not exists
then return (Left missing)
else do
str <- readFileStrict filename
return $ case lines str of
else withFileContents filename $ \str ->
case lines str of
[headder, rest] -> case checkHeader headder of
Just msg -> Left msg
Just msg -> return (Left msg)
Nothing -> case reads rest of
[(bi,_)] -> Right bi
_ -> Left cantParse
_ -> Left cantParse
[(bi,_)] -> return (Right bi)
_ -> return (Left cantParse)
_ -> return (Left cantParse)
where
readFileStrict name = do
h <- openFile name ReadMode
str <- hGetContents h >>= \str -> length str `seq` return str
hClose h
return str
checkHeader :: String -> Maybe String
checkHeader header = case parseHeader header of
Just (cabalId, compId)
......
......@@ -66,7 +66,7 @@ import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.BuildPaths (autogenModulesDir)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, readUTF8File, writeUTF8File
( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File
, die, setupMessage, intercalate
, findFileWithExtension, findFileWithExtension', dotToSep )
import Distribution.Simple.Program (Program(..), ConfiguredProgram(..),
......@@ -272,9 +272,9 @@ ppUnlit :: PreProcessor
ppUnlit =
PreProcessor {
platformIndependent = True,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile _verbosity -> do
contents <- readUTF8File inFile
either (writeUTF8File outFile) die (unlit inFile contents)
runPreProcessor = mkSimplePreProcessor $ \inFile outFile _verbosity ->
withUTF8FileContents inFile $ \contents ->
either (writeUTF8File outFile) die (unlit inFile contents)
}
ppCpp :: BuildInfo -> LocalBuildInfo -> PreProcessor
......
......@@ -68,7 +68,7 @@ import Distribution.Package
import Distribution.Version
( Version(versionBranch), VersionRange(AnyVersion) )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, readUTF8File, writeUTF8File
( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File
, copyFiles, copyFileVerbose, findFile, findFileWithExtension
, withTempDirectory, dotToSep, defaultPackageDesc
, die, warn, notice, setupMessage )
......@@ -225,9 +225,9 @@ prepareSnapshotTree verbosity pkg mb_lbi tmpDir pps date = do
-- We could just writePackageDescription targetDescFile pkg_descr,
-- but that would lose comments and formatting.
descFile <- defaultPackageDesc verbosity
writeUTF8File (targetDir </> descFile)
withUTF8FileContents descFile $
writeUTF8File (targetDir </> descFile)
. unlines . map (replaceVersion version) . lines
=<< readUTF8File descFile
replaceVersion :: Version -> String -> String
replaceVersion version line
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment