improved make facility: remember state if fails; does not need source

src/GF/Infra/ReadFiles.hs

@@ -13,10 +13,12 @@ import Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
 import Option
 import Operations
 import UseIO
+
 import System
 import Char
 import Monad
 import List
+import Directory
 
 -- make analysis for GF grammar modules. AR 11/6/2003--24/2/2004
 
@@ -76,6 +78,7 @@ selectFormat env (p,f) = do
         (Just tenv,_,_,Just tgf) | laterModTime tenv tgf -> CSEnvR
         (_,Just tenv,_,Just tgf) | laterModTime tenv tgf -> CSEnv
         (_,_,Just tgfc,Just tgf) | laterModTime tgfc tgf -> CSRead
+        (_,_,_,        Nothing) -> CSRead -- source does not exist
         _ -> CSComp
   return $ (f, (p,stat))
 
@@ -126,9 +129,9 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
   res cs = map mkRes cs where
     mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
       t | elem t [MTyResource,MTyIncResource] &&
-          not (null [m | (m,(_,CSComp)) <- cs,
+          (not (null [m | (m,(_,CSComp)) <- cs,
                                    Just ms <- [lookup m allDeps], elem f ms])
-                    || oElem retainOpers opts
+                    || oElem retainOpers opts)
         -> (f,(path,CSRes))
       _ -> x
     mkRes x = x
@@ -154,9 +157,9 @@ resModName = ('#':)
 
 getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)]
 getImports ps = get [] where
-  get ds file = do
-    let name = fileBody file
-    (p,s) <- readFileIfPath ps $ file
+  get ds file0 = do
+    let name = fileBody file0
+    (p,s) <- tryRead name
     let ((typ,mname),imps) = importsOfFile s
     ioeErr $ testErr  (mname == name) $ 
              "module name differs from file name in" +++ name
@@ -164,8 +167,17 @@ getImports ps = get [] where
       _ | elem name (map (snd . fst . fst) ds) -> return ds  --- file already read
       [] -> return $ (((typ,name),[]),p):ds
       _ -> do
-        let files = map (gfFile . fst) imps --- requires there's always .gf file
+        let files = map (gfFile . fst) imps 
         foldM get ((((typ,name),imps),p):ds) files
+  tryRead name = do
+    file <- do
+      let file_gf = gfFile name
+      b <- doesFileExistPath ps file_gf                   -- try gf file first
+      if b then return file_gf else return (gfcFile name) -- gfc next
+
+    readFileIfPath ps $ file
+
+
 
 -- internal module dep information
 

src/GF/Infra/UseIO.hs

@@ -76,6 +76,11 @@ readFileIfPath paths file = do
       return (justInitPath pfile,s)
     _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.")
 
+doesFileExistPath :: [FilePath] -> String -> IOE Bool
+doesFileExistPath paths file = do
+  mpfile <- ioeIO $ getFilePath paths file
+  return $ maybe False (const True) mpfile
+
 pFilePaths :: String -> [FilePath]
 pFilePaths s = case span (/=':') s of
   (f,_:cs) -> f : pFilePaths cs
@@ -179,6 +184,15 @@ ioeBad = ioe . return . Bad
 useIOE :: a -> IOE a -> IO a
 useIOE a ioe = appIOE ioe >>= err (\s -> putStrLn s >> return a) return 
 
+foldIOE :: (a -> b -> IOE a) -> a -> [b] -> IOE (a, Maybe String)
+foldIOE f s xs = case xs of
+  [] -> return (s,Nothing)
+  x:xx -> do
+    ev <- ioeIO $ appIOE (f s x) 
+    case ev of 
+      Ok v  -> foldIOE f v xx
+      Bad m -> return $ (s, Just m)
+
 putStrLnE :: String -> IOE ()
 putStrLnE = ioeIO . putStrLnFlush