Switch to scoped file reading rather than lazy readFile

Distribution/PackageDescription/Parse.hs

@@ -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 [] = []

Distribution/Simple/Configure.hs

@@ -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)

Distribution/Simple/PreProcess.hs

@@ -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

Distribution/Simple/SrcDist.hs

@@ -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