module Cli.RunCompiler (
runCompiler,
) where
import Control.Monad (foldM,when)
import Data.List (intercalate)
import System.Directory
import System.FilePath
import System.IO
import System.Posix.Temp (mkdtemp)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Base.CompileError
import Base.CompileInfo
import Cli.CompileOptions
import Cli.Compiler
import Cli.Programs
import Module.CompileMetadata
import Module.Paths
import Module.ProcessMetadata
runCompiler :: (PathIOHandler r, CompilerBackend b) => r -> b -> CompileOptions -> CompileInfoIO ()
runCompiler :: r -> b -> CompileOptions -> CompileInfoIO ()
runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [FilePath]
_ [FilePath]
_ [FilePath]
ds [ExtraSource]
_ [FilePath]
_ FilePath
p (ExecuteTests [FilePath]
tp) ForceMode
f) = do
FilePath
base <- r -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> m FilePath
resolveBaseModule r
resolver
[LoadedTests]
ts <- ((Map FilePath CompileMetadata, [LoadedTests]) -> [LoadedTests])
-> CompileInfoT IO (Map FilePath CompileMetadata, [LoadedTests])
-> CompileInfoT IO [LoadedTests]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map FilePath CompileMetadata, [LoadedTests]) -> [LoadedTests]
forall a b. (a, b) -> b
snd (CompileInfoT IO (Map FilePath CompileMetadata, [LoadedTests])
-> CompileInfoT IO [LoadedTests])
-> CompileInfoT IO (Map FilePath CompileMetadata, [LoadedTests])
-> CompileInfoT IO [LoadedTests]
forall a b. (a -> b) -> a -> b
$ ((Map FilePath CompileMetadata, [LoadedTests])
-> FilePath
-> CompileInfoT IO (Map FilePath CompileMetadata, [LoadedTests]))
-> (Map FilePath CompileMetadata, [LoadedTests])
-> [FilePath]
-> CompileInfoT IO (Map FilePath CompileMetadata, [LoadedTests])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (FilePath
-> (Map FilePath CompileMetadata, [LoadedTests])
-> FilePath
-> CompileInfoT IO (Map FilePath CompileMetadata, [LoadedTests])
preloadTests FilePath
base) (Map FilePath CompileMetadata
forall k a. Map k a
Map.empty,[]) [FilePath]
ds
[LoadedTests] -> CompileInfoIO ()
forall (m :: * -> *). CompileErrorM m => [LoadedTests] -> m ()
checkTestFilters [LoadedTests]
ts
[((Int, Int), CompileInfo ())]
allResults <- ([[((Int, Int), CompileInfo ())]]
-> [((Int, Int), CompileInfo ())])
-> CompileInfoT IO [[((Int, Int), CompileInfo ())]]
-> CompileInfoT IO [((Int, Int), CompileInfo ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[((Int, Int), CompileInfo ())]] -> [((Int, Int), CompileInfo ())]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (CompileInfoT IO [[((Int, Int), CompileInfo ())]]
-> CompileInfoT IO [((Int, Int), CompileInfo ())])
-> CompileInfoT IO [[((Int, Int), CompileInfo ())]]
-> CompileInfoT IO [((Int, Int), CompileInfo ())]
forall a b. (a -> b) -> a -> b
$ (LoadedTests -> CompileInfoT IO [((Int, Int), CompileInfo ())])
-> [LoadedTests]
-> CompileInfoT IO [[((Int, Int), CompileInfo ())]]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (r
-> b
-> FilePath
-> [FilePath]
-> LoadedTests
-> CompileInfoT IO [((Int, Int), CompileInfo ())]
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> FilePath
-> [FilePath]
-> LoadedTests
-> CompileInfoT IO [((Int, Int), CompileInfo ())]
runModuleTests r
resolver b
backend FilePath
base [FilePath]
tp) [LoadedTests]
ts
let passed :: Int
passed = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (((Int, Int), CompileInfo ()) -> Int)
-> [((Int, Int), CompileInfo ())] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int)
-> (((Int, Int), CompileInfo ()) -> (Int, Int))
-> ((Int, Int), CompileInfo ())
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), CompileInfo ()) -> (Int, Int)
forall a b. (a, b) -> a
fst) [((Int, Int), CompileInfo ())]
allResults
let failed :: Int
failed = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (((Int, Int), CompileInfo ()) -> Int)
-> [((Int, Int), CompileInfo ())] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int)
-> (((Int, Int), CompileInfo ()) -> (Int, Int))
-> ((Int, Int), CompileInfo ())
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), CompileInfo ()) -> (Int, Int)
forall a b. (a, b) -> a
fst) [((Int, Int), CompileInfo ())]
allResults
Int -> Int -> CompileInfo () -> CompileInfoIO ()
forall (m :: * -> *) a a.
(Show a, Show a, MonadIO m) =>
a -> a -> CompileInfo () -> CompileInfoT m ()
processResults Int
passed Int
failed ((((Int, Int), CompileInfo ()) -> CompileInfo ())
-> [((Int, Int), CompileInfo ())] -> CompileInfo ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ ((Int, Int), CompileInfo ()) -> CompileInfo ()
forall a b. (a, b) -> b
snd [((Int, Int), CompileInfo ())]
allResults) where
compilerHash :: VersionHash
compilerHash = b -> VersionHash
forall b. CompilerBackend b => b -> VersionHash
getCompilerHash b
backend
preloadTests :: FilePath
-> (Map FilePath CompileMetadata, [LoadedTests])
-> FilePath
-> CompileInfoT IO (Map FilePath CompileMetadata, [LoadedTests])
preloadTests FilePath
base (Map FilePath CompileMetadata
ca,[LoadedTests]
ms) FilePath
d = do
CompileMetadata
m <- VersionHash
-> ForceMode
-> Map FilePath CompileMetadata
-> FilePath
-> CompileInfoIO CompileMetadata
loadModuleMetadata VersionHash
compilerHash ForceMode
f Map FilePath CompileMetadata
ca (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)
let ca2 :: Map FilePath CompileMetadata
ca2 = Map FilePath CompileMetadata
ca Map FilePath CompileMetadata
-> Map FilePath CompileMetadata -> Map FilePath CompileMetadata
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> Map FilePath CompileMetadata
mapMetadata [CompileMetadata
m]
ModuleConfig
rm <- FilePath -> CompileInfoIO ModuleConfig
loadRecompile (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)
[CompileMetadata]
deps0 <- VersionHash
-> ForceMode
-> Map FilePath CompileMetadata
-> [FilePath]
-> CompileInfoIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f Map FilePath CompileMetadata
ca2 [FilePath
base]
let ca3 :: Map FilePath CompileMetadata
ca3 = Map FilePath CompileMetadata
ca2 Map FilePath CompileMetadata
-> Map FilePath CompileMetadata -> Map FilePath CompileMetadata
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> Map FilePath CompileMetadata
mapMetadata [CompileMetadata]
deps0
[CompileMetadata]
deps1 <- VersionHash
-> ForceMode
-> Map FilePath CompileMetadata
-> CompileMetadata
-> CompileInfoIO [CompileMetadata]
loadTestingDeps VersionHash
compilerHash ForceMode
f Map FilePath CompileMetadata
ca3 CompileMetadata
m
let ca4 :: Map FilePath CompileMetadata
ca4 = Map FilePath CompileMetadata
ca3 Map FilePath CompileMetadata
-> Map FilePath CompileMetadata -> Map FilePath CompileMetadata
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> Map FilePath CompileMetadata
mapMetadata [CompileMetadata]
deps1
[CompileMetadata]
deps2 <- VersionHash
-> ForceMode
-> Map FilePath CompileMetadata
-> [CompileMetadata]
-> CompileInfoIO [CompileMetadata]
loadPrivateDeps VersionHash
compilerHash ForceMode
f Map FilePath CompileMetadata
ca4 ([CompileMetadata]
deps0[CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++[CompileMetadata
m][CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++[CompileMetadata]
deps1)
let ca5 :: Map FilePath CompileMetadata
ca5 = Map FilePath CompileMetadata
ca4 Map FilePath CompileMetadata
-> Map FilePath CompileMetadata -> Map FilePath CompileMetadata
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> Map FilePath CompileMetadata
mapMetadata [CompileMetadata]
deps2
ExprMap SourcePos
em <- FilePath -> ModuleConfig -> CompileInfoIO (ExprMap SourcePos)
getExprMap (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d) ModuleConfig
rm
(Map FilePath CompileMetadata, [LoadedTests])
-> CompileInfoT IO (Map FilePath CompileMetadata, [LoadedTests])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath CompileMetadata
ca5,[LoadedTests]
ms [LoadedTests] -> [LoadedTests] -> [LoadedTests]
forall a. [a] -> [a] -> [a]
++ [FilePath
-> FilePath
-> CompileMetadata
-> ExprMap SourcePos
-> [CompileMetadata]
-> [CompileMetadata]
-> LoadedTests
LoadedTests FilePath
p FilePath
d CompileMetadata
m ExprMap SourcePos
em ([CompileMetadata]
deps0[CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++[CompileMetadata]
deps1) [CompileMetadata]
deps2])
checkTestFilters :: [LoadedTests] -> m ()
checkTestFilters [LoadedTests]
ts = do
let possibleTests :: Set FilePath
possibleTests = [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList ([FilePath] -> Set FilePath) -> [FilePath] -> Set FilePath
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (LoadedTests -> [FilePath]) -> [LoadedTests] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (CompileMetadata -> [FilePath]
cmTestFiles (CompileMetadata -> [FilePath])
-> (LoadedTests -> CompileMetadata) -> LoadedTests -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedTests -> CompileMetadata
ltMetadata) [LoadedTests]
ts
case Set FilePath -> [FilePath]
forall a. Set a -> [a]
Set.toList (Set FilePath -> [FilePath]) -> Set FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
tp) Set FilePath -> Set FilePath -> Set FilePath
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set FilePath
possibleTests of
[] -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[FilePath]
fs -> FilePath -> m ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Some test files do not occur in the selected modules: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
fs) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
processResults :: a -> a -> CompileInfo () -> CompileInfoT m ()
processResults a
passed a
failed CompileInfo ()
rs
| CompileInfo () -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo ()
rs =
(CompileInfo () -> CompileInfoT m ()
forall (m :: * -> *) a.
Monad m =>
CompileInfo a -> CompileInfoT m a
fromCompileInfo CompileInfo ()
rs) CompileInfoT m () -> FilePath -> CompileInfoT m ()
forall (m :: * -> *) a. CompileErrorM m => m a -> FilePath -> m a
<!!
(FilePath
"\nPassed: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
passed FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" test(s), Failed: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
failed FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" test(s)")
| Bool
otherwise =
IO () -> CompileInfoT m ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoT m ()) -> IO () -> CompileInfoT m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\nPassed: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
passed FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" test(s), Failed: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
failed FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" test(s)"
runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [FilePath]
is [FilePath]
is2 [FilePath]
_ [ExtraSource]
_ [FilePath]
_ FilePath
p (CompileFast CategoryName
c FunctionName
fn FilePath
f2) ForceMode
f) = do
FilePath
dir <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
mkdtemp FilePath
"/tmp/zfast_"
FilePath
absolute <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
FilePath
f2' <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
f2)
let rm :: ModuleConfig
rm = ModuleConfig :: FilePath
-> FilePath
-> [(FilePath, Expression SourcePos)]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ModuleConfig
ModuleConfig {
mcRoot :: FilePath
mcRoot = FilePath
"",
mcPath :: FilePath
mcPath = FilePath
".",
mcExprMap :: [(FilePath, Expression SourcePos)]
mcExprMap = [],
mcPublicDeps :: [FilePath]
mcPublicDeps = [],
mcPrivateDeps :: [FilePath]
mcPrivateDeps = [],
mcExtraFiles :: [ExtraSource]
mcExtraFiles = [],
mcExtraPaths :: [FilePath]
mcExtraPaths = [],
mcMode :: CompileMode
mcMode = CompileMode
CompileUnspecified
}
ExprMap SourcePos
em <- FilePath -> ModuleConfig -> CompileInfoIO (ExprMap SourcePos)
getExprMap FilePath
p ModuleConfig
rm
let spec :: ModuleSpec
spec = ModuleSpec :: FilePath
-> FilePath
-> ExprMap SourcePos
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ForceMode
-> ModuleSpec
ModuleSpec {
msRoot :: FilePath
msRoot = FilePath
absolute,
msPath :: FilePath
msPath = FilePath
dir,
msExprMap :: ExprMap SourcePos
msExprMap = ExprMap SourcePos
em,
msPublicDeps :: [FilePath]
msPublicDeps = [FilePath]
is,
msPrivateDeps :: [FilePath]
msPrivateDeps = [FilePath]
is2,
msPublicFiles :: [FilePath]
msPublicFiles = [],
msPrivateFiles :: [FilePath]
msPrivateFiles = [FilePath
f2'],
msTestFiles :: [FilePath]
msTestFiles = [],
msExtraFiles :: [ExtraSource]
msExtraFiles = [],
msExtraPaths :: [FilePath]
msExtraPaths = [],
msMode :: CompileMode
msMode = (CategoryName
-> FunctionName -> FilePath -> [FilePath] -> CompileMode
CompileBinary CategoryName
c FunctionName
fn (FilePath
absolute FilePath -> FilePath -> FilePath
</> CategoryName -> FilePath
forall a. Show a => a -> FilePath
show CategoryName
c) []),
msForce :: ForceMode
msForce = ForceMode
f
}
r -> b -> ModuleSpec -> CompileInfoIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> ModuleSpec -> CompileInfoIO ()
compileModule r
resolver b
backend ModuleSpec
spec CompileInfoIO () -> FilePath -> CompileInfoIO ()
forall (m :: * -> *) a. CompileErrorM m => m a -> FilePath -> m a
<?? (FilePath
"In compilation of \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f2' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"")
IO () -> CompileInfoIO ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoIO ()) -> IO () -> CompileInfoIO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
dir
runCompiler r
resolver b
backend (CompileOptions HelpMode
h [FilePath]
_ [FilePath]
_ [FilePath]
ds [ExtraSource]
_ [FilePath]
_ FilePath
p CompileMode
CompileRecompileRecursive ForceMode
f) = do
(Set FilePath -> FilePath -> CompileInfoT IO (Set FilePath))
-> Set FilePath -> [FilePath] -> CompileInfoT IO (Set FilePath)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (r -> Set FilePath -> FilePath -> CompileInfoT IO (Set FilePath)
forall t.
PathIOHandler t =>
t -> Set FilePath -> FilePath -> CompileInfoT IO (Set FilePath)
recursive r
resolver) Set FilePath
forall a. Set a
Set.empty [FilePath]
ds CompileInfoT IO (Set FilePath)
-> CompileInfoIO () -> CompileInfoIO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> CompileInfoIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () where
recursive :: t -> Set FilePath -> FilePath -> CompileInfoT IO (Set FilePath)
recursive t
r Set FilePath
da FilePath
d0 = do
Bool
isSystem <- t -> FilePath -> FilePath -> CompileInfoT IO Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> FilePath -> m Bool
isSystemModule t
r FilePath
p FilePath
d0
if Bool
isSystem
then do
FilePath -> CompileInfoIO ()
forall (m :: * -> *). CompileErrorM m => FilePath -> m ()
compileWarningM (FilePath -> CompileInfoIO ()) -> FilePath -> CompileInfoIO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Skipping system module " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d0 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
Set FilePath -> CompileInfoT IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Set FilePath
da
else do
FilePath
d <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d0)
ModuleConfig
rm <- FilePath -> CompileInfoIO ModuleConfig
loadRecompile FilePath
d
if ModuleConfig -> FilePath
mcPath ModuleConfig
rm FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
da
then Set FilePath -> CompileInfoT IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Set FilePath
da
else do
let ds3 :: [FilePath]
ds3 = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
d2 -> FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
d2) (ModuleConfig -> [FilePath]
mcPublicDeps ModuleConfig
rm [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ModuleConfig -> [FilePath]
mcPrivateDeps ModuleConfig
rm)
Set FilePath
da' <- (Set FilePath -> FilePath -> CompileInfoT IO (Set FilePath))
-> Set FilePath -> [FilePath] -> CompileInfoT IO (Set FilePath)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (t -> Set FilePath -> FilePath -> CompileInfoT IO (Set FilePath)
recursive t
r) (ModuleConfig -> FilePath
mcPath ModuleConfig
rm FilePath -> Set FilePath -> Set FilePath
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set FilePath
da) [FilePath]
ds3
r -> b -> CompileOptions -> CompileInfoIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> CompileOptions -> CompileInfoIO ()
runCompiler r
resolver b
backend (HelpMode
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> FilePath
-> CompileMode
-> ForceMode
-> CompileOptions
CompileOptions HelpMode
h [] [] [FilePath
d] [] [] FilePath
p CompileMode
CompileRecompile ForceMode
f)
Set FilePath -> CompileInfoT IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Set FilePath
da'
runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [FilePath]
_ [FilePath]
_ [FilePath]
ds [ExtraSource]
_ [FilePath]
_ FilePath
p CompileMode
CompileRecompile ForceMode
f) = do
(FilePath -> CompileInfoIO ()) -> [FilePath] -> CompileInfoIO ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ FilePath -> CompileInfoIO ()
recompileSingle [FilePath]
ds where
compilerHash :: VersionHash
compilerHash = b -> VersionHash
forall b. CompilerBackend b => b -> VersionHash
getCompilerHash b
backend
recompileSingle :: FilePath -> CompileInfoIO ()
recompileSingle FilePath
d0 = do
FilePath
d <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d0)
Bool
upToDate <- VersionHash -> ForceMode -> FilePath -> CompileInfoT IO Bool
isPathUpToDate VersionHash
compilerHash ForceMode
f FilePath
d
if ForceMode
f ForceMode -> ForceMode -> Bool
forall a. Ord a => a -> a -> Bool
< ForceMode
ForceAll Bool -> Bool -> Bool
&& Bool
upToDate
then FilePath -> CompileInfoIO ()
forall (m :: * -> *). CompileErrorM m => FilePath -> m ()
compileWarningM (FilePath -> CompileInfoIO ()) -> FilePath -> CompileInfoIO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Path " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d0 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is up to date"
else do
rm :: ModuleConfig
rm@(ModuleConfig FilePath
p2 FilePath
d2 [(FilePath, Expression SourcePos)]
_ [FilePath]
is [FilePath]
is2 [ExtraSource]
es [FilePath]
ep CompileMode
m) <- FilePath -> CompileInfoIO ModuleConfig
loadRecompile FilePath
d
FilePath
absolute <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d0)
let fixed :: FilePath
fixed = FilePath -> FilePath
fixPath (FilePath
absolute FilePath -> FilePath -> FilePath
</> FilePath
p2)
([FilePath]
ps,[FilePath]
xs,[FilePath]
ts) <- FilePath
-> FilePath -> CompileInfoIO ([FilePath], [FilePath], [FilePath])
findSourceFiles FilePath
fixed FilePath
d2
ExprMap SourcePos
em <- FilePath -> ModuleConfig -> CompileInfoIO (ExprMap SourcePos)
getExprMap (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d0) ModuleConfig
rm
let spec :: ModuleSpec
spec = ModuleSpec :: FilePath
-> FilePath
-> ExprMap SourcePos
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ForceMode
-> ModuleSpec
ModuleSpec {
msRoot :: FilePath
msRoot = FilePath
fixed,
msPath :: FilePath
msPath = FilePath
d2,
msExprMap :: ExprMap SourcePos
msExprMap = ExprMap SourcePos
em,
msPublicDeps :: [FilePath]
msPublicDeps = [FilePath]
is,
msPrivateDeps :: [FilePath]
msPrivateDeps = [FilePath]
is2,
msPublicFiles :: [FilePath]
msPublicFiles = [FilePath]
ps,
msPrivateFiles :: [FilePath]
msPrivateFiles = [FilePath]
xs,
msTestFiles :: [FilePath]
msTestFiles = [FilePath]
ts,
msExtraFiles :: [ExtraSource]
msExtraFiles = [ExtraSource]
es,
msExtraPaths :: [FilePath]
msExtraPaths = [FilePath]
ep,
msMode :: CompileMode
msMode = CompileMode
m,
msForce :: ForceMode
msForce = ForceMode
f
}
r -> b -> ModuleSpec -> CompileInfoIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> ModuleSpec -> CompileInfoIO ()
compileModule r
resolver b
backend ModuleSpec
spec CompileInfoIO () -> FilePath -> CompileInfoIO ()
forall (m :: * -> *) a. CompileErrorM m => m a -> FilePath -> m a
<?? (FilePath
"In compilation of module \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"")
runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [FilePath]
is [FilePath]
is2 [FilePath]
ds [ExtraSource]
_ [FilePath]
_ FilePath
p CompileMode
CreateTemplates ForceMode
f) = (FilePath -> CompileInfoIO ()) -> [FilePath] -> CompileInfoIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> CompileInfoIO ()
compileSingle [FilePath]
ds where
compilerHash :: VersionHash
compilerHash = b -> VersionHash
forall b. CompilerBackend b => b -> VersionHash
getCompilerHash b
backend
compileSingle :: FilePath -> CompileInfoIO ()
compileSingle FilePath
d = do
FilePath
d' <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)
FilePath
base <- r -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> m FilePath
resolveBaseModule r
resolver
[FilePath]
as <- ([FilePath] -> [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> CompileInfoT IO FilePath)
-> [FilePath] -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (r -> FilePath -> FilePath -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
d') [FilePath]
is
[FilePath]
as2 <- ([FilePath] -> [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> CompileInfoT IO FilePath)
-> [FilePath] -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (r -> FilePath -> FilePath -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
d') [FilePath]
is2
[CompileMetadata]
deps1 <- VersionHash
-> ForceMode
-> Map FilePath CompileMetadata
-> [FilePath]
-> CompileInfoIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f Map FilePath CompileMetadata
forall k a. Map k a
Map.empty (FilePath
baseFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
as)
[CompileMetadata]
deps2 <- VersionHash
-> ForceMode
-> Map FilePath CompileMetadata
-> [FilePath]
-> CompileInfoIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f ([CompileMetadata] -> Map FilePath CompileMetadata
mapMetadata [CompileMetadata]
deps1) [FilePath]
as2
FilePath
path <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
r
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO ()
forall r.
PathIOHandler r =>
r
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO ()
createModuleTemplates r
resolver FilePath
path FilePath
d [CompileMetadata]
deps1 [CompileMetadata]
deps2 CompileInfoIO () -> FilePath -> CompileInfoIO ()
forall (m :: * -> *) a. CompileErrorM m => m a -> FilePath -> m a
<?? (FilePath
"In module \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"")
runCompiler r
resolver b
backend (CompileOptions HelpMode
h [FilePath]
is [FilePath]
is2 [FilePath]
ds [ExtraSource]
es [FilePath]
ep FilePath
p CompileMode
m ForceMode
f) = (FilePath -> CompileInfoIO ()) -> [FilePath] -> CompileInfoIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> CompileInfoIO ()
compileSingle [FilePath]
ds where
compileSingle :: FilePath -> CompileInfoIO ()
compileSingle FilePath
d = do
[FilePath]
as <- ([FilePath] -> [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> CompileInfoT IO FilePath)
-> [FilePath] -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (r -> FilePath -> FilePath -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)) [FilePath]
is
[FilePath]
as2 <- ([FilePath] -> [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> CompileInfoT IO FilePath)
-> [FilePath] -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (r -> FilePath -> FilePath -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)) [FilePath]
is2
Bool
isConfigured <- FilePath -> FilePath -> CompileInfoT IO Bool
isPathConfigured FilePath
p FilePath
d
Bool -> CompileInfoIO () -> CompileInfoIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isConfigured Bool -> Bool -> Bool
&& ForceMode
f ForceMode -> ForceMode -> Bool
forall a. Eq a => a -> a -> Bool
== ForceMode
DoNotForce) (CompileInfoIO () -> CompileInfoIO ())
-> CompileInfoIO () -> CompileInfoIO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> CompileInfoIO ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> CompileInfoIO ()) -> FilePath -> CompileInfoIO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Module " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" has an existing configuration. " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
"Recompile with -r or use -f to overwrite the config."
FilePath
absolute <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
let rm :: ModuleConfig
rm = ModuleConfig :: FilePath
-> FilePath
-> [(FilePath, Expression SourcePos)]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ModuleConfig
ModuleConfig {
mcRoot :: FilePath
mcRoot = FilePath
absolute,
mcPath :: FilePath
mcPath = FilePath
d,
mcExprMap :: [(FilePath, Expression SourcePos)]
mcExprMap = [],
mcPublicDeps :: [FilePath]
mcPublicDeps = [FilePath]
as,
mcPrivateDeps :: [FilePath]
mcPrivateDeps = [FilePath]
as2,
mcExtraFiles :: [ExtraSource]
mcExtraFiles = [ExtraSource]
es,
mcExtraPaths :: [FilePath]
mcExtraPaths = [FilePath]
ep,
mcMode :: CompileMode
mcMode = CompileMode
m
}
FilePath -> ModuleConfig -> CompileInfoIO ()
writeRecompile (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d) ModuleConfig
rm
r -> b -> CompileOptions -> CompileInfoIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> CompileOptions -> CompileInfoIO ()
runCompiler r
resolver b
backend (HelpMode
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> FilePath
-> CompileMode
-> ForceMode
-> CompileOptions
CompileOptions HelpMode
h [] [] [FilePath
d] [] [] FilePath
p CompileMode
CompileRecompile ForceMode
DoNotForce)