Add ability to store the fiddle interface files in a different folder.

1 files changed, 33 insertions, 10 deletions

diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs
index 2568025..a9c4c8e 100644
--- a/src/Language/Fiddle/Compiler/ImportResolution.hs
+++ b/src/Language/Fiddle/Compiler/ImportResolution.hs
@@ -33,8 +33,9 @@ import System.Directory
 import System.FilePath
 import Text.Printf (printf)
 
-newtype Flags = Flags
-  { importDirectories :: [FilePath]
+data Flags = Flags
+  { importDirectories :: [FilePath],
+    interfaceDirectory :: Maybe FilePath
   }
 
 parseFlags :: Parser Flags
@@ -48,6 +49,14 @@ parseFlags =
               <> help "Directory to add to the import search path"
           )
       )
+    <*> optional
+      ( strOption
+          ( long "intf-dir"
+              <> short 'i'
+              <> metavar "INTF_DIR"
+              <> help "Directory to dump interface files to."
+          )
+      )
 
 importResolutionPhase ::
   ( FilePath ->
@@ -179,7 +188,7 @@ getImportResolutionState parseFile compileToChecked flags unit = do
               castTS u -> do
               (diagnostics, _, unitInterface) <-
                 lift $
-                  ioGetImportInterface a (importDirectories flags) (Text.unpack path)
+                  ioGetImportInterface a flags (Text.unpack path)
 
               tell
                 ( [],
@@ -204,10 +213,17 @@ getImportResolutionState parseFile compileToChecked flags unit = do
         then (diags, Nothing)
         else (diags, a)
 
-    ioGetImportInterface :: SourceSpan -> [FilePath] -> FilePath -> IO ([Diagnostic], [Artifact], Maybe UnitInterface)
-    ioGetImportInterface srcSpan imports fp = runCompl $ do
+    findInterfaceFile :: Maybe FilePath -> FilePath -> FilePath -> IO FilePath
+    findInterfaceFile Nothing foundPath _ = return $ interfaceFile foundPath
+    findInterfaceFile (Just dir) _ p = return $ interfaceFile $ dir </> p
+
+    ioGetImportInterface :: SourceSpan -> Flags -> FilePath -> IO ([Diagnostic], [Artifact], Maybe UnitInterface)
+    ioGetImportInterface srcSpan flags fp = runCompl $ do
+      let imports = importDirectories flags
+          intfDir = interfaceDirectory flags
       path <- findFileInImportPath srcSpan imports fp
-      let intf = interfaceFile path
+      intf <- lift2 $ findInterfaceFile intfDir path fp
+      -- let intf = interfaceFile path
       valid <- lift2 $ interfaceFileValid path intf
 
       let doFullCompile = do
@@ -234,21 +250,22 @@ getImportResolutionState parseFile compileToChecked flags unit = do
     addDependency path unitInterface =
       unitInterface {dependencies = path : dependencies unitInterface}
 
-    interfaceFile filePath = takeBaseName filePath <.> "fdi"
+    interfaceFile filePath = takeDirectory filePath </> takeBaseName filePath <.> "fdi"
 
     checkNeedFullRecompile intfFile (UnitInterface {dependencies = dependencies}) =
-      allM
+      anyM
         ( \depfile -> do
             timeDep <- getModificationTime depfile
             timeIntf <- getModificationTime intfFile
-            return (timeIntf > timeDep)
+            return (timeIntf < timeDep)
         )
         dependencies
 
     readInterfaceFile intfile =
       eitherDecode . GZip.decompress <$> BL.readFile intfile
 
-    writeInterfaceFile intfile val =
+    writeInterfaceFile intfile val = do
+      createDirectoryIfMissing True (takeDirectory intfile)
       BL.writeFile intfile $ GZip.compress (encode val)
 
     interfaceFileValid :: FilePath -> FilePath -> IO Bool
@@ -291,3 +308,9 @@ allM _ [] = return True
 allM fn (a : as) = do
   b <- fn a
   if b then allM fn as else return False
+
+anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
+anyM _ [] = return True
+anyM fn (a : as) = do
+  b <- fn a
+  if b then return True else anyM fn as