{- -----------------------------------------------------------------------------
Copyright 2020 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

module Cli.RunCompiler (
  runCompiler,
) where

import Control.Monad (foldM,when)
import Data.List (intercalate,nub)
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.CompilerError
import Base.TrackedErrors
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 -> TrackedErrorsIO ()
runCompiler :: r -> b -> CompileOptions -> TrackedErrorsIO ()
runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [FilePath]
_ [FilePath]
_ [FilePath]
ds [ExtraSource]
_ [FilePath]
_ FilePath
p (ExecuteTests [FilePath]
tp) ForceMode
f) = do
  FilePath
base <- r -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
resolveBaseModule r
resolver
  [LoadedTests]
ts <- ((Map FilePath CompileMetadata, [LoadedTests]) -> [LoadedTests])
-> TrackedErrorsT IO (Map FilePath CompileMetadata, [LoadedTests])
-> TrackedErrorsT 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 (TrackedErrorsT IO (Map FilePath CompileMetadata, [LoadedTests])
 -> TrackedErrorsT IO [LoadedTests])
-> TrackedErrorsT IO (Map FilePath CompileMetadata, [LoadedTests])
-> TrackedErrorsT IO [LoadedTests]
forall a b. (a -> b) -> a -> b
$ ((Map FilePath CompileMetadata, [LoadedTests])
 -> FilePath
 -> TrackedErrorsT IO (Map FilePath CompileMetadata, [LoadedTests]))
-> (Map FilePath CompileMetadata, [LoadedTests])
-> [FilePath]
-> TrackedErrorsT 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
-> TrackedErrorsT IO (Map FilePath CompileMetadata, [LoadedTests])
preloadTests FilePath
base) (Map FilePath CompileMetadata
forall k a. Map k a
Map.empty,[]) [FilePath]
ds
  [LoadedTests] -> TrackedErrorsIO ()
forall (m :: * -> *). ErrorContextM m => [LoadedTests] -> m ()
checkTestFilters [LoadedTests]
ts
  [((Int, Int), TrackedErrors ())]
allResults <- ([[((Int, Int), TrackedErrors ())]]
 -> [((Int, Int), TrackedErrors ())])
-> TrackedErrorsT IO [[((Int, Int), TrackedErrors ())]]
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[((Int, Int), TrackedErrors ())]]
-> [((Int, Int), TrackedErrors ())]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (TrackedErrorsT IO [[((Int, Int), TrackedErrors ())]]
 -> TrackedErrorsT IO [((Int, Int), TrackedErrors ())])
-> TrackedErrorsT IO [[((Int, Int), TrackedErrors ())]]
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
forall a b. (a -> b) -> a -> b
$ (LoadedTests -> TrackedErrorsT IO [((Int, Int), TrackedErrors ())])
-> [LoadedTests]
-> TrackedErrorsT IO [[((Int, Int), TrackedErrors ())]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r
-> b
-> FilePath
-> [FilePath]
-> LoadedTests
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> FilePath
-> [FilePath]
-> LoadedTests
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
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), TrackedErrors ()) -> Int)
-> [((Int, Int), TrackedErrors ())] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int)
-> (((Int, Int), TrackedErrors ()) -> (Int, Int))
-> ((Int, Int), TrackedErrors ())
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), TrackedErrors ()) -> (Int, Int)
forall a b. (a, b) -> a
fst) [((Int, Int), TrackedErrors ())]
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), TrackedErrors ()) -> Int)
-> [((Int, Int), TrackedErrors ())] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int)
-> (((Int, Int), TrackedErrors ()) -> (Int, Int))
-> ((Int, Int), TrackedErrors ())
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), TrackedErrors ()) -> (Int, Int)
forall a b. (a, b) -> a
fst) [((Int, Int), TrackedErrors ())]
allResults
  Int -> Int -> TrackedErrors () -> TrackedErrorsIO ()
forall (m :: * -> *) a a.
(Show a, Show a, MonadIO m) =>
a -> a -> TrackedErrors () -> TrackedErrorsT m ()
processResults Int
passed Int
failed ((((Int, Int), TrackedErrors ()) -> TrackedErrors ())
-> [((Int, Int), TrackedErrors ())] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ ((Int, Int), TrackedErrors ()) -> TrackedErrors ()
forall a b. (a, b) -> b
snd [((Int, Int), TrackedErrors ())]
allResults) where
    compilerHash :: VersionHash
compilerHash = b -> VersionHash
forall b. CompilerBackend b => b -> VersionHash
getCompilerHash b
backend
    preloadTests :: FilePath
-> (Map FilePath CompileMetadata, [LoadedTests])
-> FilePath
-> TrackedErrorsT 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
-> TrackedErrorsIO 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 -> TrackedErrorsIO ModuleConfig
loadRecompile (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)
      [CompileMetadata]
deps0 <- VersionHash
-> ForceMode
-> Map FilePath CompileMetadata
-> [FilePath]
-> TrackedErrorsIO [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
-> TrackedErrorsIO [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]
-> TrackedErrorsIO [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 SourceContext
em <- FilePath -> ModuleConfig -> TrackedErrorsIO (ExprMap SourceContext)
getExprMap (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d) ModuleConfig
rm
      (Map FilePath CompileMetadata, [LoadedTests])
-> TrackedErrorsT 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 SourceContext
-> [CompileMetadata]
-> [CompileMetadata]
-> LoadedTests
LoadedTests FilePath
p FilePath
d CompileMetadata
m ExprMap SourceContext
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. ErrorContextM m => FilePath -> m a
compilerErrorM (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 -> TrackedErrors () -> TrackedErrorsT m ()
processResults a
passed a
failed TrackedErrors ()
rs
      | TrackedErrors () -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors ()
rs =
        (TrackedErrors () -> TrackedErrorsT m ()
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors TrackedErrors ()
rs) TrackedErrorsT m () -> FilePath -> TrackedErrorsT m ()
forall (m :: * -> *) a. ErrorContextM 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 () -> TrackedErrorsT m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> TrackedErrorsT m ()) -> IO () -> TrackedErrorsT 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 -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
mkdtemp FilePath
"/tmp/zfast_"
  FilePath
absolute <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
  FilePath
f2' <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT 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
-> [(MacroName, Expression SourceContext)]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ModuleConfig
ModuleConfig {
    mcRoot :: FilePath
mcRoot = FilePath
"",
    mcPath :: FilePath
mcPath = FilePath
".",
    mcExprMap :: [(MacroName, Expression SourceContext)]
mcExprMap = [],
    mcPublicDeps :: [FilePath]
mcPublicDeps = [],
    mcPrivateDeps :: [FilePath]
mcPrivateDeps = [],
    mcExtraFiles :: [ExtraSource]
mcExtraFiles = [],
    mcExtraPaths :: [FilePath]
mcExtraPaths = [],
    mcMode :: CompileMode
mcMode = CompileMode
CompileUnspecified
  }
  ExprMap SourceContext
em <- FilePath -> ModuleConfig -> TrackedErrorsIO (ExprMap SourceContext)
getExprMap FilePath
p ModuleConfig
rm
  let spec :: ModuleSpec
spec = ModuleSpec :: FilePath
-> FilePath
-> ExprMap SourceContext
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ForceMode
-> ModuleSpec
ModuleSpec {
    msRoot :: FilePath
msRoot = FilePath
absolute,
    msPath :: FilePath
msPath = FilePath
dir,
    msExprMap :: ExprMap SourceContext
msExprMap = ExprMap SourceContext
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 -> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> ModuleSpec -> TrackedErrorsIO ()
compileModule r
resolver b
backend ModuleSpec
spec TrackedErrorsIO () -> FilePath -> TrackedErrorsIO ()
forall (m :: * -> *) a. ErrorContextM 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 () -> TrackedErrorsIO ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> TrackedErrorsIO ()) -> IO () -> TrackedErrorsIO ()
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, FilePath) -> TrackedErrorsT IO (Set FilePath))
-> Set FilePath
-> [(FilePath, FilePath)]
-> TrackedErrorsT 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, FilePath)
-> TrackedErrorsT IO (Set FilePath)
forall t.
PathIOHandler t =>
t
-> Set FilePath
-> (FilePath, FilePath)
-> TrackedErrorsT IO (Set FilePath)
recursive r
resolver) Set FilePath
forall a. Set a
Set.empty ((FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) FilePath
p) [FilePath]
ds) TrackedErrorsT IO (Set FilePath)
-> TrackedErrorsIO () -> TrackedErrorsIO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TrackedErrorsIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () where
    recursive :: t
-> Set FilePath
-> (FilePath, FilePath)
-> TrackedErrorsT IO (Set FilePath)
recursive t
r Set FilePath
da (FilePath
p2,FilePath
d0) = do
      Bool
isSystem <- t -> FilePath -> FilePath -> TrackedErrorsT IO Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m Bool
isSystemModule t
r FilePath
p2 FilePath
d0
      if Bool
isSystem
         then Set FilePath -> TrackedErrorsT IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Set FilePath
da
         else do
           FilePath
d <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p2 FilePath -> FilePath -> FilePath
</> FilePath
d0)
           ModuleConfig
rm <- FilePath -> TrackedErrorsIO 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 -> TrackedErrorsT IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Set FilePath
da
               else do
                 let ds3 :: [(FilePath, FilePath)]
ds3 = (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) FilePath
d) (ModuleConfig -> [FilePath]
mcPublicDeps ModuleConfig
rm [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ModuleConfig -> [FilePath]
mcPrivateDeps ModuleConfig
rm)
                 Set FilePath
da' <- (Set FilePath
 -> (FilePath, FilePath) -> TrackedErrorsT IO (Set FilePath))
-> Set FilePath
-> [(FilePath, FilePath)]
-> TrackedErrorsT 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, FilePath)
-> TrackedErrorsT 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, FilePath)]
ds3
                 r -> b -> CompileOptions -> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> CompileOptions -> TrackedErrorsIO ()
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 -> TrackedErrorsT 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 -> TrackedErrorsIO ())
-> [FilePath] -> TrackedErrorsIO ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ FilePath -> TrackedErrorsIO ()
recompileSingle [FilePath]
ds where
    compilerHash :: VersionHash
compilerHash = b -> VersionHash
forall b. CompilerBackend b => b -> VersionHash
getCompilerHash b
backend
    recompileSingle :: FilePath -> TrackedErrorsIO ()
recompileSingle FilePath
d0 = do
      FilePath
d <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT 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 -> TrackedErrorsT 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 -> TrackedErrorsIO ()
forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
compilerWarningM (FilePath -> TrackedErrorsIO ()) -> FilePath -> TrackedErrorsIO ()
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 [(MacroName, Expression SourceContext)]
_ [FilePath]
is [FilePath]
is2 [ExtraSource]
es [FilePath]
ep CompileMode
m) <- FilePath -> TrackedErrorsIO ModuleConfig
loadRecompile FilePath
d
           -- In case the module is manually configured with a p such as "..",
           -- since the absolute path might not be known ahead of time.
           FilePath
absolute <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT 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 -> TrackedErrorsIO ([FilePath], [FilePath], [FilePath])
findSourceFiles FilePath
fixed FilePath
d2
           ExprMap SourceContext
em <- FilePath -> ModuleConfig -> TrackedErrorsIO (ExprMap SourceContext)
getExprMap (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d0) ModuleConfig
rm
           let spec :: ModuleSpec
spec = ModuleSpec :: FilePath
-> FilePath
-> ExprMap SourceContext
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ForceMode
-> ModuleSpec
ModuleSpec {
             msRoot :: FilePath
msRoot = FilePath
fixed,
             msPath :: FilePath
msPath = FilePath
d2,
             msExprMap :: ExprMap SourceContext
msExprMap = ExprMap SourceContext
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 -> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> ModuleSpec -> TrackedErrorsIO ()
compileModule r
resolver b
backend ModuleSpec
spec TrackedErrorsIO () -> FilePath -> TrackedErrorsIO ()
forall (m :: * -> *) a. ErrorContextM 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 -> TrackedErrorsIO ())
-> [FilePath] -> TrackedErrorsIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> TrackedErrorsIO ()
compileSingle [FilePath]
ds where
  compilerHash :: VersionHash
compilerHash = b -> VersionHash
forall b. CompilerBackend b => b -> VersionHash
getCompilerHash b
backend
  compileSingle :: FilePath -> TrackedErrorsIO ()
compileSingle FilePath
d = do
    FilePath
d' <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)
    ([FilePath]
is',[FilePath]
is2') <- FilePath -> TrackedErrorsT IO ([FilePath], [FilePath])
maybeUseConfig FilePath
d'
    FilePath
base <- r -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
resolveBaseModule r
resolver
    [FilePath]
as  <- ([FilePath] -> [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
d') [FilePath]
is'
    [FilePath]
as2 <- ([FilePath] -> [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
d') [FilePath]
is2'
    [CompileMetadata]
deps1 <- VersionHash
-> ForceMode
-> Map FilePath CompileMetadata
-> [FilePath]
-> TrackedErrorsIO [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]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f ([CompileMetadata] -> Map FilePath CompileMetadata
mapMetadata [CompileMetadata]
deps1) [FilePath]
as2
    FilePath
path <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
    r
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO ()
forall r.
PathIOHandler r =>
r
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO ()
createModuleTemplates r
resolver FilePath
path FilePath
d [CompileMetadata]
deps1 [CompileMetadata]
deps2 TrackedErrorsIO () -> FilePath -> TrackedErrorsIO ()
forall (m :: * -> *) a. ErrorContextM 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
"\""
  maybeUseConfig :: FilePath -> TrackedErrorsT IO ([FilePath], [FilePath])
maybeUseConfig FilePath
d2 = do
    let rm :: TrackedErrorsIO ModuleConfig
rm = FilePath -> TrackedErrorsIO ModuleConfig
loadRecompile FilePath
d2
    Bool
isError <- TrackedErrorsIO ModuleConfig -> TrackedErrorsT IO Bool
forall (m :: * -> *) a. CollectErrorsM m => m a -> m Bool
isCompilerErrorM TrackedErrorsIO ModuleConfig
rm
    if Bool
isError
       then ([FilePath], [FilePath])
-> TrackedErrorsT IO ([FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
is,[FilePath]
is2)
       else do
         (ModuleConfig FilePath
_ FilePath
_ [(MacroName, Expression SourceContext)]
_ [FilePath]
is3 [FilePath]
is4 [ExtraSource]
_ [FilePath]
_ CompileMode
_) <- TrackedErrorsIO ModuleConfig
rm
         ([FilePath], [FilePath])
-> TrackedErrorsT IO ([FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
is [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
is3,[FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
is2 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
is4)

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 -> TrackedErrorsIO ())
-> [FilePath] -> TrackedErrorsIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> TrackedErrorsIO ()
compileSingle [FilePath]
ds where
  compileSingle :: FilePath -> TrackedErrorsIO ()
compileSingle FilePath
d = do
    [FilePath]
as  <- ([FilePath] -> [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)) [FilePath]
is
    [FilePath]
as2 <- ([FilePath] -> [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)) [FilePath]
is2
    Bool
isConfigured <- FilePath -> FilePath -> TrackedErrorsT IO Bool
isPathConfigured FilePath
p FilePath
d
    Bool -> TrackedErrorsIO () -> TrackedErrorsIO ()
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) (TrackedErrorsIO () -> TrackedErrorsIO ())
-> TrackedErrorsIO () -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> TrackedErrorsIO ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> TrackedErrorsIO ()) -> FilePath -> TrackedErrorsIO ()
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 -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
    let rm :: ModuleConfig
rm = ModuleConfig :: FilePath
-> FilePath
-> [(MacroName, Expression SourceContext)]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ModuleConfig
ModuleConfig {
      mcRoot :: FilePath
mcRoot = FilePath
absolute,
      mcPath :: FilePath
mcPath = FilePath
d,
      mcExprMap :: [(MacroName, Expression SourceContext)]
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 -> TrackedErrorsIO ()
writeRecompile (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d) ModuleConfig
rm
    r -> b -> CompileOptions -> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> CompileOptions -> TrackedErrorsIO ()
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)