{- -----------------------------------------------------------------------------
Copyright 2020-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.Compiler (
  LoadedTests(..),
  ModuleSpec(..),
  compileModule,
  createModuleTemplates,
  runModuleTests,
) where

import Control.Arrow (first)
import Control.Monad (foldM,when)
import Data.Either (partitionEithers)
import Data.List (isSuffixOf,nub,sort)
import Data.Time.Clock (getCurrentTime)
import System.Directory
import System.FilePath
import System.IO
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Base.TrackedErrors
import Cli.CompileOptions
import Cli.Programs
import Cli.TestRunner
import Compilation.ProcedureContext (ExprMap)
import CompilerCxx.CxxFiles
import CompilerCxx.LanguageModule
import CompilerCxx.Naming
import Module.CompileMetadata
import Module.Paths
import Module.ProcessMetadata
import Parser.SourceFile
import Parser.TextParser (SourceContext)
import Types.Builtin (requiredStaticTypes)
import Types.DefinedCategory
import Types.TypeCategory
import Types.TypeInstance


data ModuleSpec =
  ModuleSpec {
    ModuleSpec -> FilePath
msRoot :: FilePath,
    ModuleSpec -> FilePath
msPath :: FilePath,
    ModuleSpec -> [FilePath]
msExtra :: [FilePath],
    ModuleSpec -> ExprMap SourceContext
msExprMap :: ExprMap SourceContext,
    ModuleSpec -> [FilePath]
msPublicDeps :: [FilePath],
    ModuleSpec -> [FilePath]
msPrivateDeps :: [FilePath],
    ModuleSpec -> [FilePath]
msPublicFiles :: [FilePath],
    ModuleSpec -> [FilePath]
msPrivateFiles :: [FilePath],
    ModuleSpec -> [FilePath]
msTestFiles :: [FilePath],
    ModuleSpec -> [ExtraSource]
msExtraFiles :: [ExtraSource],
    ModuleSpec -> [(CategoryName, CategorySpec SourceContext)]
msCategories :: [(CategoryName,CategorySpec SourceContext)],
    ModuleSpec -> [FilePath]
msExtraPaths :: [FilePath],
    ModuleSpec -> CompileMode
msMode :: CompileMode,
    ModuleSpec -> ForceMode
msForce :: ForceMode,
    ModuleSpec -> Int
msParallel :: Int
  }
  deriving (Int -> ModuleSpec -> ShowS
[ModuleSpec] -> ShowS
ModuleSpec -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ModuleSpec] -> ShowS
$cshowList :: [ModuleSpec] -> ShowS
show :: ModuleSpec -> FilePath
$cshow :: ModuleSpec -> FilePath
showsPrec :: Int -> ModuleSpec -> ShowS
$cshowsPrec :: Int -> ModuleSpec -> ShowS
Show)

data LoadedTests =
  LoadedTests {
    LoadedTests -> CompileMetadata
ltMetadata :: CompileMetadata,
    LoadedTests -> ExprMap SourceContext
ltExprMap :: ExprMap SourceContext,
    LoadedTests -> [CompileMetadata]
ltPublicDeps :: [CompileMetadata],
    LoadedTests -> [CompileMetadata]
ltPrivateDeps :: [CompileMetadata]
  }
  deriving (Int -> LoadedTests -> ShowS
[LoadedTests] -> ShowS
LoadedTests -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LoadedTests] -> ShowS
$cshowList :: [LoadedTests] -> ShowS
show :: LoadedTests -> FilePath
$cshow :: LoadedTests -> FilePath
showsPrec :: Int -> LoadedTests -> ShowS
$cshowsPrec :: Int -> LoadedTests -> ShowS
Show)

compileModule :: (PathIOHandler r, CompilerBackend b) => r -> b -> ModuleSpec -> TrackedErrorsIO ()
compileModule :: forall r b.
(PathIOHandler r, CompilerBackend b) =>
r -> b -> ModuleSpec -> TrackedErrorsIO ()
compileModule r
resolver b
backend (ModuleSpec FilePath
p FilePath
d [FilePath]
ee ExprMap SourceContext
em [FilePath]
is [FilePath]
is2 [FilePath]
ps [FilePath]
xs [FilePath]
ts [ExtraSource]
es [(CategoryName, CategorySpec SourceContext)]
cs [FilePath]
ep CompileMode
m ForceMode
f Int
pn) = do
  UTCTime
time <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO UTCTime
getCurrentTime
  [FilePath]
as  <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> ShowS
</> FilePath
d)) [FilePath]
is
  [FilePath]
as2 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> ShowS
</> FilePath
d)) [FilePath]
is2
  let ca0 :: Map k a
ca0 = forall k a. Map k a
Map.empty
  VersionHash
compilerHash <- forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> m VersionHash
getCompilerHash b
backend
  [CompileMetadata]
deps1 <- VersionHash
-> ForceMode
-> MetadataMap
-> [FilePath]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f forall k a. Map k a
ca0 [FilePath]
as
  let ca1 :: MetadataMap
ca1 = forall k a. Map k a
ca0 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
-> [FilePath]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f MetadataMap
ca1 [FilePath]
as2
  let ca2 :: MetadataMap
ca2 = MetadataMap
ca1 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> MetadataMap
mapMetadata [CompileMetadata]
deps2
  FilePath
base <- forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
resolveBaseModule r
resolver
  FilePath
actual <- forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
p FilePath
d
  Bool
isBase <- forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> m Bool
isBaseModule r
resolver FilePath
actual
  -- Lazy dependency loading, in case we're compiling base.
  [CompileMetadata]
deps1' <- if Bool
isBase
               then forall (m :: * -> *) a. Monad m => a -> m a
return [CompileMetadata]
deps1
               else do
                 [CompileMetadata]
bpDeps <- VersionHash
-> ForceMode
-> MetadataMap
-> [FilePath]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f MetadataMap
ca2 [FilePath
base]
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [CompileMetadata]
bpDeps forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps1
  FilePath
root <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
  FilePath
path <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> ShowS
</> FilePath
d)
  [FilePath]
extra <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> IO FilePath
canonicalizePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
pFilePath -> ShowS
</>)) [FilePath]
ee
  -- NOTE: Making the public namespace deterministic allows freshness checks to
  -- skip checking all inputs/outputs for each dependency.
  let ns0 :: Namespace
ns0 = FilePath -> Namespace
StaticNamespace forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> FilePath
publicNamespace  forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show VersionHash
compilerHash forall a. [a] -> [a] -> [a]
++ FilePath
path
  let ns1 :: Namespace
ns1 = FilePath -> Namespace
StaticNamespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> FilePath
privateNamespace forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show UTCTime
time forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show VersionHash
compilerHash forall a. [a] -> [a] -> [a]
++ FilePath
path
  let extensions :: [CategoryName]
extensions = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ExtraSource -> [CategoryName]
getSourceCategories [ExtraSource]
es
  ([WithVisibility (AnyCategory SourceContext)]
cs2,Set FilePath
private) <- forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
loadModuleGlobals r
resolver FilePath
p (Namespace
ns0,Namespace
ns1) [FilePath]
ps forall a. Maybe a
Nothing [CompileMetadata]
deps1' [CompileMetadata]
deps2
  let cm :: LanguageModule SourceContext
cm = forall c.
[CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [CategoryName]
extensions ExprMap SourceContext
em [WithVisibility (AnyCategory SourceContext)]
cs2
  let cs2' :: [WithVisibility (AnyCategory SourceContext)]
cs2' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
FromDependency) [WithVisibility (AnyCategory SourceContext)]
cs2
  let pc :: [CategoryName]
pc = forall a b. (a -> b) -> [a] -> [b]
map (forall c. AnyCategory c -> CategoryName
getCategoryName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. WithVisibility a -> a
wvData) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly) [WithVisibility (AnyCategory SourceContext)]
cs2'
  let tc :: [CategoryName]
tc = forall a b. (a -> b) -> [a] -> [b]
map (forall c. AnyCategory c -> CategoryName
getCategoryName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. WithVisibility a -> a
wvData) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly)       [WithVisibility (AnyCategory SourceContext)]
cs2'
  let dc :: [CategoryName]
dc = forall a b. (a -> b) -> [a] -> [b]
map (forall c. AnyCategory c -> CategoryName
getCategoryName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. WithVisibility a -> a
wvData) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
FromDependency) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly) [WithVisibility (AnyCategory SourceContext)]
cs2
  [PrivateSource SourceContext]
xa <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall r.
PathIOHandler r =>
r
-> VersionHash
-> FilePath
-> FilePath
-> TrackedErrorsIO (PrivateSource SourceContext)
loadPrivateSource r
resolver VersionHash
compilerHash FilePath
p) [FilePath]
xs
  Map CategoryName (CategorySpec SourceContext)
cs' <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *} {k} {a}.
(Ord k, ErrorContextM m, Show k, Show a) =>
Map k (CategorySpec a)
-> (k, CategorySpec a) -> m (Map k (CategorySpec a))
includeSpec forall k a. Map k a
Map.empty [(CategoryName, CategorySpec SourceContext)]
cs
  [CxxOutput]
fs <- forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> Map CategoryName (CategorySpec c)
-> [PrivateSource c]
-> m [CxxOutput]
compileLanguageModule LanguageModule SourceContext
cm Map CategoryName (CategorySpec SourceContext)
cs' [PrivateSource SourceContext]
xa
  [CxxOutput]
mf <- forall {f :: * -> *} {c}.
(Ord c, Show c, CollectErrorsM f) =>
LanguageModule c
-> [PrivateSource c] -> CompileMode -> f [CxxOutput]
maybeCreateMain LanguageModule SourceContext
cm [PrivateSource SourceContext]
xa CompileMode
m
  FilePath -> TrackedErrorsIO ()
eraseCachedData (FilePath
p FilePath -> ShowS
</> FilePath
d)
  [(FilePath, FilePath)]
pps <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
ps) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
pFilePath -> ShowS
</>)) [FilePath]
ps
  let ps2 :: [FilePath]
ps2 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
private) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)) [(FilePath, FilePath)]
pps
  let xs2 :: [FilePath]
xs2 = [FilePath]
xs forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
private) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(FilePath, FilePath)]
pps)
  let ts2 :: [FilePath]
ts2 = [FilePath]
ts
  let paths :: [FilePath]
paths = forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
ns -> FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) FilePath
ns FilePath
"") forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CxxOutput -> Namespace
coNamespace [CxxOutput]
fs
  [FilePath]
paths' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath) [FilePath]
paths
  FilePath
s0 <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (forall a. Show a => a -> FilePath
show Namespace
ns0) FilePath
""
  FilePath
s1 <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (forall a. Show a => a -> FilePath
show Namespace
ns1) FilePath
""
  let paths2 :: [FilePath]
paths2 = FilePath
baseforall a. a -> [a] -> [a]
:FilePath
s0forall a. a -> [a] -> [a]
:FilePath
s1forall a. a -> [a] -> [a]
:([CompileMetadata] -> [FilePath]
getIncludePathsForDeps ([CompileMetadata]
deps1' forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps2)) forall a. [a] -> [a] -> [a]
++ [FilePath]
ep' forall a. [a] -> [a] -> [a]
++ [FilePath]
paths'
  let hxx :: [CxxOutput]
hxx   = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".hpp" forall b c a. (b -> c) -> (a -> b) -> a -> c
. CxxOutput -> FilePath
coFilename)       [CxxOutput]
fs
  let other :: [CxxOutput]
other = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".hpp" forall b c a. (b -> c) -> (a -> b) -> a -> c
. CxxOutput -> FilePath
coFilename) [CxxOutput]
fs
  [([FilePath], CxxOutput)]
os1 <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
[FilePath]
-> UTCTime
-> CxxOutput
-> TrackedErrorsT
     IO (Either (m (AsyncWait b), CxxOutput) CxxOutput)
writeOutputFile [FilePath]
paths2 UTCTime
time) ([CxxOutput]
hxx forall a. [a] -> [a] -> [a]
++ [CxxOutput]
other) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a}.
(MonadIO m, CollectErrorsM m) =>
[Either (m (AsyncWait b), a) a] -> m [([FilePath], a)]
compileGenerated
  let files :: [FilePath]
files = forall a b. (a -> b) -> [a] -> [b]
map (\CxxOutput
f2 -> FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ CxxOutput -> Namespace
coNamespace CxxOutput
f2) (CxxOutput -> FilePath
coFilename CxxOutput
f2)) [CxxOutput]
fs forall a. [a] -> [a] -> [a]
++
              forall a b. (a -> b) -> [a] -> [b]
map (\ExtraSource
f2 -> FilePath
p FilePath -> ShowS
</> ExtraSource -> FilePath
getSourceFile ExtraSource
f2) [ExtraSource]
es
  [FilePath]
files' <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall {m :: * -> *}.
(MonadIO m, ErrorContextM m) =>
FilePath -> m FilePath
checkOwnedFile [FilePath]
files
  let ca :: Map CategoryName Namespace
ca = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\AnyCategory SourceContext
c -> (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory SourceContext
c,forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory SourceContext
c)) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData [WithVisibility (AnyCategory SourceContext)]
cs2
  [Either ([FilePath], CxxOutput) ObjectFile]
os2 <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
(Namespace, Namespace)
-> Map CategoryName Namespace
-> [FilePath]
-> ExtraSource
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
compileExtraSource (Namespace
ns0,Namespace
ns1) Map CategoryName Namespace
ca [FilePath]
paths2) [ExtraSource]
es forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a}.
(MonadIO m, CollectErrorsM m) =>
[Either (m (AsyncWait b), Maybe [a]) ([FilePath], Maybe [a])]
-> m [Either ([FilePath], a) ObjectFile]
compileExtra
  let ([FilePath]
hxx',[FilePath]
cxx,[FilePath]
os') = [FilePath] -> ([FilePath], [FilePath], [FilePath])
sortCompiledFiles [FilePath]
files'
  let ([([FilePath], CxxOutput)]
osCat,[ObjectFile]
osOther) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either ([FilePath], CxxOutput) ObjectFile]
os2
  let os1' :: [ObjectFile]
os1' = [CompileMetadata]
-> FilePath
-> FilePath
-> [([FilePath], CxxOutput)]
-> [ObjectFile]
resolveObjectDeps ([CompileMetadata]
deps1' forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps2) FilePath
path FilePath
path ([([FilePath], CxxOutput)]
os1 forall a. [a] -> [a] -> [a]
++ [([FilePath], CxxOutput)]
osCat)
  forall r.
PathIOHandler r =>
r
-> FilePath
-> [CategoryName]
-> [CategoryName]
-> [ObjectFile]
-> [FilePath]
-> TrackedErrorsIO ()
warnPublic r
resolver (FilePath
p FilePath -> ShowS
</> FilePath
d) [CategoryName]
pc [CategoryName]
dc [ObjectFile]
os1' [FilePath]
is
  let allObjects :: [ObjectFile]
allObjects = [ObjectFile]
os1' forall a. [a] -> [a] -> [a]
++ [ObjectFile]
osOther forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> ObjectFile
OtherObjectFile [FilePath]
os'
  FilePath -> TrackedErrorsIO ()
createCachePath (FilePath
p FilePath -> ShowS
</> FilePath
d)
  let libraryName :: FilePath
libraryName = FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) FilePath
"" (forall a. Show a => a -> FilePath
show Namespace
ns0 forall a. [a] -> [a] -> [a]
++ FilePath
".so")
  [FilePath]
ls <- forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
FilePath
-> [FilePath] -> [CompileMetadata] -> [ObjectFile] -> m [FilePath]
createLibrary FilePath
libraryName (CompileMode -> [FilePath]
getLinkFlags CompileMode
m) ([CompileMetadata]
deps1' forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps2) [ObjectFile]
allObjects
  let cm2 :: CompileMetadata
cm2 = CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = VersionHash
compilerHash,
      cmRoot :: FilePath
cmRoot = FilePath
root,
      cmPath :: FilePath
cmPath = FilePath
path,
      cmExtra :: [FilePath]
cmExtra = [FilePath]
extra,
      cmPublicNamespace :: Namespace
cmPublicNamespace = Namespace
ns0,
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = Namespace
ns1,
      cmPublicDeps :: [FilePath]
cmPublicDeps = [FilePath]
as,
      cmPrivateDeps :: [FilePath]
cmPrivateDeps = if Bool
isBase then [FilePath]
as2 else (FilePath
baseforall a. a -> [a] -> [a]
:[FilePath]
as2),
      cmPublicCategories :: [CategoryName]
cmPublicCategories = forall a. Ord a => [a] -> [a]
sort [CategoryName]
pc,
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = forall a. Ord a => [a] -> [a]
sort [CategoryName]
tc,
      cmPublicSubdirs :: [FilePath]
cmPublicSubdirs = [FilePath
s0],
      cmPrivateSubdirs :: [FilePath]
cmPrivateSubdirs = [FilePath
s1],
      cmPublicFiles :: [FilePath]
cmPublicFiles = forall a. Ord a => [a] -> [a]
sort [FilePath]
ps2,
      cmPrivateFiles :: [FilePath]
cmPrivateFiles = forall a. Ord a => [a] -> [a]
sort [FilePath]
xs2,
      cmTestFiles :: [FilePath]
cmTestFiles = forall a. Ord a => [a] -> [a]
sort [FilePath]
ts2,
      cmHxxFiles :: [FilePath]
cmHxxFiles = forall a. Ord a => [a] -> [a]
sort [FilePath]
hxx',
      cmCxxFiles :: [FilePath]
cmCxxFiles = forall a. Ord a => [a] -> [a]
sort [FilePath]
cxx,
      cmLibraries :: [FilePath]
cmLibraries = [FilePath]
ls,
      cmBinaries :: [FilePath]
cmBinaries = [],
      cmLinkFlags :: [FilePath]
cmLinkFlags = CompileMode -> [FilePath]
getLinkFlags CompileMode
m,
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = [ObjectFile]
os1' forall a. [a] -> [a] -> [a]
++ [ObjectFile]
osOther forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> ObjectFile
OtherObjectFile [FilePath]
os'
    }
  [FilePath]
bs <- VersionHash
-> [FilePath]
-> [CompileMetadata]
-> UTCTime
-> CompileMode
-> [CxxOutput]
-> TrackedErrorsT IO [FilePath]
createBinary VersionHash
compilerHash [FilePath]
paths' (CompileMetadata
cm2forall a. a -> [a] -> [a]
:([CompileMetadata]
deps1' forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps2)) UTCTime
time CompileMode
m [CxxOutput]
mf
  let cm2' :: CompileMetadata
cm2' = CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = CompileMetadata -> VersionHash
cmVersionHash CompileMetadata
cm2,
      cmRoot :: FilePath
cmRoot = CompileMetadata -> FilePath
cmRoot CompileMetadata
cm2,
      cmPath :: FilePath
cmPath = CompileMetadata -> FilePath
cmPath CompileMetadata
cm2,
      cmExtra :: [FilePath]
cmExtra = CompileMetadata -> [FilePath]
cmExtra CompileMetadata
cm2,
      cmPublicNamespace :: Namespace
cmPublicNamespace = CompileMetadata -> Namespace
cmPublicNamespace CompileMetadata
cm2,
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = CompileMetadata -> Namespace
cmPrivateNamespace CompileMetadata
cm2,
      cmPublicDeps :: [FilePath]
cmPublicDeps = CompileMetadata -> [FilePath]
cmPublicDeps CompileMetadata
cm2,
      cmPrivateDeps :: [FilePath]
cmPrivateDeps = CompileMetadata -> [FilePath]
cmPrivateDeps CompileMetadata
cm2,
      cmPublicCategories :: [CategoryName]
cmPublicCategories = CompileMetadata -> [CategoryName]
cmPublicCategories CompileMetadata
cm2,
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = CompileMetadata -> [CategoryName]
cmPrivateCategories CompileMetadata
cm2,
      cmPublicSubdirs :: [FilePath]
cmPublicSubdirs = CompileMetadata -> [FilePath]
cmPublicSubdirs CompileMetadata
cm2,
      cmPrivateSubdirs :: [FilePath]
cmPrivateSubdirs = CompileMetadata -> [FilePath]
cmPrivateSubdirs CompileMetadata
cm2,
      cmPublicFiles :: [FilePath]
cmPublicFiles = CompileMetadata -> [FilePath]
cmPublicFiles CompileMetadata
cm2,
      cmPrivateFiles :: [FilePath]
cmPrivateFiles = CompileMetadata -> [FilePath]
cmPrivateFiles CompileMetadata
cm2,
      cmTestFiles :: [FilePath]
cmTestFiles = CompileMetadata -> [FilePath]
cmTestFiles CompileMetadata
cm2,
      cmHxxFiles :: [FilePath]
cmHxxFiles = CompileMetadata -> [FilePath]
cmHxxFiles CompileMetadata
cm2,
      cmCxxFiles :: [FilePath]
cmCxxFiles = CompileMetadata -> [FilePath]
cmCxxFiles CompileMetadata
cm2,
      cmBinaries :: [FilePath]
cmBinaries = [FilePath]
bs,
      cmLibraries :: [FilePath]
cmLibraries = CompileMetadata -> [FilePath]
cmLibraries CompileMetadata
cm2,
      cmLinkFlags :: [FilePath]
cmLinkFlags = CompileMetadata -> [FilePath]
cmLinkFlags CompileMetadata
cm2,
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = CompileMetadata -> [ObjectFile]
cmObjectFiles CompileMetadata
cm2
    }
  FilePath -> CompileMetadata -> UTCTime -> TrackedErrorsIO ()
writeMetadata (FilePath
p FilePath -> ShowS
</> FilePath
d) CompileMetadata
cm2' UTCTime
time
  let traces :: Set FilePath
traces = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CxxOutput -> Set FilePath
coPossibleTraces forall a b. (a -> b) -> a -> b
$ [CxxOutput]
hxx forall a. [a] -> [a] -> [a]
++ [CxxOutput]
other
  FilePath -> Set FilePath -> TrackedErrorsIO ()
writePossibleTraces (FilePath
p FilePath -> ShowS
</> FilePath
d) Set FilePath
traces where
    ep' :: [FilePath]
ep' = [FilePath] -> [FilePath]
fixPaths forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FilePath
p FilePath -> ShowS
</>) [FilePath]
ep
    includeSpec :: Map k (CategorySpec a)
-> (k, CategorySpec a) -> m (Map k (CategorySpec a))
includeSpec Map k (CategorySpec a)
cm (k
n,CategorySpec a
cc) = do
      case k
n forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (CategorySpec a)
cm of
           Just CategorySpec a
cc2 -> forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$
             FilePath
"Internal specs for category " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show k
n forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> FilePath
formatFullContextBrace (forall c. CategorySpec c -> [c]
csContext CategorySpec a
cc) forall a. [a] -> [a] -> [a]
++
             FilePath
" already defined at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> FilePath
formatFullContextBrace (forall c. CategorySpec c -> [c]
csContext CategorySpec a
cc2)
           Maybe (CategorySpec a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
n CategorySpec a
cc Map k (CategorySpec a)
cm
    writeOutputFile :: [FilePath]
-> UTCTime
-> CxxOutput
-> TrackedErrorsT
     IO (Either (m (AsyncWait b), CxxOutput) CxxOutput)
writeOutputFile [FilePath]
paths UTCTime
time ca :: CxxOutput
ca@(CxxOutput Maybe CategoryName
_ FilePath
f2 Namespace
ns Set Namespace
_ Set CategoryName
_ Set FilePath
_ [FilePath]
content) = do
      forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file " forall a. [a] -> [a] -> [a]
++ FilePath
f2
      ()
_ <- FilePath
-> FilePath
-> FilePath
-> Maybe UTCTime
-> FilePath
-> TrackedErrorsIO ()
writeCachedFile (FilePath
p FilePath -> ShowS
</> FilePath
d) (forall a. Show a => a -> FilePath
show Namespace
ns) FilePath
f2 (forall a. a -> Maybe a
Just UTCTime
time) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ FilePath
"\n") [FilePath]
content
      if forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".cpp" FilePath
f2 Bool -> Bool -> Bool
|| forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".cc" FilePath
f2
         then do
           let f2' :: FilePath
f2' = FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (forall a. Show a => a -> FilePath
show Namespace
ns) FilePath
f2
           let p0 :: FilePath
p0 = FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) FilePath
"" FilePath
""
           let p1 :: FilePath
p1 = FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (forall a. Show a => a -> FilePath
show Namespace
ns) FilePath
""
           FilePath -> TrackedErrorsIO ()
createCachePath (FilePath
p FilePath -> ShowS
</> FilePath
d)
           let ms :: [a]
ms = []
           let command :: CxxCommand
command = FilePath
-> FilePath
-> [(FilePath, Maybe FilePath)]
-> [FilePath]
-> Bool
-> CxxCommand
CompileToObject FilePath
f2' (FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (forall a. Show a => a -> FilePath
show Namespace
ns) FilePath
"") forall a. [a]
ms (FilePath
p0forall a. a -> [a] -> [a]
:FilePath
p1forall a. a -> [a] -> [a]
:[FilePath]
paths) Bool
False
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m (AsyncWait b)
asyncCxxCommand b
backend CxxCommand
command,CxxOutput
ca)
         else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right CxxOutput
ca
    compileGenerated :: [Either (m (AsyncWait b), a) a] -> m [([FilePath], a)]
compileGenerated [Either (m (AsyncWait b), a) a]
files = do
      let ([(m (AsyncWait b), a)]
compiled,[a]
saved) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (m (AsyncWait b), a) a]
files
      [(FilePath, a)]
compiled' <- forall b (m :: * -> *) a.
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> Int -> [(m (AsyncWait b), a)] -> m [(FilePath, a)]
parallelProcess b
backend Int
pn [(m (AsyncWait b), a)]
compiled
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((,) []) [a]
saved forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. a -> [a] -> [a]
:[])) [(FilePath, a)]
compiled'
    compileExtraSource :: (Namespace, Namespace)
-> Map CategoryName Namespace
-> [FilePath]
-> ExtraSource
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
compileExtraSource (Namespace
ns0,Namespace
ns1) Map CategoryName Namespace
ca [FilePath]
paths (CategorySource FilePath
f2 [CategoryName]
cs2 [CategoryName]
ds2) = do
      Either (m (AsyncWait b)) [FilePath]
f2' <- forall {m :: * -> *} {a} {b}.
(MonadIO m, CollectErrorsM m, Show a, Show b) =>
Bool
-> (a, b)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
compileExtraFile Bool
False (Namespace
ns0,Namespace
ns1) [FilePath]
paths FilePath
f2
      case Either (m (AsyncWait b)) [FilePath]
f2' of
           Left m (AsyncWait b)
process -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left  (m (AsyncWait b)
process,forall a. a -> Maybe a
Just [CxxOutput]
allFakeCxx)
           Right [FilePath]
fs     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ([FilePath]
fs,     forall a. a -> Maybe a
Just [CxxOutput]
allFakeCxx)
      where
        allDeps :: Set CategoryName
allDeps = forall a. Ord a => [a] -> Set a
Set.fromList ([CategoryName]
cs2 forall a. [a] -> [a] -> [a]
++ [CategoryName]
ds2)
        allFakeCxx :: [CxxOutput]
allFakeCxx = forall a b. (a -> b) -> [a] -> [b]
map CategoryName -> CxxOutput
fakeCxx [CategoryName]
cs2
        fakeCxx :: CategoryName -> CxxOutput
fakeCxx CategoryName
c = CxxOutput {
            coCategory :: Maybe CategoryName
coCategory = forall a. a -> Maybe a
Just CategoryName
c,
            coFilename :: FilePath
coFilename = FilePath
"",
            coNamespace :: Namespace
coNamespace = case CategoryName
c forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map CategoryName Namespace
ca of
                               Just Namespace
ns2 -> Namespace
ns2
                               Maybe Namespace
Nothing  -> Namespace
NoNamespace,
            coUsesNamespace :: Set Namespace
coUsesNamespace = forall a. Ord a => [a] -> Set a
Set.fromList [Namespace
ns0,Namespace
ns1],
            coUsesCategory :: Set CategoryName
coUsesCategory = CategoryName
c forall a. Ord a => a -> Set a -> Set a
`Set.delete` Set CategoryName
allDeps,
            coPossibleTraces :: Set FilePath
coPossibleTraces = forall a. Set a
Set.empty,
            coOutput :: [FilePath]
coOutput = []
          }
    compileExtraSource (Namespace
ns0,Namespace
ns1) Map CategoryName Namespace
_ [FilePath]
paths (OtherSource FilePath
f2) = do
      Either (m (AsyncWait b)) [FilePath]
f2' <- forall {m :: * -> *} {a} {b}.
(MonadIO m, CollectErrorsM m, Show a, Show b) =>
Bool
-> (a, b)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
compileExtraFile Bool
False (Namespace
ns0,Namespace
ns1) [FilePath]
paths FilePath
f2
      case Either (m (AsyncWait b)) [FilePath]
f2' of
           Left m (AsyncWait b)
process -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left  (m (AsyncWait b)
process,forall a. Maybe a
Nothing)
           Right [FilePath]
fs     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ([FilePath]
fs,     forall a. Maybe a
Nothing)
    compileExtra :: [Either (m (AsyncWait b), Maybe [a]) ([FilePath], Maybe [a])]
-> m [Either ([FilePath], a) ObjectFile]
compileExtra [Either (m (AsyncWait b), Maybe [a]) ([FilePath], Maybe [a])]
files = do
      let ([(m (AsyncWait b), Maybe [a])]
compiled,[([FilePath], Maybe [a])]
inert) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (m (AsyncWait b), Maybe [a]) ([FilePath], Maybe [a])]
files
      [(FilePath, Maybe [a])]
compiled' <- forall b (m :: * -> *) a.
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> Int -> [(m (AsyncWait b), a)] -> m [(FilePath, a)]
parallelProcess b
backend Int
pn [(m (AsyncWait b), Maybe [a])]
compiled
      -- NOTE: Leave inert last in case it contains .a files.
      let files' :: [([FilePath], Maybe [a])]
files' = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. a -> [a] -> [a]
:[])) [(FilePath, Maybe [a])]
compiled' forall a. [a] -> [a] -> [a]
++ [([FilePath], Maybe [a])]
inert
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}.
([FilePath], Maybe [a]) -> [Either ([FilePath], a) ObjectFile]
expand [([FilePath], Maybe [a])]
files' where
        expand :: ([FilePath], Maybe [a]) -> [Either ([FilePath], a) ObjectFile]
expand ([FilePath]
os,Just [a]
cxx) = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) [FilePath]
os) [a]
cxx
        expand ([FilePath]
os,Maybe [a]
Nothing)  = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ObjectFile
OtherObjectFile) [FilePath]
os
    checkOwnedFile :: FilePath -> m FilePath
checkOwnedFile FilePath
f2 = do
      Bool
exists <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
f2
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
exists) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ FilePath
"Owned file " forall a. [a] -> [a] -> [a]
++ FilePath
f2 forall a. [a] -> [a] -> [a]
++ FilePath
" does not exist."
      forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
f2
    compileExtraFile :: Bool
-> (a, b)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
compileExtraFile Bool
e (a
ns0,b
ns1) [FilePath]
paths FilePath
f2
      | forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".cpp" FilePath
f2 Bool -> Bool -> Bool
|| forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".cc" FilePath
f2 = do
          let f2' :: FilePath
f2' = FilePath
p FilePath -> ShowS
</> FilePath
f2
          FilePath -> TrackedErrorsIO ()
createCachePath (FilePath
p FilePath -> ShowS
</> FilePath
d)
          let ms :: [(FilePath, Maybe FilePath)]
ms = [(FilePath
publicNamespaceMacro,forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show a
ns0),(FilePath
privateNamespaceMacro,forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show b
ns1)]
          FilePath
objPath <- FilePath -> FilePath -> TrackedErrorsT IO FilePath
createCachedDir (FilePath
p FilePath -> ShowS
</> FilePath
d) FilePath
"extra"
          let command :: CxxCommand
command = FilePath
-> FilePath
-> [(FilePath, Maybe FilePath)]
-> [FilePath]
-> Bool
-> CxxCommand
CompileToObject FilePath
f2' FilePath
objPath [(FilePath, Maybe FilePath)]
ms [FilePath]
paths Bool
e
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m (AsyncWait b)
asyncCxxCommand b
backend CxxCommand
command
      | forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".a" FilePath
f2 Bool -> Bool -> Bool
|| forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".o" FilePath
f2 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [FilePath
f2]
      | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right []
    createBinary :: VersionHash
-> [FilePath]
-> [CompileMetadata]
-> UTCTime
-> CompileMode
-> [CxxOutput]
-> TrackedErrorsT IO [FilePath]
createBinary VersionHash
compilerHash [FilePath]
paths [CompileMetadata]
deps UTCTime
time (CompileBinary CategoryName
n FunctionName
_ LinkerMode
lm FilePath
o [FilePath]
lf) [CxxOutput Maybe CategoryName
_ FilePath
_ Namespace
_ Set Namespace
ns2 Set CategoryName
req Set FilePath
_ [FilePath]
content] = do
      FilePath
f0 <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
o
                then forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath forall a b. (a -> b) -> a -> b
$ FilePath
p FilePath -> ShowS
</> FilePath
d FilePath -> ShowS
</> forall a. Show a => a -> FilePath
show CategoryName
n
                else forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath forall a b. (a -> b) -> a -> b
$ FilePath
p FilePath -> ShowS
</> FilePath
d FilePath -> ShowS
</> FilePath
o
      let main :: FilePath
main = ShowS
takeFileName FilePath
f0 forall a. [a] -> [a] -> [a]
++ FilePath
".cpp"
      forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file " forall a. [a] -> [a] -> [a]
++ FilePath
main
      let mainAbs :: FilePath
mainAbs = FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) FilePath
"main" FilePath
main
      ()
_ <- FilePath
-> FilePath
-> FilePath
-> Maybe UTCTime
-> FilePath
-> TrackedErrorsIO ()
writeCachedFile (FilePath
p FilePath -> ShowS
</> FilePath
d) FilePath
"main" FilePath
main (forall a. a -> Maybe a
Just UTCTime
time) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ FilePath
"\n") [FilePath]
content
      FilePath
base <- forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
resolveBaseModule r
resolver
      [CompileMetadata]
deps2  <- VersionHash
-> ForceMode
-> MetadataMap
-> [CompileMetadata]
-> TrackedErrorsIO [CompileMetadata]
loadPrivateDeps VersionHash
compilerHash ForceMode
f ([CompileMetadata] -> MetadataMap
mapMetadata [CompileMetadata]
deps) [CompileMetadata]
deps
      let paths' :: [FilePath]
paths' = [FilePath] -> [FilePath]
fixPaths forall a b. (a -> b) -> a -> b
$ [FilePath]
paths forall a. [a] -> [a] -> [a]
++ FilePath
baseforall a. a -> [a] -> [a]
:([CompileMetadata] -> [FilePath]
getIncludePathsForDeps [CompileMetadata]
deps)
      CxxCommand
command <- forall {m :: * -> *}.
Monad m =>
LinkerMode
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [FilePath]
-> m CxxCommand
getCommand LinkerMode
lm FilePath
mainAbs FilePath
f0 [CompileMetadata]
deps2 [FilePath]
paths'
      forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ FilePath
"Creating binary " forall a. [a] -> [a] -> [a]
++ FilePath
f0
      FilePath
f1 <- forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m FilePath
syncCxxCommand b
backend CxxCommand
command
      forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
f1] where
        getCommand :: LinkerMode
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [FilePath]
-> m CxxCommand
getCommand LinkerMode
LinkStatic FilePath
mainAbs FilePath
f0 [CompileMetadata]
deps2 [FilePath]
paths2 = do
          let lf' :: [FilePath]
lf' = [FilePath]
lf forall a. [a] -> [a] -> [a]
++ [CompileMetadata] -> [FilePath]
getLinkFlagsForDeps [CompileMetadata]
deps2
          let os :: [ObjectFile]
os     = [CompileMetadata] -> [ObjectFile]
getObjectFilesForDeps [CompileMetadata]
deps2
          let ofr :: Set Namespace -> Set CategoryName -> [FilePath]
ofr = [ObjectFile] -> Set Namespace -> Set CategoryName -> [FilePath]
getObjectFileResolver [ObjectFile]
os
          let objects :: [FilePath]
objects = Set Namespace -> Set CategoryName -> [FilePath]
ofr Set Namespace
ns2 (Set CategoryName
req forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CategoryName
requiredStaticTypes)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> [(FilePath, Maybe FilePath)]
-> FilePath
-> [FilePath]
-> [FilePath]
-> CxxCommand
CompileToBinary FilePath
mainAbs [FilePath]
objects [] FilePath
f0 [FilePath]
paths2 [FilePath]
lf'
        getCommand LinkerMode
LinkDynamic FilePath
mainAbs FilePath
f0 [CompileMetadata]
deps2 [FilePath]
paths2 = do
          let objects :: [FilePath]
objects = [CompileMetadata] -> [FilePath]
getLibrariesForDeps [CompileMetadata]
deps2
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> [(FilePath, Maybe FilePath)]
-> FilePath
-> [FilePath]
-> [FilePath]
-> CxxCommand
CompileToBinary FilePath
mainAbs [FilePath]
objects [] FilePath
f0 [FilePath]
paths2 []
    createBinary VersionHash
_ [FilePath]
_ [CompileMetadata]
_ UTCTime
_ (CompileBinary CategoryName
n FunctionName
_ LinkerMode
_ FilePath
_ [FilePath]
_) [] =
      forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ FilePath
"Main category " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show CategoryName
n forall a. [a] -> [a] -> [a]
++ FilePath
" not found."
    createBinary VersionHash
_ [FilePath]
_ [CompileMetadata]
_ UTCTime
_ (CompileBinary CategoryName
n FunctionName
_ LinkerMode
_ FilePath
_ [FilePath]
_) [CxxOutput]
_ =
      forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ FilePath
"Multiple matches for main category " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show CategoryName
n forall a. [a] -> [a] -> [a]
++ FilePath
"."
    createBinary VersionHash
_ [FilePath]
_ [CompileMetadata]
_ UTCTime
_ CompileMode
_ [CxxOutput]
_  = forall (m :: * -> *) a. Monad m => a -> m a
return []
    createLibrary :: FilePath
-> [FilePath] -> [CompileMetadata] -> [ObjectFile] -> m [FilePath]
createLibrary FilePath
_ [FilePath]
_ [] [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
    createLibrary FilePath
name [FilePath]
lf [CompileMetadata]
deps [ObjectFile]
os = do
      let flags :: [FilePath]
flags = [FilePath]
lf forall a. [a] -> [a] -> [a]
++ [CompileMetadata] -> [FilePath]
getLinkFlagsForDeps [CompileMetadata]
deps
      -- NOTE: nub is needed because an extension that defines multiple
      -- categories will show up more than once in getObjectFiles.
      let objects :: [FilePath]
objects = (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ObjectFile -> [FilePath]
getObjectFiles [ObjectFile]
os) forall a. [a] -> [a] -> [a]
++ [CompileMetadata] -> [FilePath]
getLibrariesForDeps [CompileMetadata]
deps
      let command :: CxxCommand
command = [FilePath] -> FilePath -> [FilePath] -> CxxCommand
CompileToShared [FilePath]
objects FilePath
name [FilePath]
flags
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m FilePath
syncCxxCommand b
backend CxxCommand
command
    maybeCreateMain :: LanguageModule c
-> [PrivateSource c] -> CompileMode -> f [CxxOutput]
maybeCreateMain LanguageModule c
cm2 [PrivateSource c]
xs2 (CompileBinary CategoryName
n FunctionName
f2 LinkerMode
_ FilePath
_ [FilePath]
_) =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput
compileModuleMain LanguageModule c
cm2 [PrivateSource c]
xs2 CategoryName
n FunctionName
f2
    maybeCreateMain LanguageModule c
_ [PrivateSource c]
_ CompileMode
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []

createModuleTemplates :: PathIOHandler r => r -> FilePath -> FilePath -> [FilePath] ->
  Map.Map CategoryName (CategorySpec SourceContext) ->[CompileMetadata] ->
  [CompileMetadata] -> TrackedErrorsIO ()
createModuleTemplates :: forall r.
PathIOHandler r =>
r
-> FilePath
-> FilePath
-> [FilePath]
-> Map CategoryName (CategorySpec SourceContext)
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO ()
createModuleTemplates r
resolver FilePath
p FilePath
d [FilePath]
ds Map CategoryName (CategorySpec SourceContext)
cm [CompileMetadata]
deps1 [CompileMetadata]
deps2 = do
  UTCTime
time <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO UTCTime
getCurrentTime
  ([FilePath]
ps,[FilePath]
xs,[FilePath]
_) <- FilePath
-> [FilePath]
-> TrackedErrorsIO ([FilePath], [FilePath], [FilePath])
findSourceFiles FilePath
p (FilePath
dforall a. a -> [a] -> [a]
:[FilePath]
ds)
  (LanguageModule Set Namespace
_ Set Namespace
_ Set Namespace
_ [AnyCategory SourceContext]
cs0 [AnyCategory SourceContext]
ps0 [AnyCategory SourceContext]
tc0 [AnyCategory SourceContext]
tp0 [AnyCategory SourceContext]
cs1 [AnyCategory SourceContext]
ps1 [AnyCategory SourceContext]
tc1 [AnyCategory SourceContext]
tp1 [CategoryName]
_ ExprMap SourceContext
_ CategoryMap SourceContext
cm0) <-
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c.
[CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [] forall k a. Map k a
Map.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
loadModuleGlobals r
resolver FilePath
p (Namespace
PublicNamespace,Namespace
PrivateNamespace) [FilePath]
ps forall a. Maybe a
Nothing [CompileMetadata]
deps1 [CompileMetadata]
deps2
  [(FilePath, FilePath)]
xs' <- forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver FilePath
p [FilePath]
xs
  [([PragmaSource SourceContext], [AnyCategory SourceContext],
  [DefinedCategory SourceContext])]
ds2 <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall (m :: * -> *).
ErrorContextM m =>
(FilePath, FilePath)
-> m ([PragmaSource SourceContext], [AnyCategory SourceContext],
      [DefinedCategory SourceContext])
parseInternalSource [(FilePath, FilePath)]
xs'
  let ds3 :: [DefinedCategory SourceContext]
ds3 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\([PragmaSource SourceContext]
_,[AnyCategory SourceContext]
_,[DefinedCategory SourceContext]
d2) -> [DefinedCategory SourceContext]
d2) [([PragmaSource SourceContext], [AnyCategory SourceContext],
  [DefinedCategory SourceContext])]
ds2
  CategoryMap SourceContext
tm <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap SourceContext
cm0 [[AnyCategory SourceContext]
cs0,[AnyCategory SourceContext]
cs1,[AnyCategory SourceContext]
ps0,[AnyCategory SourceContext]
ps1,[AnyCategory SourceContext]
tc0,[AnyCategory SourceContext]
tp0,[AnyCategory SourceContext]
tc1,[AnyCategory SourceContext]
tp1]
  let cs :: [AnyCategory SourceContext]
cs = forall a. (a -> Bool) -> [a] -> [a]
filter forall c. AnyCategory c -> Bool
isValueConcrete forall a b. (a -> b) -> a -> b
$ [AnyCategory SourceContext]
cs1forall a. [a] -> [a] -> [a]
++[AnyCategory SourceContext]
ps1forall a. [a] -> [a] -> [a]
++[AnyCategory SourceContext]
tc1forall a. [a] -> [a] -> [a]
++[AnyCategory SourceContext]
tp1
  let ca :: Set CategoryName
ca = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. AnyCategory c -> CategoryName
getCategoryName forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall c. AnyCategory c -> Bool
isValueConcrete [AnyCategory SourceContext]
cs
  let ca' :: Set CategoryName
ca' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => a -> Set a -> Set a
Set.delete Set CategoryName
ca forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. DefinedCategory c -> CategoryName
dcName [DefinedCategory SourceContext]
ds3
  let testingCats :: Set CategoryName
testingCats = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map forall c. AnyCategory c -> CategoryName
getCategoryName [AnyCategory SourceContext]
tc1) forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map forall c. AnyCategory c -> CategoryName
getCategoryName [AnyCategory SourceContext]
tp1)
  [CxxOutput]
ts <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (\CategoryName
n -> forall {m :: * -> *}.
CollectErrorsM m =>
Bool -> CategoryMap SourceContext -> CategoryName -> m [CxxOutput]
generate (CategoryName
n forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
testingCats) CategoryMap SourceContext
tm CategoryName
n) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set CategoryName
ca'
  forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (forall {m :: * -> *}.
(MonadIO m, ErrorContextM m) =>
UTCTime -> CxxOutput -> m ()
writeTemplate UTCTime
time) [CxxOutput]
ts where
    generate :: Bool -> CategoryMap SourceContext -> CategoryName -> m [CxxOutput]
generate Bool
testing CategoryMap SourceContext
tm CategoryName
n = do
      ([SourceContext]
_,AnyCategory SourceContext
t) <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap SourceContext
tm ([],CategoryName
n)
      let spec :: CategorySpec SourceContext
spec = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall c.
[c] -> [ValueRefine c] -> [ValueDefine c] -> CategorySpec c
CategorySpec [] [] []) (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory SourceContext
t) Map CategoryName (CategorySpec SourceContext)
cm
      forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool
-> CategoryMap c
-> AnyCategory c
-> CategorySpec c
-> m [CxxOutput]
generateStreamlinedTemplate Bool
testing CategoryMap SourceContext
tm AnyCategory SourceContext
t CategorySpec SourceContext
spec
    writeTemplate :: UTCTime -> CxxOutput -> m ()
writeTemplate UTCTime
time (CxxOutput Maybe CategoryName
_ FilePath
n Namespace
_ Set Namespace
_ Set CategoryName
_ Set FilePath
_ [FilePath]
content) = do
      let n' :: FilePath
n' = FilePath
p FilePath -> ShowS
</> FilePath
d FilePath -> ShowS
</> FilePath
n
      Bool
exists <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
n'
      if Bool
exists
         then forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
compilerWarningM forall a b. (a -> b) -> a -> b
$ FilePath
"Skipping existing file " forall a. [a] -> [a] -> [a]
++ FilePath
n
         else do
           forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file " forall a. [a] -> [a] -> [a]
++ FilePath
n
           forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
n' forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ FilePath
"\n") [FilePath]
content
           -- This is to avoid a race condition when the module is compiled
           -- immediately after generating templates, since the former
           -- explicitly sets the metadata timestamp.
           forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> UTCTime -> IO ()
setModificationTime FilePath
n' UTCTime
time

runModuleTests :: (PathIOHandler r, CompilerBackend b) =>
  r -> b -> FilePath -> FilePath -> [FilePath] -> LoadedTests ->
  TrackedErrorsIO [((Int,Int),TrackedErrors ())]
runModuleTests :: forall r b.
(PathIOHandler r, CompilerBackend b) =>
r
-> b
-> FilePath
-> FilePath
-> [FilePath]
-> LoadedTests
-> TrackedErrorsIO [((Int, Int), TrackedErrors ())]
runModuleTests r
resolver b
backend FilePath
cl FilePath
base [FilePath]
tp (LoadedTests CompileMetadata
m ExprMap SourceContext
em [CompileMetadata]
deps1 [CompileMetadata]
deps2) = do
  let paths :: [FilePath]
paths = FilePath
baseforall a. a -> [a] -> [a]
:(CompileMetadata -> [FilePath]
cmPublicSubdirs CompileMetadata
m forall a. [a] -> [a] -> [a]
++ CompileMetadata -> [FilePath]
cmPrivateSubdirs CompileMetadata
m forall a. [a] -> [a] -> [a]
++ [CompileMetadata] -> [FilePath]
getIncludePathsForDeps [CompileMetadata]
deps1)
  forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
showSkipped forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
isTestAllowed) forall a b. (a -> b) -> a -> b
$ CompileMetadata -> [FilePath]
cmTestFiles CompileMetadata
m
  [(FilePath, FilePath)]
ts' <- forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver (CompileMetadata -> FilePath
cmRoot CompileMetadata
m) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isTestAllowed forall a b. (a -> b) -> a -> b
$ CompileMetadata -> [FilePath]
cmTestFiles CompileMetadata
m
  let path :: FilePath
path = CompileMetadata -> FilePath
cmPath CompileMetadata
m
  LanguageModule SourceContext
cm <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c.
[CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [] ExprMap SourceContext
em forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
loadModuleGlobals r
resolver FilePath
path (Namespace
NoNamespace,Namespace
NoNamespace) [] (forall a. a -> Maybe a
Just CompileMetadata
m) [CompileMetadata]
deps1 []
  forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall b.
CompilerBackend b =>
b
-> FilePath
-> LanguageModule SourceContext
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> TrackedErrorsIO ((Int, Int), TrackedErrors ())
runSingleTest b
backend FilePath
cl LanguageModule SourceContext
cm [FilePath]
paths (CompileMetadata
mforall a. a -> [a] -> [a]
:[CompileMetadata]
deps2)) [(FilePath, FilePath)]
ts' where
    allowTests :: Set FilePath
allowTests = forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
tp
    isTestAllowed :: FilePath -> Bool
isTestAllowed FilePath
t
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set FilePath
allowTests = Bool
True
      | Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
t) Set FilePath
allowTests
    showSkipped :: FilePath -> m ()
showSkipped FilePath
f = forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
compilerWarningM forall a b. (a -> b) -> a -> b
$ FilePath
"Skipping tests in " forall a. [a] -> [a] -> [a]
++ FilePath
f forall a. [a] -> [a] -> [a]
++ FilePath
" due to explicit test filter."

loadPrivateSource :: PathIOHandler r => r -> VersionHash -> FilePath -> FilePath -> TrackedErrorsIO (PrivateSource SourceContext)
loadPrivateSource :: forall r.
PathIOHandler r =>
r
-> VersionHash
-> FilePath
-> FilePath
-> TrackedErrorsIO (PrivateSource SourceContext)
loadPrivateSource r
resolver VersionHash
h FilePath
p FilePath
f = do
  [(FilePath, FilePath)
f'] <- forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver FilePath
p [FilePath
f]
  UTCTime
time <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO UTCTime
getCurrentTime
  FilePath
path <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> ShowS
</> FilePath
f)
  let ns :: Namespace
ns = FilePath -> Namespace
StaticNamespace forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> FilePath
privateNamespace forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show UTCTime
time forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show VersionHash
h forall a. [a] -> [a] -> [a]
++ FilePath
path
  ([PragmaSource SourceContext]
pragmas,[AnyCategory SourceContext]
cs,[DefinedCategory SourceContext]
ds) <- forall (m :: * -> *).
ErrorContextM m =>
(FilePath, FilePath)
-> m ([PragmaSource SourceContext], [AnyCategory SourceContext],
      [DefinedCategory SourceContext])
parseInternalSource (FilePath, FilePath)
f'
  let cs' :: [AnyCategory SourceContext]
cs' = forall a b. (a -> b) -> [a] -> [b]
map (forall c. Namespace -> AnyCategory c -> AnyCategory c
setCategoryNamespace Namespace
ns) [AnyCategory SourceContext]
cs
  let testing :: Bool
testing = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall c. PragmaSource c -> Bool
isTestsOnly [PragmaSource SourceContext]
pragmas
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
Namespace
-> Bool
-> [AnyCategory c]
-> [DefinedCategory c]
-> PrivateSource c
PrivateSource Namespace
ns Bool
testing [AnyCategory SourceContext]
cs' [DefinedCategory SourceContext]
ds

createLanguageModule :: [CategoryName] -> ExprMap c ->
  [WithVisibility (AnyCategory c)] -> LanguageModule c
createLanguageModule :: forall c.
[CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [CategoryName]
ss ExprMap c
em [WithVisibility (AnyCategory c)]
cs = LanguageModule c
lm where
  lm :: LanguageModule c
lm = LanguageModule {
      lmPublicNamespaces :: Set Namespace
lmPublicNamespaces    = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility Namespace]
ns [forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly],
      lmPrivateNamespaces :: Set Namespace
lmPrivateNamespaces   = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility Namespace]
ns [forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly],
      lmLocalNamespaces :: Set Namespace
lmLocalNamespaces     = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility Namespace]
ns [forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency],
      lmPublicDeps :: [AnyCategory c]
lmPublicDeps          = forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPrivateDeps :: [AnyCategory c]
lmPrivateDeps         = forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPublicTestingDeps :: [AnyCategory c]
lmPublicTestingDeps   = forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly,forall a. CodeVisibility -> WithVisibility a -> Bool
with CodeVisibility
TestsOnly],
      lmPrivateTestingDeps :: [AnyCategory c]
lmPrivateTestingDeps  = forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly,forall a. CodeVisibility -> WithVisibility a -> Bool
with CodeVisibility
TestsOnly],
      lmPublicLocal :: [AnyCategory c]
lmPublicLocal         = forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPrivateLocal :: [AnyCategory c]
lmPrivateLocal        = forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPublicTestingLocal :: [AnyCategory c]
lmPublicTestingLocal  = forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly,forall a. CodeVisibility -> WithVisibility a -> Bool
with CodeVisibility
TestsOnly],
      lmPrivateTestingLocal :: [AnyCategory c]
lmPrivateTestingLocal = forall a b. (a -> b) -> [a] -> [b]
map forall a. WithVisibility a -> a
wvData forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency,forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly,forall a. CodeVisibility -> WithVisibility a -> Bool
with CodeVisibility
TestsOnly],
      lmStreamlined :: [CategoryName]
lmStreamlined = [CategoryName]
ss,
      lmExprMap :: ExprMap c
lmExprMap  = ExprMap c
em,
      lmEmptyCategories :: CategoryMap c
lmEmptyCategories = forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km forall k a. Map k a
Map.empty
    }
  km :: Map CategoryName [c]
km = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(WithVisibility Set CodeVisibility
_ AnyCategory c
t) -> (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t,forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory c
t)) [WithVisibility (AnyCategory c)]
cs
  ns :: [WithVisibility Namespace]
ns = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> WithVisibility a -> WithVisibility b
mapCodeVisibility forall c. AnyCategory c -> Namespace
getCategoryNamespace) [WithVisibility (AnyCategory c)]
cs
  with :: CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
v = forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
v
  without :: CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
v = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
v
  apply :: [a] -> [a -> Bool] -> [a]
apply = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. (a -> Bool) -> [a] -> [a]
filter

warnPublic :: PathIOHandler r => r -> FilePath -> [CategoryName] ->
  [CategoryName] -> [ObjectFile] -> [FilePath] -> TrackedErrorsIO ()
warnPublic :: forall r.
PathIOHandler r =>
r
-> FilePath
-> [CategoryName]
-> [CategoryName]
-> [ObjectFile]
-> [FilePath]
-> TrackedErrorsIO ()
warnPublic r
resolver FilePath
p [CategoryName]
pc [CategoryName]
dc [ObjectFile]
os = forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
FilePath -> m ()
checkPublic where
  checkPublic :: FilePath -> m ()
checkPublic FilePath
d = do
    FilePath
d2 <- forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
p FilePath
d
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ FilePath
d2 forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
neededPublic) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
compilerWarningM forall a b. (a -> b) -> a -> b
$ FilePath
"Dependency \"" forall a. [a] -> [a] -> [a]
++ FilePath
d forall a. [a] -> [a] -> [a]
++ FilePath
"\" does not need to be public"
  pc' :: Set CategoryName
pc' = forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
pc
  dc' :: Set CategoryName
dc' = forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
dc
  neededPublic :: Set FilePath
neededPublic = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ObjectFile -> [FilePath]
checkDep [ObjectFile]
os
  checkDep :: ObjectFile -> [FilePath]
checkDep (CategoryObjectFile (CategoryIdentifier FilePath
_ CategoryName
n Namespace
_) [CategoryIdentifier]
ds [FilePath]
_)
    | CategoryName
n forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
pc' = forall a b. (a -> b) -> [a] -> [b]
map CategoryIdentifier -> FilePath
ciPath forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
dc') forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategoryIdentifier -> CategoryName
ciCategory) [CategoryIdentifier]
ds
  checkDep ObjectFile
_ = []