{- -----------------------------------------------------------------------------
Copyright 2020-2021,2023 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 :: forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> CompileOptions -> TrackedErrorsIO ()
runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [String]
_ [String]
_ [String]
ds [ExtraSource]
_ [String]
_ String
p (ExecuteTests [String]
tp Maybe String
cl) ForceMode
f Int
_) = do
  String
base <- r -> TrackedErrorsT IO String
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m String
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> m String
resolveBaseModule r
resolver
  [LoadedTests]
ts <- ((MetadataMap, [LoadedTests]) -> [LoadedTests])
-> TrackedErrorsT IO (MetadataMap, [LoadedTests])
-> TrackedErrorsT IO [LoadedTests]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MetadataMap, [LoadedTests]) -> [LoadedTests]
forall a b. (a, b) -> b
snd (TrackedErrorsT IO (MetadataMap, [LoadedTests])
 -> TrackedErrorsT IO [LoadedTests])
-> TrackedErrorsT IO (MetadataMap, [LoadedTests])
-> TrackedErrorsT IO [LoadedTests]
forall a b. (a -> b) -> a -> b
$ ((MetadataMap, [LoadedTests])
 -> String -> TrackedErrorsT IO (MetadataMap, [LoadedTests]))
-> (MetadataMap, [LoadedTests])
-> [String]
-> TrackedErrorsT IO (MetadataMap, [LoadedTests])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (MetadataMap, [LoadedTests])
-> String -> TrackedErrorsT IO (MetadataMap, [LoadedTests])
preloadTests (MetadataMap
forall k a. Map k a
Map.empty,[]) [String]
ds
  [LoadedTests] -> TrackedErrorsIO ()
forall {m :: * -> *}. ErrorContextM m => [LoadedTests] -> m ()
checkTestFilters [LoadedTests]
ts
  String
cl2 <- Maybe String -> TrackedErrorsT IO String
forall {m :: * -> *}.
(MonadIO m, ErrorContextM m) =>
Maybe String -> m String
prepareCallLog Maybe String
cl
  [((Int, Int), TrackedErrors ())]
allResults <- ([[((Int, Int), TrackedErrors ())]]
 -> [((Int, Int), TrackedErrors ())])
-> TrackedErrorsT IO [[((Int, Int), TrackedErrors ())]]
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
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
-> String
-> String
-> [String]
-> LoadedTests
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> String
-> String
-> [String]
-> LoadedTests
-> TrackedErrorsT IO [((Int, Int), TrackedErrors ())]
runModuleTests r
resolver b
backend String
cl2 String
base [String]
tp) [LoadedTests]
ts
  let passed :: Int
passed = [Int] -> Int
forall a. Num a => [a] -> a
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 a. Num a => [a] -> a
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 String -> m String
prepareCallLog (Just String
cl2) = do
      String
clFull <- IO String -> m String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath (String
p String -> String -> String
</> String
cl2)
      String -> m ()
forall (m :: * -> *). ErrorContextM m => String -> m ()
compilerWarningM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Logging calls to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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
$ String -> String -> IO ()
writeFile String
clFull (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
tracesLogHeader) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")
      String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
clFull
    prepareCallLog Maybe String
_ = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    preloadTests :: (MetadataMap, [LoadedTests])
-> String -> TrackedErrorsT IO (MetadataMap, [LoadedTests])
preloadTests (MetadataMap
ca,[LoadedTests]
ms) String
d = do
      VersionHash
compilerHash <- b -> TrackedErrorsT IO VersionHash
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
getCompilerHash b
backend
      CompileMetadata
m <- VersionHash
-> ForceMode
-> MetadataMap
-> String
-> TrackedErrorsIO CompileMetadata
loadModuleMetadata VersionHash
compilerHash ForceMode
f MetadataMap
ca (String
p String -> String -> String
</> String
d)
      let ca2 :: MetadataMap
ca2 = MetadataMap
ca MetadataMap -> MetadataMap -> MetadataMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> MetadataMap
mapMetadata [CompileMetadata
m]
      ModuleConfig
rm <- String -> TrackedErrorsIO ModuleConfig
loadRecompile (String
p String -> String -> String
</> String
d)
      let ca3 :: MetadataMap
ca3 = MetadataMap
ca2 MetadataMap -> MetadataMap -> MetadataMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> MetadataMap
mapMetadata []
      [CompileMetadata]
deps1 <- VersionHash
-> ForceMode
-> MetadataMap
-> CompileMetadata
-> TrackedErrorsIO [CompileMetadata]
loadTestingDeps VersionHash
compilerHash ForceMode
f MetadataMap
ca3 CompileMetadata
m
      let ca4 :: MetadataMap
ca4 = MetadataMap
ca3 MetadataMap -> MetadataMap -> MetadataMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> MetadataMap
mapMetadata [CompileMetadata]
deps1
      [CompileMetadata]
deps2 <- VersionHash
-> ForceMode
-> MetadataMap
-> [CompileMetadata]
-> TrackedErrorsIO [CompileMetadata]
loadPrivateDeps VersionHash
compilerHash ForceMode
f MetadataMap
ca4 ([CompileMetadata
m][CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++[CompileMetadata]
deps1)
      let ca5 :: MetadataMap
ca5 = MetadataMap
ca4 MetadataMap -> MetadataMap -> MetadataMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> MetadataMap
mapMetadata [CompileMetadata]
deps2
      ExprMap SourceContext
em <- String -> ModuleConfig -> TrackedErrorsIO (ExprMap SourceContext)
getExprMap (String
p String -> String -> String
</> String
d) ModuleConfig
rm
      (MetadataMap, [LoadedTests])
-> TrackedErrorsT IO (MetadataMap, [LoadedTests])
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MetadataMap
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 :: [String]
possibleTests = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (LoadedTests -> [String]) -> [LoadedTests] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (CompileMetadata -> [String]
cmTestFiles (CompileMetadata -> [String])
-> (LoadedTests -> CompileMetadata) -> LoadedTests -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedTests -> CompileMetadata
ltMetadata) [LoadedTests]
ts
      let remaining :: [String]
remaining = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((String -> Bool) -> Bool) -> [String -> Bool] -> Bool)
-> [String -> Bool] -> ((String -> Bool) -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String -> Bool) -> Bool) -> [String -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool) -> [String] -> [String -> Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> Bool) -> String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf) [String]
possibleTests)(((String -> Bool) -> Bool) -> Bool)
-> (String -> (String -> Bool) -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> Bool) -> String -> Bool)
-> String -> (String -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
($)) [String]
tp
      case [String]
remaining of
          [] -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          [String]
fs -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Some test files do not occur in the selected modules: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
fs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\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 () -> String -> TrackedErrorsT m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
          String
"\nPassed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
passed String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" test(s), Failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
failed String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\nPassed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
passed String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" test(s), Failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
failed String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" test(s)"

runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [String]
is [String]
is2 [String]
_ [ExtraSource]
_ [String]
_ String
p (CompileFast CategoryName
c FunctionName
fn String
f2) ForceMode
f Int
pn) = do
  String
dir <- IO String -> TrackedErrorsT IO String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> TrackedErrorsT IO String)
-> IO String -> TrackedErrorsT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
mkdtemp String
"/tmp/zfast_"
  String
absolute <- IO String -> TrackedErrorsT IO String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> TrackedErrorsT IO String)
-> IO String -> TrackedErrorsT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
p
  String
f2' <- IO String -> TrackedErrorsT IO String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> TrackedErrorsT IO String)
-> IO String -> TrackedErrorsT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath (String
p String -> String -> String
</> String
f2)
  let rm :: ModuleConfig
rm = ModuleConfig {
    mcRoot :: String
mcRoot = String
"",
    mcPath :: String
mcPath = String
".",
    mcExtra :: [String]
mcExtra = [],
    mcExprMap :: [(MacroName, Expression SourceContext)]
mcExprMap = [],
    mcPublicDeps :: [String]
mcPublicDeps = [],
    mcPrivateDeps :: [String]
mcPrivateDeps = [],
    mcExtraFiles :: [ExtraSource]
mcExtraFiles = [],
    mcCategories :: [(CategoryName, CategorySpec SourceContext)]
mcCategories = [],
    mcExtraPaths :: [String]
mcExtraPaths = [],
    mcMode :: CompileMode
mcMode = CompileMode
CompileUnspecified
  }
  ExprMap SourceContext
em <- String -> ModuleConfig -> TrackedErrorsIO (ExprMap SourceContext)
getExprMap String
p ModuleConfig
rm
  let spec :: ModuleSpec
spec = ModuleSpec {
    msRoot :: String
msRoot = String
absolute,
    msPath :: String
msPath = String
dir,
    msExtra :: [String]
msExtra = [],
    msExprMap :: ExprMap SourceContext
msExprMap = ExprMap SourceContext
em,
    msPublicDeps :: [String]
msPublicDeps = [String]
is,
    msPrivateDeps :: [String]
msPrivateDeps = [String]
is2,
    msPublicFiles :: [String]
msPublicFiles = [],
    msPrivateFiles :: [String]
msPrivateFiles = [String
f2'],
    msTestFiles :: [String]
msTestFiles = [],
    msExtraFiles :: [ExtraSource]
msExtraFiles = [],
    msCategories :: [(CategoryName, CategorySpec SourceContext)]
msCategories = [],
    msExtraPaths :: [String]
msExtraPaths = [],
    msMode :: CompileMode
msMode = (CategoryName
-> FunctionName -> LinkerMode -> String -> [String] -> CompileMode
CompileBinary CategoryName
c FunctionName
fn LinkerMode
LinkStatic (String
absolute String -> String -> String
</> CategoryName -> String
forall a. Show a => a -> String
show CategoryName
c) []),
    msForce :: ForceMode
msForce = ForceMode
f,
    msParallel :: Int
msParallel = Int
pn
  }
  r -> b -> ModuleSpec -> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> ModuleSpec -> TrackedErrorsIO ()
compileModule r
resolver b
backend ModuleSpec
spec TrackedErrorsIO () -> String -> TrackedErrorsIO ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
"In compilation of \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f2' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
  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
$ String -> IO ()
removeDirectoryRecursive String
dir

runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [String]
_ [String]
_ [String]
ds [ExtraSource]
_ [String]
_ String
p CompileMode
CompileRecompileRecursive ForceMode
f Int
pn) =
  r
-> b
-> ForceMode
-> Int
-> Bool
-> String
-> [String]
-> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> ForceMode
-> Int
-> Bool
-> String
-> [String]
-> TrackedErrorsIO ()
runRecompileCommon r
resolver b
backend ForceMode
f Int
pn Bool
True String
p [String]
ds

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

runCompiler r
resolver b
backend (CompileOptions HelpMode
_ [String]
is [String]
is2 [String]
ds [ExtraSource]
_ [String]
_ String
p CompileMode
CreateTemplates ForceMode
f Int
_) = (String -> TrackedErrorsIO ()) -> [String] -> TrackedErrorsIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> TrackedErrorsIO ()
compileSingle [String]
ds where
  compileSingle :: String -> TrackedErrorsIO ()
compileSingle String
d = do
    VersionHash
compilerHash <- b -> TrackedErrorsT IO VersionHash
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
getCompilerHash b
backend
    String
d' <- IO String -> TrackedErrorsT IO String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> TrackedErrorsT IO String)
-> IO String -> TrackedErrorsT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath (String
p String -> String -> String
</> String
d)
    ([String]
ep,[String]
is',[String]
is2',Map CategoryName (CategorySpec SourceContext)
cm) <- String
-> TrackedErrorsT
     IO
     ([String], [String], [String],
      Map CategoryName (CategorySpec SourceContext))
maybeUseConfig String
d'
    [String]
as  <- ([String] -> [String])
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO [String]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
fixPaths (TrackedErrorsT IO [String] -> TrackedErrorsT IO [String])
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> TrackedErrorsT IO String)
-> [String] -> TrackedErrorsT IO [String]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> String -> String -> TrackedErrorsT IO String
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m String
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m String
resolveModule r
resolver String
d') [String]
is'
    [String]
as2 <- ([String] -> [String])
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO [String]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
fixPaths (TrackedErrorsT IO [String] -> TrackedErrorsT IO [String])
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> TrackedErrorsT IO String)
-> [String] -> TrackedErrorsT IO [String]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> String -> String -> TrackedErrorsT IO String
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m String
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m String
resolveModule r
resolver String
d') [String]
is2'
    Bool
isBase <- r -> String -> TrackedErrorsT IO Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> String -> m Bool
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> String -> m Bool
isBaseModule r
resolver String
d'
    [CompileMetadata]
deps1 <- if Bool
isBase
                then VersionHash
-> ForceMode
-> MetadataMap
-> [String]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f MetadataMap
forall k a. Map k a
Map.empty [String]
as
                else do
                  String
base <- r -> TrackedErrorsT IO String
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m String
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> m String
resolveBaseModule r
resolver
                  VersionHash
-> ForceMode
-> MetadataMap
-> [String]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f MetadataMap
forall k a. Map k a
Map.empty (String
baseString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as)
    [CompileMetadata]
deps2 <- VersionHash
-> ForceMode
-> MetadataMap
-> [String]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f ([CompileMetadata] -> MetadataMap
mapMetadata [CompileMetadata]
deps1) [String]
as2
    String
path <- IO String -> TrackedErrorsT IO String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> TrackedErrorsT IO String)
-> IO String -> TrackedErrorsT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
p
    r
-> String
-> String
-> [String]
-> Map CategoryName (CategorySpec SourceContext)
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO ()
forall r.
PathIOHandler r =>
r
-> String
-> String
-> [String]
-> Map CategoryName (CategorySpec SourceContext)
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO ()
createModuleTemplates r
resolver String
path String
d [String]
ep Map CategoryName (CategorySpec SourceContext)
cm [CompileMetadata]
deps1 [CompileMetadata]
deps2 TrackedErrorsIO () -> String -> TrackedErrorsIO ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
"In module \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
  maybeUseConfig :: String
-> TrackedErrorsT
     IO
     ([String], [String], [String],
      Map CategoryName (CategorySpec SourceContext))
maybeUseConfig String
d2 = do
    let rm :: TrackedErrorsIO ModuleConfig
rm = String -> TrackedErrorsIO ModuleConfig
loadRecompile String
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 ([String], [String], [String],
 Map CategoryName (CategorySpec SourceContext))
-> TrackedErrorsT
     IO
     ([String], [String], [String],
      Map CategoryName (CategorySpec SourceContext))
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[String]
is,[String]
is2,Map CategoryName (CategorySpec SourceContext)
forall k a. Map k a
Map.empty)
       else do
         (ModuleConfig String
p2 String
_ [String]
ep [(MacroName, Expression SourceContext)]
_ [String]
is3 [String]
is4  [ExtraSource]
_ [(CategoryName, CategorySpec SourceContext)]
cs [String]
_ CompileMode
_) <- TrackedErrorsIO ModuleConfig
rm
         ([String], [String], [String],
 Map CategoryName (CategorySpec SourceContext))
-> TrackedErrorsT
     IO
     ([String], [String], [String],
      Map CategoryName (CategorySpec SourceContext))
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
d2 String -> String -> String
</> String
p2) String -> String -> String
</>) [String]
ep,[String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
is [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
is3,[String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
is2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
is4,[(CategoryName, CategorySpec SourceContext)]
-> Map CategoryName (CategorySpec SourceContext)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CategoryName, CategorySpec SourceContext)]
cs)

runCompiler r
resolver b
_ (CompileOptions HelpMode
_ [String]
is [String]
is2 [String]
ds [ExtraSource]
es [String]
ep String
p CompileMode
m ForceMode
f Int
_) = (String -> TrackedErrorsIO ()) -> [String] -> TrackedErrorsIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> TrackedErrorsIO ()
compileSingle [String]
ds where
  compileSingle :: String -> TrackedErrorsIO ()
compileSingle String
d = do
    [String]
as  <- ([String] -> [String])
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO [String]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
fixPaths (TrackedErrorsT IO [String] -> TrackedErrorsT IO [String])
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> TrackedErrorsT IO String)
-> [String] -> TrackedErrorsT IO [String]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (String -> String -> TrackedErrorsT IO String
forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
String -> String -> m String
autoDep (String
p String -> String -> String
</> String
d)) [String]
is
    [String]
as2 <- ([String] -> [String])
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO [String]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
fixPaths (TrackedErrorsT IO [String] -> TrackedErrorsT IO [String])
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> TrackedErrorsT IO String)
-> [String] -> TrackedErrorsT IO [String]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (String -> String -> TrackedErrorsT IO String
forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
String -> String -> m String
autoDep (String
p String -> String -> String
</> String
d)) [String]
is2
    Bool
isConfigured <- String -> String -> TrackedErrorsT IO Bool
isPathConfigured String
p String
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
      String -> TrackedErrorsIO ()
forall a. String -> TrackedErrorsT IO a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> TrackedErrorsIO ()) -> String -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ String
"Module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has an existing configuration. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
"Recompile with -r or use -f to overwrite the config."
    String
absolute <- IO String -> TrackedErrorsT IO String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> TrackedErrorsT IO String)
-> IO String -> TrackedErrorsT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
p
    let rm :: ModuleConfig
rm = ModuleConfig {
      mcRoot :: String
mcRoot = String
absolute,
      mcPath :: String
mcPath = String
d,
      mcExtra :: [String]
mcExtra = [],
      mcExprMap :: [(MacroName, Expression SourceContext)]
mcExprMap = [],
      mcPublicDeps :: [String]
mcPublicDeps = [String]
as,
      mcPrivateDeps :: [String]
mcPrivateDeps = [String]
as2,
      mcExtraFiles :: [ExtraSource]
mcExtraFiles = [ExtraSource]
es,
      mcCategories :: [(CategoryName, CategorySpec SourceContext)]
mcCategories = [],
      mcExtraPaths :: [String]
mcExtraPaths = [String]
ep,
      mcMode :: CompileMode
mcMode = CompileMode
m
    }
    String -> ModuleConfig -> TrackedErrorsIO ()
writeRecompile (String
p String -> String -> String
</> String
d) ModuleConfig
rm
    String
config <- String -> TrackedErrorsT IO String
getRecompilePath (String
p String -> String -> String
</> String
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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"*** Setup complete. Please edit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
config String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and recompile with zeolite -r. ***"
  autoDep :: String -> String -> m String
autoDep String
p2 String
i = do
    Bool
isSystem <- r -> String -> String -> m Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m Bool
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m Bool
isSystemModule r
resolver String
p2 String
i
    if Bool
isSystem
       then String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
i
       else r -> String -> String -> m String
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m String
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m String
resolveModule r
resolver String
p2 String
i

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

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

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

runRecompileCommon :: (PathIOHandler r, CompilerBackend b) => r -> b ->
  ForceMode -> Int -> Bool -> FilePath -> [FilePath] -> TrackedErrorsIO ()
runRecompileCommon :: forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> ForceMode
-> Int
-> Bool
-> String
-> [String]
-> TrackedErrorsIO ()
runRecompileCommon r
resolver b
backend ForceMode
f Int
pn Bool
rec String
p [String]
ds = do
  Set String
explicit <- ([String] -> Set String)
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO (Set String)
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList (TrackedErrorsT IO [String] -> TrackedErrorsT IO (Set String))
-> TrackedErrorsT IO [String] -> TrackedErrorsT IO (Set String)
forall a b. (a -> b) -> a -> b
$ (String -> TrackedErrorsT IO String)
-> [String] -> TrackedErrorsT IO [String]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (IO String -> TrackedErrorsT IO String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> TrackedErrorsT IO String)
-> (String -> IO String) -> String -> TrackedErrorsT IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
canonicalizePath (String -> IO String) -> (String -> String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
p String -> String -> String
</>)) [String]
ds
  (Set String -> (String, String) -> TrackedErrorsT IO (Set String))
-> Set String
-> [(String, String)]
-> TrackedErrorsT IO (Set String)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (r
-> Set String
-> Set String
-> (String, String)
-> TrackedErrorsT IO (Set String)
forall {t}.
PathIOHandler t =>
t
-> Set String
-> Set String
-> (String, String)
-> TrackedErrorsT IO (Set String)
recursive r
resolver Set String
explicit) Set String
forall a. Set a
Set.empty ((String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) String
p) [String]
ds) TrackedErrorsT IO (Set String)
-> TrackedErrorsIO () -> TrackedErrorsIO ()
forall a b.
TrackedErrorsT IO a -> TrackedErrorsT IO b -> TrackedErrorsT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TrackedErrorsIO ()
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () where
    recursive :: t
-> Set String
-> Set String
-> (String, String)
-> TrackedErrorsT IO (Set String)
recursive t
r Set String
explicit Set String
da (String
p2,String
d0) = do
      String
d <- t -> String -> String -> TrackedErrorsT IO String
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m String
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
t -> String -> String -> m String
resolveModule t
r String
p2 String
d0
      Bool
isSystem <- t -> String -> String -> TrackedErrorsT IO Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> String -> String -> m Bool
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
t -> String -> String -> m Bool
isSystemModule t
r String
p2 String
d0
      let process :: Bool
process = if Bool
rec
                       then String
d String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
explicit Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isSystem
                       else String
d String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
explicit
      if Bool -> Bool
not Bool
process Bool -> Bool -> Bool
|| String
d String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
da
         then Set String -> TrackedErrorsT IO (Set String)
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Set String
da
         else do
           ModuleConfig
rm <- String -> TrackedErrorsIO ModuleConfig
loadRecompile String
d
           let ds3 :: [(String, String)]
ds3 = (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) String
d) (ModuleConfig -> [String]
mcPublicDeps ModuleConfig
rm [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ModuleConfig -> [String]
mcPrivateDeps ModuleConfig
rm)
           Set String
da' <- (Set String -> (String, String) -> TrackedErrorsT IO (Set String))
-> Set String
-> [(String, String)]
-> TrackedErrorsT IO (Set String)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (t
-> Set String
-> Set String
-> (String, String)
-> TrackedErrorsT IO (Set String)
recursive t
r Set String
explicit) (String
d String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set String
da) [(String, String)]
ds3
           String -> TrackedErrorsIO ()
recompile String
d
           Set String -> TrackedErrorsT IO (Set String)
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Set String
da'
    recompile :: String -> TrackedErrorsIO ()
recompile String
d = do
      VersionHash
compilerHash <- b -> TrackedErrorsT IO VersionHash
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
getCompilerHash b
backend
      Bool
upToDate <- VersionHash -> ForceMode -> String -> TrackedErrorsT IO Bool
isPathUpToDate VersionHash
compilerHash ForceMode
f String
d
      if ForceMode
f ForceMode -> ForceMode -> Bool
forall a. Ord a => a -> a -> Bool
< ForceMode
ForceAll Bool -> Bool -> Bool
&& Bool
upToDate
         then String -> TrackedErrorsIO ()
forall (m :: * -> *). ErrorContextM m => String -> m ()
compilerWarningM (String -> TrackedErrorsIO ()) -> String -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ String
"Path " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is up to date"
         else do
           rm :: ModuleConfig
rm@(ModuleConfig String
p2 String
d2 [String]
ee [(MacroName, Expression SourceContext)]
_ [String]
is [String]
is2 [ExtraSource]
es [(CategoryName, CategorySpec SourceContext)]
cs [String]
ep CompileMode
m) <- String -> TrackedErrorsIO ModuleConfig
loadRecompile String
d
           let fixed :: String
fixed = String -> String
fixPath (String
d String -> String -> String
</> String
p2)
           ([String]
ps,[String]
xs,[String]
ts) <- String
-> [String] -> TrackedErrorsIO ([String], [String], [String])
findSourceFiles String
fixed (String
d2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ee)
           ExprMap SourceContext
em <- String -> ModuleConfig -> TrackedErrorsIO (ExprMap SourceContext)
getExprMap String
d ModuleConfig
rm
           let spec :: ModuleSpec
spec = ModuleSpec {
             msRoot :: String
msRoot = String
fixed,
             msPath :: String
msPath = String
d2,
             msExtra :: [String]
msExtra = [String]
ee,
             msExprMap :: ExprMap SourceContext
msExprMap = ExprMap SourceContext
em,
             msPublicDeps :: [String]
msPublicDeps = [String]
is,
             msPrivateDeps :: [String]
msPrivateDeps = [String]
is2,
             msPublicFiles :: [String]
msPublicFiles = [String]
ps,
             msPrivateFiles :: [String]
msPrivateFiles = [String]
xs,
             msTestFiles :: [String]
msTestFiles = [String]
ts,
             msExtraFiles :: [ExtraSource]
msExtraFiles = [ExtraSource]
es,
             msCategories :: [(CategoryName, CategorySpec SourceContext)]
msCategories = [(CategoryName, CategorySpec SourceContext)]
cs,
             msExtraPaths :: [String]
msExtraPaths = [String]
ep,
             msMode :: CompileMode
msMode = CompileMode
m,
             msForce :: ForceMode
msForce = ForceMode
f,
             msParallel :: Int
msParallel = Int
pn
           }
           r -> b -> ModuleSpec -> TrackedErrorsIO ()
forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> ModuleSpec -> TrackedErrorsIO ()
compileModule r
resolver b
backend ModuleSpec
spec TrackedErrorsIO () -> String -> TrackedErrorsIO ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
"In compilation of module \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""