summaryrefslogtreecommitdiff
path: root/src/Language/Fiddle/Compiler/ImportResolution.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/Fiddle/Compiler/ImportResolution.hs')
-rw-r--r--src/Language/Fiddle/Compiler/ImportResolution.hs43
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