[commit: packages/filepath] master: Only write out a new generated file if it has changed (e8d126c)

git at git.haskell.org git at git.haskell.org
Thu Mar 19 11:36:36 UTC 2015


Repository : ssh://git@git.haskell.org/filepath

On branch  : master
Link       : http://git.haskell.org/packages/filepath.git/commitdiff/e8d126cf8bccd11e9361d372b05c9a6abcae5ed6

>---------------------------------------------------------------

commit e8d126cf8bccd11e9361d372b05c9a6abcae5ed6
Author: Neil Mitchell <ndmitchell at gmail.com>
Date:   Wed Oct 29 09:19:18 2014 +0000

    Only write out a new generated file if it has changed


>---------------------------------------------------------------

e8d126cf8bccd11e9361d372b05c9a6abcae5ed6
 Generate.hs | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/Generate.hs b/Generate.hs
index 0dee626..e228cbf 100755
--- a/Generate.hs
+++ b/Generate.hs
@@ -1,8 +1,11 @@
 
 module Generate(main) where
 
+import Control.Exception
+import Control.Monad
 import Data.Char
 import Data.List
+import System.Directory
 import System.IO
 
 
@@ -19,7 +22,7 @@ main :: IO ()
 main = do
     src <- readFile "System/FilePath/Internal.hs"
     let tests = concatMap getTest $ zip [1..] (lines src)
-    writeFileBinary "tests/TestGen.hs" (prefix ++ genTests tests)
+    writeFileBinaryChanged "tests/TestGen.hs" (prefix ++ genTests tests)
 
 prefix = unlines
     ["module TestGen(tests) where"
@@ -115,3 +118,16 @@ genTest (Test free x) = "quickSafe (\\" ++ concatMap ((' ':) . f) free ++ " -> (
 
 writeFileBinary :: FilePath -> String -> IO ()
 writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x
+
+readFileBinary' :: FilePath -> IO String
+readFileBinary' file = withBinaryFile file ReadMode $ \h -> do
+    s <- hGetContents h
+    evaluate $ length s
+    return s
+
+writeFileBinaryChanged :: FilePath -> String -> IO ()
+writeFileBinaryChanged file x = do
+    b <- doesFileExist file
+    old <- if b then fmap Just $ readFileBinary' file else return Nothing
+    when (Just x /= old) $
+        writeFileBinary file x



More information about the ghc-commits mailing list