{- -----------------------------------------------------------------------------
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
(Int -> ModuleSpec -> ShowS)
-> (ModuleSpec -> FilePath)
-> ([ModuleSpec] -> ShowS)
-> Show ModuleSpec
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleSpec -> ShowS
showsPrec :: Int -> ModuleSpec -> ShowS
$cshow :: ModuleSpec -> FilePath
show :: ModuleSpec -> FilePath
$cshowList :: [ModuleSpec] -> ShowS
showList :: [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
(Int -> LoadedTests -> ShowS)
-> (LoadedTests -> FilePath)
-> ([LoadedTests] -> ShowS)
-> Show LoadedTests
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoadedTests -> ShowS
showsPrec :: Int -> LoadedTests -> ShowS
$cshow :: LoadedTests -> FilePath
show :: LoadedTests -> FilePath
$cshowList :: [LoadedTests] -> ShowS
showList :: [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 <- IO UTCTime -> TrackedErrorsT IO UTCTime
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO UTCTime
getCurrentTime
  [FilePath]
as  <- ([FilePath] -> [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> ShowS
</> FilePath
d)) [FilePath]
is
  [FilePath]
as2 <- ([FilePath] -> [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
(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 = Map k a
forall k a. Map k a
Map.empty
  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]
deps1 <- VersionHash
-> ForceMode
-> MetadataMap
-> [FilePath]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f MetadataMap
forall k a. Map k a
ca0 [FilePath]
as
  let ca1 :: MetadataMap
ca1 = MetadataMap
forall k a. Map k a
ca0 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
-> [FilePath]
-> TrackedErrorsIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f MetadataMap
ca1 [FilePath]
as2
  let ca2 :: MetadataMap
ca2 = MetadataMap
ca1 MetadataMap -> MetadataMap -> MetadataMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [CompileMetadata] -> MetadataMap
mapMetadata [CompileMetadata]
deps2
  FilePath
base <- r -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> m FilePath
resolveBaseModule r
resolver
  FilePath
actual <- r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
p FilePath
d
  Bool
isBase <- r -> FilePath -> TrackedErrorsT IO Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> m Bool
forall (m :: * -> *).
(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 [CompileMetadata] -> TrackedErrorsIO [CompileMetadata]
forall a. a -> TrackedErrorsT IO a
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]
                 [CompileMetadata] -> TrackedErrorsIO [CompileMetadata]
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompileMetadata] -> TrackedErrorsIO [CompileMetadata])
-> [CompileMetadata] -> TrackedErrorsIO [CompileMetadata]
forall a b. (a -> b) -> a -> b
$ [CompileMetadata]
bpDeps [CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps1
  FilePath
root <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
  FilePath
path <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> ShowS
</> FilePath
d)
  [FilePath]
extra <- IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [IO FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([IO FilePath] -> IO [FilePath]) -> [IO FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO FilePath) -> [FilePath] -> [IO FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> ShowS -> FilePath -> IO FilePath
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 (FilePath -> Namespace) -> FilePath -> Namespace
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Hashable a => a -> FilePath
publicNamespace  ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ VersionHash -> FilePath
forall a. Show a => a -> FilePath
show VersionHash
compilerHash FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path
  let ns1 :: Namespace
ns1 = FilePath -> Namespace
StaticNamespace (FilePath -> Namespace) -> ShowS -> FilePath -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Hashable a => a -> FilePath
privateNamespace (FilePath -> Namespace) -> FilePath -> Namespace
forall a b. (a -> b) -> a -> b
$ UTCTime -> FilePath
forall a. Show a => a -> FilePath
show UTCTime
time FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ VersionHash -> FilePath
forall a. Show a => a -> FilePath
show VersionHash
compilerHash FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path
  let extensions :: [CategoryName]
extensions = [[CategoryName]] -> [CategoryName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CategoryName]] -> [CategoryName])
-> [[CategoryName]] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (ExtraSource -> [CategoryName])
-> [ExtraSource] -> [[CategoryName]]
forall a b. (a -> b) -> [a] -> [b]
map ExtraSource -> [CategoryName]
getSourceCategories [ExtraSource]
es
  ([WithVisibility (AnyCategory SourceContext)]
cs2,Set FilePath
private) <- r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
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 Maybe CompileMetadata
forall a. Maybe a
Nothing [CompileMetadata]
deps1' [CompileMetadata]
deps2
  let cm :: LanguageModule SourceContext
cm = [CategoryName]
-> ExprMap SourceContext
-> [WithVisibility (AnyCategory SourceContext)]
-> LanguageModule SourceContext
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' = (WithVisibility (AnyCategory SourceContext) -> Bool)
-> [WithVisibility (AnyCategory SourceContext)]
-> [WithVisibility (AnyCategory SourceContext)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (WithVisibility (AnyCategory SourceContext) -> Bool)
-> WithVisibility (AnyCategory SourceContext)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVisibility
-> WithVisibility (AnyCategory SourceContext) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
FromDependency) [WithVisibility (AnyCategory SourceContext)]
cs2
  let pc :: [CategoryName]
pc = (WithVisibility (AnyCategory SourceContext) -> CategoryName)
-> [WithVisibility (AnyCategory SourceContext)] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory SourceContext -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName (AnyCategory SourceContext -> CategoryName)
-> (WithVisibility (AnyCategory SourceContext)
    -> AnyCategory SourceContext)
-> WithVisibility (AnyCategory SourceContext)
-> CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithVisibility (AnyCategory SourceContext)
-> AnyCategory SourceContext
forall a. WithVisibility a -> a
wvData) ([WithVisibility (AnyCategory SourceContext)] -> [CategoryName])
-> [WithVisibility (AnyCategory SourceContext)] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourceContext) -> Bool)
-> [WithVisibility (AnyCategory SourceContext)]
-> [WithVisibility (AnyCategory SourceContext)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (WithVisibility (AnyCategory SourceContext) -> Bool)
-> WithVisibility (AnyCategory SourceContext)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVisibility
-> WithVisibility (AnyCategory SourceContext) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly) [WithVisibility (AnyCategory SourceContext)]
cs2'
  let tc :: [CategoryName]
tc = (WithVisibility (AnyCategory SourceContext) -> CategoryName)
-> [WithVisibility (AnyCategory SourceContext)] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory SourceContext -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName (AnyCategory SourceContext -> CategoryName)
-> (WithVisibility (AnyCategory SourceContext)
    -> AnyCategory SourceContext)
-> WithVisibility (AnyCategory SourceContext)
-> CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithVisibility (AnyCategory SourceContext)
-> AnyCategory SourceContext
forall a. WithVisibility a -> a
wvData) ([WithVisibility (AnyCategory SourceContext)] -> [CategoryName])
-> [WithVisibility (AnyCategory SourceContext)] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourceContext) -> Bool)
-> [WithVisibility (AnyCategory SourceContext)]
-> [WithVisibility (AnyCategory SourceContext)]
forall a. (a -> Bool) -> [a] -> [a]
filter (CodeVisibility
-> WithVisibility (AnyCategory SourceContext) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly)       [WithVisibility (AnyCategory SourceContext)]
cs2'
  let dc :: [CategoryName]
dc = (WithVisibility (AnyCategory SourceContext) -> CategoryName)
-> [WithVisibility (AnyCategory SourceContext)] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory SourceContext -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName (AnyCategory SourceContext -> CategoryName)
-> (WithVisibility (AnyCategory SourceContext)
    -> AnyCategory SourceContext)
-> WithVisibility (AnyCategory SourceContext)
-> CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithVisibility (AnyCategory SourceContext)
-> AnyCategory SourceContext
forall a. WithVisibility a -> a
wvData) ([WithVisibility (AnyCategory SourceContext)] -> [CategoryName])
-> [WithVisibility (AnyCategory SourceContext)] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourceContext) -> Bool)
-> [WithVisibility (AnyCategory SourceContext)]
-> [WithVisibility (AnyCategory SourceContext)]
forall a. (a -> Bool) -> [a] -> [a]
filter (CodeVisibility
-> WithVisibility (AnyCategory SourceContext) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
FromDependency) ([WithVisibility (AnyCategory SourceContext)]
 -> [WithVisibility (AnyCategory SourceContext)])
-> [WithVisibility (AnyCategory SourceContext)]
-> [WithVisibility (AnyCategory SourceContext)]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourceContext) -> Bool)
-> [WithVisibility (AnyCategory SourceContext)]
-> [WithVisibility (AnyCategory SourceContext)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (WithVisibility (AnyCategory SourceContext) -> Bool)
-> WithVisibility (AnyCategory SourceContext)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVisibility
-> WithVisibility (AnyCategory SourceContext) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly) [WithVisibility (AnyCategory SourceContext)]
cs2
  [PrivateSource SourceContext]
xa <- (FilePath -> TrackedErrorsT IO (PrivateSource SourceContext))
-> [FilePath] -> TrackedErrorsT IO [PrivateSource SourceContext]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r
-> VersionHash
-> FilePath
-> FilePath
-> TrackedErrorsT IO (PrivateSource SourceContext)
forall r.
PathIOHandler r =>
r
-> VersionHash
-> FilePath
-> FilePath
-> TrackedErrorsT IO (PrivateSource SourceContext)
loadPrivateSource r
resolver VersionHash
compilerHash FilePath
p) [FilePath]
xs
  Map CategoryName (CategorySpec SourceContext)
cs' <- (Map CategoryName (CategorySpec SourceContext)
 -> (CategoryName, CategorySpec SourceContext)
 -> TrackedErrorsT
      IO (Map CategoryName (CategorySpec SourceContext)))
-> Map CategoryName (CategorySpec SourceContext)
-> [(CategoryName, CategorySpec SourceContext)]
-> TrackedErrorsT
     IO (Map CategoryName (CategorySpec SourceContext))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map CategoryName (CategorySpec SourceContext)
-> (CategoryName, CategorySpec SourceContext)
-> TrackedErrorsT
     IO (Map CategoryName (CategorySpec SourceContext))
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 Map CategoryName (CategorySpec SourceContext)
forall k a. Map k a
Map.empty [(CategoryName, CategorySpec SourceContext)]
cs
  [CxxOutput]
fs <- LanguageModule SourceContext
-> Map CategoryName (CategorySpec SourceContext)
-> [PrivateSource SourceContext]
-> TrackedErrorsT IO [CxxOutput]
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 <- LanguageModule SourceContext
-> [PrivateSource SourceContext]
-> CompileMode
-> TrackedErrorsT IO [CxxOutput]
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 <- ([FilePath] -> [(FilePath, FilePath)])
-> TrackedErrorsT IO [FilePath]
-> TrackedErrorsT IO [(FilePath, FilePath)]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
ps) (TrackedErrorsT IO [FilePath]
 -> TrackedErrorsT IO [(FilePath, FilePath)])
-> TrackedErrorsT IO [FilePath]
-> TrackedErrorsT IO [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> (FilePath -> IO FilePath)
-> FilePath
-> TrackedErrorsT IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> ShowS -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
pFilePath -> ShowS
</>)) [FilePath]
ps
  let ps2 :: [FilePath]
ps2 = ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((FilePath, FilePath) -> Bool) -> (FilePath, FilePath) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
private) (FilePath -> Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd)) [(FilePath, FilePath)]
pps
  let xs2 :: [FilePath]
xs2 = [FilePath]
xs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
private) (FilePath -> Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) [(FilePath, FilePath)]
pps)
  let ts2 :: [FilePath]
ts2 = [FilePath]
ts
  let paths :: [FilePath]
paths = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
ns -> FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) FilePath
ns FilePath
"") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Namespace -> FilePath) -> [Namespace] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Namespace -> FilePath
forall a. Show a => a -> FilePath
show ([Namespace] -> [FilePath]) -> [Namespace] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (CxxOutput -> Namespace) -> [CxxOutput] -> [Namespace]
forall a b. (a -> b) -> [a] -> [b]
map CxxOutput -> Namespace
coNamespace [CxxOutput]
fs
  [FilePath]
paths' <- (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> (FilePath -> IO FilePath)
-> FilePath
-> TrackedErrorsT IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath) [FilePath]
paths
  FilePath
s0 <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (Namespace -> FilePath
forall a. Show a => a -> FilePath
show Namespace
ns0) FilePath
""
  FilePath
s1 <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (Namespace -> FilePath
forall a. Show a => a -> FilePath
show Namespace
ns1) FilePath
""
  let paths2 :: [FilePath]
paths2 = FilePath
baseFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:FilePath
s0FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:FilePath
s1FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:([CompileMetadata] -> [FilePath]
getIncludePathsForDeps ([CompileMetadata]
deps1' [CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps2)) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
ep' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
paths'
  let hxx :: [CxxOutput]
hxx   = (CxxOutput -> Bool) -> [CxxOutput] -> [CxxOutput]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".hpp" (FilePath -> Bool) -> (CxxOutput -> FilePath) -> CxxOutput -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CxxOutput -> FilePath
coFilename)       [CxxOutput]
fs
  let other :: [CxxOutput]
other = (CxxOutput -> Bool) -> [CxxOutput] -> [CxxOutput]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CxxOutput -> Bool) -> CxxOutput -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".hpp" (FilePath -> Bool) -> (CxxOutput -> FilePath) -> CxxOutput -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CxxOutput -> FilePath
coFilename) [CxxOutput]
fs
  [([FilePath], CxxOutput)]
os1 <- (CxxOutput
 -> TrackedErrorsT
      IO (Either (TrackedErrorsT IO (AsyncWait b), CxxOutput) CxxOutput))
-> [CxxOutput]
-> TrackedErrorsT
     IO [Either (TrackedErrorsT IO (AsyncWait b), CxxOutput) CxxOutput]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ([FilePath]
-> UTCTime
-> CxxOutput
-> TrackedErrorsT
     IO (Either (TrackedErrorsT IO (AsyncWait b), CxxOutput) CxxOutput)
forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
[FilePath]
-> UTCTime
-> CxxOutput
-> TrackedErrorsT
     IO (Either (m (AsyncWait b), CxxOutput) CxxOutput)
writeOutputFile [FilePath]
paths2 UTCTime
time) ([CxxOutput]
hxx [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
other) TrackedErrorsT
  IO [Either (TrackedErrorsT IO (AsyncWait b), CxxOutput) CxxOutput]
-> ([Either (TrackedErrorsT IO (AsyncWait b), CxxOutput) CxxOutput]
    -> TrackedErrorsT IO [([FilePath], CxxOutput)])
-> TrackedErrorsT IO [([FilePath], CxxOutput)]
forall a b.
TrackedErrorsT IO a
-> (a -> TrackedErrorsT IO b) -> TrackedErrorsT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Either (TrackedErrorsT IO (AsyncWait b), CxxOutput) CxxOutput]
-> TrackedErrorsT IO [([FilePath], CxxOutput)]
forall {m :: * -> *} {a}.
(MonadIO m, CollectErrorsM m) =>
[Either (m (AsyncWait b), a) a] -> m [([FilePath], a)]
compileGenerated
  let files :: [FilePath]
files = (CxxOutput -> FilePath) -> [CxxOutput] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\CxxOutput
f2 -> FilePath -> FilePath -> ShowS
getCachedPath (FilePath
p FilePath -> ShowS
</> FilePath
d) (Namespace -> FilePath
forall a. Show a => a -> FilePath
show (Namespace -> FilePath) -> Namespace -> FilePath
forall a b. (a -> b) -> a -> b
$ CxxOutput -> Namespace
coNamespace CxxOutput
f2) (CxxOutput -> FilePath
coFilename CxxOutput
f2)) [CxxOutput]
fs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
              (ExtraSource -> FilePath) -> [ExtraSource] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\ExtraSource
f2 -> FilePath
p FilePath -> ShowS
</> ExtraSource -> FilePath
getSourceFile ExtraSource
f2) [ExtraSource]
es
  [FilePath]
files' <- (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM FilePath -> TrackedErrorsT IO FilePath
forall {m :: * -> *}.
(MonadIO m, ErrorContextM m) =>
FilePath -> m FilePath
checkOwnedFile [FilePath]
files
  let ca :: Map CategoryName Namespace
ca = [(CategoryName, Namespace)] -> Map CategoryName Namespace
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CategoryName, Namespace)] -> Map CategoryName Namespace)
-> [(CategoryName, Namespace)] -> Map CategoryName Namespace
forall a b. (a -> b) -> a -> b
$ (AnyCategory SourceContext -> (CategoryName, Namespace))
-> [AnyCategory SourceContext] -> [(CategoryName, Namespace)]
forall a b. (a -> b) -> [a] -> [b]
map (\AnyCategory SourceContext
c -> (AnyCategory SourceContext -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory SourceContext
c,AnyCategory SourceContext -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory SourceContext
c)) ([AnyCategory SourceContext] -> [(CategoryName, Namespace)])
-> [AnyCategory SourceContext] -> [(CategoryName, Namespace)]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourceContext)
 -> AnyCategory SourceContext)
-> [WithVisibility (AnyCategory SourceContext)]
-> [AnyCategory SourceContext]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory SourceContext)
-> AnyCategory SourceContext
forall a. WithVisibility a -> a
wvData [WithVisibility (AnyCategory SourceContext)]
cs2
  [Either ([FilePath], CxxOutput) ObjectFile]
os2 <- (ExtraSource
 -> TrackedErrorsT
      IO
      (Either
         (TrackedErrorsT IO (AsyncWait b), Maybe [CxxOutput])
         ([FilePath], Maybe [CxxOutput])))
-> [ExtraSource]
-> TrackedErrorsT
     IO
     [Either
        (TrackedErrorsT IO (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput])]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ((Namespace, Namespace)
-> Map CategoryName Namespace
-> [FilePath]
-> ExtraSource
-> TrackedErrorsT
     IO
     (Either
        (TrackedErrorsT IO (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
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 TrackedErrorsT
  IO
  [Either
     (TrackedErrorsT IO (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])]
-> ([Either
       (TrackedErrorsT IO (AsyncWait b), Maybe [CxxOutput])
       ([FilePath], Maybe [CxxOutput])]
    -> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile])
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall a b.
TrackedErrorsT IO a
-> (a -> TrackedErrorsT IO b) -> TrackedErrorsT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Either
   (TrackedErrorsT IO (AsyncWait b), Maybe [CxxOutput])
   ([FilePath], Maybe [CxxOutput])]
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
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) = [Either ([FilePath], CxxOutput) ObjectFile]
-> ([([FilePath], CxxOutput)], [ObjectFile])
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' [CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps2) FilePath
path FilePath
path ([([FilePath], CxxOutput)]
os1 [([FilePath], CxxOutput)]
-> [([FilePath], CxxOutput)] -> [([FilePath], CxxOutput)]
forall a. [a] -> [a] -> [a]
++ [([FilePath], CxxOutput)]
osCat)
  r
-> FilePath
-> [CategoryName]
-> [CategoryName]
-> [ObjectFile]
-> [FilePath]
-> TrackedErrorsIO ()
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' [ObjectFile] -> [ObjectFile] -> [ObjectFile]
forall a. [a] -> [a] -> [a]
++ [ObjectFile]
osOther [ObjectFile] -> [ObjectFile] -> [ObjectFile]
forall a. [a] -> [a] -> [a]
++ (FilePath -> ObjectFile) -> [FilePath] -> [ObjectFile]
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
"" (Namespace -> FilePath
forall a. Show a => a -> FilePath
show Namespace
ns0 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".so")
  [FilePath]
ls <- FilePath
-> [FilePath]
-> [CompileMetadata]
-> [ObjectFile]
-> TrackedErrorsT IO [FilePath]
forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
FilePath
-> [FilePath] -> [CompileMetadata] -> [ObjectFile] -> m [FilePath]
createLibrary FilePath
libraryName (CompileMode -> [FilePath]
getLinkFlags CompileMode
m) ([CompileMetadata]
deps1' [CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
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
baseFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
as2),
      cmPublicCategories :: [CategoryName]
cmPublicCategories = [CategoryName] -> [CategoryName]
forall a. Ord a => [a] -> [a]
sort [CategoryName]
pc,
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = [CategoryName] -> [CategoryName]
forall a. Ord a => [a] -> [a]
sort [CategoryName]
tc,
      cmPublicSubdirs :: [FilePath]
cmPublicSubdirs = [FilePath
s0],
      cmPrivateSubdirs :: [FilePath]
cmPrivateSubdirs = [FilePath
s1],
      cmPublicFiles :: [FilePath]
cmPublicFiles = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
ps2,
      cmPrivateFiles :: [FilePath]
cmPrivateFiles = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
xs2,
      cmTestFiles :: [FilePath]
cmTestFiles = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
ts2,
      cmHxxFiles :: [FilePath]
cmHxxFiles = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
hxx',
      cmCxxFiles :: [FilePath]
cmCxxFiles = [FilePath] -> [FilePath]
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' [ObjectFile] -> [ObjectFile] -> [ObjectFile]
forall a. [a] -> [a] -> [a]
++ [ObjectFile]
osOther [ObjectFile] -> [ObjectFile] -> [ObjectFile]
forall a. [a] -> [a] -> [a]
++ (FilePath -> ObjectFile) -> [FilePath] -> [ObjectFile]
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
cm2CompileMetadata -> [CompileMetadata] -> [CompileMetadata]
forall a. a -> [a] -> [a]
:([CompileMetadata]
deps1' [CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
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 = [Set FilePath] -> Set FilePath
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set FilePath] -> Set FilePath) -> [Set FilePath] -> Set FilePath
forall a b. (a -> b) -> a -> b
$ (CxxOutput -> Set FilePath) -> [CxxOutput] -> [Set FilePath]
forall a b. (a -> b) -> [a] -> [b]
map CxxOutput -> Set FilePath
coPossibleTraces ([CxxOutput] -> [Set FilePath]) -> [CxxOutput] -> [Set FilePath]
forall a b. (a -> b) -> a -> b
$ [CxxOutput]
hxx [CxxOutput] -> [CxxOutput] -> [CxxOutput]
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 ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
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 k -> Map k (CategorySpec a) -> Maybe (CategorySpec a)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (CategorySpec a)
cm of
           Just CategorySpec a
cc2 -> FilePath -> m ()
forall a. FilePath -> m a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$
             FilePath
"Internal specs for category " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ k -> FilePath
forall a. Show a => a -> FilePath
show k
n FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> FilePath
forall a. Show a => [a] -> FilePath
formatFullContextBrace (CategorySpec a -> [a]
forall c. CategorySpec c -> [c]
csContext CategorySpec a
cc) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
             FilePath
" already defined at " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> FilePath
forall a. Show a => [a] -> FilePath
formatFullContextBrace (CategorySpec a -> [a]
forall c. CategorySpec c -> [c]
csContext CategorySpec a
cc2)
           Maybe (CategorySpec a)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Map k (CategorySpec a) -> m (Map k (CategorySpec a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k (CategorySpec a) -> m (Map k (CategorySpec a)))
-> Map k (CategorySpec a) -> m (Map k (CategorySpec a))
forall a b. (a -> b) -> a -> b
$ k
-> CategorySpec a
-> Map k (CategorySpec a)
-> Map k (CategorySpec a)
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
      IO () -> TrackedErrorsIO ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> TrackedErrorsIO ()) -> IO () -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
f2
      ()
_ <- FilePath
-> FilePath
-> FilePath
-> Maybe UTCTime
-> FilePath
-> TrackedErrorsIO ()
writeCachedFile (FilePath
p FilePath -> ShowS
</> FilePath
d) (Namespace -> FilePath
forall a. Show a => a -> FilePath
show Namespace
ns) FilePath
f2 (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
time) (FilePath -> TrackedErrorsIO ()) -> FilePath -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") [FilePath]
content
      if FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".cpp" FilePath
f2 Bool -> Bool -> Bool
|| FilePath -> FilePath -> 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) (Namespace -> FilePath
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) (Namespace -> FilePath
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) (Namespace -> FilePath
forall a. Show a => a -> FilePath
show Namespace
ns) FilePath
"") [(FilePath, Maybe FilePath)]
forall a. [a]
ms (FilePath
p0FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:FilePath
p1FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
paths) Bool
False
           Either (m (AsyncWait b), CxxOutput) CxxOutput
-> TrackedErrorsT
     IO (Either (m (AsyncWait b), CxxOutput) CxxOutput)
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (m (AsyncWait b), CxxOutput) CxxOutput
 -> TrackedErrorsT
      IO (Either (m (AsyncWait b), CxxOutput) CxxOutput))
-> Either (m (AsyncWait b), CxxOutput) CxxOutput
-> TrackedErrorsT
     IO (Either (m (AsyncWait b), CxxOutput) CxxOutput)
forall a b. (a -> b) -> a -> b
$ (m (AsyncWait b), CxxOutput)
-> Either (m (AsyncWait b), CxxOutput) CxxOutput
forall a b. a -> Either a b
Left (b -> CxxCommand -> m (AsyncWait b)
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m (AsyncWait b)
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m (AsyncWait b)
asyncCxxCommand b
backend CxxCommand
command,CxxOutput
ca)
         else Either (m (AsyncWait b), CxxOutput) CxxOutput
-> TrackedErrorsT
     IO (Either (m (AsyncWait b), CxxOutput) CxxOutput)
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (m (AsyncWait b), CxxOutput) CxxOutput
 -> TrackedErrorsT
      IO (Either (m (AsyncWait b), CxxOutput) CxxOutput))
-> Either (m (AsyncWait b), CxxOutput) CxxOutput
-> TrackedErrorsT
     IO (Either (m (AsyncWait b), CxxOutput) CxxOutput)
forall a b. (a -> b) -> a -> b
$ CxxOutput -> Either (m (AsyncWait b), CxxOutput) CxxOutput
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) = [Either (m (AsyncWait b), a) a] -> ([(m (AsyncWait b), a)], [a])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (m (AsyncWait b), a) a]
files
      [(FilePath, a)]
compiled' <- b -> Int -> [(m (AsyncWait b), a)] -> m [(FilePath, a)]
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
      [([FilePath], a)] -> m [([FilePath], a)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([([FilePath], a)] -> m [([FilePath], a)])
-> [([FilePath], a)] -> m [([FilePath], a)]
forall a b. (a -> b) -> a -> b
$ (a -> ([FilePath], a)) -> [a] -> [([FilePath], a)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) []) [a]
saved [([FilePath], a)] -> [([FilePath], a)] -> [([FilePath], a)]
forall a. [a] -> [a] -> [a]
++ ((FilePath, a) -> ([FilePath], a))
-> [(FilePath, a)] -> [([FilePath], a)]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> [FilePath]) -> (FilePath, a) -> ([FilePath], a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (FilePath -> [FilePath] -> [FilePath]
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' <- Bool
-> (Namespace, Namespace)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
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 -> Either
  (m (AsyncWait b), Maybe [CxxOutput])
  ([FilePath], Maybe [CxxOutput])
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (m (AsyncWait b), Maybe [CxxOutput])
   ([FilePath], Maybe [CxxOutput])
 -> TrackedErrorsT
      IO
      (Either
         (m (AsyncWait b), Maybe [CxxOutput])
         ([FilePath], Maybe [CxxOutput])))
-> Either
     (m (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
forall a b. (a -> b) -> a -> b
$ (m (AsyncWait b), Maybe [CxxOutput])
-> Either
     (m (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])
forall a b. a -> Either a b
Left  (m (AsyncWait b)
process,[CxxOutput] -> Maybe [CxxOutput]
forall a. a -> Maybe a
Just [CxxOutput]
allFakeCxx)
           Right [FilePath]
fs     -> Either
  (m (AsyncWait b), Maybe [CxxOutput])
  ([FilePath], Maybe [CxxOutput])
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (m (AsyncWait b), Maybe [CxxOutput])
   ([FilePath], Maybe [CxxOutput])
 -> TrackedErrorsT
      IO
      (Either
         (m (AsyncWait b), Maybe [CxxOutput])
         ([FilePath], Maybe [CxxOutput])))
-> Either
     (m (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
forall a b. (a -> b) -> a -> b
$ ([FilePath], Maybe [CxxOutput])
-> Either
     (m (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])
forall a b. b -> Either a b
Right ([FilePath]
fs,     [CxxOutput] -> Maybe [CxxOutput]
forall a. a -> Maybe a
Just [CxxOutput]
allFakeCxx)
      where
        allDeps :: Set CategoryName
allDeps = [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList ([CategoryName]
cs2 [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++ [CategoryName]
ds2)
        allFakeCxx :: [CxxOutput]
allFakeCxx = (CategoryName -> CxxOutput) -> [CategoryName] -> [CxxOutput]
forall a b. (a -> b) -> [a] -> [b]
map CategoryName -> CxxOutput
fakeCxx [CategoryName]
cs2
        fakeCxx :: CategoryName -> CxxOutput
fakeCxx CategoryName
c = CxxOutput {
            coCategory :: Maybe CategoryName
coCategory = CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just CategoryName
c,
            coFilename :: FilePath
coFilename = FilePath
"",
            coNamespace :: Namespace
coNamespace = case CategoryName
c CategoryName -> Map CategoryName Namespace -> Maybe Namespace
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 = [Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
Set.fromList [Namespace
ns0,Namespace
ns1],
            coUsesCategory :: Set CategoryName
coUsesCategory = CategoryName
c CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => a -> Set a -> Set a
`Set.delete` Set CategoryName
allDeps,
            coPossibleTraces :: Set FilePath
coPossibleTraces = Set FilePath
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' <- Bool
-> (Namespace, Namespace)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
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 -> Either
  (m (AsyncWait b), Maybe [CxxOutput])
  ([FilePath], Maybe [CxxOutput])
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (m (AsyncWait b), Maybe [CxxOutput])
   ([FilePath], Maybe [CxxOutput])
 -> TrackedErrorsT
      IO
      (Either
         (m (AsyncWait b), Maybe [CxxOutput])
         ([FilePath], Maybe [CxxOutput])))
-> Either
     (m (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
forall a b. (a -> b) -> a -> b
$ (m (AsyncWait b), Maybe [CxxOutput])
-> Either
     (m (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])
forall a b. a -> Either a b
Left  (m (AsyncWait b)
process,Maybe [CxxOutput]
forall a. Maybe a
Nothing)
           Right [FilePath]
fs     -> Either
  (m (AsyncWait b), Maybe [CxxOutput])
  ([FilePath], Maybe [CxxOutput])
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (m (AsyncWait b), Maybe [CxxOutput])
   ([FilePath], Maybe [CxxOutput])
 -> TrackedErrorsT
      IO
      (Either
         (m (AsyncWait b), Maybe [CxxOutput])
         ([FilePath], Maybe [CxxOutput])))
-> Either
     (m (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])
-> TrackedErrorsT
     IO
     (Either
        (m (AsyncWait b), Maybe [CxxOutput])
        ([FilePath], Maybe [CxxOutput]))
forall a b. (a -> b) -> a -> b
$ ([FilePath], Maybe [CxxOutput])
-> Either
     (m (AsyncWait b), Maybe [CxxOutput])
     ([FilePath], Maybe [CxxOutput])
forall a b. b -> Either a b
Right ([FilePath]
fs,     Maybe [CxxOutput]
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) = [Either (m (AsyncWait b), Maybe [a]) ([FilePath], Maybe [a])]
-> ([(m (AsyncWait b), Maybe [a])], [([FilePath], Maybe [a])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (m (AsyncWait b), Maybe [a]) ([FilePath], Maybe [a])]
files
      [(FilePath, Maybe [a])]
compiled' <- b
-> Int
-> [(m (AsyncWait b), Maybe [a])]
-> m [(FilePath, Maybe [a])]
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' = ((FilePath, Maybe [a]) -> ([FilePath], Maybe [a]))
-> [(FilePath, Maybe [a])] -> [([FilePath], Maybe [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> [FilePath])
-> (FilePath, Maybe [a]) -> ([FilePath], Maybe [a])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[])) [(FilePath, Maybe [a])]
compiled' [([FilePath], Maybe [a])]
-> [([FilePath], Maybe [a])] -> [([FilePath], Maybe [a])]
forall a. [a] -> [a] -> [a]
++ [([FilePath], Maybe [a])]
inert
      [Either ([FilePath], a) ObjectFile]
-> m [Either ([FilePath], a) ObjectFile]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either ([FilePath], a) ObjectFile]
 -> m [Either ([FilePath], a) ObjectFile])
-> [Either ([FilePath], a) ObjectFile]
-> m [Either ([FilePath], a) ObjectFile]
forall a b. (a -> b) -> a -> b
$ [[Either ([FilePath], a) ObjectFile]]
-> [Either ([FilePath], a) ObjectFile]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either ([FilePath], a) ObjectFile]]
 -> [Either ([FilePath], a) ObjectFile])
-> [[Either ([FilePath], a) ObjectFile]]
-> [Either ([FilePath], a) ObjectFile]
forall a b. (a -> b) -> a -> b
$ (([FilePath], Maybe [a]) -> [Either ([FilePath], a) ObjectFile])
-> [([FilePath], Maybe [a])]
-> [[Either ([FilePath], a) ObjectFile]]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath], Maybe [a]) -> [Either ([FilePath], a) ObjectFile]
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) = (a -> Either ([FilePath], a) ObjectFile)
-> [a] -> [Either ([FilePath], a) ObjectFile]
forall a b. (a -> b) -> [a] -> [b]
map (([FilePath], a) -> Either ([FilePath], a) ObjectFile
forall a b. a -> Either a b
Left (([FilePath], a) -> Either ([FilePath], a) ObjectFile)
-> (a -> ([FilePath], a)) -> a -> Either ([FilePath], a) ObjectFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) [FilePath]
os) [a]
cxx
        expand ([FilePath]
os,Maybe [a]
Nothing)  = (FilePath -> Either ([FilePath], a) ObjectFile)
-> [FilePath] -> [Either ([FilePath], a) ObjectFile]
forall a b. (a -> b) -> [a] -> [b]
map (ObjectFile -> Either ([FilePath], a) ObjectFile
forall a b. b -> Either a b
Right (ObjectFile -> Either ([FilePath], a) ObjectFile)
-> (FilePath -> ObjectFile)
-> FilePath
-> Either ([FilePath], a) ObjectFile
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 <- IO Bool -> m Bool
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
f2
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
exists) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall a. FilePath -> m a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Owned file " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
f2 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" does not exist."
      IO FilePath -> m FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
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
      | FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".cpp" FilePath
f2 Bool -> Bool -> Bool
|| FilePath -> FilePath -> 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,FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall a. Show a => a -> FilePath
show a
ns0),(FilePath
privateNamespaceMacro,FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ b -> FilePath
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
          Either (m (AsyncWait b)) [FilePath]
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (m (AsyncWait b)) [FilePath]
 -> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath]))
-> Either (m (AsyncWait b)) [FilePath]
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
forall a b. (a -> b) -> a -> b
$ m (AsyncWait b) -> Either (m (AsyncWait b)) [FilePath]
forall a b. a -> Either a b
Left (m (AsyncWait b) -> Either (m (AsyncWait b)) [FilePath])
-> m (AsyncWait b) -> Either (m (AsyncWait b)) [FilePath]
forall a b. (a -> b) -> a -> b
$ b -> CxxCommand -> m (AsyncWait b)
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m (AsyncWait b)
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m (AsyncWait b)
asyncCxxCommand b
backend CxxCommand
command
      | FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".a" FilePath
f2 Bool -> Bool -> Bool
|| FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".o" FilePath
f2 = Either (m (AsyncWait b)) [FilePath]
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (m (AsyncWait b)) [FilePath]
 -> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath]))
-> Either (m (AsyncWait b)) [FilePath]
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Either (m (AsyncWait b)) [FilePath]
forall a b. b -> Either a b
Right [FilePath
f2]
      | Bool
otherwise = Either (m (AsyncWait b)) [FilePath]
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (m (AsyncWait b)) [FilePath]
 -> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath]))
-> Either (m (AsyncWait b)) [FilePath]
-> TrackedErrorsT IO (Either (m (AsyncWait b)) [FilePath])
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Either (m (AsyncWait b)) [FilePath]
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 FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
o
                then IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
p FilePath -> ShowS
</> FilePath
d FilePath -> ShowS
</> CategoryName -> FilePath
forall a. Show a => a -> FilePath
show CategoryName
n
                else IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
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 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".cpp"
      IO () -> TrackedErrorsIO ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> TrackedErrorsIO ()) -> IO () -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file " FilePath -> ShowS
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 (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
time) (FilePath -> TrackedErrorsIO ()) -> FilePath -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") [FilePath]
content
      FilePath
base <- r -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
forall (m :: * -> *).
(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 ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath
baseFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:([CompileMetadata] -> [FilePath]
getIncludePathsForDeps [CompileMetadata]
deps)
      CxxCommand
command <- LinkerMode
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [FilePath]
-> TrackedErrorsT IO CxxCommand
forall {m :: * -> *}.
Monad m =>
LinkerMode
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [FilePath]
-> m CxxCommand
getCommand LinkerMode
lm FilePath
mainAbs FilePath
f0 [CompileMetadata]
deps2 [FilePath]
paths'
      IO () -> TrackedErrorsIO ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> TrackedErrorsIO ()) -> IO () -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Creating binary " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
f0
      FilePath
f1 <- b -> CxxCommand -> TrackedErrorsT IO FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m FilePath
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m FilePath
syncCxxCommand b
backend CxxCommand
command
      [FilePath] -> TrackedErrorsT IO [FilePath]
forall a. a -> TrackedErrorsT IO a
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 [FilePath] -> [FilePath] -> [FilePath]
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 Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CategoryName
requiredStaticTypes)
          CxxCommand -> m CxxCommand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxCommand -> m CxxCommand) -> CxxCommand -> m CxxCommand
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
          CxxCommand -> m CxxCommand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxCommand -> m CxxCommand) -> CxxCommand -> m CxxCommand
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]
_) [] =
      FilePath -> TrackedErrorsT IO [FilePath]
forall a. FilePath -> TrackedErrorsT IO a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> TrackedErrorsT IO [FilePath])
-> FilePath -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
"Main category " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> FilePath
forall a. Show a => a -> FilePath
show CategoryName
n FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" not found."
    createBinary VersionHash
_ [FilePath]
_ [CompileMetadata]
_ UTCTime
_ (CompileBinary CategoryName
n FunctionName
_ LinkerMode
_ FilePath
_ [FilePath]
_) [CxxOutput]
_ =
      FilePath -> TrackedErrorsT IO [FilePath]
forall a. FilePath -> TrackedErrorsT IO a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> TrackedErrorsT IO [FilePath])
-> FilePath -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
"Multiple matches for main category " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> FilePath
forall a. Show a => a -> FilePath
show CategoryName
n FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
    createBinary VersionHash
_ [FilePath]
_ [CompileMetadata]
_ UTCTime
_ CompileMode
_ [CxxOutput]
_  = [FilePath] -> TrackedErrorsT IO [FilePath]
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    createLibrary :: FilePath
-> [FilePath] -> [CompileMetadata] -> [ObjectFile] -> m [FilePath]
createLibrary FilePath
_ [FilePath]
_ [] [] = [FilePath] -> m [FilePath]
forall a. a -> m a
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 [FilePath] -> [FilePath] -> [FilePath]
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 = ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (ObjectFile -> [FilePath]) -> [ObjectFile] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map ObjectFile -> [FilePath]
getObjectFiles [ObjectFile]
os) [FilePath] -> [FilePath] -> [FilePath]
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
      (FilePath -> [FilePath]) -> m FilePath -> m [FilePath]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[]) (m FilePath -> m [FilePath]) -> m FilePath -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ b -> CxxCommand -> m FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m FilePath
forall (m :: * -> *).
(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]
_) =
      (CxxOutput -> [CxxOutput]) -> f CxxOutput -> f [CxxOutput]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[]) (f CxxOutput -> f [CxxOutput]) -> f CxxOutput -> f [CxxOutput]
forall a b. (a -> b) -> a -> b
$ LanguageModule c
-> [PrivateSource c] -> CategoryName -> FunctionName -> f CxxOutput
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
_ = [CxxOutput] -> f [CxxOutput]
forall a. a -> f a
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 <- IO UTCTime -> TrackedErrorsT IO UTCTime
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
dFilePath -> [FilePath] -> [FilePath]
forall 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) <-
    (([WithVisibility (AnyCategory SourceContext)], Set FilePath)
 -> LanguageModule SourceContext)
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
-> TrackedErrorsT IO (LanguageModule SourceContext)
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CategoryName]
-> ExprMap SourceContext
-> [WithVisibility (AnyCategory SourceContext)]
-> LanguageModule SourceContext
forall c.
[CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [] ExprMap SourceContext
forall k a. Map k a
Map.empty ([WithVisibility (AnyCategory SourceContext)]
 -> LanguageModule SourceContext)
-> (([WithVisibility (AnyCategory SourceContext)], Set FilePath)
    -> [WithVisibility (AnyCategory SourceContext)])
-> ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
-> LanguageModule SourceContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
-> [WithVisibility (AnyCategory SourceContext)]
forall a b. (a, b) -> a
fst) (TrackedErrorsIO
   ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
 -> TrackedErrorsT IO (LanguageModule SourceContext))
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
-> TrackedErrorsT IO (LanguageModule SourceContext)
forall a b. (a -> b) -> a -> b
$ r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
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 Maybe CompileMetadata
forall a. Maybe a
Nothing [CompileMetadata]
deps1 [CompileMetadata]
deps2
  [(FilePath, FilePath)]
xs' <- r
-> FilePath
-> [FilePath]
-> TrackedErrorsT IO [(FilePath, FilePath)]
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver FilePath
p [FilePath]
xs
  [([PragmaSource SourceContext], [AnyCategory SourceContext],
  [DefinedCategory SourceContext])]
ds2 <- ((FilePath, FilePath)
 -> TrackedErrorsT
      IO
      ([PragmaSource SourceContext], [AnyCategory SourceContext],
       [DefinedCategory SourceContext]))
-> [(FilePath, FilePath)]
-> TrackedErrorsT
     IO
     [([PragmaSource SourceContext], [AnyCategory SourceContext],
       [DefinedCategory SourceContext])]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (FilePath, FilePath)
-> TrackedErrorsT
     IO
     ([PragmaSource SourceContext], [AnyCategory SourceContext],
      [DefinedCategory SourceContext])
forall (m :: * -> *).
ErrorContextM m =>
(FilePath, FilePath)
-> m ([PragmaSource SourceContext], [AnyCategory SourceContext],
      [DefinedCategory SourceContext])
parseInternalSource [(FilePath, FilePath)]
xs'
  let ds3 :: [DefinedCategory SourceContext]
ds3 = [[DefinedCategory SourceContext]]
-> [DefinedCategory SourceContext]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[DefinedCategory SourceContext]]
 -> [DefinedCategory SourceContext])
-> [[DefinedCategory SourceContext]]
-> [DefinedCategory SourceContext]
forall a b. (a -> b) -> a -> b
$ (([PragmaSource SourceContext], [AnyCategory SourceContext],
  [DefinedCategory SourceContext])
 -> [DefinedCategory SourceContext])
-> [([PragmaSource SourceContext], [AnyCategory SourceContext],
     [DefinedCategory SourceContext])]
-> [[DefinedCategory SourceContext]]
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 <- (CategoryMap SourceContext
 -> [AnyCategory SourceContext]
 -> TrackedErrorsT IO (CategoryMap SourceContext))
-> CategoryMap SourceContext
-> [[AnyCategory SourceContext]]
-> TrackedErrorsT IO (CategoryMap SourceContext)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CategoryMap SourceContext
-> [AnyCategory SourceContext]
-> TrackedErrorsT IO (CategoryMap SourceContext)
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 = (AnyCategory SourceContext -> Bool)
-> [AnyCategory SourceContext] -> [AnyCategory SourceContext]
forall a. (a -> Bool) -> [a] -> [a]
filter AnyCategory SourceContext -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete ([AnyCategory SourceContext] -> [AnyCategory SourceContext])
-> [AnyCategory SourceContext] -> [AnyCategory SourceContext]
forall a b. (a -> b) -> a -> b
$ [AnyCategory SourceContext]
cs1[AnyCategory SourceContext]
-> [AnyCategory SourceContext] -> [AnyCategory SourceContext]
forall a. [a] -> [a] -> [a]
++[AnyCategory SourceContext]
ps1[AnyCategory SourceContext]
-> [AnyCategory SourceContext] -> [AnyCategory SourceContext]
forall a. [a] -> [a] -> [a]
++[AnyCategory SourceContext]
tc1[AnyCategory SourceContext]
-> [AnyCategory SourceContext] -> [AnyCategory SourceContext]
forall a. [a] -> [a] -> [a]
++[AnyCategory SourceContext]
tp1
  let ca :: Set CategoryName
ca = [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList ([CategoryName] -> Set CategoryName)
-> [CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (AnyCategory SourceContext -> CategoryName)
-> [AnyCategory SourceContext] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map AnyCategory SourceContext -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName ([AnyCategory SourceContext] -> [CategoryName])
-> [AnyCategory SourceContext] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (AnyCategory SourceContext -> Bool)
-> [AnyCategory SourceContext] -> [AnyCategory SourceContext]
forall a. (a -> Bool) -> [a] -> [a]
filter AnyCategory SourceContext -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete [AnyCategory SourceContext]
cs
  let ca' :: Set CategoryName
ca' = (CategoryName -> Set CategoryName -> Set CategoryName)
-> Set CategoryName -> [CategoryName] -> Set CategoryName
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => a -> Set a -> Set a
Set.delete Set CategoryName
ca ([CategoryName] -> Set CategoryName)
-> [CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (DefinedCategory SourceContext -> CategoryName)
-> [DefinedCategory SourceContext] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map DefinedCategory SourceContext -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName [DefinedCategory SourceContext]
ds3
  let testingCats :: Set CategoryName
testingCats = [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList ([CategoryName] -> Set CategoryName)
-> [CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ ((AnyCategory SourceContext -> CategoryName)
-> [AnyCategory SourceContext] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map AnyCategory SourceContext -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName [AnyCategory SourceContext]
tc1) [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++ ((AnyCategory SourceContext -> CategoryName)
-> [AnyCategory SourceContext] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map AnyCategory SourceContext -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName [AnyCategory SourceContext]
tp1)
  [CxxOutput]
ts <- ([[CxxOutput]] -> [CxxOutput])
-> TrackedErrorsT IO [[CxxOutput]] -> TrackedErrorsT IO [CxxOutput]
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (TrackedErrorsT IO [[CxxOutput]] -> TrackedErrorsT IO [CxxOutput])
-> TrackedErrorsT IO [[CxxOutput]] -> TrackedErrorsT IO [CxxOutput]
forall a b. (a -> b) -> a -> b
$ (CategoryName -> TrackedErrorsT IO [CxxOutput])
-> [CategoryName] -> TrackedErrorsT IO [[CxxOutput]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (\CategoryName
n -> Bool
-> CategoryMap SourceContext
-> CategoryName
-> TrackedErrorsT IO [CxxOutput]
forall {m :: * -> *}.
CollectErrorsM m =>
Bool -> CategoryMap SourceContext -> CategoryName -> m [CxxOutput]
generate (CategoryName
n CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
testingCats) CategoryMap SourceContext
tm CategoryName
n) ([CategoryName] -> TrackedErrorsT IO [[CxxOutput]])
-> [CategoryName] -> TrackedErrorsT IO [[CxxOutput]]
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList Set CategoryName
ca'
  (CxxOutput -> TrackedErrorsIO ())
-> [CxxOutput] -> TrackedErrorsIO ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (UTCTime -> CxxOutput -> TrackedErrorsIO ()
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) <- CategoryMap SourceContext
-> ([SourceContext], CategoryName)
-> m ([SourceContext], AnyCategory SourceContext)
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 = CategorySpec SourceContext
-> CategoryName
-> Map CategoryName (CategorySpec SourceContext)
-> CategorySpec SourceContext
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ([SourceContext]
-> [ValueRefine SourceContext]
-> [ValueDefine SourceContext]
-> CategorySpec SourceContext
forall c.
[c] -> [ValueRefine c] -> [ValueDefine c] -> CategorySpec c
CategorySpec [] [] []) (AnyCategory SourceContext -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory SourceContext
t) Map CategoryName (CategorySpec SourceContext)
cm
      Bool
-> CategoryMap SourceContext
-> AnyCategory SourceContext
-> CategorySpec SourceContext
-> m [CxxOutput]
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 <- IO Bool -> m Bool
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
n'
      if Bool
exists
         then FilePath -> m ()
forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
compilerWarningM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Skipping existing file " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
n
         else do
           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
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
n
           IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
n' (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ShowS
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.
           IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> 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
baseFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(CompileMetadata -> [FilePath]
cmPublicSubdirs CompileMetadata
m [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ CompileMetadata -> [FilePath]
cmPrivateSubdirs CompileMetadata
m [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [CompileMetadata] -> [FilePath]
getIncludePathsForDeps [CompileMetadata]
deps1)
  (FilePath -> TrackedErrorsIO ())
-> [FilePath] -> TrackedErrorsIO ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ FilePath -> TrackedErrorsIO ()
forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
showSkipped ([FilePath] -> TrackedErrorsIO ())
-> [FilePath] -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
isTestAllowed) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ CompileMetadata -> [FilePath]
cmTestFiles CompileMetadata
m
  [(FilePath, FilePath)]
ts' <- r
-> FilePath
-> [FilePath]
-> TrackedErrorsT IO [(FilePath, FilePath)]
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver (CompileMetadata -> FilePath
cmRoot CompileMetadata
m) ([FilePath] -> TrackedErrorsT IO [(FilePath, FilePath)])
-> [FilePath] -> TrackedErrorsT IO [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isTestAllowed ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ CompileMetadata -> [FilePath]
cmTestFiles CompileMetadata
m
  let path :: FilePath
path = CompileMetadata -> FilePath
cmPath CompileMetadata
m
  LanguageModule SourceContext
cm <- (([WithVisibility (AnyCategory SourceContext)], Set FilePath)
 -> LanguageModule SourceContext)
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
-> TrackedErrorsT IO (LanguageModule SourceContext)
forall a b. (a -> b) -> TrackedErrorsT IO a -> TrackedErrorsT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CategoryName]
-> ExprMap SourceContext
-> [WithVisibility (AnyCategory SourceContext)]
-> LanguageModule SourceContext
forall c.
[CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [] ExprMap SourceContext
em ([WithVisibility (AnyCategory SourceContext)]
 -> LanguageModule SourceContext)
-> (([WithVisibility (AnyCategory SourceContext)], Set FilePath)
    -> [WithVisibility (AnyCategory SourceContext)])
-> ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
-> LanguageModule SourceContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
-> [WithVisibility (AnyCategory SourceContext)]
forall a b. (a, b) -> a
fst) (TrackedErrorsIO
   ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
 -> TrackedErrorsT IO (LanguageModule SourceContext))
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
-> TrackedErrorsT IO (LanguageModule SourceContext)
forall a b. (a -> b) -> a -> b
$ r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO
     ([WithVisibility (AnyCategory SourceContext)], Set FilePath)
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) [] (CompileMetadata -> Maybe CompileMetadata
forall a. a -> Maybe a
Just CompileMetadata
m) [CompileMetadata]
deps1 []
  ((FilePath, FilePath)
 -> TrackedErrorsT IO ((Int, Int), TrackedErrors ()))
-> [(FilePath, FilePath)]
-> TrackedErrorsIO [((Int, Int), TrackedErrors ())]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (b
-> FilePath
-> LanguageModule SourceContext
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> TrackedErrorsT IO ((Int, Int), TrackedErrors ())
forall b.
CompilerBackend b =>
b
-> FilePath
-> LanguageModule SourceContext
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> TrackedErrorsT IO ((Int, Int), TrackedErrors ())
runSingleTest b
backend FilePath
cl LanguageModule SourceContext
cm [FilePath]
paths (CompileMetadata
mCompileMetadata -> [CompileMetadata] -> [CompileMetadata]
forall a. a -> [a] -> [a]
:[CompileMetadata]
deps2)) [(FilePath, FilePath)]
ts' where
    allowTests :: Set FilePath
allowTests = [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
tp
    isTestAllowed :: FilePath -> Bool
isTestAllowed FilePath
t
      | Set FilePath -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set FilePath
allowTests = Bool
True
      | Bool
otherwise = (FilePath -> Bool) -> Set FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
t) Set FilePath
allowTests
    showSkipped :: FilePath -> m ()
showSkipped FilePath
f = FilePath -> m ()
forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
compilerWarningM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Skipping tests in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
f FilePath -> ShowS
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
-> TrackedErrorsT IO (PrivateSource SourceContext)
loadPrivateSource r
resolver VersionHash
h FilePath
p FilePath
f = do
  [(FilePath, FilePath)
f'] <- r
-> FilePath
-> [FilePath]
-> TrackedErrorsT IO [(FilePath, FilePath)]
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver FilePath
p [FilePath
f]
  UTCTime
time <- IO UTCTime -> TrackedErrorsT IO UTCTime
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO UTCTime
getCurrentTime
  FilePath
path <- IO FilePath -> TrackedErrorsT IO FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> TrackedErrorsT IO FilePath)
-> IO FilePath -> TrackedErrorsT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> ShowS
</> FilePath
f)
  let ns :: Namespace
ns = FilePath -> Namespace
StaticNamespace (FilePath -> Namespace) -> FilePath -> Namespace
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Hashable a => a -> FilePath
privateNamespace ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ UTCTime -> FilePath
forall a. Show a => a -> FilePath
show UTCTime
time FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ VersionHash -> FilePath
forall a. Show a => a -> FilePath
show VersionHash
h FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path
  ([PragmaSource SourceContext]
pragmas,[AnyCategory SourceContext]
cs,[DefinedCategory SourceContext]
ds) <- (FilePath, FilePath)
-> TrackedErrorsT
     IO
     ([PragmaSource SourceContext], [AnyCategory SourceContext],
      [DefinedCategory SourceContext])
forall (m :: * -> *).
ErrorContextM m =>
(FilePath, FilePath)
-> m ([PragmaSource SourceContext], [AnyCategory SourceContext],
      [DefinedCategory SourceContext])
parseInternalSource (FilePath, FilePath)
f'
  let cs' :: [AnyCategory SourceContext]
cs' = (AnyCategory SourceContext -> AnyCategory SourceContext)
-> [AnyCategory SourceContext] -> [AnyCategory SourceContext]
forall a b. (a -> b) -> [a] -> [b]
map (Namespace -> AnyCategory SourceContext -> AnyCategory SourceContext
forall c. Namespace -> AnyCategory c -> AnyCategory c
setCategoryNamespace Namespace
ns) [AnyCategory SourceContext]
cs
  let testing :: Bool
testing = (PragmaSource SourceContext -> Bool)
-> [PragmaSource SourceContext] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PragmaSource SourceContext -> Bool
forall c. PragmaSource c -> Bool
isTestsOnly [PragmaSource SourceContext]
pragmas
  PrivateSource SourceContext
-> TrackedErrorsT IO (PrivateSource SourceContext)
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrivateSource SourceContext
 -> TrackedErrorsT IO (PrivateSource SourceContext))
-> PrivateSource SourceContext
-> TrackedErrorsT IO (PrivateSource SourceContext)
forall a b. (a -> b) -> a -> b
$ Namespace
-> Bool
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> PrivateSource SourceContext
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    = [Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
Set.fromList ([Namespace] -> Set Namespace) -> [Namespace] -> Set Namespace
forall a b. (a -> b) -> a -> b
$ (WithVisibility Namespace -> Namespace)
-> [WithVisibility Namespace] -> [Namespace]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility Namespace -> Namespace
forall a. WithVisibility a -> a
wvData ([WithVisibility Namespace] -> [Namespace])
-> [WithVisibility Namespace] -> [Namespace]
forall a b. (a -> b) -> a -> b
$ [WithVisibility Namespace]
-> [WithVisibility Namespace -> Bool] -> [WithVisibility Namespace]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility Namespace]
ns [CodeVisibility -> WithVisibility Namespace -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,CodeVisibility -> WithVisibility Namespace -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly],
      lmPrivateNamespaces :: Set Namespace
lmPrivateNamespaces   = [Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
Set.fromList ([Namespace] -> Set Namespace) -> [Namespace] -> Set Namespace
forall a b. (a -> b) -> a -> b
$ (WithVisibility Namespace -> Namespace)
-> [WithVisibility Namespace] -> [Namespace]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility Namespace -> Namespace
forall a. WithVisibility a -> a
wvData ([WithVisibility Namespace] -> [Namespace])
-> [WithVisibility Namespace] -> [Namespace]
forall a b. (a -> b) -> a -> b
$ [WithVisibility Namespace]
-> [WithVisibility Namespace -> Bool] -> [WithVisibility Namespace]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility Namespace]
ns [CodeVisibility -> WithVisibility Namespace -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,CodeVisibility -> WithVisibility Namespace -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly],
      lmLocalNamespaces :: Set Namespace
lmLocalNamespaces     = [Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
Set.fromList ([Namespace] -> Set Namespace) -> [Namespace] -> Set Namespace
forall a b. (a -> b) -> a -> b
$ (WithVisibility Namespace -> Namespace)
-> [WithVisibility Namespace] -> [Namespace]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility Namespace -> Namespace
forall a. WithVisibility a -> a
wvData ([WithVisibility Namespace] -> [Namespace])
-> [WithVisibility Namespace] -> [Namespace]
forall a b. (a -> b) -> a -> b
$ [WithVisibility Namespace]
-> [WithVisibility Namespace -> Bool] -> [WithVisibility Namespace]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility Namespace]
ns [CodeVisibility -> WithVisibility Namespace -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency],
      lmPublicDeps :: [AnyCategory c]
lmPublicDeps          = (WithVisibility (AnyCategory c) -> AnyCategory c)
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory c) -> AnyCategory c
forall a. WithVisibility a -> a
wvData ([WithVisibility (AnyCategory c)] -> [AnyCategory c])
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [WithVisibility (AnyCategory c)]
-> [WithVisibility (AnyCategory c) -> Bool]
-> [WithVisibility (AnyCategory c)]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPrivateDeps :: [AnyCategory c]
lmPrivateDeps         = (WithVisibility (AnyCategory c) -> AnyCategory c)
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory c) -> AnyCategory c
forall a. WithVisibility a -> a
wvData ([WithVisibility (AnyCategory c)] -> [AnyCategory c])
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [WithVisibility (AnyCategory c)]
-> [WithVisibility (AnyCategory c) -> Bool]
-> [WithVisibility (AnyCategory c)]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPublicTestingDeps :: [AnyCategory c]
lmPublicTestingDeps   = (WithVisibility (AnyCategory c) -> AnyCategory c)
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory c) -> AnyCategory c
forall a. WithVisibility a -> a
wvData ([WithVisibility (AnyCategory c)] -> [AnyCategory c])
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [WithVisibility (AnyCategory c)]
-> [WithVisibility (AnyCategory c) -> Bool]
-> [WithVisibility (AnyCategory c)]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with CodeVisibility
TestsOnly],
      lmPrivateTestingDeps :: [AnyCategory c]
lmPrivateTestingDeps  = (WithVisibility (AnyCategory c) -> AnyCategory c)
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory c) -> AnyCategory c
forall a. WithVisibility a -> a
wvData ([WithVisibility (AnyCategory c)] -> [AnyCategory c])
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [WithVisibility (AnyCategory c)]
-> [WithVisibility (AnyCategory c) -> Bool]
-> [WithVisibility (AnyCategory c)]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
FromDependency,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with CodeVisibility
TestsOnly],
      lmPublicLocal :: [AnyCategory c]
lmPublicLocal         = (WithVisibility (AnyCategory c) -> AnyCategory c)
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory c) -> AnyCategory c
forall a. WithVisibility a -> a
wvData ([WithVisibility (AnyCategory c)] -> [AnyCategory c])
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [WithVisibility (AnyCategory c)]
-> [WithVisibility (AnyCategory c) -> Bool]
-> [WithVisibility (AnyCategory c)]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPrivateLocal :: [AnyCategory c]
lmPrivateLocal        = (WithVisibility (AnyCategory c) -> AnyCategory c)
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory c) -> AnyCategory c
forall a. WithVisibility a -> a
wvData ([WithVisibility (AnyCategory c)] -> [AnyCategory c])
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [WithVisibility (AnyCategory c)]
-> [WithVisibility (AnyCategory c) -> Bool]
-> [WithVisibility (AnyCategory c)]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPublicTestingLocal :: [AnyCategory c]
lmPublicTestingLocal  = (WithVisibility (AnyCategory c) -> AnyCategory c)
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory c) -> AnyCategory c
forall a. WithVisibility a -> a
wvData ([WithVisibility (AnyCategory c)] -> [AnyCategory c])
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [WithVisibility (AnyCategory c)]
-> [WithVisibility (AnyCategory c) -> Bool]
-> [WithVisibility (AnyCategory c)]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
ModuleOnly,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with CodeVisibility
TestsOnly],
      lmPrivateTestingLocal :: [AnyCategory c]
lmPrivateTestingLocal = (WithVisibility (AnyCategory c) -> AnyCategory c)
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory c) -> AnyCategory c
forall a. WithVisibility a -> a
wvData ([WithVisibility (AnyCategory c)] -> [AnyCategory c])
-> [WithVisibility (AnyCategory c)] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [WithVisibility (AnyCategory c)]
-> [WithVisibility (AnyCategory c) -> Bool]
-> [WithVisibility (AnyCategory c)]
forall {a}. [a] -> [a -> Bool] -> [a]
apply [WithVisibility (AnyCategory c)]
cs [CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
FromDependency,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
ModuleOnly,CodeVisibility -> WithVisibility (AnyCategory c) -> Bool
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 = Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
forall k a. Map k a
Map.empty
    }
  km :: Map CategoryName [c]
km = [(CategoryName, [c])] -> Map CategoryName [c]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CategoryName, [c])] -> Map CategoryName [c])
-> [(CategoryName, [c])] -> Map CategoryName [c]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory c) -> (CategoryName, [c]))
-> [WithVisibility (AnyCategory c)] -> [(CategoryName, [c])]
forall a b. (a -> b) -> [a] -> [b]
map (\(WithVisibility Set CodeVisibility
_ AnyCategory c
t) -> (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t,AnyCategory c -> [c]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory c
t)) [WithVisibility (AnyCategory c)]
cs
  ns :: [WithVisibility Namespace]
ns = (WithVisibility (AnyCategory c) -> WithVisibility Namespace)
-> [WithVisibility (AnyCategory c)] -> [WithVisibility Namespace]
forall a b. (a -> b) -> [a] -> [b]
map ((AnyCategory c -> Namespace)
-> WithVisibility (AnyCategory c) -> WithVisibility Namespace
forall a b. (a -> b) -> WithVisibility a -> WithVisibility b
mapCodeVisibility AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace) [WithVisibility (AnyCategory c)]
cs
  with :: CodeVisibility -> WithVisibility a -> Bool
with    CodeVisibility
v = CodeVisibility -> WithVisibility a -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
v
  without :: CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
v = Bool -> Bool
not (Bool -> Bool)
-> (WithVisibility a -> Bool) -> WithVisibility a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVisibility -> WithVisibility a -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
v
  apply :: [a] -> [a -> Bool] -> [a]
apply = ((a -> Bool) -> [a] -> [a]) -> [a] -> [a -> Bool] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> Bool) -> [a] -> [a]
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 = (FilePath -> TrackedErrorsIO ())
-> [FilePath] -> TrackedErrorsIO ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ FilePath -> TrackedErrorsIO ()
forall {m :: * -> *}.
(MonadIO m, CollectErrorsM m) =>
FilePath -> m ()
checkPublic where
  checkPublic :: FilePath -> m ()
checkPublic FilePath
d = do
    FilePath
d2 <- r -> FilePath -> FilePath -> m FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
p FilePath
d
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
d2 FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
neededPublic) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). ErrorContextM m => FilePath -> m ()
compilerWarningM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Dependency \"" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
d FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\" does not need to be public"
  pc' :: Set CategoryName
pc' = [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
pc
  dc' :: Set CategoryName
dc' = [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
dc
  neededPublic :: Set FilePath
neededPublic = [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList ([FilePath] -> Set FilePath) -> [FilePath] -> Set FilePath
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (ObjectFile -> [FilePath]) -> [ObjectFile] -> [[FilePath]]
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 CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
pc' = (CategoryIdentifier -> FilePath)
-> [CategoryIdentifier] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map CategoryIdentifier -> FilePath
ciPath ([CategoryIdentifier] -> [FilePath])
-> [CategoryIdentifier] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (CategoryIdentifier -> Bool)
-> [CategoryIdentifier] -> [CategoryIdentifier]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
dc') (CategoryName -> Bool)
-> (CategoryIdentifier -> CategoryName)
-> CategoryIdentifier
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategoryIdentifier -> CategoryName
ciCategory) [CategoryIdentifier]
ds
  checkDep ObjectFile
_ = []