{- -----------------------------------------------------------------------------
Copyright 2020 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 Text.Parsec (SourcePos)
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompileError
import Base.CompileInfo
import Cli.CompileOptions
import Cli.Programs
import Cli.TestRunner -- Not safe, due to Text.Regex.TDFA.
import Compilation.ProcedureContext (ExprMap)
import CompilerCxx.Category
import CompilerCxx.Naming
import Module.CompileMetadata
import Module.Paths
import Module.ProcessMetadata
import Parser.SourceFile
import Types.Builtin
import Types.DefinedCategory
import Types.Pragma
import Types.Procedure (isLiteralCategory)
import Types.TypeCategory
import Types.TypeInstance


data ModuleSpec =
  ModuleSpec {
    ModuleSpec -> FilePath
msRoot :: FilePath,
    ModuleSpec -> FilePath
msPath :: FilePath,
    ModuleSpec -> ExprMap SourcePos
msExprMap :: ExprMap SourcePos,
    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 SourcePos
ltExprMap :: ExprMap SourcePos,
    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 -> CompileInfoIO ()
compileModule :: r -> b -> ModuleSpec -> CompileInfoIO ()
compileModule r
resolver b
backend (ModuleSpec FilePath
p FilePath
d ExprMap SourcePos
em [FilePath]
is [FilePath]
is2 [FilePath]
ps [FilePath]
xs [FilePath]
ts [ExtraSource]
es [FilePath]
ep CompileMode
m ForceMode
f) = do
  [FilePath]
as  <- ([FilePath] -> [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> CompileInfoT IO FilePath)
-> [FilePath] -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (r -> FilePath -> FilePath -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver (FilePath
p FilePath -> ShowS
</> FilePath
d)) [FilePath]
is
  [FilePath]
as2 <- ([FilePath] -> [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
fixPaths (CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath])
-> CompileInfoT IO [FilePath] -> CompileInfoT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> CompileInfoT IO FilePath)
-> [FilePath] -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (r -> FilePath -> FilePath -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM 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]
-> CompileInfoIO [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]
-> CompileInfoIO [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 -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> m FilePath
resolveBaseModule r
resolver
  FilePath
actual <- r -> FilePath -> FilePath -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> FilePath -> m FilePath
resolveModule r
resolver FilePath
p FilePath
d
  Bool
isBase <- r -> FilePath -> CompileInfoT IO Bool
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM 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] -> CompileInfoIO [CompileMetadata]
forall (m :: * -> *) a. Monad m => a -> m a
return [CompileMetadata]
deps1
               else do
                 [CompileMetadata]
bpDeps <- VersionHash
-> ForceMode
-> MetadataMap
-> [FilePath]
-> CompileInfoIO [CompileMetadata]
loadPublicDeps VersionHash
compilerHash ForceMode
f MetadataMap
ca2 [FilePath
base]
                 [CompileMetadata] -> CompileInfoIO [CompileMetadata]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompileMetadata] -> CompileInfoIO [CompileMetadata])
-> [CompileMetadata] -> CompileInfoIO [CompileMetadata]
forall a b. (a -> b) -> a -> b
$ [CompileMetadata]
bpDeps [CompileMetadata] -> [CompileMetadata] -> [CompileMetadata]
forall a. [a] -> [a] -> [a]
++ [CompileMetadata]
deps1
  ZonedTime
time <- IO ZonedTime -> CompileInfoT IO ZonedTime
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO IO ZonedTime
getZonedTime
  FilePath
path <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT 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 ex :: [CategoryName]
ex = [[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]
ex
  [WithVisibility (AnyCategory SourcePos)]
cs <- r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
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 SourcePos
cm = [CategoryName]
-> [CategoryName]
-> ExprMap SourcePos
-> [WithVisibility (AnyCategory SourcePos)]
-> LanguageModule SourcePos
forall c.
[CategoryName]
-> [CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [CategoryName]
ex [CategoryName]
ss ExprMap SourcePos
em [WithVisibility (AnyCategory SourcePos)]
cs
  let cs2 :: [WithVisibility (AnyCategory SourcePos)]
cs2 = (WithVisibility (AnyCategory SourcePos) -> Bool)
-> [WithVisibility (AnyCategory SourcePos)]
-> [WithVisibility (AnyCategory SourcePos)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (WithVisibility (AnyCategory SourcePos) -> Bool)
-> WithVisibility (AnyCategory SourcePos)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVisibility -> WithVisibility (AnyCategory SourcePos) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
FromDependency) [WithVisibility (AnyCategory SourcePos)]
cs
  let pc :: [CategoryName]
pc = (WithVisibility (AnyCategory SourcePos) -> CategoryName)
-> [WithVisibility (AnyCategory SourcePos)] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory SourcePos -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName (AnyCategory SourcePos -> CategoryName)
-> (WithVisibility (AnyCategory SourcePos)
    -> AnyCategory SourcePos)
-> WithVisibility (AnyCategory SourcePos)
-> CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithVisibility (AnyCategory SourcePos) -> AnyCategory SourcePos
forall a. WithVisibility a -> a
wvData) ([WithVisibility (AnyCategory SourcePos)] -> [CategoryName])
-> [WithVisibility (AnyCategory SourcePos)] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourcePos) -> Bool)
-> [WithVisibility (AnyCategory SourcePos)]
-> [WithVisibility (AnyCategory SourcePos)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (WithVisibility (AnyCategory SourcePos) -> Bool)
-> WithVisibility (AnyCategory SourcePos)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVisibility -> WithVisibility (AnyCategory SourcePos) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly) [WithVisibility (AnyCategory SourcePos)]
cs2
  let tc :: [CategoryName]
tc = (WithVisibility (AnyCategory SourcePos) -> CategoryName)
-> [WithVisibility (AnyCategory SourcePos)] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory SourcePos -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName (AnyCategory SourcePos -> CategoryName)
-> (WithVisibility (AnyCategory SourcePos)
    -> AnyCategory SourcePos)
-> WithVisibility (AnyCategory SourcePos)
-> CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithVisibility (AnyCategory SourcePos) -> AnyCategory SourcePos
forall a. WithVisibility a -> a
wvData) ([WithVisibility (AnyCategory SourcePos)] -> [CategoryName])
-> [WithVisibility (AnyCategory SourcePos)] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourcePos) -> Bool)
-> [WithVisibility (AnyCategory SourcePos)]
-> [WithVisibility (AnyCategory SourcePos)]
forall a. (a -> Bool) -> [a] -> [a]
filter (CodeVisibility -> WithVisibility (AnyCategory SourcePos) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly)       [WithVisibility (AnyCategory SourcePos)]
cs2
  let dc :: [CategoryName]
dc = (WithVisibility (AnyCategory SourcePos) -> CategoryName)
-> [WithVisibility (AnyCategory SourcePos)] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory SourcePos -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName (AnyCategory SourcePos -> CategoryName)
-> (WithVisibility (AnyCategory SourcePos)
    -> AnyCategory SourcePos)
-> WithVisibility (AnyCategory SourcePos)
-> CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithVisibility (AnyCategory SourcePos) -> AnyCategory SourcePos
forall a. WithVisibility a -> a
wvData) ([WithVisibility (AnyCategory SourcePos)] -> [CategoryName])
-> [WithVisibility (AnyCategory SourcePos)] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourcePos) -> Bool)
-> [WithVisibility (AnyCategory SourcePos)]
-> [WithVisibility (AnyCategory SourcePos)]
forall a. (a -> Bool) -> [a] -> [a]
filter (CodeVisibility -> WithVisibility (AnyCategory SourcePos) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
FromDependency) ([WithVisibility (AnyCategory SourcePos)]
 -> [WithVisibility (AnyCategory SourcePos)])
-> [WithVisibility (AnyCategory SourcePos)]
-> [WithVisibility (AnyCategory SourcePos)]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourcePos) -> Bool)
-> [WithVisibility (AnyCategory SourcePos)]
-> [WithVisibility (AnyCategory SourcePos)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (WithVisibility (AnyCategory SourcePos) -> Bool)
-> WithVisibility (AnyCategory SourcePos)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVisibility -> WithVisibility (AnyCategory SourcePos) -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
hasCodeVisibility CodeVisibility
ModuleOnly) [WithVisibility (AnyCategory SourcePos)]
cs
  [PrivateSource SourcePos]
xa <- (FilePath -> CompileInfoT IO (PrivateSource SourcePos))
-> [FilePath] -> CompileInfoT IO [PrivateSource SourcePos]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (r
-> VersionHash
-> FilePath
-> FilePath
-> CompileInfoT IO (PrivateSource SourcePos)
forall r.
PathIOHandler r =>
r
-> VersionHash
-> FilePath
-> FilePath
-> CompileInfoT IO (PrivateSource SourcePos)
loadPrivateSource r
resolver VersionHash
compilerHash FilePath
p) [FilePath]
xs
  [CxxOutput]
fs <- LanguageModule SourcePos
-> [PrivateSource SourcePos] -> CompileInfoT IO [CxxOutput]
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
compileLanguageModule LanguageModule SourcePos
cm [PrivateSource SourcePos]
xa
  [CxxOutput]
mf <- LanguageModule SourcePos
-> [PrivateSource SourcePos]
-> CompileMode
-> CompileInfoT IO [CxxOutput]
forall (f :: * -> *) c.
(Show c, CompileErrorM f) =>
LanguageModule c
-> [PrivateSource c] -> CompileMode -> f [CxxOutput]
maybeCreateMain LanguageModule SourcePos
cm [PrivateSource SourcePos]
xa CompileMode
m
  FilePath -> CompileInfoIO ()
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 -> CompileInfoT IO FilePath)
-> [FilePath] -> CompileInfoT IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> (FilePath -> IO FilePath)
-> FilePath
-> CompileInfoT IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath) [FilePath]
paths
  FilePath
s0 <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT 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 -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT 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 -> CompileInfoT IO ([FilePath], CxxOutput))
-> [CxxOutput] -> CompileInfoT IO [([FilePath], CxxOutput)]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM ([FilePath] -> CxxOutput -> CompileInfoT IO ([FilePath], CxxOutput)
writeOutputFile [FilePath]
paths2) ([CxxOutput] -> CompileInfoT IO [([FilePath], CxxOutput)])
-> [CxxOutput] -> CompileInfoT 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 -> CompileInfoT IO FilePath)
-> [FilePath] -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *).
(MonadIO m, CompileErrorM 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 SourcePos -> (CategoryName, Namespace))
-> [AnyCategory SourcePos] -> [(CategoryName, Namespace)]
forall a b. (a -> b) -> [a] -> [b]
map (\AnyCategory SourcePos
c -> (AnyCategory SourcePos -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory SourcePos
c,AnyCategory SourcePos -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory SourcePos
c)) ([AnyCategory SourcePos] -> [(CategoryName, Namespace)])
-> [AnyCategory SourcePos] -> [(CategoryName, Namespace)]
forall a b. (a -> b) -> a -> b
$ (WithVisibility (AnyCategory SourcePos) -> AnyCategory SourcePos)
-> [WithVisibility (AnyCategory SourcePos)]
-> [AnyCategory SourcePos]
forall a b. (a -> b) -> [a] -> [b]
map WithVisibility (AnyCategory SourcePos) -> AnyCategory SourcePos
forall a. WithVisibility a -> a
wvData [WithVisibility (AnyCategory SourcePos)]
cs2
  [Either ([FilePath], CxxOutput) ObjectFile]
os2 <- ([[Either ([FilePath], CxxOutput) ObjectFile]]
 -> [Either ([FilePath], CxxOutput) ObjectFile])
-> CompileInfoT IO [[Either ([FilePath], CxxOutput) ObjectFile]]
-> CompileInfoT 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 (CompileInfoT IO [[Either ([FilePath], CxxOutput) ObjectFile]]
 -> CompileInfoT IO [Either ([FilePath], CxxOutput) ObjectFile])
-> CompileInfoT IO [[Either ([FilePath], CxxOutput) ObjectFile]]
-> CompileInfoT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall a b. (a -> b) -> a -> b
$ (ExtraSource
 -> CompileInfoT IO [Either ([FilePath], CxxOutput) ObjectFile])
-> [ExtraSource]
-> CompileInfoT IO [[Either ([FilePath], CxxOutput) ObjectFile]]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM ((Namespace, Namespace)
-> Map CategoryName Namespace
-> [FilePath]
-> ExtraSource
-> CompileInfoT 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]
-> CompileInfoIO ()
forall r.
PathIOHandler r =>
r
-> FilePath
-> [CategoryName]
-> [CategoryName]
-> [ObjectFile]
-> [FilePath]
-> CompileInfoIO ()
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]
-> CompileInfoT 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 -> CompileInfoIO ()
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 -> CompileInfoT IO ([FilePath], CxxOutput)
writeOutputFile [FilePath]
paths ca :: CxxOutput
ca@(CxxOutput Maybe CategoryName
_ FilePath
f2 Namespace
ns [Namespace]
_ [CategoryName]
_ [FilePath]
content) = do
      IO () -> CompileInfoIO ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoIO ()) -> IO () -> CompileInfoIO ()
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 -> CompileInfoIO ()
writeCachedFile (FilePath
p FilePath -> ShowS
</> FilePath
d) (Namespace -> FilePath
forall a. Show a => a -> FilePath
show Namespace
ns) FilePath
f2 (FilePath -> CompileInfoIO ()) -> FilePath -> CompileInfoIO ()
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 -> CompileInfoIO ()
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 -> CompileInfoT IO FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CompileErrorM m) =>
b -> CxxCommand -> m FilePath
runCxxCommand b
backend CxxCommand
command
           ([FilePath], CxxOutput) -> CompileInfoT IO ([FilePath], CxxOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return (([FilePath], CxxOutput)
 -> CompileInfoT IO ([FilePath], CxxOutput))
-> ([FilePath], CxxOutput)
-> CompileInfoT IO ([FilePath], CxxOutput)
forall a b. (a -> b) -> a -> b
$ ([FilePath
o2],CxxOutput
ca)
         else ([FilePath], CxxOutput) -> CompileInfoT IO ([FilePath], CxxOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],CxxOutput
ca)
    compileExtraSource :: (Namespace, Namespace)
-> Map CategoryName Namespace
-> [FilePath]
-> ExtraSource
-> CompileInfoT 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
-> CompileInfoT IO (Maybe FilePath)
forall a b.
(Show a, Show b) =>
Bool
-> (a, b)
-> [FilePath]
-> FilePath
-> CompileInfoT 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]
-> CompileInfoT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall (m :: * -> *) a. Monad m => a -> m a
return []
           Just FilePath
o  -> [Either ([FilePath], CxxOutput) ObjectFile]
-> CompileInfoT IO [Either ([FilePath], CxxOutput) ObjectFile]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either ([FilePath], CxxOutput) ObjectFile]
 -> CompileInfoT IO [Either ([FilePath], CxxOutput) ObjectFile])
-> [Either ([FilePath], CxxOutput) ObjectFile]
-> CompileInfoT 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
        fakeCxx :: CategoryName -> CxxOutput
fakeCxx CategoryName
c = CxxOutput :: Maybe CategoryName
-> FilePath
-> Namespace
-> [Namespace]
-> [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 :: [Namespace]
coUsesNamespace = [Namespace
ns0,Namespace
ns1],
            coUsesCategory :: [CategoryName]
coUsesCategory = [CategoryName]
ds2,
            coOutput :: [FilePath]
coOutput = []
          }
    compileExtraSource (Namespace, Namespace)
_ Map CategoryName Namespace
_ [FilePath]
paths (OtherSource FilePath
f2) = do
      Maybe FilePath
f2' <- Bool
-> (Namespace, Namespace)
-> [FilePath]
-> FilePath
-> CompileInfoT IO (Maybe FilePath)
forall a b.
(Show a, Show b) =>
Bool
-> (a, b)
-> [FilePath]
-> FilePath
-> CompileInfoT 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]
-> CompileInfoT 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]
-> CompileInfoT 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, CompileErrorM 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. CompileErrorM m => FilePath -> m a
compileErrorM (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, CompileErrorM 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
-> CompileInfoT 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 -> CompileInfoIO ()
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)
-> CompileInfoT IO FilePath -> CompileInfoT 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 (CompileInfoT IO FilePath -> CompileInfoT IO (Maybe FilePath))
-> CompileInfoT IO FilePath -> CompileInfoT IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ b -> CxxCommand -> CompileInfoT IO FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CompileErrorM 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 -> CompileInfoT 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 -> CompileInfoT IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
    createBinary :: [FilePath]
-> [CompileMetadata]
-> CompileMode
-> [CxxOutput]
-> CompileInfoT 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 -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> CompileInfoT IO [FilePath])
-> FilePath -> CompileInfoT 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 -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> CompileInfoT IO [FilePath])
-> FilePath -> CompileInfoT 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 -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT 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 -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT 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
_ [Namespace]
ns2 [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) -> CompileInfoT IO (FilePath, Handle)
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO (FilePath, Handle) -> CompileInfoT IO (FilePath, Handle))
-> IO (FilePath, Handle) -> CompileInfoT IO (FilePath, Handle)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO (FilePath, Handle)
mkstemps FilePath
"/tmp/zmain_" FilePath
".cpp"
          IO () -> CompileInfoIO ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoIO ()) -> IO () -> CompileInfoIO ()
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 () -> CompileInfoIO ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoIO ()) -> IO () -> CompileInfoIO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
          FilePath
base <- r -> CompileInfoT IO FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> m FilePath
resolveBaseModule r
resolver
          [CompileMetadata]
deps2  <- VersionHash
-> ForceMode
-> MetadataMap
-> [CompileMetadata]
-> CompileInfoIO [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 :: [Namespace] -> [CategoryName] -> [FilePath]
ofr = [ObjectFile] -> [Namespace] -> [CategoryName] -> [FilePath]
getObjectFileResolver [ObjectFile]
os
          let os' :: [FilePath]
os' = [Namespace] -> [CategoryName] -> [FilePath]
ofr [Namespace]
ns2 [CategoryName]
req
          let command :: CxxCommand
command = FilePath
-> [FilePath] -> FilePath -> [FilePath] -> [FilePath] -> CxxCommand
CompileToBinary FilePath
o' [FilePath]
os' FilePath
f0 [FilePath]
paths' [FilePath]
lf'
          IO () -> CompileInfoIO ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoIO ()) -> IO () -> CompileInfoIO ()
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 -> CompileInfoT IO FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CompileErrorM m) =>
b -> CxxCommand -> m FilePath
runCxxCommand b
backend CxxCommand
command
          IO () -> CompileInfoIO ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoIO ()) -> IO () -> CompileInfoIO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
o'
          [FilePath] -> CompileInfoT IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
f1]
    createBinary [FilePath]
_ [CompileMetadata]
_ CompileMode
_ [CxxOutput]
_ = [FilePath] -> CompileInfoT 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 :: * -> *).
(Show c, CompileErrorM 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] -> CompileInfoIO ()
createModuleTemplates :: r
-> FilePath
-> FilePath
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO ()
createModuleTemplates r
resolver FilePath
p FilePath
d [CompileMetadata]
deps1 [CompileMetadata]
deps2 = do
  ([FilePath]
ps,[FilePath]
xs,[FilePath]
_) <- FilePath
-> FilePath -> CompileInfoIO ([FilePath], [FilePath], [FilePath])
findSourceFiles FilePath
p FilePath
d
  (LanguageModule [Namespace]
_ [Namespace]
_ [Namespace]
_ [AnyCategory SourcePos]
cs0 [AnyCategory SourcePos]
ps0 [AnyCategory SourcePos]
ts0 [AnyCategory SourcePos]
cs1 [AnyCategory SourcePos]
ps1 [AnyCategory SourcePos]
ts1 [CategoryName]
_ [CategoryName]
_ ExprMap SourcePos
_) <-
    ([WithVisibility (AnyCategory SourcePos)]
 -> LanguageModule SourcePos)
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
-> CompileInfoT IO (LanguageModule SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CategoryName]
-> [CategoryName]
-> ExprMap SourcePos
-> [WithVisibility (AnyCategory SourcePos)]
-> LanguageModule SourcePos
forall c.
[CategoryName]
-> [CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [] [] ExprMap SourcePos
forall k a. Map k a
Map.empty) (CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
 -> CompileInfoT IO (LanguageModule SourcePos))
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
-> CompileInfoT IO (LanguageModule SourcePos)
forall a b. (a -> b) -> a -> b
$ r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
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] -> CompileInfoT IO [(FilePath, FilePath)]
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver FilePath
p [FilePath]
xs
  [([Pragma SourcePos], [AnyCategory SourcePos],
  [DefinedCategory SourcePos])]
ds <- ((FilePath, FilePath)
 -> CompileInfoT
      IO
      ([Pragma SourcePos], [AnyCategory SourcePos],
       [DefinedCategory SourcePos]))
-> [(FilePath, FilePath)]
-> CompileInfoT
     IO
     [([Pragma SourcePos], [AnyCategory SourcePos],
       [DefinedCategory SourcePos])]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (FilePath, FilePath)
-> CompileInfoT
     IO
     ([Pragma SourcePos], [AnyCategory SourcePos],
      [DefinedCategory SourcePos])
forall (m :: * -> *).
CompileErrorM m =>
(FilePath, FilePath)
-> m ([Pragma SourcePos], [AnyCategory SourcePos],
      [DefinedCategory SourcePos])
parseInternalSource [(FilePath, FilePath)]
xs'
  let ds2 :: [DefinedCategory SourcePos]
ds2 = [[DefinedCategory SourcePos]] -> [DefinedCategory SourcePos]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[DefinedCategory SourcePos]] -> [DefinedCategory SourcePos])
-> [[DefinedCategory SourcePos]] -> [DefinedCategory SourcePos]
forall a b. (a -> b) -> a -> b
$ (([Pragma SourcePos], [AnyCategory SourcePos],
  [DefinedCategory SourcePos])
 -> [DefinedCategory SourcePos])
-> [([Pragma SourcePos], [AnyCategory SourcePos],
     [DefinedCategory SourcePos])]
-> [[DefinedCategory SourcePos]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Pragma SourcePos]
_,[AnyCategory SourcePos]
_,[DefinedCategory SourcePos]
d2) -> [DefinedCategory SourcePos]
d2) [([Pragma SourcePos], [AnyCategory SourcePos],
  [DefinedCategory SourcePos])]
ds
  CategoryMap SourcePos
tm <- (CategoryMap SourcePos
 -> [AnyCategory SourcePos]
 -> CompileInfoT IO (CategoryMap SourcePos))
-> CategoryMap SourcePos
-> [[AnyCategory SourcePos]]
-> CompileInfoT IO (CategoryMap SourcePos)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CategoryMap SourcePos
-> [AnyCategory SourcePos]
-> CompileInfoT IO (CategoryMap SourcePos)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap SourcePos
forall c. CategoryMap c
defaultCategories [[AnyCategory SourcePos]
cs0,[AnyCategory SourcePos]
cs1,[AnyCategory SourcePos]
ps0,[AnyCategory SourcePos]
ps1,[AnyCategory SourcePos]
ts0,[AnyCategory SourcePos]
ts1]
  let cs :: [AnyCategory SourcePos]
cs = (AnyCategory SourcePos -> Bool)
-> [AnyCategory SourcePos] -> [AnyCategory SourcePos]
forall a. (a -> Bool) -> [a] -> [a]
filter AnyCategory SourcePos -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete ([AnyCategory SourcePos] -> [AnyCategory SourcePos])
-> [AnyCategory SourcePos] -> [AnyCategory SourcePos]
forall a b. (a -> b) -> a -> b
$ [AnyCategory SourcePos]
cs1[AnyCategory SourcePos]
-> [AnyCategory SourcePos] -> [AnyCategory SourcePos]
forall a. [a] -> [a] -> [a]
++[AnyCategory SourcePos]
ps1[AnyCategory SourcePos]
-> [AnyCategory SourcePos] -> [AnyCategory SourcePos]
forall a. [a] -> [a] -> [a]
++[AnyCategory SourcePos]
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 SourcePos -> CategoryName)
-> [AnyCategory SourcePos] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map AnyCategory SourcePos -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName ([AnyCategory SourcePos] -> [CategoryName])
-> [AnyCategory SourcePos] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (AnyCategory SourcePos -> Bool)
-> [AnyCategory SourcePos] -> [AnyCategory SourcePos]
forall a. (a -> Bool) -> [a] -> [a]
filter AnyCategory SourcePos -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete [AnyCategory SourcePos]
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 SourcePos -> CategoryName)
-> [DefinedCategory SourcePos] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map DefinedCategory SourcePos -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName [DefinedCategory SourcePos]
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 SourcePos -> CategoryName)
-> [AnyCategory SourcePos] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map AnyCategory SourcePos -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName [AnyCategory SourcePos]
ts1
  [CxxOutput]
ts <- (CategoryName -> CompileInfoT IO CxxOutput)
-> [CategoryName] -> CompileInfoT IO [CxxOutput]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (\CategoryName
n -> Bool
-> CategoryMap SourcePos
-> CategoryName
-> CompileInfoT IO CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool -> CategoryMap c -> CategoryName -> m CxxOutput
compileConcreteTemplate (CategoryName
n CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
testingCats) CategoryMap SourcePos
tm CategoryName
n) ([CategoryName] -> CompileInfoT IO [CxxOutput])
-> [CategoryName] -> CompileInfoT IO [CxxOutput]
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList Set CategoryName
ca'
  (CxxOutput -> CompileInfoIO ()) -> [CxxOutput] -> CompileInfoIO ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ CxxOutput -> CompileInfoIO ()
forall (m :: * -> *).
(MonadIO m, CompileErrorM m) =>
CxxOutput -> m ()
writeTemplate [CxxOutput]
ts where
  writeTemplate :: CxxOutput -> m ()
writeTemplate (CxxOutput Maybe CategoryName
_ FilePath
n Namespace
_ [Namespace]
_ [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, CompileErrorM 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 :: * -> *). CompileErrorM m => FilePath -> m ()
compileWarningM (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, CompileErrorM 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, CompileErrorM 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 -> CompileInfoIO [((Int,Int),CompileInfo ())]
runModuleTests :: r
-> b
-> FilePath
-> [FilePath]
-> LoadedTests
-> CompileInfoIO [((Int, Int), CompileInfo ())]
runModuleTests r
resolver b
backend FilePath
base [FilePath]
tp (LoadedTests FilePath
p FilePath
d CompileMetadata
m ExprMap SourcePos
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 -> CompileInfoIO ()) -> [FilePath] -> CompileInfoIO ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ FilePath -> CompileInfoIO ()
forall (m :: * -> *). CompileErrorM m => FilePath -> m ()
showSkipped ([FilePath] -> CompileInfoIO ()) -> [FilePath] -> CompileInfoIO ()
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] -> CompileInfoT IO [(FilePath, FilePath)]
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver FilePath
p ([FilePath] -> CompileInfoT IO [(FilePath, FilePath)])
-> [FilePath] -> CompileInfoT 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 -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
p FilePath -> ShowS
</> FilePath
d)
  LanguageModule SourcePos
cm <- ([WithVisibility (AnyCategory SourcePos)]
 -> LanguageModule SourcePos)
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
-> CompileInfoT IO (LanguageModule SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CategoryName]
-> [CategoryName]
-> ExprMap SourcePos
-> [WithVisibility (AnyCategory SourcePos)]
-> LanguageModule SourcePos
forall c.
[CategoryName]
-> [CategoryName]
-> ExprMap c
-> [WithVisibility (AnyCategory c)]
-> LanguageModule c
createLanguageModule [] [] ExprMap SourcePos
em) (CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
 -> CompileInfoT IO (LanguageModule SourcePos))
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
-> CompileInfoT IO (LanguageModule SourcePos)
forall a b. (a -> b) -> a -> b
$ r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
forall r.
PathIOHandler r =>
r
-> FilePath
-> (Namespace, Namespace)
-> [FilePath]
-> Maybe CompileMetadata
-> [CompileMetadata]
-> [CompileMetadata]
-> CompileInfoIO [WithVisibility (AnyCategory SourcePos)]
loadModuleGlobals r
resolver FilePath
path (Namespace
NoNamespace,Namespace
NoNamespace) [] (CompileMetadata -> Maybe CompileMetadata
forall a. a -> Maybe a
Just CompileMetadata
m) [CompileMetadata]
deps1 []
  ((FilePath, FilePath)
 -> CompileInfoT IO ((Int, Int), CompileInfo ()))
-> [(FilePath, FilePath)]
-> CompileInfoIO [((Int, Int), CompileInfo ())]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (b
-> LanguageModule SourcePos
-> FilePath
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> CompileInfoT IO ((Int, Int), CompileInfo ())
forall b.
CompilerBackend b =>
b
-> LanguageModule SourcePos
-> FilePath
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> CompileInfoT IO ((Int, Int), CompileInfo ())
runSingleTest b
backend LanguageModule SourcePos
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 :: * -> *). CompileErrorM m => FilePath -> m ()
compileWarningM (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 -> CompileInfoIO (PrivateSource SourcePos)
loadPrivateSource :: r
-> VersionHash
-> FilePath
-> FilePath
-> CompileInfoT IO (PrivateSource SourcePos)
loadPrivateSource r
resolver VersionHash
h FilePath
p FilePath
f = do
  [(FilePath, FilePath)
f'] <- r
-> FilePath -> [FilePath] -> CompileInfoT IO [(FilePath, FilePath)]
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CompileErrorM m) =>
r -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents r
resolver FilePath
p [FilePath
f]
  ZonedTime
time <- IO ZonedTime -> CompileInfoT IO ZonedTime
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO IO ZonedTime
getZonedTime
  FilePath
path <- IO FilePath -> CompileInfoT IO FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO FilePath -> CompileInfoT IO FilePath)
-> IO FilePath -> CompileInfoT 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
  ([Pragma SourcePos]
pragmas,[AnyCategory SourcePos]
cs,[DefinedCategory SourcePos]
ds) <- (FilePath, FilePath)
-> CompileInfoT
     IO
     ([Pragma SourcePos], [AnyCategory SourcePos],
      [DefinedCategory SourcePos])
forall (m :: * -> *).
CompileErrorM m =>
(FilePath, FilePath)
-> m ([Pragma SourcePos], [AnyCategory SourcePos],
      [DefinedCategory SourcePos])
parseInternalSource (FilePath, FilePath)
f'
  let cs' :: [AnyCategory SourcePos]
cs' = (AnyCategory SourcePos -> AnyCategory SourcePos)
-> [AnyCategory SourcePos] -> [AnyCategory SourcePos]
forall a b. (a -> b) -> [a] -> [b]
map (Namespace -> AnyCategory SourcePos -> AnyCategory SourcePos
forall c. Namespace -> AnyCategory c -> AnyCategory c
setCategoryNamespace Namespace
ns) [AnyCategory SourcePos]
cs
  let testing :: Bool
testing = (Pragma SourcePos -> Bool) -> [Pragma SourcePos] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pragma SourcePos -> Bool
forall c. Pragma c -> Bool
isTestsOnly [Pragma SourcePos]
pragmas
  PrivateSource SourcePos
-> CompileInfoT IO (PrivateSource SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrivateSource SourcePos
 -> CompileInfoT IO (PrivateSource SourcePos))
-> PrivateSource SourcePos
-> CompileInfoT IO (PrivateSource SourcePos)
forall a b. (a -> b) -> a -> b
$ Namespace
-> Bool
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> PrivateSource SourcePos
forall c.
Namespace
-> Bool
-> [AnyCategory c]
-> [DefinedCategory c]
-> PrivateSource c
PrivateSource Namespace
ns Bool
testing [AnyCategory SourcePos]
cs' [DefinedCategory SourcePos]
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.
[Namespace]
-> [Namespace]
-> [Namespace]
-> [AnyCategory c]
-> [AnyCategory c]
-> [AnyCategory c]
-> [AnyCategory c]
-> [AnyCategory c]
-> [AnyCategory c]
-> [CategoryName]
-> [CategoryName]
-> ExprMap c
-> LanguageModule c
LanguageModule {
      lmPublicNamespaces :: [Namespace]
lmPublicNamespaces  = (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,CodeVisibility -> WithVisibility Namespace -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmPrivateNamespaces :: [Namespace]
lmPrivateNamespaces = (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,CodeVisibility -> WithVisibility Namespace -> Bool
forall a. CodeVisibility -> WithVisibility a -> Bool
without CodeVisibility
TestsOnly],
      lmLocalNamespaces :: [Namespace]
lmLocalNamespaces   = (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] -> CompileInfoIO ()
warnPublic :: r
-> FilePath
-> [CategoryName]
-> [CategoryName]
-> [ObjectFile]
-> [FilePath]
-> CompileInfoIO ()
warnPublic r
resolver FilePath
p [CategoryName]
pc [CategoryName]
dc [ObjectFile]
os = (FilePath -> CompileInfoIO ()) -> [FilePath] -> CompileInfoIO ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ FilePath -> CompileInfoIO ()
forall (m :: * -> *).
(MonadIO m, CompileErrorM 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, CompileErrorM 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 :: * -> *). CompileErrorM m => FilePath -> m ()
compileWarningM (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
_ = []