From 40b8c5fb99785e563099ea2e70eaba5dd2f3ca65 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Thu, 9 Jan 2014 14:18:21 +0000
Subject: [PATCH] Check file datestamps before unioning PGF files

When running a command like

 gf -make -name=T L_1.pgf ... L_n.pgf

gf now checks if T.pgf exists and is up-to-date before reading and computing
the union of the L_i.pgf files.

The name (T) of the target PGF file has to be given explicitly for this to work,
since otherwise the name is not known until the union has been computed.
If the functions for reading PGF files and computing the union were lazier,
this would not be necessary...
---
 src/compiler/GFC.hs | 36 +++++++++++++++++++++++++-----------
 1 file changed, 25 insertions(+), 11 deletions(-)

diff --git a/src/compiler/GFC.hs b/src/compiler/GFC.hs
index cb3fa7afd..ef63104f9 100644
--- a/src/compiler/GFC.hs
+++ b/src/compiler/GFC.hs
@@ -15,6 +15,8 @@ import GF.Infra.Ident(identS)
 import GF.Infra.UseIO
 import GF.Infra.Option
 import GF.Data.ErrM
+import GF.System.Directory
+import GF.System.Catch
 
 import Data.Maybe
 import Data.Binary
@@ -23,7 +25,7 @@ import qualified Data.ByteString as BSS
 import qualified Data.ByteString.Lazy as BSL
 import System.FilePath
 import System.IO
-import Control.Exception
+import Control.Exception(bracket)
 import Control.Monad(unless,forM_)
 
 mainGFC :: Options -> [FilePath] -> IO ()
@@ -63,16 +65,28 @@ compileCFFiles opts fs =
                  writeOutputs opts pgf
 
 unionPGFFiles :: Options -> [FilePath] -> IOE ()
-unionPGFFiles opts fs = 
-    do pgfs <- mapM readPGFVerbose fs
-       let pgf0 = foldl1 unionPGF pgfs
-           pgf  = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
-           pgfFile = grammarName opts pgf <.> "pgf"
-       if pgfFile `elem` fs
-         then putStrLnE $ "Refusing to overwrite " ++ pgfFile
-         else writePGF opts pgf
-       writeOutputs opts pgf
-  where readPGFVerbose f = putPointE Normal opts ("Reading " ++ f ++ "...") $ liftIO $ readPGF f
+unionPGFFiles opts fs = maybe doIt checkFirst (flag optName opts)
+  where
+    checkFirst name =
+      do let pgfFile = name <.> "pgf"
+         sourceTime <- liftIO $ maximum `fmap` mapM getModificationTime fs
+         targetTime <- maybeIO $ getModificationTime pgfFile
+         if targetTime >= Just sourceTime
+           then putIfVerb opts $ pgfFile ++ " is up-to-date."
+           else doIt
+
+    doIt =
+      do pgfs <- mapM readPGFVerbose fs
+         let pgf0 = foldl1 unionPGF pgfs
+             pgf  = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
+             pgfFile = grammarName opts pgf <.> "pgf"
+         if pgfFile `elem` fs
+           then putStrLnE $ "Refusing to overwrite " ++ pgfFile
+           else writePGF opts pgf
+         writeOutputs opts pgf
+
+    readPGFVerbose f =
+        putPointE Normal opts ("Reading " ++ f ++ "...") $ liftIO $ readPGF f
 
 writeOutputs :: Options -> PGF -> IOE ()
 writeOutputs opts pgf = do