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

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

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

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

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

module Cli.Compiler (
  LoadedTests(..),
  ModuleSpec(..),
  compileModule,
  createModuleTemplates,
  runModuleTests,
) where

import Control.Monad (foldM,when)
import Data.Either (partitionEithers)
import Data.List (isSuffixOf,nub,sort)
import Data.Time.LocalTime (getZonedTime)
import System.Directory
import System.FilePath
import System.Posix.Temp (mkstemps)
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
import Types.DefinedCategory
import Types.Procedure (isLiteralCategory)
import Types.TypeCategory
import Types.TypeInstance


data ModuleSpec =
  ModuleSpec {
    ModuleSpec -> FilePath
msRoot :: FilePath,
    ModuleSpec -> FilePath
msPath :: 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 -> [FilePath]
msExtraPaths :: [FilePath],
    ModuleSpec -> CompileMode
msMode :: CompileMode,
    ModuleSpec -> ForceMode
msForce :: ForceMode
  }
  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
showList :: [ModuleSpec] -> ShowS
$cshowList :: [ModuleSpec] -> ShowS
show :: ModuleSpec -> FilePath
$cshow :: ModuleSpec -> FilePath
showsPrec :: Int -> ModuleSpec -> ShowS
$cshowsPrec :: Int -> ModuleSpec -> ShowS
Show)

data LoadedTests =
  LoadedTests {
    LoadedTests -> FilePath
ltRoot :: FilePath,
    LoadedTests -> FilePath
ltPath :: FilePath,
    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
showList :: [LoadedTests] -> ShowS
$cshowList :: [LoadedTests] -> ShowS
show :: LoadedTests -> FilePath
$cshow :: LoadedTests -> FilePath
showsPrec :: Int -> LoadedTests -> ShowS
$cshowsPrec :: Int -> LoadedTests -> ShowS
Show)

compileModule :: (PathIOHandler r, CompilerBackend b) => r -> b -> ModuleSpec -> TrackedErrorsIO ()
compileModule :: r -> b -> ModuleSpec -> TrackedErrorsIO ()
compileModule r
resolver b
backend (ModuleSpec FilePath
p FilePath
d ExprMap SourceContext
em [FilePath]
is [FilePath]
is2 [FilePath]
ps [FilePath]
xs [FilePath]
ts [ExtraSource]
es [FilePath]
ep CompileMode
m ForceMode
f) = do
  [FilePath]
as  <- ([FilePath] -> [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> ShowS
</> FilePath
d)) [FilePath]
is
  [FilePath]
as2 <- ([FilePath] -> [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath])
-> TrackedErrorsT IO [FilePath] -> TrackedErrorsT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> TrackedErrorsT IO FilePath)
-> [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> FilePath -> FilePath -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> ShowS
</> FilePath
d)) [FilePath]
is2
  let ca0 :: Map k a
ca0 = Map k a
forall k a. Map k a
Map.empty
  [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
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
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
isBaseModule r
resolver FilePath
actual
  -- Lazy dependency loading, in case we're compiling base.
  [CompileMetadata]
deps1' <- if Bool
isBase
               then [CompileMetadata] -> TrackedErrorsIO [CompileMetadata]
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 (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
  ZonedTime
time <- IO ZonedTime -> TrackedErrorsT IO ZonedTime
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO ZonedTime
getZonedTime
  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 -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
p FilePath -> ShowS
</> FilePath
d
  -- 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
$ ZonedTime -> FilePath
forall a. Show a => a -> FilePath
show ZonedTime
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
  let ss :: [CategoryName]
ss = (CategoryName -> Bool) -> [CategoryName] -> [CategoryName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CategoryName -> Bool) -> CategoryName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategoryName -> Bool
isLiteralCategory) [CategoryName]
extensions
  let ex :: [CategoryName]
ex = (CategoryName -> Bool) -> [CategoryName] -> [CategoryName]
forall a. (a -> Bool) -> [a] -> [a]
filter CategoryName -> Bool
isLiteralCategory [CategoryName]
extensions
  [WithVisibility (AnyCategory SourceContext)]
cs <- r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
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]
-> [CategoryName]
-> ExprMap SourceContext
-> [WithVisibility (AnyCategory SourceContext)]
-> LanguageModule SourceContext
forall c.
[CategoryName]
-> [CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [CategoryName]
ex [CategoryName]
ss ExprMap SourceContext
em [WithVisibility (AnyCategory SourceContext)]
cs
  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)]
cs
  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)]
cs
  [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
  [CxxOutput]
fs <- LanguageModule SourceContext
-> [PrivateSource SourceContext] -> TrackedErrorsT IO [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
compileLanguageModule LanguageModule SourceContext
cm [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)
  let ps2 :: [FilePath]
ps2 = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
takeFileName [FilePath]
ps
  let xs2 :: [FilePath]
xs2 = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
takeFileName [FilePath]
xs
  let ts2 :: [FilePath]
ts2 = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
takeFileName [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 (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)
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 ([FilePath], CxxOutput))
-> [CxxOutput] -> TrackedErrorsT IO [([FilePath], CxxOutput)]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ([FilePath]
-> CxxOutput -> TrackedErrorsT IO ([FilePath], CxxOutput)
writeOutputFile [FilePath]
paths2) ([CxxOutput] -> TrackedErrorsT IO [([FilePath], CxxOutput)])
-> [CxxOutput] -> TrackedErrorsT IO [([FilePath], CxxOutput)]
forall a b. (a -> b) -> a -> b
$ [CxxOutput]
hxx [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
other
  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 <- ([[Either ([FilePath], CxxOutput) ObjectFile]]
 -> [Either ([FilePath], CxxOutput) ObjectFile])
-> TrackedErrorsT IO [[Either ([FilePath], CxxOutput) ObjectFile]]
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Either ([FilePath], CxxOutput) ObjectFile]]
-> [Either ([FilePath], CxxOutput) ObjectFile]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (TrackedErrorsT IO [[Either ([FilePath], CxxOutput) ObjectFile]]
 -> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile])
-> TrackedErrorsT IO [[Either ([FilePath], CxxOutput) ObjectFile]]
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall a b. (a -> b) -> a -> b
$ (ExtraSource
 -> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile])
-> [ExtraSource]
-> TrackedErrorsT IO [[Either ([FilePath], CxxOutput) ObjectFile]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ((Namespace, Namespace)
-> Map CategoryName Namespace
-> [FilePath]
-> ExtraSource
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
compileExtraSource (Namespace
ns0,Namespace
ns1) Map CategoryName Namespace
ca [FilePath]
paths2) [ExtraSource]
es
  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 cm2 :: CompileMetadata
cm2 = CompileMetadata :: VersionHash
-> FilePath
-> Namespace
-> Namespace
-> [FilePath]
-> [FilePath]
-> [CategoryName]
-> [CategoryName]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ObjectFile]
-> CompileMetadata
CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = VersionHash
compilerHash,
      cmPath :: FilePath
cmPath = FilePath
path,
      cmPublicNamespace :: Namespace
cmPublicNamespace = Namespace
ns0,
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = Namespace
ns1,
      cmPublicDeps :: [FilePath]
cmPublicDeps = [FilePath]
as,
      cmPrivateDeps :: [FilePath]
cmPrivateDeps = [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,
      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 <- [FilePath]
-> [CompileMetadata]
-> CompileMode
-> [CxxOutput]
-> TrackedErrorsT IO [FilePath]
createBinary [FilePath]
paths' (CompileMetadata
cm2CompileMetadata -> [CompileMetadata] -> [CompileMetadata]
forall a. a -> [a] -> [a]
:([CompileMetadata]
deps1' [CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps2)) CompileMode
m [CxxOutput]
mf
  let cm2' :: CompileMetadata
cm2' = CompileMetadata :: VersionHash
-> FilePath
-> Namespace
-> Namespace
-> [FilePath]
-> [FilePath]
-> [CategoryName]
-> [CategoryName]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ObjectFile]
-> CompileMetadata
CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = CompileMetadata -> VersionHash
cmVersionHash CompileMetadata
cm2,
      cmPath :: FilePath
cmPath = CompileMetadata -> FilePath
cmPath 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,
      cmLinkFlags :: [FilePath]
cmLinkFlags = CompileMetadata -> [FilePath]
cmLinkFlags CompileMetadata
cm2,
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = CompileMetadata -> [ObjectFile]
cmObjectFiles CompileMetadata
cm2
    }
  FilePath -> CompileMetadata -> TrackedErrorsIO ()
writeMetadata (FilePath
p FilePath -> ShowS
</> FilePath
d) CompileMetadata
cm2' where
    compilerHash :: VersionHash
compilerHash = b -> VersionHash
forall b. CompilerBackend b => b -> VersionHash
getCompilerHash b
backend
    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
    writeOutputFile :: [FilePath]
-> CxxOutput -> TrackedErrorsT IO ([FilePath], CxxOutput)
writeOutputFile [FilePath]
paths ca :: CxxOutput
ca@(CxxOutput Maybe CategoryName
_ FilePath
f2 Namespace
ns Set Namespace
_ Set CategoryName
_ [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 -> FilePath -> TrackedErrorsIO ()
writeCachedFile (FilePath
p FilePath -> ShowS
</> FilePath
d) (Namespace -> FilePath
forall a. Show a => a -> FilePath
show Namespace
ns) FilePath
f2 (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
           FilePath
o2 <- b -> CxxCommand -> TrackedErrorsT IO FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, ErrorContextM m) =>
b -> CxxCommand -> m FilePath
runCxxCommand b
backend CxxCommand
command
           ([FilePath], CxxOutput)
-> TrackedErrorsT IO ([FilePath], CxxOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return (([FilePath], CxxOutput)
 -> TrackedErrorsT IO ([FilePath], CxxOutput))
-> ([FilePath], CxxOutput)
-> TrackedErrorsT IO ([FilePath], CxxOutput)
forall a b. (a -> b) -> a -> b
$ ([FilePath
o2],CxxOutput
ca)
         else ([FilePath], CxxOutput)
-> TrackedErrorsT IO ([FilePath], CxxOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],CxxOutput
ca)
    compileExtraSource :: (Namespace, Namespace)
-> Map CategoryName Namespace
-> [FilePath]
-> ExtraSource
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
compileExtraSource (Namespace
ns0,Namespace
ns1) Map CategoryName Namespace
ca [FilePath]
paths (CategorySource FilePath
f2 [CategoryName]
cs [CategoryName]
ds2) = do
      Maybe FilePath
f2' <- Bool
-> (Namespace, Namespace)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Maybe FilePath)
forall a b.
(Show a, Show b) =>
Bool
-> (a, b)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Maybe FilePath)
compileExtraFile Bool
False (Namespace
ns0,Namespace
ns1) [FilePath]
paths FilePath
f2
      case Maybe FilePath
f2' of
           Maybe FilePath
Nothing -> [Either ([FilePath], CxxOutput) ObjectFile]
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall (m :: * -> *) a. Monad m => a -> m a
return []
           Just FilePath
o  -> [Either ([FilePath], CxxOutput) ObjectFile]
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either ([FilePath], CxxOutput) ObjectFile]
 -> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile])
-> [Either ([FilePath], CxxOutput) ObjectFile]
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall a b. (a -> b) -> a -> b
$ (CategoryName -> Either ([FilePath], CxxOutput) ObjectFile)
-> [CategoryName] -> [Either ([FilePath], CxxOutput) ObjectFile]
forall a b. (a -> b) -> [a] -> [b]
map (\CategoryName
c -> ([FilePath], CxxOutput)
-> Either ([FilePath], CxxOutput) ObjectFile
forall a b. a -> Either a b
Left (([FilePath], CxxOutput)
 -> Either ([FilePath], CxxOutput) ObjectFile)
-> ([FilePath], CxxOutput)
-> Either ([FilePath], CxxOutput) ObjectFile
forall a b. (a -> b) -> a -> b
$ ([FilePath
o],CategoryName -> CxxOutput
fakeCxx CategoryName
c)) [CategoryName]
cs
      where
        allDeps :: Set CategoryName
allDeps = [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList ([CategoryName]
cs [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++ [CategoryName]
ds2)
        fakeCxx :: CategoryName -> CxxOutput
fakeCxx CategoryName
c = CxxOutput :: Maybe CategoryName
-> FilePath
-> Namespace
-> Set Namespace
-> Set CategoryName
-> [FilePath]
-> CxxOutput
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,
            coOutput :: [FilePath]
coOutput = []
          }
    compileExtraSource (Namespace, Namespace)
_ Map CategoryName Namespace
_ [FilePath]
paths (OtherSource FilePath
f2) = do
      Maybe FilePath
f2' <- Bool
-> (Namespace, Namespace)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Maybe FilePath)
forall a b.
(Show a, Show b) =>
Bool
-> (a, b)
-> [FilePath]
-> FilePath
-> TrackedErrorsT IO (Maybe FilePath)
compileExtraFile Bool
True (Namespace
NoNamespace,Namespace
NoNamespace) [FilePath]
paths FilePath
f2
      case Maybe FilePath
f2' of
           Just FilePath
o  -> [Either ([FilePath], CxxOutput) ObjectFile]
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall (m :: * -> *) a. Monad m => a -> m a
return [ObjectFile -> Either ([FilePath], CxxOutput) ObjectFile
forall a b. b -> Either a b
Right (ObjectFile -> Either ([FilePath], CxxOutput) ObjectFile)
-> ObjectFile -> Either ([FilePath], CxxOutput) ObjectFile
forall a b. (a -> b) -> a -> b
$ FilePath -> ObjectFile
OtherObjectFile FilePath
o]
           Maybe FilePath
Nothing -> [Either ([FilePath], CxxOutput) ObjectFile]
-> TrackedErrorsT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    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 (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 (Maybe 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)]
          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) FilePath
"" FilePath
"") [(FilePath, Maybe FilePath)]
ms [FilePath]
paths Bool
e
          (FilePath -> Maybe FilePath)
-> TrackedErrorsT IO FilePath -> TrackedErrorsT IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (TrackedErrorsT IO FilePath -> TrackedErrorsT IO (Maybe FilePath))
-> TrackedErrorsT IO FilePath -> TrackedErrorsT IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ b -> CxxCommand -> TrackedErrorsT IO FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, ErrorContextM m) =>
b -> CxxCommand -> m FilePath
runCxxCommand 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 = Maybe FilePath -> TrackedErrorsT IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f2)
      | Bool
otherwise = Maybe FilePath -> TrackedErrorsT IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
    createBinary :: [FilePath]
-> [CompileMetadata]
-> CompileMode
-> [CxxOutput]
-> TrackedErrorsT IO [FilePath]
createBinary [FilePath]
paths [CompileMetadata]
deps (CompileBinary CategoryName
n FunctionName
_ FilePath
o [FilePath]
lf) [CxxOutput]
ms
      | [CxxOutput] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CxxOutput]
ms Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
1 = FilePath -> TrackedErrorsT IO [FilePath]
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
"."
      | [CxxOutput] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CxxOutput]
ms Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = FilePath -> TrackedErrorsT IO [FilePath]
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."
      | Bool
otherwise = do
          FilePath
f0 <- if FilePath -> 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 (CxxOutput Maybe CategoryName
_ FilePath
_ Namespace
_ Set Namespace
ns2 Set CategoryName
req [FilePath]
content) = [CxxOutput] -> CxxOutput
forall a. [a] -> a
head [CxxOutput]
ms
          -- TODO: Create a helper or a constant or something.
          (FilePath
o',Handle
h) <- IO (FilePath, Handle) -> TrackedErrorsT IO (FilePath, Handle)
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO (FilePath, Handle) -> TrackedErrorsT IO (FilePath, Handle))
-> IO (FilePath, Handle) -> TrackedErrorsT IO (FilePath, Handle)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO (FilePath, Handle)
mkstemps FilePath
"/tmp/zmain_" 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 ()
hPutStr Handle
h (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
          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 -> IO ()
hClose Handle
h
          FilePath
base <- r -> TrackedErrorsT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
resolveBaseModule r
resolver
          [CompileMetadata]
deps2  <- VersionHash
-> ForceMode
-> MetadataMap
-> [CompileMetadata]
-> TrackedErrorsIO [CompileMetadata]
loadPrivateDeps VersionHash
compilerHash ForceMode
f ([CompileMetadata] -> MetadataMap
mapMetadata [CompileMetadata]
deps) [CompileMetadata]
deps
          let lf' :: [FilePath]
lf' = [FilePath]
lf [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [CompileMetadata] -> [FilePath]
getLinkFlagsForDeps [CompileMetadata]
deps2
          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)
          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 os' :: [FilePath]
os' = Set Namespace -> Set CategoryName -> [FilePath]
ofr Set Namespace
ns2 Set CategoryName
req
          let command :: CxxCommand
command = FilePath
-> [FilePath] -> FilePath -> [FilePath] -> [FilePath] -> CxxCommand
CompileToBinary FilePath
o' [FilePath]
os' FilePath
f0 [FilePath]
paths' [FilePath]
lf'
          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, ErrorContextM m) =>
b -> CxxCommand -> m FilePath
runCxxCommand b
backend CxxCommand
command
          IO () -> TrackedErrorsIO ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> TrackedErrorsIO ()) -> IO () -> TrackedErrorsIO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
o'
          [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
f1]
    createBinary [FilePath]
_ [CompileMetadata]
_ CompileMode
_ [CxxOutput]
_ = [FilePath] -> TrackedErrorsT IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    maybeCreateMain :: LanguageModule c
-> [PrivateSource c] -> CompileMode -> f [CxxOutput]
maybeCreateMain LanguageModule c
cm2 [PrivateSource c]
xs2 (CompileBinary CategoryName
n FunctionName
f2 FilePath
_ [FilePath]
_) =
      (CxxOutput -> [CxxOutput]) -> f CxxOutput -> f [CxxOutput]
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 (m :: * -> *) a. Monad m => a -> m a
return []

createModuleTemplates :: PathIOHandler r => r -> FilePath -> FilePath ->
  [CompileMetadata] -> [CompileMetadata] -> TrackedErrorsIO ()
createModuleTemplates :: r
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO ()
createModuleTemplates r
resolver FilePath
p FilePath
d [CompileMetadata]
deps1 [CompileMetadata]
deps2 = do
  ([FilePath]
ps,[FilePath]
xs,[FilePath]
_) <- FilePath
-> FilePath -> TrackedErrorsIO ([FilePath], [FilePath], [FilePath])
findSourceFiles FilePath
p FilePath
d
  (LanguageModule Set Namespace
_ Set Namespace
_ Set Namespace
_ [AnyCategory SourceContext]
cs0 [AnyCategory SourceContext]
ps0 [AnyCategory SourceContext]
ts0 [AnyCategory SourceContext]
cs1 [AnyCategory SourceContext]
ps1 [AnyCategory SourceContext]
ts1 [CategoryName]
_ [CategoryName]
_ ExprMap SourceContext
_) <-
    ([WithVisibility (AnyCategory SourceContext)]
 -> LanguageModule SourceContext)
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
-> TrackedErrorsT IO (LanguageModule SourceContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CategoryName]
-> [CategoryName]
-> ExprMap SourceContext
-> [WithVisibility (AnyCategory SourceContext)]
-> LanguageModule SourceContext
forall c.
[CategoryName]
-> [CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [] [] ExprMap SourceContext
forall k a. Map k a
Map.empty) (TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
 -> TrackedErrorsT IO (LanguageModule SourceContext))
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
-> TrackedErrorsT IO (LanguageModule SourceContext)
forall a b. (a -> b) -> a -> b
$ r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
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)]
zipWithContents r
resolver FilePath
p [FilePath]
xs
  [([PragmaSource SourceContext], [AnyCategory SourceContext],
  [DefinedCategory SourceContext])]
ds <- ((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 ds2 :: [DefinedCategory SourceContext]
ds2 = [[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])]
ds
  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
forall c. CategoryMap c
defaultCategories [[AnyCategory SourceContext]
cs0,[AnyCategory SourceContext]
cs1,[AnyCategory SourceContext]
ps0,[AnyCategory SourceContext]
ps1,[AnyCategory SourceContext]
ts0,[AnyCategory SourceContext]
ts1]
  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]
ts1
  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 (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]
ds2
  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]
ts1
  [CxxOutput]
ts <- ([[CxxOutput]] -> [CxxOutput])
-> TrackedErrorsT IO [[CxxOutput]] -> TrackedErrorsT IO [CxxOutput]
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 :: * -> *) c.
(Show c, CollectErrorsM m, Ord c) =>
Bool -> CategoryMap c -> 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_ CxxOutput -> TrackedErrorsIO ()
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
CxxOutput -> m ()
writeTemplate [CxxOutput]
ts where
    generate :: Bool -> CategoryMap c -> CategoryName -> m [CxxOutput]
generate Bool
testing CategoryMap c
tm CategoryName
n = do
      ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
tm ([],CategoryName
n)
      let ctx :: FileContext c
ctx = Bool
-> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
forall c.
Bool
-> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
FileContext Bool
testing CategoryMap c
tm Set Namespace
forall a. Set a
Set.empty ExprMap c
forall k a. Map k a
Map.empty
      FileContext c -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
FileContext c -> AnyCategory c -> m [CxxOutput]
generateStreamlinedTemplate FileContext c
ctx AnyCategory c
t
    writeTemplate :: CxxOutput -> m ()
writeTemplate (CxxOutput Maybe CategoryName
_ FilePath
n Namespace
_ Set Namespace
_ Set CategoryName
_ [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

runModuleTests :: (PathIOHandler r, CompilerBackend b) => r -> b -> FilePath ->
  [FilePath] -> LoadedTests -> TrackedErrorsIO [((Int,Int),TrackedErrors ())]
runModuleTests :: r
-> b
-> FilePath
-> [FilePath]
-> LoadedTests
-> TrackedErrorsIO [((Int, Int), TrackedErrors ())]
runModuleTests r
resolver b
backend FilePath
base [FilePath]
tp (LoadedTests FilePath
p FilePath
d 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)]
zipWithContents r
resolver FilePath
p ([FilePath] -> TrackedErrorsT IO [(FilePath, FilePath)])
-> [FilePath] -> TrackedErrorsT IO [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
d FilePath -> ShowS
</>) ([FilePath] -> [FilePath]) -> [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
  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)
  LanguageModule SourceContext
cm <- ([WithVisibility (AnyCategory SourceContext)]
 -> LanguageModule SourceContext)
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
-> TrackedErrorsT IO (LanguageModule SourceContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CategoryName]
-> [CategoryName]
-> ExprMap SourceContext
-> [WithVisibility (AnyCategory SourceContext)]
-> LanguageModule SourceContext
forall c.
[CategoryName]
-> [CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [] [] ExprMap SourceContext
em) (TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
 -> TrackedErrorsT IO (LanguageModule SourceContext))
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
-> TrackedErrorsT IO (LanguageModule SourceContext)
forall a b. (a -> b) -> a -> b
$ r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> TrackedErrorsIO [WithVisibility (AnyCategory SourceContext)]
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
-> LanguageModule SourceContext
-> FilePath
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> TrackedErrorsT IO ((Int, Int), TrackedErrors ())
forall b.
CompilerBackend b =>
b
-> LanguageModule SourceContext
-> FilePath
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> TrackedErrorsT IO ((Int, Int), TrackedErrors ())
runSingleTest b
backend LanguageModule SourceContext
cm FilePath
path [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 = if Set FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set FilePath
allowTests then Bool
True else FilePath
t FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` 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 :: 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)]
zipWithContents r
resolver FilePath
p [FilePath
f]
  ZonedTime
time <- IO ZonedTime -> TrackedErrorsT IO ZonedTime
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO ZonedTime
getZonedTime
  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
$ ZonedTime -> FilePath
forall a. Show a => a -> FilePath
show ZonedTime
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 (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] -> [CategoryName] -> ExprMap c ->
  [WithVisibility (AnyCategory c)] -> LanguageModule c
createLanguageModule :: [CategoryName]
-> [CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [CategoryName]
ex [CategoryName]
ss ExprMap c
em [WithVisibility (AnyCategory c)]
cs = LanguageModule c
lm where
  lm :: LanguageModule c
lm = LanguageModule :: forall c.
Set Namespace
-> Set Namespace
-> Set Namespace
-> [AnyCategory c]
-> [AnyCategory c]
-> [AnyCategory c]
-> [AnyCategory c]
-> [AnyCategory c]
-> [AnyCategory c]
-> [CategoryName]
-> [CategoryName]
-> ExprMap c
-> LanguageModule c
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],
      lmTestingDeps :: [AnyCategory c]
lmTestingDeps       = (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
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],
      lmTestingLocal :: [AnyCategory c]
lmTestingLocal      = (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
TestsOnly],
      lmExternal :: [CategoryName]
lmExternal = [CategoryName]
ex,
      lmStreamlined :: [CategoryName]
lmStreamlined = [CategoryName]
ss,
      lmExprMap :: ExprMap c
lmExprMap  = ExprMap c
em
    }
  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 (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 :: 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
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
_ = []