{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Stack.Build.Source
( projectLocalPackages
, localDependencies
, loadCommonPackage
, loadLocalPackage
, loadSourceMap
, getLocalFlags
, addUnlistedToBuildCache
, hashSourceMapData
) where
import Conduit ( ZipSink (..), withSourceFile )
import Data.ByteString.Builder ( toLazyByteString )
import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Map.Merge.Lazy as Map
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import qualified Distribution.PackageDescription as C
import qualified Pantry.SHA256 as SHA256
import Stack.Build.Cache ( tryGetBuildCache )
import Stack.Build.Haddock ( shouldHaddockDeps )
import Stack.Package ( resolvePackage )
import Stack.Prelude
import Stack.SourceMap
( DumpedGlobalPackage, checkFlagsUsedThrowing
, getCompilerInfo, immutableLocSha, mkProjectPackage
, pruneGlobals
)
import Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
import Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
import Stack.Types.BuildConfig
( BuildConfig (..), HasBuildConfig (..) )
import Stack.Types.BuildOpts
( ApplyCLIFlag (..), BuildOpts (..), BuildOptsCLI (..)
, TestOpts (..), boptsCLIAllProgOptions
)
import Stack.Types.CabalConfigKey ( CabalConfigKey (..) )
import Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath )
import Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
import Stack.Types.Curator ( Curator (..) )
import Stack.Types.EnvConfig
( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..)
, actualCompilerVersionL
)
import Stack.Types.NamedComponent
( NamedComponent (..), isCInternalLib )
import Stack.Types.Package
( FileCacheInfo (..), LocalPackage (..), Package (..)
, PackageConfig (..), PackageLibraries (..)
, dotCabalGetPath, memoizeRefWith, runMemoizedWith
)
import Stack.Types.PackageFile ( PackageWarning, getPackageFiles )
import Stack.Types.Platform ( HasPlatform (..) )
import Stack.Types.SourceMap
( CommonPackage (..), DepPackage (..), ProjectPackage (..)
, SMActual (..), SMTargets (..), SourceMap (..)
, SourceMapHash (..), Target (..), ppGPD, ppRoot
)
import Stack.Types.UnusedFlags ( FlagSource (..) )
import System.FilePath ( takeFileName )
import System.IO.Error ( isDoesNotExistError )
projectLocalPackages :: HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages :: forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages = do
SourceMap
sm <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sm) forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage
localDependencies :: HasEnvConfig env => RIO env [LocalPackage]
localDependencies :: forall env. HasEnvConfig env => RIO env [LocalPackage]
localDependencies = do
BuildOpts
bopts <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> BuildOpts
configBuild
SourceMap
sourceMap <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM (forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sourceMap) forall a b. (a -> b) -> a -> b
$ \DepPackage
dp ->
case DepPackage -> PackageLocation
dpLocation DepPackage
dp of
PLMutable ResolvedPath Dir
dir -> do
ProjectPackage
pp <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
mkProjectPackage PrintWarnings
YesPrintWarnings ResolvedPath Dir
dir (BuildOpts -> Bool
shouldHaddockDeps BuildOpts
bopts)
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage ProjectPackage
pp
PackageLocation
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
loadSourceMap :: HasBuildConfig env
=> SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap :: forall env.
HasBuildConfig env =>
SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap SMTargets
smt BuildOptsCLI
boptsCli SMActual DumpedGlobalPackage
sma = do
BuildConfig
bconfig <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
let compiler :: ActualCompiler
compiler = forall global. SMActual global -> ActualCompiler
smaCompiler SMActual DumpedGlobalPackage
sma
project :: Map PackageName ProjectPackage
project = forall a b k. (a -> b) -> Map k a -> Map k b
M.map ProjectPackage -> ProjectPackage
applyOptsFlagsPP forall a b. (a -> b) -> a -> b
$ forall global. SMActual global -> Map PackageName ProjectPackage
smaProject SMActual DumpedGlobalPackage
sma
bopts :: BuildOpts
bopts = Config -> BuildOpts
configBuild (BuildConfig -> Config
bcConfig BuildConfig
bconfig)
applyOptsFlagsPP :: ProjectPackage -> ProjectPackage
applyOptsFlagsPP p :: ProjectPackage
p@ProjectPackage{ppCommon :: ProjectPackage -> CommonPackage
ppCommon = CommonPackage
c} =
ProjectPackage
p{ppCommon :: CommonPackage
ppCommon = Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags (forall k a. Ord k => k -> Map k a -> Bool
M.member (CommonPackage -> PackageName
cpName CommonPackage
c) (SMTargets -> Map PackageName Target
smtTargets SMTargets
smt)) Bool
True CommonPackage
c}
deps0 :: Map PackageName DepPackage
deps0 = SMTargets -> Map PackageName DepPackage
smtDeps SMTargets
smt forall a. Semigroup a => a -> a -> a
<> forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual DumpedGlobalPackage
sma
deps :: Map PackageName DepPackage
deps = forall a b k. (a -> b) -> Map k a -> Map k b
M.map DepPackage -> DepPackage
applyOptsFlagsDep Map PackageName DepPackage
deps0
applyOptsFlagsDep :: DepPackage -> DepPackage
applyOptsFlagsDep d :: DepPackage
d@DepPackage{dpCommon :: DepPackage -> CommonPackage
dpCommon = CommonPackage
c} =
DepPackage
d{dpCommon :: CommonPackage
dpCommon = Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags (forall k a. Ord k => k -> Map k a -> Bool
M.member (CommonPackage -> PackageName
cpName CommonPackage
c) (SMTargets -> Map PackageName DepPackage
smtDeps SMTargets
smt)) Bool
False CommonPackage
c}
applyOptsFlags :: Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags Bool
isTarget Bool
isProjectPackage CommonPackage
common =
let name :: PackageName
name = CommonPackage -> PackageName
cpName CommonPackage
common
flags :: Map FlagName Bool
flags = BuildOptsCLI -> PackageName -> Map FlagName Bool
getLocalFlags BuildOptsCLI
boptsCli PackageName
name
ghcOptions :: [Text]
ghcOptions =
BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bconfig BuildOptsCLI
boptsCli Bool
isTarget Bool
isProjectPackage
cabalConfigOpts :: [Text]
cabalConfigOpts =
BuildConfig
-> BuildOptsCLI -> PackageName -> Bool -> Bool -> [Text]
generalCabalConfigOpts BuildConfig
bconfig BuildOptsCLI
boptsCli (CommonPackage -> PackageName
cpName CommonPackage
common) Bool
isTarget Bool
isProjectPackage
in CommonPackage
common
{ cpFlags :: Map FlagName Bool
cpFlags =
if forall k a. Map k a -> Bool
M.null Map FlagName Bool
flags
then CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common
else Map FlagName Bool
flags
, cpGhcOptions :: [Text]
cpGhcOptions =
[Text]
ghcOptions forall a. [a] -> [a] -> [a]
++ CommonPackage -> [Text]
cpGhcOptions CommonPackage
common
, cpCabalConfigOpts :: [Text]
cpCabalConfigOpts =
[Text]
cabalConfigOpts forall a. [a] -> [a] -> [a]
++ CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common
, cpHaddocks :: Bool
cpHaddocks =
if Bool
isTarget
then BuildOpts -> Bool
boptsHaddock BuildOpts
bopts
else BuildOpts -> Bool
shouldHaddockDeps BuildOpts
bopts
}
packageCliFlags :: Map PackageName (Map FlagName Bool)
packageCliFlags = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. (ApplyCLIFlag, b) -> Maybe (PackageName, b)
maybeProjectFlags forall a b. (a -> b) -> a -> b
$
forall k a. Map k a -> [(k, a)]
Map.toList (BuildOptsCLI -> Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags BuildOptsCLI
boptsCli)
maybeProjectFlags :: (ApplyCLIFlag, b) -> Maybe (PackageName, b)
maybeProjectFlags (ACFByName PackageName
name, b
fs) = forall a. a -> Maybe a
Just (PackageName
name, b
fs)
maybeProjectFlags (ApplyCLIFlag, b)
_ = forall a. Maybe a
Nothing
globals :: Map PackageName GlobalPackage
globals = Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals (forall global. SMActual global -> Map PackageName global
smaGlobal SMActual DumpedGlobalPackage
sma) (forall k a. Map k a -> Set k
Map.keysSet Map PackageName DepPackage
deps)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Checking flags"
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Map PackageName (Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> m ()
checkFlagsUsedThrowing Map PackageName (Map FlagName Bool)
packageCliFlags FlagSource
FSCommandLine Map PackageName ProjectPackage
project Map PackageName DepPackage
deps
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"SourceMap constructed"
forall (f :: * -> *) a. Applicative f => a -> f a
pure
SourceMap
{ smTargets :: SMTargets
smTargets = SMTargets
smt
, smCompiler :: ActualCompiler
smCompiler = ActualCompiler
compiler
, smProject :: Map PackageName ProjectPackage
smProject = Map PackageName ProjectPackage
project
, smDeps :: Map PackageName DepPackage
smDeps = Map PackageName DepPackage
deps
, smGlobal :: Map PackageName GlobalPackage
smGlobal = Map PackageName GlobalPackage
globals
}
hashSourceMapData ::
(HasBuildConfig env, HasCompiler env)
=> BuildOptsCLI
-> SourceMap
-> RIO env SourceMapHash
hashSourceMapData :: forall env.
(HasBuildConfig env, HasCompiler env) =>
BuildOptsCLI -> SourceMap -> RIO env SourceMapHash
hashSourceMapData BuildOptsCLI
boptsCli SourceMap
sm = do
Builder
compilerPath <- Utf8Builder -> Builder
getUtf8Builder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env. HasCompiler env => RIO env (Path Abs File)
getCompilerPath
Builder
compilerInfo <- forall env. (HasConfig env, HasCompiler env) => RIO env Builder
getCompilerInfo
[Builder]
immDeps <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [a]
Map.elems (SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sm)) forall env. HasConfig env => DepPackage -> RIO env Builder
depPackageHashableContent
BuildConfig
bc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
let
bootGhcOpts :: [Utf8Builder]
bootGhcOpts = forall a b. (a -> b) -> [a] -> [b]
map forall a. Display a => a -> Utf8Builder
display (BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bc BuildOptsCLI
boptsCli Bool
False Bool
False)
hashedContent :: ByteString
hashedContent =
Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ Builder
compilerPath
forall a. Semigroup a => a -> a -> a
<> Builder
compilerInfo
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder (forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
bootGhcOpts)
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [Builder]
immDeps
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SHA256 -> SourceMapHash
SourceMapHash (ByteString -> SHA256
SHA256.hashLazyBytes ByteString
hashedContent)
depPackageHashableContent :: (HasConfig env) => DepPackage -> RIO env Builder
depPackageHashableContent :: forall env. HasConfig env => DepPackage -> RIO env Builder
depPackageHashableContent DepPackage {Bool
PackageLocation
FromSnapshot
CommonPackage
dpFromSnapshot :: DepPackage -> FromSnapshot
dpHidden :: DepPackage -> Bool
dpFromSnapshot :: FromSnapshot
dpHidden :: Bool
dpLocation :: PackageLocation
dpCommon :: CommonPackage
dpCommon :: DepPackage -> CommonPackage
dpLocation :: DepPackage -> PackageLocation
..} =
case PackageLocation
dpLocation of
PLMutable ResolvedPath Dir
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
""
PLImmutable PackageLocationImmutable
pli -> do
let flagToBs :: (FlagName, Bool) -> a
flagToBs (FlagName
f, Bool
enabled) =
if Bool
enabled
then a
""
else a
"-" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (FlagName -> String
C.unFlagName FlagName
f)
flags :: [Utf8Builder]
flags = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (IsString a, Semigroup a) => (FlagName, Bool) -> a
flagToBs forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList (CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
dpCommon)
ghcOptions :: [Utf8Builder]
ghcOptions = forall a b. (a -> b) -> [a] -> [b]
map forall a. Display a => a -> Utf8Builder
display (CommonPackage -> [Text]
cpGhcOptions CommonPackage
dpCommon)
cabalConfigOpts :: [Utf8Builder]
cabalConfigOpts = forall a b. (a -> b) -> [a] -> [b]
map forall a. Display a => a -> Utf8Builder
display (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
dpCommon)
haddocks :: Builder
haddocks = if CommonPackage -> Bool
cpHaddocks CommonPackage
dpCommon then Builder
"haddocks" else Builder
""
hash :: Builder
hash = PackageLocationImmutable -> Builder
immutableLocSha PackageLocationImmutable
pli
forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ Builder
hash
forall a. Semigroup a => a -> a -> a
<> Builder
haddocks
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder (forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
flags)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder (forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
ghcOptions)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder (forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
cabalConfigOpts)
getLocalFlags ::
BuildOptsCLI
-> PackageName
-> Map FlagName Bool
getLocalFlags :: BuildOptsCLI -> PackageName -> Map FlagName Bool
getLocalFlags BuildOptsCLI
boptsCli PackageName
name = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
[ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty (PackageName -> ApplyCLIFlag
ACFByName PackageName
name) Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
, forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty ApplyCLIFlag
ACFAllProjectPackages Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
]
where
cliFlags :: Map ApplyCLIFlag (Map FlagName Bool)
cliFlags = BuildOptsCLI -> Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags BuildOptsCLI
boptsCli
generalCabalConfigOpts ::
BuildConfig
-> BuildOptsCLI
-> PackageName
-> Bool
-> Bool
-> [Text]
generalCabalConfigOpts :: BuildConfig
-> BuildOptsCLI -> PackageName -> Bool -> Bool -> [Text]
generalCabalConfigOpts BuildConfig
bconfig BuildOptsCLI
boptsCli PackageName
name Bool
isTarget Bool
isLocal = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKEverything (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
, if Bool
isLocal
then forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKLocals (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
else []
, if Bool
isTarget
then forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKTargets (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
else []
, forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (PackageName -> CabalConfigKey
CCKPackage PackageName
name) (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
, if Bool
includeExtraOptions
then BuildOptsCLI -> [Text]
boptsCLIAllProgOptions BuildOptsCLI
boptsCli
else []
]
where
config :: Config
config = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL BuildConfig
bconfig
includeExtraOptions :: Bool
includeExtraOptions =
case Config -> ApplyProgOptions
configApplyProgOptions Config
config of
ApplyProgOptions
APOTargets -> Bool
isTarget
ApplyProgOptions
APOLocals -> Bool
isLocal
ApplyProgOptions
APOEverything -> Bool
True
generalGhcOptions :: BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions :: BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bconfig BuildOptsCLI
boptsCli Bool
isTarget Bool
isLocal = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOEverything (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
, if Bool
isLocal
then forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOLocals (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
else []
, if Bool
isTarget
then forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOTargets (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
else []
, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text
"-fhpc"] | Bool
isLocal Bool -> Bool -> Bool
&& TestOpts -> Bool
toCoverage (BuildOpts -> TestOpts
boptsTestOpts BuildOpts
bopts)]
, if BuildOpts -> Bool
boptsLibProfile BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeProfile BuildOpts
bopts
then [Text
"-fprof-auto", Text
"-fprof-cafs"]
else []
, [ Text
"-g" | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
boptsLibStrip BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeStrip BuildOpts
bopts ]
, if Bool
includeExtraOptions
then BuildOptsCLI -> [Text]
boptsCLIGhcOptions BuildOptsCLI
boptsCli
else []
]
where
bopts :: BuildOpts
bopts = Config -> BuildOpts
configBuild Config
config
config :: Config
config = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL BuildConfig
bconfig
includeExtraOptions :: Bool
includeExtraOptions =
case Config -> ApplyGhcOptions
configApplyGhcOptions Config
config of
ApplyGhcOptions
AGOTargets -> Bool
isTarget
ApplyGhcOptions
AGOLocals -> Bool
isLocal
ApplyGhcOptions
AGOEverything -> Bool
True
splitComponents :: [NamedComponent]
-> (Set Text, Set Text, Set Text)
splitComponents :: [NamedComponent] -> (Set Text, Set Text, Set Text)
splitComponents =
forall {a} {a} {a}.
(Ord a, Ord a, Ord a) =>
([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id
where
go :: ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c [] = (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
a [], forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
b [], forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
c [])
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (NamedComponent
CLib:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CInternalLib Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go ([Text] -> [a]
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
x:)) [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CExe Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go ([Text] -> [a]
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
x:)) [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CTest Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a ([Text] -> [a]
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
x:)) [Text] -> [a]
c [NamedComponent]
xs
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CBench Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b ([Text] -> [a]
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
x:)) [NamedComponent]
xs
loadCommonPackage ::
forall env. (HasBuildConfig env, HasSourceMap env)
=> CommonPackage
-> RIO env Package
loadCommonPackage :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
CommonPackage -> RIO env Package
loadCommonPackage CommonPackage
common = do
PackageConfig
config <-
forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig
(CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common)
(CommonPackage -> [Text]
cpGhcOptions CommonPackage
common)
(CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common)
GenericPackageDescription
gpkg <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD CommonPackage
common
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg
loadLocalPackage ::
forall env. (HasBuildConfig env, HasSourceMap env)
=> ProjectPackage
-> RIO env LocalPackage
loadLocalPackage :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage ProjectPackage
pp = do
SourceMap
sm <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => Lens' env SourceMap
sourceMapL
let common :: CommonPackage
common = ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp
BuildOpts
bopts <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
Maybe Curator
mcurator <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to BuildConfig -> Maybe Curator
bcCurator
PackageConfig
config <- forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig
(CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common)
(CommonPackage -> [Text]
cpGhcOptions CommonPackage
common)
(CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common)
GenericPackageDescription
gpkg <- forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m GenericPackageDescription
ppGPD ProjectPackage
pp
let name :: PackageName
name = CommonPackage -> PackageName
cpName CommonPackage
common
mtarget :: Maybe Target
mtarget = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name (SMTargets -> Map PackageName Target
smtTargets forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sm)
(Set Text
exeCandidates, Set Text
testCandidates, Set Text
benchCandidates) =
case Maybe Target
mtarget of
Just (TargetComps Set NamedComponent
comps) -> [NamedComponent] -> (Set Text, Set Text, Set Text)
splitComponents forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set NamedComponent
comps
Just (TargetAll PackageType
_packageType) ->
( Package -> Set Text
packageExes Package
pkg
, if BuildOpts -> Bool
boptsTests BuildOpts
bopts
Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curator -> Set PackageName
curatorSkipTest) Maybe Curator
mcurator
then forall k a. Map k a -> Set k
Map.keysSet (Package -> Map Text TestSuiteInterface
packageTests Package
pkg)
else forall a. Set a
Set.empty
, if BuildOpts -> Bool
boptsBenchmarks BuildOpts
bopts
Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe
Bool
True
(forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curator -> Set PackageName
curatorSkipBenchmark)
Maybe Curator
mcurator
then Package -> Set Text
packageBenchmarks Package
pkg
else forall a. Set a
Set.empty
)
Maybe Target
Nothing -> forall a. Monoid a => a
mempty
isWanted :: Bool
isWanted = case Maybe Target
mtarget of
Maybe Target
Nothing -> Bool
False
Just Target
_ ->
let hasLibrary :: Bool
hasLibrary =
case Package -> PackageLibraries
packageLibraries Package
pkg of
PackageLibraries
NoLibraries -> Bool
False
HasLibraries Set Text
_ -> Bool
True
in Bool
hasLibrary
Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set NamedComponent
nonLibComponents)
Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Set a -> Bool
Set.null forall a b. (a -> b) -> a -> b
$ Package -> Set Text
packageInternalLibraries Package
pkg)
filterSkippedComponents :: Set Text -> Set Text
filterSkippedComponents =
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildOpts -> [Text]
boptsSkipComponents BuildOpts
bopts))
(Set Text
exes, Set Text
tests, Set Text
benches) = ( Set Text -> Set Text
filterSkippedComponents Set Text
exeCandidates
, Set Text -> Set Text
filterSkippedComponents Set Text
testCandidates
, Set Text -> Set Text
filterSkippedComponents Set Text
benchCandidates
)
nonLibComponents :: Set NamedComponent
nonLibComponents = Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents Set Text
exes Set Text
tests Set Text
benches
toComponents :: Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents Set Text
e Set Text
t Set Text
b = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
[ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CExe Set Text
e
, forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CTest Set Text
t
, forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CBench Set Text
b
]
btconfig :: PackageConfig
btconfig = PackageConfig
config
{ packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
Set.null Set Text
tests
, packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
Set.null Set Text
benches
}
pkg :: Package
pkg = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg
btpkg :: Maybe Package
btpkg
| forall a. Set a -> Bool
Set.null Set Text
tests Bool -> Bool -> Bool
&& forall a. Set a -> Bool
Set.null Set Text
benches = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
btconfig GenericPackageDescription
gpkg)
MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles <- forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith forall a b. (a -> b) -> a -> b
$
forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg (ProjectPackage -> Path Abs File
ppCabalFP ProjectPackage
pp) Set NamedComponent
nonLibComponents
MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults <- forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith forall a b. (a -> b) -> a -> b
$ do
Map NamedComponent (Set (Path Abs File))
componentFiles' <- forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
Map.toList Map NamedComponent (Set (Path Abs File))
componentFiles') forall a b. (a -> b) -> a -> b
$ \(NamedComponent
component, Set (Path Abs File)
files) -> do
Maybe (Map String FileCacheInfo)
mbuildCache <- forall env.
HasEnvConfig env =>
Path Abs Dir
-> NamedComponent -> RIO env (Maybe (Map String FileCacheInfo))
tryGetBuildCache (ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp) NamedComponent
component
(Set String, Map String FileCacheInfo)
checkCacheResult <- forall (m :: * -> *).
MonadIO m =>
Map String FileCacheInfo
-> [Path Abs File] -> m (Set String, Map String FileCacheInfo)
checkBuildCache
(forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
Map.empty Maybe (Map String FileCacheInfo)
mbuildCache)
(forall a. Set a -> [a]
Set.toList Set (Path Abs File)
files)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedComponent
component, (Set String, Map String FileCacheInfo)
checkCacheResult)
let dirtyFiles :: MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles = do
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults' <- MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults
let allDirtyFiles :: Set String
allDirtyFiles =
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(NamedComponent
_, (Set String
x, Map String FileCacheInfo
_)) -> Set String
x) [(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set String
allDirtyFiles)
then let tryStripPrefix :: String -> String
tryStripPrefix String
y =
forall a. a -> Maybe a -> a
fromMaybe String
y (forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix (forall b t. Path b t -> String
toFilePath forall a b. (a -> b) -> a -> b
$ ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp) String
y)
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map String -> String
tryStripPrefix Set String
allDirtyFiles
else forall a. Maybe a
Nothing
newBuildCaches :: MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(NamedComponent
c, (Set String
_, Map String FileCacheInfo
cache)) -> (NamedComponent
c, Map String FileCacheInfo
cache)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalPackage
{ lpPackage :: Package
lpPackage = Package
pkg
, lpTestBench :: Maybe Package
lpTestBench = Maybe Package
btpkg
, lpComponentFiles :: MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
lpComponentFiles = MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles
, lpBuildHaddocks :: Bool
lpBuildHaddocks = CommonPackage -> Bool
cpHaddocks (ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp)
, lpForceDirty :: Bool
lpForceDirty = BuildOpts -> Bool
boptsForceDirty BuildOpts
bopts
, lpDirtyFiles :: MemoizedWith EnvConfig (Maybe (Set String))
lpDirtyFiles = MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles
, lpNewBuildCaches :: MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
lpNewBuildCaches = MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches
, lpCabalFile :: Path Abs File
lpCabalFile = ProjectPackage -> Path Abs File
ppCabalFP ProjectPackage
pp
, lpWanted :: Bool
lpWanted = Bool
isWanted
, lpComponents :: Set NamedComponent
lpComponents = Set NamedComponent
nonLibComponents
, lpUnbuildable :: Set NamedComponent
lpUnbuildable = Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents
(Set Text
exes forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set Text
packageExes Package
pkg)
(Set Text
tests forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` forall k a. Map k a -> Set k
Map.keysSet (Package -> Map Text TestSuiteInterface
packageTests Package
pkg))
(Set Text
benches forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set Text
packageBenchmarks Package
pkg)
}
checkBuildCache :: forall m. (MonadIO m)
=> Map FilePath FileCacheInfo
-> [Path Abs File]
-> m (Set FilePath, Map FilePath FileCacheInfo)
checkBuildCache :: forall (m :: * -> *).
MonadIO m =>
Map String FileCacheInfo
-> [Path Abs File] -> m (Set String, Map String FileCacheInfo)
checkBuildCache Map String FileCacheInfo
oldCache [Path Abs File]
files = do
Map String (Maybe SHA256)
fileTimes <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Abs File]
files forall a b. (a -> b) -> a -> b
$ \Path Abs File
fp -> do
Maybe SHA256
mdigest <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *). MonadIO m => String -> m (Maybe SHA256)
getFileDigestMaybe (forall b t. Path b t -> String
toFilePath Path Abs File
fp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b t. Path b t -> String
toFilePath Path Abs File
fp, Maybe SHA256
mdigest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
(forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\String
fp Maybe SHA256
mdigest -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest forall a. Maybe a
Nothing))
(forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\String
fp FileCacheInfo
fci -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just FileCacheInfo
fci)))
(forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\String
fp Maybe SHA256
mdigest FileCacheInfo
fci -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest (forall a. a -> Maybe a
Just FileCacheInfo
fci)))
Map String (Maybe SHA256)
fileTimes
Map String FileCacheInfo
oldCache
where
go :: FilePath
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set FilePath, Map FilePath FileCacheInfo)
go :: String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
_ Maybe FileCacheInfo
_ | String -> String
takeFileName String
fp forall a. Eq a => a -> a -> Bool
== String
"cabal_macros.h" = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
Set.empty, forall k a. Map k a
Map.empty)
go String
fp (Just SHA256
digest') (Just FileCacheInfo
fci)
| FileCacheInfo -> SHA256
fciHash FileCacheInfo
fci forall a. Eq a => a -> a -> Bool
== SHA256
digest' = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
Set.empty, forall k a. k -> a -> Map k a
Map.singleton String
fp FileCacheInfo
fci)
| Bool
otherwise =
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
Set.singleton String
fp, forall k a. k -> a -> Map k a
Map.singleton String
fp forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest')
go String
fp Maybe SHA256
Nothing Maybe FileCacheInfo
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
Set.singleton String
fp, forall k a. Map k a
Map.empty)
go String
fp (Just SHA256
digest') Maybe FileCacheInfo
Nothing =
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
Set.singleton String
fp, forall k a. k -> a -> Map k a
Map.singleton String
fp forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest')
addUnlistedToBuildCache ::
HasEnvConfig env
=> Package
-> Path Abs File
-> Set NamedComponent
-> Map NamedComponent (Map FilePath a)
-> RIO env (Map NamedComponent [Map FilePath FileCacheInfo], [PackageWarning])
addUnlistedToBuildCache :: forall env a.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> Map NamedComponent (Map String a)
-> RIO
env
(Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
addUnlistedToBuildCache Package
pkg Path Abs File
cabalFP Set NamedComponent
nonLibComponents Map NamedComponent (Map String a)
buildCaches = do
(Map NamedComponent (Set (Path Abs File))
componentFiles, [PackageWarning]
warnings) <-
forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg Path Abs File
cabalFP Set NamedComponent
nonLibComponents
[((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
M.toList Map NamedComponent (Set (Path Abs File))
componentFiles) forall a b. (a -> b) -> a -> b
$ \(NamedComponent
component, Set (Path Abs File)
files) -> do
let buildCache :: Map String a
buildCache = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall k a. Map k a
M.empty NamedComponent
component Map NamedComponent (Map String a)
buildCaches
newFiles :: [String]
newFiles =
forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall b t. Path b t -> String
toFilePath Set (Path Abs File)
files forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` forall k a. Map k a -> Set k
Map.keysSet Map String a
buildCache
[Map String FileCacheInfo]
addBuildCache <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
MonadIO m =>
String -> m (Map String FileCacheInfo)
addFileToCache [String]
newFiles
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((NamedComponent
component, [Map String FileCacheInfo]
addBuildCache), [PackageWarning]
warnings)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results), forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results)
where
addFileToCache :: String -> m (Map String FileCacheInfo)
addFileToCache String
fp = do
Maybe SHA256
mdigest <- forall (m :: * -> *). MonadIO m => String -> m (Maybe SHA256)
getFileDigestMaybe String
fp
case Maybe SHA256
mdigest of
Maybe SHA256
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
Just SHA256
digest' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton String
fp forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest'
getPackageFilesForTargets ::
HasEnvConfig env
=> Package
-> Path Abs File
-> Set NamedComponent
-> RIO env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets :: forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg Path Abs File
cabalFP Set NamedComponent
nonLibComponents = do
(Map NamedComponent (Map ModuleName (Path Abs File))
components',Map NamedComponent [DotCabalPath]
compFiles,Set (Path Abs File)
otherFiles,[PackageWarning]
warnings) <-
GetPackageFiles
-> forall env.
HasEnvConfig env =>
Path Abs File
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
getPackageFiles (Package -> GetPackageFiles
packageFiles Package
pkg) Path Abs File
cabalFP
let necessaryComponents :: Set NamedComponent
necessaryComponents =
forall a. Ord a => a -> Set a -> Set a
Set.insert NamedComponent
CLib forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Set a -> Set a
Set.filter NamedComponent -> Bool
isCInternalLib (forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
components')
components :: Set NamedComponent
components = Set NamedComponent
necessaryComponents forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set NamedComponent
nonLibComponents
componentsFiles :: Map NamedComponent (Set (Path Abs File))
componentsFiles = forall a b k. (a -> b) -> Map k a -> Map k b
M.map
(\[DotCabalPath]
files ->
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Path Abs File)
otherFiles (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map DotCabalPath -> Path Abs File
dotCabalGetPath forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [DotCabalPath]
files)
)
forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\NamedComponent
component [DotCabalPath]
_ -> NamedComponent
component forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set NamedComponent
components) Map NamedComponent [DotCabalPath]
compFiles
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NamedComponent (Set (Path Abs File))
componentsFiles, [PackageWarning]
warnings)
getFileDigestMaybe :: MonadIO m => FilePath -> m (Maybe SHA256)
getFileDigestMaybe :: forall (m :: * -> *). MonadIO m => String -> m (Maybe SHA256)
getFileDigestMaybe String
fp =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) i a.
(MonadUnliftIO m, MonadIO n) =>
String -> (ConduitM i ByteString n () -> m a) -> m a
withSourceFile String
fp forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}.
Monad m =>
ConduitT () ByteString m () -> m SHA256
getDigest)
(\IOError
e ->
if IOError -> Bool
isDoesNotExistError IOError
e
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM IOError
e)
where
getDigest :: ConduitT () ByteString m () -> m SHA256
getDigest ConduitT () ByteString m ()
src = forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString m ()
src forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall i (m :: * -> *) r. ZipSink i m r -> ConduitT i Void m r
getZipSink (forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
ZipSink forall (m :: * -> *) o. Monad m => ConduitT ByteString o m SHA256
SHA256.sinkHash)
getPackageConfig ::
(HasBuildConfig env, HasSourceMap env)
=> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO env PackageConfig
getPackageConfig :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig Map FlagName Bool
flags [Text]
ghcOptions [Text]
cabalConfigOpts = do
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
ActualCompiler
compilerVersion <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageConfig
{ packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
False
, packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
False
, packageConfigFlags :: Map FlagName Bool
packageConfigFlags = Map FlagName Bool
flags
, packageConfigGhcOptions :: [Text]
packageConfigGhcOptions = [Text]
ghcOptions
, packageConfigCabalConfigOpts :: [Text]
packageConfigCabalConfigOpts = [Text]
cabalConfigOpts
, packageConfigCompilerVersion :: ActualCompiler
packageConfigCompilerVersion = ActualCompiler
compilerVersion
, packageConfigPlatform :: Platform
packageConfigPlatform = Platform
platform
}