[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