{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Build.Source
( projectLocalPackages
, localDependencies
, loadCommonPackage
, loadLocalPackage
, loadSourceMap
, getLocalFlags
, addUnlistedToBuildCache
, hashSourceMapData
) where
import Stack.Prelude
import qualified Pantry.SHA256 as SHA256
import Data.ByteString.Builder (toLazyByteString)
import Conduit (ZipSink (..), withSourceFile)
import qualified Distribution.PackageDescription as C
import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import Stack.Build.Cache
import Stack.Build.Haddock (shouldHaddockDeps)
import Stack.Build.Target
import Stack.Package
import Stack.SourceMap
import Stack.Types.Build
import Stack.Types.Config
import Stack.Types.NamedComponent
import Stack.Types.Package
import Stack.Types.PackageFile
import Stack.Types.SourceMap
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 -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts BuildConfig
bconfig (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
..} = do
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
loadCabalConfigOpts :: BuildConfig -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts :: BuildConfig -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts BuildConfig
bconfig 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)
]
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
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 []
, if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
boptsLibStrip BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeStrip BuildOpts
bopts
then [Text
"-g"]
else []
, 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
xforall a. a -> [a] -> [a]
:)) [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
xforall a. a -> [a] -> [a]
:)) [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
xforall a. a -> [a] -> [a]
:)) [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
xforall a. a -> [a] -> [a]
:)) [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 (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM 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 (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (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 b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey
(\String
fp Maybe SHA256
mdigest FileCacheInfo
fci -> forall a. a -> Maybe a
Just (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)))
(forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\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 k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\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)))
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 b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
(forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM 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
}