{- -----------------------------------------------------------------------------
Copyright 2020-2021 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 (
  TraceEntry(..),
  parseTracesFile,
  runCompiler,
) where

import Control.Monad (foldM,when)
import Data.List (intercalate,isSuffixOf,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
import Parser.Common
import Parser.TextParser


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 Maybe FilePath
cl) 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 (Map FilePath CompileMetadata, [LoadedTests])
-> FilePath
-> TrackedErrorsT IO (Map FilePath CompileMetadata, [LoadedTests])
preloadTests (Map FilePath CompileMetadata
forall k a. Map k a
Map.empty,[]) [FilePath]
ds
  [LoadedTests] -> TrackedErrorsIO ()
forall (m :: * -> *). ErrorContextM m => [LoadedTests] -> m ()
checkTestFilters [LoadedTests]
ts
  FilePath
cl2 <- Maybe FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
Maybe FilePath -> m FilePath
prepareCallLog Maybe FilePath
cl
  [((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
-> [FilePath]
-> LoadedTests
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> FilePath
-> FilePath
-> [FilePath]
-> LoadedTests
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
runModuleTests r
resolver b
backend FilePath
cl2 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
    prepareCallLog :: Maybe FilePath -> m FilePath
prepareCallLog (Just FilePath
cl2) = do
      FilePath
clFull <- IO FilePath -> m FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
cl2)
      FilePath -> m ()
forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
compilerWarningM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Logging calls to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
clFull
      IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
clFull (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]
tracesLogHeader) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")
      FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
clFull
    prepareCallLog Maybe FilePath
_ = FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
    preloadTests :: (Map FilePath CompileMetadata, [LoadedTests])
-> FilePath
-> TrackedErrorsT IO (Map FilePath CompileMetadata, [LoadedTests])
preloadTests (Map FilePath CompileMetadata
ca,[LoadedTests]
ms) FilePath
d = do
      VersionHash
compilerHash <- b -> TrackedErrorsT IO VersionHash
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
getCompilerHash b
backend
      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)
      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]
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
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]
++ [CompileMetadata
-> ExprMap SourceContext
-> [CompileMetadata]
-> [CompileMetadata]
-> LoadedTests
LoadedTests CompileMetadata
m ExprMap SourceContext
em ([CompileMetadata]
deps1) [CompileMetadata]
deps2])
    checkTestFilters :: [LoadedTests] -> m ()
checkTestFilters [LoadedTests]
ts = do
      let possibleTests :: [FilePath]
possibleTests = [[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
      let remaining :: [FilePath]
remaining = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((FilePath -> Bool) -> Bool) -> [FilePath -> Bool] -> Bool)
-> [FilePath -> Bool] -> ((FilePath -> Bool) -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((FilePath -> Bool) -> Bool) -> [FilePath -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((FilePath -> FilePath -> Bool) -> [FilePath] -> [FilePath -> Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf) [FilePath]
possibleTests)(((FilePath -> Bool) -> Bool) -> Bool)
-> (FilePath -> (FilePath -> Bool) -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath -> Bool) -> FilePath -> Bool)
-> FilePath -> (FilePath -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
($)) [FilePath]
tp
      case [FilePath]
remaining 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
-> [FilePath]
-> [(MacroName, Expression SourceContext)]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ModuleConfig
ModuleConfig {
    mcRoot :: FilePath
mcRoot = FilePath
"",
    mcPath :: FilePath
mcPath = FilePath
".",
    mcExtra :: [FilePath]
mcExtra = [],
    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
-> [FilePath]
-> ExprMap SourceContext
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ForceMode
-> ModuleSpec
ModuleSpec {
    msRoot :: FilePath
msRoot = FilePath
absolute,
    msPath :: FilePath
msPath = FilePath
dir,
    msExtra :: [FilePath]
msExtra = [],
    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
-> LinkerMode
-> FilePath
-> [FilePath]
-> CompileMode
CompileBinary CategoryName
c FunctionName
fn LinkerMode
LinkStatic (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
_ [FilePath]
_ [FilePath]
_ [FilePath]
ds [ExtraSource]
_ [FilePath]
_ FilePath
p CompileMode
CompileRecompileRecursive ForceMode
f) =
  r
-> b
-> ForceMode
-> Bool
-> FilePath
-> [FilePath]
-> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> ForceMode
-> Bool
-> FilePath
-> [FilePath]
-> TrackedErrorsIO ()
runRecompileCommon r
resolver b
backend ForceMode
f Bool
True FilePath
p [FilePath]
ds

runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [FilePath]
_ [FilePath]
_ [FilePath]
ds [ExtraSource]
_ [FilePath]
_ FilePath
p CompileMode
CompileRecompile ForceMode
f) =
  r
-> b
-> ForceMode
-> Bool
-> FilePath
-> [FilePath]
-> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> ForceMode
-> Bool
-> FilePath
-> [FilePath]
-> TrackedErrorsIO ()
runRecompileCommon r
resolver b
backend ForceMode
f Bool
False FilePath
p [FilePath]
ds

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
  compileSingle :: FilePath -> TrackedErrorsIO ()
compileSingle FilePath
d = do
    VersionHash
compilerHash <- b -> TrackedErrorsT IO VersionHash
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
getCompilerHash b
backend
    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]
ep,[FilePath]
is',[FilePath]
is2') <- FilePath -> TrackedErrorsT IO ([FilePath], [FilePath], [FilePath])
maybeUseConfig FilePath
d'
    [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'
    Bool
isBase <- r -> FilePath -> TrackedErrorsT IO Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> m Bool
isBaseModule r
resolver FilePath
d'
    [CompileMetadata]
deps1 <- if Bool
isBase
                then 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]
as
                else do
                  FilePath
base <- r -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
resolveBaseModule r
resolver
                  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
-> [FilePath]
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO ()
forall r.
PathIOHandler r =>
r
-> FilePath
-> FilePath
-> [FilePath]
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO ()
createModuleTemplates r
resolver FilePath
path FilePath
d [FilePath]
ep [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], [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], [FilePath])
-> TrackedErrorsT IO ([FilePath], [FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[FilePath]
is,[FilePath]
is2)
       else do
         (ModuleConfig FilePath
p2 FilePath
_ [FilePath]
ep [(MacroName, Expression SourceContext)]
_ [FilePath]
is3 [FilePath]
is4 [ExtraSource]
_ [FilePath]
_ CompileMode
_) <- TrackedErrorsIO ModuleConfig
rm
         ([FilePath], [FilePath], [FilePath])
-> TrackedErrorsT IO ([FilePath], [FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
p2 FilePath -> FilePath -> FilePath
</>) [FilePath]
ep,[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
_ (CompileOptions HelpMode
_ [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 (FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
FilePath -> FilePath -> m FilePath
autoDep (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 (FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
FilePath -> FilePath -> m FilePath
autoDep (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
-> [FilePath]
-> [(MacroName, Expression SourceContext)]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ModuleConfig
ModuleConfig {
      mcRoot :: FilePath
mcRoot = FilePath
absolute,
      mcPath :: FilePath
mcPath = FilePath
d,
      mcExtra :: [FilePath]
mcExtra = [],
      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
    FilePath
config <- FilePath -> TrackedErrorsT IO FilePath
getRecompilePath (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
d)
    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
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"*** Setup complete. Please edit " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
config FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" and recompile with zeolite -r. ***"
  autoDep :: FilePath -> FilePath -> m FilePath
autoDep FilePath
p2 FilePath
i = do
    Bool
isSystem <- r -> FilePath -> FilePath -> m Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m Bool
isSystemModule r
resolver FilePath
p2 FilePath
i
    if Bool
isSystem
       then FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
i
       else r -> FilePath -> FilePath -> m FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
p2 FilePath
i

data TraceEntry =
  TraceEntry {
    TraceEntry -> Integer
teMicroseconds :: Integer,
    TraceEntry -> Integer
teProcess :: Integer,
    TraceEntry -> FilePath
teFunction :: String,
    TraceEntry -> FilePath
teContext :: String
  }

tracesLogHeader :: [String]
tracesLogHeader :: [FilePath]
tracesLogHeader = [FilePath
"microseconds",FilePath
"pid",FilePath
"function",FilePath
"context"]

parseTracesFile :: (FilePath,String) -> TrackedErrorsIO [TraceEntry]
parseTracesFile :: (FilePath, FilePath) -> TrackedErrorsIO [TraceEntry]
parseTracesFile (FilePath
f,FilePath
s) = TextParser [TraceEntry]
-> FilePath -> FilePath -> TrackedErrorsIO [TraceEntry]
forall (m :: * -> *) a.
ErrorContextM m =>
TextParser a -> FilePath -> FilePath -> m a
runTextParser (ParsecT CompilerMessage FilePath Identity ()
-> ParsecT CompilerMessage FilePath Identity ()
-> TextParser [TraceEntry]
-> TextParser [TraceEntry]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT CompilerMessage FilePath Identity ()
nullParse ParsecT CompilerMessage FilePath Identity ()
endOfDoc TextParser [TraceEntry]
tracesFile) FilePath
f FilePath
s where
  tracesFile :: TextParser [TraceEntry]
tracesFile =  do
    ParsecT CompilerMessage FilePath Identity ()
parseHeader
    ParsecT CompilerMessage FilePath Identity TraceEntry
-> TextParser [TraceEntry]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CompilerMessage FilePath Identity TraceEntry
parseSingle
  parseHeader :: ParsecT CompilerMessage FilePath Identity ()
parseHeader = do
    [ParsecT CompilerMessage FilePath Identity ()]
-> ParsecT CompilerMessage FilePath Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([ParsecT CompilerMessage FilePath Identity ()]
 -> ParsecT CompilerMessage FilePath Identity ())
-> [ParsecT CompilerMessage FilePath Identity ()]
-> ParsecT CompilerMessage FilePath Identity ()
forall a b. (a -> b) -> a -> b
$ [ParsecT CompilerMessage FilePath Identity ()]
-> [[ParsecT CompilerMessage FilePath Identity ()]]
-> [ParsecT CompilerMessage FilePath Identity ()]
forall a. [a] -> [[a]] -> [a]
intercalate [FilePath -> ParsecT CompilerMessage FilePath Identity ()
string_ FilePath
","] ([[ParsecT CompilerMessage FilePath Identity ()]]
 -> [ParsecT CompilerMessage FilePath Identity ()])
-> [[ParsecT CompilerMessage FilePath Identity ()]]
-> [ParsecT CompilerMessage FilePath Identity ()]
forall a b. (a -> b) -> a -> b
$ (FilePath -> [ParsecT CompilerMessage FilePath Identity ()])
-> [FilePath] -> [[ParsecT CompilerMessage FilePath Identity ()]]
forall a b. (a -> b) -> [a] -> [b]
map ((ParsecT CompilerMessage FilePath Identity ()
-> [ParsecT CompilerMessage FilePath Identity ()]
-> [ParsecT CompilerMessage FilePath Identity ()]
forall a. a -> [a] -> [a]
:[]) (ParsecT CompilerMessage FilePath Identity ()
 -> [ParsecT CompilerMessage FilePath Identity ()])
-> (FilePath -> ParsecT CompilerMessage FilePath Identity ())
-> FilePath
-> [ParsecT CompilerMessage FilePath Identity ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ParsecT CompilerMessage FilePath Identity ()
parseColTitle) [FilePath]
tracesLogHeader
    ParsecT CompilerMessage FilePath Identity Char
-> ParsecT CompilerMessage FilePath Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token FilePath
-> ParsecT CompilerMessage FilePath Identity (Token FilePath)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token FilePath
'\n' ParsecT CompilerMessage FilePath Identity Char
-> ParsecT CompilerMessage FilePath Identity Char
-> ParsecT CompilerMessage FilePath Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token FilePath
-> ParsecT CompilerMessage FilePath Identity (Token FilePath)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token FilePath
'\r') ParsecT CompilerMessage FilePath Identity FilePath
-> ParsecT CompilerMessage FilePath Identity ()
-> ParsecT CompilerMessage FilePath Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT CompilerMessage FilePath Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  parseSingle :: ParsecT CompilerMessage FilePath Identity TraceEntry
parseSingle = do
    Integer
ms <- TextParser Integer
parseDec
    FilePath -> ParsecT CompilerMessage FilePath Identity ()
string_ FilePath
","
    Integer
pid <- TextParser Integer
parseDec
    FilePath -> ParsecT CompilerMessage FilePath Identity ()
string_ FilePath
","
    FilePath
func <- ParsecT CompilerMessage FilePath Identity FilePath
quotedString
    FilePath -> ParsecT CompilerMessage FilePath Identity ()
string_ FilePath
","
    FilePath
c <- ParsecT CompilerMessage FilePath Identity FilePath
quotedString
    ParsecT CompilerMessage FilePath Identity Char
-> ParsecT CompilerMessage FilePath Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token FilePath
-> ParsecT CompilerMessage FilePath Identity (Token FilePath)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token FilePath
'\n' ParsecT CompilerMessage FilePath Identity Char
-> ParsecT CompilerMessage FilePath Identity Char
-> ParsecT CompilerMessage FilePath Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token FilePath
-> ParsecT CompilerMessage FilePath Identity (Token FilePath)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token FilePath
'\r') ParsecT CompilerMessage FilePath Identity FilePath
-> ParsecT CompilerMessage FilePath Identity ()
-> ParsecT CompilerMessage FilePath Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT CompilerMessage FilePath Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    TraceEntry -> ParsecT CompilerMessage FilePath Identity TraceEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (TraceEntry
 -> ParsecT CompilerMessage FilePath Identity TraceEntry)
-> TraceEntry
-> ParsecT CompilerMessage FilePath Identity TraceEntry
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> FilePath -> FilePath -> TraceEntry
TraceEntry Integer
ms Integer
pid FilePath
func FilePath
c
  parseColTitle :: FilePath -> ParsecT CompilerMessage FilePath Identity ()
parseColTitle FilePath
expected = do
    FilePath
title <- ParsecT CompilerMessage FilePath Identity FilePath
quotedString
    Bool
-> ParsecT CompilerMessage FilePath Identity ()
-> ParsecT CompilerMessage FilePath Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
expected FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
title) (ParsecT CompilerMessage FilePath Identity ()
 -> ParsecT CompilerMessage FilePath Identity ())
-> ParsecT CompilerMessage FilePath Identity ()
-> ParsecT CompilerMessage FilePath Identity ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT CompilerMessage FilePath Identity ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> ParsecT CompilerMessage FilePath Identity ())
-> FilePath -> ParsecT CompilerMessage FilePath Identity ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Expected column named \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
expected FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" but found \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
title FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\""

runRecompileCommon :: (PathIOHandler r, CompilerBackend b) => r -> b ->
  ForceMode -> Bool -> FilePath -> [FilePath] -> TrackedErrorsIO ()
runRecompileCommon :: r
-> b
-> ForceMode
-> Bool
-> FilePath
-> [FilePath]
-> TrackedErrorsIO ()
runRecompileCommon r
resolver b
backend ForceMode
f Bool
rec FilePath
p [FilePath]
ds = do
  Set FilePath
explicit <- ([FilePath] -> Set FilePath)
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO (Set FilePath))
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO (Set 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 (IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> (FilePath -> IO FilePath)
-> FilePath
-> TrackedErrorsT IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath)
-> (FilePath -> FilePath) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
p FilePath -> FilePath -> FilePath
</>)) [FilePath]
ds
  (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
-> Set FilePath
-> (FilePath, FilePath)
-> TrackedErrorsT IO (Set FilePath)
forall t.
PathIOHandler t =>
t
-> Set FilePath
-> Set FilePath
-> (FilePath, FilePath)
-> TrackedErrorsT IO (Set FilePath)
recursive r
resolver Set FilePath
explicit) 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
-> Set FilePath
-> (FilePath, FilePath)
-> TrackedErrorsT IO (Set FilePath)
recursive t
r Set FilePath
explicit Set FilePath
da (FilePath
p2,FilePath
d0) = do
      FilePath
d <- t -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule t
r FilePath
p2 FilePath
d0
      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
      let process :: Bool
process = if Bool
rec
                       then FilePath
d FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
explicit Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isSystem
                       else FilePath
d FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
explicit
      if Bool -> Bool
not Bool
process Bool -> Bool -> Bool
|| FilePath
d 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
           ModuleConfig
rm <- FilePath -> TrackedErrorsIO ModuleConfig
loadRecompile FilePath
d
           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
-> Set FilePath
-> (FilePath, FilePath)
-> TrackedErrorsT IO (Set FilePath)
recursive t
r Set FilePath
explicit) (FilePath
d FilePath -> Set FilePath -> Set FilePath
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set FilePath
da) [(FilePath, FilePath)]
ds3
           FilePath -> TrackedErrorsIO ()
recompile FilePath
d
           Set FilePath -> TrackedErrorsT IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Set FilePath
da'
    recompile :: FilePath -> TrackedErrorsIO ()
recompile FilePath
d = do
      VersionHash
compilerHash <- b -> TrackedErrorsT IO VersionHash
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
getCompilerHash b
backend
      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
d FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is up to date"
         else do
           rm :: ModuleConfig
rm@(ModuleConfig FilePath
p2 FilePath
d2 [FilePath]
ee [(MacroName, Expression SourceContext)]
_ [FilePath]
is [FilePath]
is2 [ExtraSource]
es [FilePath]
ep CompileMode
m) <- FilePath -> TrackedErrorsIO ModuleConfig
loadRecompile FilePath
d
           let fixed :: FilePath
fixed = FilePath -> FilePath
fixPath (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
p2)
           ([FilePath]
ps,[FilePath]
xs,[FilePath]
ts) <- FilePath
-> [FilePath]
-> TrackedErrorsT IO ([FilePath], [FilePath], [FilePath])
findSourceFiles FilePath
fixed (FilePath
d2FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ee)
           ExprMap SourceContext
em <- FilePath -> ModuleConfig -> TrackedErrorsIO (ExprMap SourceContext)
getExprMap FilePath
d ModuleConfig
rm
           let spec :: ModuleSpec
spec = ModuleSpec :: FilePath
-> 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,
             msExtra :: [FilePath]
msExtra = [FilePath]
ee,
             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
"\""