diff options
| -rw-r--r-- | src/Language/Fiddle/Compiler/ImportResolution.hs | 43 |
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 |