{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Build.Source
( projectLocalPackages
, localDependencies
, loadCommonPackage
, loadLocalPackage
, loadSourceMap
, addUnlistedToBuildCache
, hashSourceMapData
) where
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
( buildableBenchmarks, buildableExes, buildableTestSuites
, hasBuildableMainLibrary, resolvePackage
)
import Stack.PackageFile ( getPackageFile )
import Stack.Prelude
import Stack.SourceMap
( DumpedGlobalPackage, getCompilerInfo, immutableLocSha
, mkProjectPackage, pruneGlobals
)
import Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
import Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
import Stack.Types.Build.Exception ( BuildPrettyException (..) )
import Stack.Types.BuildConfig
( BuildConfig (..), HasBuildConfig (..) )
import Stack.Types.BuildOpts ( BuildOpts (..), TestOpts (..) )
import Stack.Types.BuildOptsCLI
( ApplyCLIFlag (..), BuildOptsCLI (..)
, 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.FileDigestCache ( readFileDigest )
import Stack.Types.NamedComponent
( NamedComponent (..), isCSubLib, splitComponents )
import Stack.Types.Package
( FileCacheInfo (..), LocalPackage (..), Package (..)
, PackageConfig (..), dotCabalGetPath, memoizeRefWith
, runMemoizedWith
)
import Stack.Types.PackageFile
( PackageComponentFile (..), PackageWarning )
import Stack.Types.Platform ( HasPlatform (..) )
import Stack.Types.SourceMap
( CommonPackage (..), DepPackage (..), ProjectPackage (..)
, SMActual (..), SMTargets (..), SourceMap (..)
, SourceMapHash (..), Target (..), ppGPD, ppRoot
)
import Stack.Types.UnusedFlags ( FlagSource (..), UnusedFlags (..) )
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 <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMap env SourceMap -> RIO env SourceMap)
-> Getting SourceMap env SourceMap -> RIO env SourceMap
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL ((EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env)
-> ((SourceMap -> Const SourceMap SourceMap)
-> EnvConfig -> Const SourceMap EnvConfig)
-> Getting SourceMap env SourceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvConfig -> SourceMap) -> SimpleGetter EnvConfig SourceMap
forall s a. (s -> a) -> SimpleGetter s a
to (.sourceMap)
[ProjectPackage]
-> (ProjectPackage -> RIO env LocalPackage)
-> RIO env [LocalPackage]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map PackageName ProjectPackage -> [ProjectPackage]
forall a. Map PackageName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SourceMap
sm.project) ProjectPackage -> RIO env LocalPackage
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 <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting BuildOpts env BuildOpts -> RIO env BuildOpts)
-> Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall a b. (a -> b) -> a -> b
$ (Config -> Const BuildOpts Config) -> env -> Const BuildOpts env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL ((Config -> Const BuildOpts Config) -> env -> Const BuildOpts env)
-> ((BuildOpts -> Const BuildOpts BuildOpts)
-> Config -> Const BuildOpts Config)
-> Getting BuildOpts env BuildOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> BuildOpts) -> SimpleGetter Config BuildOpts
forall s a. (s -> a) -> SimpleGetter s a
to (.build)
SourceMap
sourceMap <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMap env SourceMap -> RIO env SourceMap)
-> Getting SourceMap env SourceMap -> RIO env SourceMap
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL ((EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env)
-> ((SourceMap -> Const SourceMap SourceMap)
-> EnvConfig -> Const SourceMap EnvConfig)
-> Getting SourceMap env SourceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvConfig -> SourceMap) -> SimpleGetter EnvConfig SourceMap
forall s a. (s -> a) -> SimpleGetter s a
to (.sourceMap)
[DepPackage]
-> (DepPackage -> RIO env (Maybe LocalPackage))
-> RIO env [LocalPackage]
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM (Map PackageName DepPackage -> [DepPackage]
forall k a. Map k a -> [a]
Map.elems SourceMap
sourceMap.deps) ((DepPackage -> RIO env (Maybe LocalPackage))
-> RIO env [LocalPackage])
-> (DepPackage -> RIO env (Maybe LocalPackage))
-> RIO env [LocalPackage]
forall a b. (a -> b) -> a -> b
$ \DepPackage
dp ->
case DepPackage
dp.location of
PLMutable ResolvedPath Dir
dir -> do
ProjectPackage
pp <- PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
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)
LocalPackage -> Maybe LocalPackage
forall a. a -> Maybe a
Just (LocalPackage -> Maybe LocalPackage)
-> RIO env LocalPackage -> RIO env (Maybe LocalPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectPackage -> RIO env LocalPackage
forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage ProjectPackage
pp
PackageLocation
_ -> Maybe LocalPackage -> RIO env (Maybe LocalPackage)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LocalPackage
forall a. Maybe a
Nothing
loadSourceMap ::
forall env. HasBuildConfig env
=> SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap :: forall env.
HasBuildConfig env =>
SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap SMTargets
targets BuildOptsCLI
boptsCli SMActual DumpedGlobalPackage
sma = do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Applying and checking flags"
let errsPackages :: [UnusedFlags]
errsPackages = (PackageName -> Maybe UnusedFlags)
-> [PackageName] -> [UnusedFlags]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PackageName -> Maybe UnusedFlags
checkPackage [PackageName]
packagesWithCliFlags
[Either UnusedFlags (PackageName, ProjectPackage)]
eProject <- ((PackageName, ProjectPackage)
-> RIO env (Either UnusedFlags (PackageName, ProjectPackage)))
-> [(PackageName, ProjectPackage)]
-> RIO env [Either UnusedFlags (PackageName, ProjectPackage)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PackageName, ProjectPackage)
-> RIO env (Either UnusedFlags (PackageName, ProjectPackage))
forall a.
(a, ProjectPackage)
-> RIO env (Either UnusedFlags (a, ProjectPackage))
applyOptsFlagsPP (Map PackageName ProjectPackage -> [(PackageName, ProjectPackage)]
forall k a. Map k a -> [(k, a)]
M.toList SMActual DumpedGlobalPackage
sma.project)
[Either UnusedFlags (PackageName, DepPackage)]
eDeps <- ((PackageName, DepPackage)
-> RIO env (Either UnusedFlags (PackageName, DepPackage)))
-> [(PackageName, DepPackage)]
-> RIO env [Either UnusedFlags (PackageName, DepPackage)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PackageName, DepPackage)
-> RIO env (Either UnusedFlags (PackageName, DepPackage))
forall a.
(a, DepPackage) -> RIO env (Either UnusedFlags (a, DepPackage))
applyOptsFlagsDep (Map PackageName DepPackage -> [(PackageName, DepPackage)]
forall k a. Map k a -> [(k, a)]
M.toList Map PackageName DepPackage
targetsAndSmaDeps)
let ([UnusedFlags]
errsProject, [(PackageName, ProjectPackage)]
project') = [Either UnusedFlags (PackageName, ProjectPackage)]
-> ([UnusedFlags], [(PackageName, ProjectPackage)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either UnusedFlags (PackageName, ProjectPackage)]
eProject
([UnusedFlags]
errsDeps, [(PackageName, DepPackage)]
deps') = [Either UnusedFlags (PackageName, DepPackage)]
-> ([UnusedFlags], [(PackageName, DepPackage)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either UnusedFlags (PackageName, DepPackage)]
eDeps
errs :: [UnusedFlags]
errs = [UnusedFlags]
errsPackages [UnusedFlags] -> [UnusedFlags] -> [UnusedFlags]
forall a. Semigroup a => a -> a -> a
<> [UnusedFlags]
errsProject [UnusedFlags] -> [UnusedFlags] -> [UnusedFlags]
forall a. Semigroup a => a -> a -> a
<> [UnusedFlags]
errsDeps
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([UnusedFlags] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnusedFlags]
errs) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ BuildPrettyException -> RIO env ()
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM (BuildPrettyException -> RIO env ())
-> BuildPrettyException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [UnusedFlags] -> BuildPrettyException
InvalidFlagSpecification [UnusedFlags]
errs
let compiler :: ActualCompiler
compiler = SMActual DumpedGlobalPackage
sma.compiler
project :: Map PackageName ProjectPackage
project = [(PackageName, ProjectPackage)] -> Map PackageName ProjectPackage
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(PackageName, ProjectPackage)]
project'
deps :: Map PackageName DepPackage
deps = [(PackageName, DepPackage)] -> Map PackageName DepPackage
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(PackageName, DepPackage)]
deps'
globalPkgs :: Map PackageName GlobalPackage
globalPkgs = Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals SMActual DumpedGlobalPackage
sma.globals (Map PackageName DepPackage -> Set PackageName
forall k a. Map k a -> Set k
Map.keysSet Map PackageName DepPackage
deps)
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"SourceMap constructed"
SourceMap -> RIO env SourceMap
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceMap
{ SMTargets
targets :: SMTargets
targets :: SMTargets
targets
, ActualCompiler
compiler :: ActualCompiler
compiler :: ActualCompiler
compiler
, Map PackageName ProjectPackage
project :: Map PackageName ProjectPackage
project :: Map PackageName ProjectPackage
project
, Map PackageName DepPackage
deps :: Map PackageName DepPackage
deps :: Map PackageName DepPackage
deps
, Map PackageName GlobalPackage
globalPkgs :: Map PackageName GlobalPackage
globalPkgs :: Map PackageName GlobalPackage
globalPkgs
}
where
cliFlags :: Map ApplyCLIFlag (Map FlagName Bool)
cliFlags = BuildOptsCLI
boptsCli.flags
targetsAndSmaDeps :: Map PackageName DepPackage
targetsAndSmaDeps = SMTargets
targets.deps Map PackageName DepPackage
-> Map PackageName DepPackage -> Map PackageName DepPackage
forall a. Semigroup a => a -> a -> a
<> SMActual DumpedGlobalPackage
sma.deps
packagesWithCliFlags :: [PackageName]
packagesWithCliFlags = ((ApplyCLIFlag, Map FlagName Bool) -> Maybe PackageName)
-> [(ApplyCLIFlag, Map FlagName Bool)] -> [PackageName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ApplyCLIFlag, Map FlagName Bool) -> Maybe PackageName
forall {b}. (ApplyCLIFlag, b) -> Maybe PackageName
maybeProjectWithCliFlags ([(ApplyCLIFlag, Map FlagName Bool)] -> [PackageName])
-> [(ApplyCLIFlag, Map FlagName Bool)] -> [PackageName]
forall a b. (a -> b) -> a -> b
$ Map ApplyCLIFlag (Map FlagName Bool)
-> [(ApplyCLIFlag, Map FlagName Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
where
maybeProjectWithCliFlags :: (ApplyCLIFlag, b) -> Maybe PackageName
maybeProjectWithCliFlags (ACFByName PackageName
name, b
_) = PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just PackageName
name
maybeProjectWithCliFlags (ApplyCLIFlag, b)
_ = Maybe PackageName
forall a. Maybe a
Nothing
checkPackage :: PackageName -> Maybe UnusedFlags
checkPackage :: PackageName -> Maybe UnusedFlags
checkPackage PackageName
name =
let maybeCommon :: Maybe CommonPackage
maybeCommon =
(ProjectPackage -> CommonPackage)
-> Maybe ProjectPackage -> Maybe CommonPackage
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.projectCommon) (PackageName
-> Map PackageName ProjectPackage -> Maybe ProjectPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name SMActual DumpedGlobalPackage
sma.project)
Maybe CommonPackage -> Maybe CommonPackage -> Maybe CommonPackage
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (DepPackage -> CommonPackage)
-> Maybe DepPackage -> Maybe CommonPackage
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.depCommon) (PackageName -> Map PackageName DepPackage -> Maybe DepPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName DepPackage
targetsAndSmaDeps)
in Maybe UnusedFlags
-> (CommonPackage -> Maybe UnusedFlags)
-> Maybe CommonPackage
-> Maybe UnusedFlags
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(UnusedFlags -> Maybe UnusedFlags
forall a. a -> Maybe a
Just (UnusedFlags -> Maybe UnusedFlags)
-> UnusedFlags -> Maybe UnusedFlags
forall a b. (a -> b) -> a -> b
$ FlagSource -> PackageName -> UnusedFlags
UFNoPackage FlagSource
FSCommandLine PackageName
name)
(Maybe UnusedFlags -> CommonPackage -> Maybe UnusedFlags
forall a b. a -> b -> a
const Maybe UnusedFlags
forall a. Maybe a
Nothing)
Maybe CommonPackage
maybeCommon
applyOptsFlagsPP ::
(a, ProjectPackage)
-> RIO env (Either UnusedFlags (a, ProjectPackage))
applyOptsFlagsPP :: forall a.
(a, ProjectPackage)
-> RIO env (Either UnusedFlags (a, ProjectPackage))
applyOptsFlagsPP (a
name, p :: ProjectPackage
p@ProjectPackage{ projectCommon :: ProjectPackage -> CommonPackage
projectCommon = CommonPackage
common }) = do
let isTarget :: Bool
isTarget = PackageName -> Map PackageName Target -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member CommonPackage
common.name SMTargets
targets.targets
Either UnusedFlags CommonPackage
eCommon <- Bool
-> Bool
-> CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
applyOptsFlags Bool
isTarget Bool
True CommonPackage
common
Either UnusedFlags (a, ProjectPackage)
-> RIO env (Either UnusedFlags (a, ProjectPackage))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnusedFlags (a, ProjectPackage)
-> RIO env (Either UnusedFlags (a, ProjectPackage)))
-> Either UnusedFlags (a, ProjectPackage)
-> RIO env (Either UnusedFlags (a, ProjectPackage))
forall a b. (a -> b) -> a -> b
$ (\CommonPackage
common' -> (a
name, ProjectPackage
p { projectCommon = common' })) (CommonPackage -> (a, ProjectPackage))
-> Either UnusedFlags CommonPackage
-> Either UnusedFlags (a, ProjectPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either UnusedFlags CommonPackage
eCommon
applyOptsFlagsDep ::
(a, DepPackage)
-> RIO env (Either UnusedFlags (a, DepPackage))
applyOptsFlagsDep :: forall a.
(a, DepPackage) -> RIO env (Either UnusedFlags (a, DepPackage))
applyOptsFlagsDep (a
name, d :: DepPackage
d@DepPackage{ depCommon :: DepPackage -> CommonPackage
depCommon = CommonPackage
common }) = do
let isTarget :: Bool
isTarget = PackageName -> Map PackageName DepPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member CommonPackage
common.name SMTargets
targets.deps
Either UnusedFlags CommonPackage
eCommon <- Bool
-> Bool
-> CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
applyOptsFlags Bool
isTarget Bool
False CommonPackage
common
Either UnusedFlags (a, DepPackage)
-> RIO env (Either UnusedFlags (a, DepPackage))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnusedFlags (a, DepPackage)
-> RIO env (Either UnusedFlags (a, DepPackage)))
-> Either UnusedFlags (a, DepPackage)
-> RIO env (Either UnusedFlags (a, DepPackage))
forall a b. (a -> b) -> a -> b
$ (\CommonPackage
common' -> (a
name, DepPackage
d { depCommon = common' })) (CommonPackage -> (a, DepPackage))
-> Either UnusedFlags CommonPackage
-> Either UnusedFlags (a, DepPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either UnusedFlags CommonPackage
eCommon
applyOptsFlags ::
Bool
-> Bool
-> CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
applyOptsFlags :: Bool
-> Bool
-> CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
applyOptsFlags Bool
isTarget Bool
isProjectPackage CommonPackage
common = do
let name :: PackageName
name = CommonPackage
common.name
cliFlagsByName :: Map FlagName Bool
cliFlagsByName = Map FlagName Bool
-> ApplyCLIFlag
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Map FlagName Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map FlagName Bool
forall k a. Map k a
Map.empty (PackageName -> ApplyCLIFlag
ACFByName PackageName
name) Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
cliFlagsAll :: Map FlagName Bool
cliFlagsAll =
Map FlagName Bool
-> ApplyCLIFlag
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Map FlagName Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map FlagName Bool
forall k a. Map k a
Map.empty ApplyCLIFlag
ACFAllProjectPackages Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
noOptsToApply :: Bool
noOptsToApply = Map FlagName Bool -> Bool
forall k a. Map k a -> Bool
Map.null Map FlagName Bool
cliFlagsByName Bool -> Bool -> Bool
&& Map FlagName Bool -> Bool
forall k a. Map k a -> Bool
Map.null Map FlagName Bool
cliFlagsAll
(Map FlagName Bool
flags, Set FlagName
unusedByName, Set FlagName
pkgFlags) <- if Bool
noOptsToApply
then
(Map FlagName Bool, Set FlagName, Set FlagName)
-> RIO env (Map FlagName Bool, Set FlagName, Set FlagName)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FlagName Bool
forall k a. Map k a
Map.empty, Set FlagName
forall a. Set a
Set.empty, Set FlagName
forall a. Set a
Set.empty)
else do
GenericPackageDescription
gpd <-
IO GenericPackageDescription -> RIO env GenericPackageDescription
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO CommonPackage
common.gpd
let pkgFlags :: Set FlagName
pkgFlags = [FlagName] -> Set FlagName
forall a. Ord a => [a] -> Set a
Set.fromList ([FlagName] -> Set FlagName) -> [FlagName] -> Set FlagName
forall a b. (a -> b) -> a -> b
$ (PackageFlag -> FlagName) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> FlagName
C.flagName ([PackageFlag] -> [FlagName]) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> [PackageFlag]
C.genPackageFlags GenericPackageDescription
gpd
unusedByName :: Set FlagName
unusedByName = Map FlagName Bool -> Set FlagName
forall k a. Map k a -> Set k
Map.keysSet (Map FlagName Bool -> Set FlagName)
-> Map FlagName Bool -> Set FlagName
forall a b. (a -> b) -> a -> b
$ Map FlagName Bool -> Set FlagName -> Map FlagName Bool
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map FlagName Bool
cliFlagsByName Set FlagName
pkgFlags
cliFlagsAllRelevant :: Map FlagName Bool
cliFlagsAllRelevant =
(FlagName -> Bool -> Bool)
-> Map FlagName Bool -> Map FlagName Bool
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\FlagName
k Bool
_ -> FlagName
k FlagName -> Set FlagName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FlagName
pkgFlags) Map FlagName Bool
cliFlagsAll
flags :: Map FlagName Bool
flags = Map FlagName Bool
cliFlagsByName Map FlagName Bool -> Map FlagName Bool -> Map FlagName Bool
forall a. Semigroup a => a -> a -> a
<> Map FlagName Bool
cliFlagsAllRelevant
(Map FlagName Bool, Set FlagName, Set FlagName)
-> RIO env (Map FlagName Bool, Set FlagName, Set FlagName)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FlagName Bool
flags, Set FlagName
unusedByName, Set FlagName
pkgFlags)
if Set FlagName -> Bool
forall a. Set a -> Bool
Set.null Set FlagName
unusedByName
then do
BuildConfig
bconfig <- Getting BuildConfig env BuildConfig -> RIO env BuildConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildConfig env BuildConfig
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL
let bopts :: BuildOpts
bopts = BuildConfig
bconfig.config.build
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
PackageName
name
Bool
isTarget
Bool
isProjectPackage
Either UnusedFlags CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnusedFlags CommonPackage
-> RIO env (Either UnusedFlags CommonPackage))
-> Either UnusedFlags CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
forall a b. (a -> b) -> a -> b
$ CommonPackage -> Either UnusedFlags CommonPackage
forall a b. b -> Either a b
Right CommonPackage
common
{ flags =
if M.null flags
then common.flags
else flags
, ghcOptions =
ghcOptions ++ common.ghcOptions
, cabalConfigOpts =
cabalConfigOpts ++ common.cabalConfigOpts
, buildHaddocks =
if isTarget
then bopts.buildHaddocks
else shouldHaddockDeps bopts
}
else
Either UnusedFlags CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnusedFlags CommonPackage
-> RIO env (Either UnusedFlags CommonPackage))
-> Either UnusedFlags CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
forall a b. (a -> b) -> a -> b
$ UnusedFlags -> Either UnusedFlags CommonPackage
forall a b. a -> Either a b
Left (UnusedFlags -> Either UnusedFlags CommonPackage)
-> UnusedFlags -> Either UnusedFlags CommonPackage
forall a b. (a -> b) -> a -> b
$ FlagSource
-> PackageName -> Set FlagName -> Set FlagName -> UnusedFlags
UFFlagsNotDefined FlagSource
FSCommandLine PackageName
name Set FlagName
pkgFlags Set FlagName
unusedByName
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 (Utf8Builder -> Builder)
-> (Path Abs File -> Utf8Builder) -> Path Abs File -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (Path Abs File -> String) -> Path Abs File -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> Builder)
-> RIO env (Path Abs File) -> RIO env Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO env (Path Abs File)
forall env. HasCompiler env => RIO env (Path Abs File)
getCompilerPath
Builder
compilerInfo <- RIO env Builder
forall env. (HasConfig env, HasCompiler env) => RIO env Builder
getCompilerInfo
[Builder]
immDeps <- [DepPackage]
-> (DepPackage -> RIO env Builder) -> RIO env [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map PackageName DepPackage -> [DepPackage]
forall k a. Map k a -> [a]
Map.elems SourceMap
sm.deps) DepPackage -> RIO env Builder
forall env. HasConfig env => DepPackage -> RIO env Builder
depPackageHashableContent
BuildConfig
bc <- Getting BuildConfig env BuildConfig -> RIO env BuildConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildConfig env BuildConfig
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL
let
bootGhcOpts :: [Utf8Builder]
bootGhcOpts = (Text -> Utf8Builder) -> [Text] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bc BuildOptsCLI
boptsCli Bool
False Bool
False)
hashedContent :: LazyByteString
hashedContent =
Builder -> LazyByteString
toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
forall a b. (a -> b) -> a -> b
$ Builder
compilerPath
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
compilerInfo
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
bootGhcOpts)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
immDeps
SourceMapHash -> RIO env SourceMapHash
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceMapHash -> RIO env SourceMapHash)
-> SourceMapHash -> RIO env SourceMapHash
forall a b. (a -> b) -> a -> b
$ SHA256 -> SourceMapHash
SourceMapHash (LazyByteString -> SHA256
SHA256.hashLazyBytes LazyByteString
hashedContent)
depPackageHashableContent :: (HasConfig env) => DepPackage -> RIO env Builder
depPackageHashableContent :: forall env. HasConfig env => DepPackage -> RIO env Builder
depPackageHashableContent DepPackage
dp =
case DepPackage
dp.location of
PLMutable ResolvedPath Dir
_ -> Builder -> RIO env Builder
forall a. a -> RIO env a
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
"-") a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> a
forall a. IsString a => String -> a
fromString (FlagName -> String
C.unFlagName FlagName
f)
flags :: [Utf8Builder]
flags = ((FlagName, Bool) -> Utf8Builder)
-> [(FlagName, Bool)] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map (FlagName, Bool) -> Utf8Builder
forall {a}. (Semigroup a, IsString a) => (FlagName, Bool) -> a
flagToBs ([(FlagName, Bool)] -> [Utf8Builder])
-> [(FlagName, Bool)] -> [Utf8Builder]
forall a b. (a -> b) -> a -> b
$ Map FlagName Bool -> [(FlagName, Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList DepPackage
dp.depCommon.flags
ghcOptions :: [Utf8Builder]
ghcOptions = (Text -> Utf8Builder) -> [Text] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display DepPackage
dp.depCommon.ghcOptions
cabalConfigOpts :: [Utf8Builder]
cabalConfigOpts = (Text -> Utf8Builder) -> [Text] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display DepPackage
dp.depCommon.cabalConfigOpts
haddocks :: Builder
haddocks = if DepPackage
dp.depCommon.buildHaddocks then Builder
"haddocks" else Builder
""
hash :: Builder
hash = PackageLocationImmutable -> Builder
immutableLocSha PackageLocationImmutable
pli
Builder -> RIO env Builder
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Builder -> RIO env Builder) -> Builder -> RIO env Builder
forall a b. (a -> b) -> a -> b
$ Builder
hash
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
haddocks
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
flags)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
ghcOptions)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
cabalConfigOpts)
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 = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKEverything Config
config.cabalConfigOpts
, if Bool
isLocal
then [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKLocals Config
config.cabalConfigOpts
else []
, if Bool
isTarget
then [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKTargets Config
config.cabalConfigOpts
else []
, [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (PackageName -> CabalConfigKey
CCKPackage PackageName
name) Config
config.cabalConfigOpts
, if Bool
includeExtraOptions
then BuildOptsCLI -> [Text]
boptsCLIAllProgOptions BuildOptsCLI
boptsCli
else []
]
where
config :: Config
config = Getting Config BuildConfig Config -> BuildConfig -> Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config BuildConfig Config
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL BuildConfig
bconfig
includeExtraOptions :: Bool
includeExtraOptions =
case Config
config.applyProgOptions 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 = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Text] -> ApplyGhcOptions -> Map ApplyGhcOptions [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOEverything Config
config.ghcOptionsByCat
, if Bool
isLocal
then [Text] -> ApplyGhcOptions -> Map ApplyGhcOptions [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOLocals Config
config.ghcOptionsByCat
else []
, if Bool
isTarget
then [Text] -> ApplyGhcOptions -> Map ApplyGhcOptions [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOTargets Config
config.ghcOptionsByCat
else []
, [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text
"-fhpc"] | Bool
isLocal Bool -> Bool -> Bool
&& BuildOpts
bopts.testOpts.coverage]
, if BuildOpts
bopts.libProfile Bool -> Bool -> Bool
|| BuildOpts
bopts.exeProfile
then [Text
"-fprof-auto", Text
"-fprof-cafs"]
else []
, [ Text
"-g" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BuildOpts
bopts.libStrip Bool -> Bool -> Bool
|| BuildOpts
bopts.exeStrip ]
, if Bool
includeExtraOptions
then BuildOptsCLI
boptsCli.ghcOptions
else []
]
where
bopts :: BuildOpts
bopts = Config
config.build
config :: Config
config = Getting Config BuildConfig Config -> BuildConfig -> Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config BuildConfig Config
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL BuildConfig
bconfig
includeExtraOptions :: Bool
includeExtraOptions =
case Config
config.applyGhcOptions of
ApplyGhcOptions
AGOTargets -> Bool
isTarget
ApplyGhcOptions
AGOLocals -> Bool
isLocal
ApplyGhcOptions
AGOEverything -> Bool
True
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 <-
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig
CommonPackage
common.flags
CommonPackage
common.ghcOptions
CommonPackage
common.cabalConfigOpts
GenericPackageDescription
gpkg <- IO GenericPackageDescription -> RIO env GenericPackageDescription
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO CommonPackage
common.gpd
Package -> RIO env Package
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> RIO env Package) -> Package -> RIO env Package
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 <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceMap env SourceMap
forall env. HasSourceMap env => Lens' env SourceMap
Lens' env SourceMap
sourceMapL
let common :: CommonPackage
common = ProjectPackage
pp.projectCommon
BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildOpts env BuildOpts
forall s. HasConfig s => Lens' s BuildOpts
Lens' env BuildOpts
buildOptsL
Maybe Curator
mcurator <- Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator))
-> Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator)
forall a b. (a -> b) -> a -> b
$ (BuildConfig -> Const (Maybe Curator) BuildConfig)
-> env -> Const (Maybe Curator) env
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL ((BuildConfig -> Const (Maybe Curator) BuildConfig)
-> env -> Const (Maybe Curator) env)
-> ((Maybe Curator -> Const (Maybe Curator) (Maybe Curator))
-> BuildConfig -> Const (Maybe Curator) BuildConfig)
-> Getting (Maybe Curator) env (Maybe Curator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildConfig -> Maybe Curator)
-> SimpleGetter BuildConfig (Maybe Curator)
forall s a. (s -> a) -> SimpleGetter s a
to (.curator)
PackageConfig
config <- Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig
CommonPackage
common.flags
CommonPackage
common.ghcOptions
CommonPackage
common.cabalConfigOpts
GenericPackageDescription
gpkg <- ProjectPackage -> RIO env GenericPackageDescription
forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m GenericPackageDescription
ppGPD ProjectPackage
pp
let name :: PackageName
name = CommonPackage
common.name
mtarget :: Maybe Target
mtarget = PackageName -> Map PackageName Target -> Maybe Target
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name SourceMap
sm.targets.targets
(Set StackUnqualCompName
exeCandidates, Set StackUnqualCompName
testCandidates, Set StackUnqualCompName
benchCandidates) =
case Maybe Target
mtarget of
Just (TargetComps Set NamedComponent
comps) ->
let (Set StackUnqualCompName
_s, Set StackUnqualCompName
e, Set StackUnqualCompName
t, Set StackUnqualCompName
b) = [NamedComponent]
-> (Set StackUnqualCompName, Set StackUnqualCompName,
Set StackUnqualCompName, Set StackUnqualCompName)
splitComponents ([NamedComponent]
-> (Set StackUnqualCompName, Set StackUnqualCompName,
Set StackUnqualCompName, Set StackUnqualCompName))
-> [NamedComponent]
-> (Set StackUnqualCompName, Set StackUnqualCompName,
Set StackUnqualCompName, Set StackUnqualCompName)
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList Set NamedComponent
comps
in (Set StackUnqualCompName
e, Set StackUnqualCompName
t, Set StackUnqualCompName
b)
Just (TargetAll PackageType
_packageType) ->
( Package -> Set StackUnqualCompName
buildableExes Package
pkg
, if BuildOpts
bopts.tests
Bool -> Bool -> Bool
&& Bool -> (Curator -> Bool) -> Maybe Curator -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name (Set PackageName -> Bool)
-> (Curator -> Set PackageName) -> Curator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.skipTest)) Maybe Curator
mcurator
then Package -> Set StackUnqualCompName
buildableTestSuites Package
pkg
else Set StackUnqualCompName
forall a. Set a
Set.empty
, if BuildOpts
bopts.benchmarks
Bool -> Bool -> Bool
&& Bool -> (Curator -> Bool) -> Maybe Curator -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
Bool
True
(PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name (Set PackageName -> Bool)
-> (Curator -> Set PackageName) -> Curator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.skipBenchmark))
Maybe Curator
mcurator
then Package -> Set StackUnqualCompName
buildableBenchmarks Package
pkg
else Set StackUnqualCompName
forall a. Set a
Set.empty
)
Maybe Target
Nothing -> (Set StackUnqualCompName, Set StackUnqualCompName,
Set StackUnqualCompName)
forall a. Monoid a => a
mempty
isWanted :: Bool
isWanted = case Maybe Target
mtarget of
Maybe Target
Nothing -> Bool
False
Just Target
_ ->
Package -> Bool
hasBuildableMainLibrary Package
pkg
Bool -> Bool -> Bool
|| Bool -> Bool
not (Set NamedComponent -> Bool
forall a. Set a -> Bool
Set.null Set NamedComponent
nonLibComponents)
Bool -> Bool -> Bool
|| Bool -> Bool
not (CompCollection StackLibrary -> Bool
forall a. CompCollection a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Package
pkg.subLibraries)
filterSkippedComponents :: Set StackUnqualCompName -> Set StackUnqualCompName
filterSkippedComponents =
(StackUnqualCompName -> Bool)
-> Set StackUnqualCompName -> Set StackUnqualCompName
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool)
-> (StackUnqualCompName -> Bool) -> StackUnqualCompName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StackUnqualCompName -> [StackUnqualCompName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildOpts
bopts.skipComponents))
(Set StackUnqualCompName
exes, Set StackUnqualCompName
tests, Set StackUnqualCompName
benches) = ( Set StackUnqualCompName -> Set StackUnqualCompName
filterSkippedComponents Set StackUnqualCompName
exeCandidates
, Set StackUnqualCompName -> Set StackUnqualCompName
filterSkippedComponents Set StackUnqualCompName
testCandidates
, Set StackUnqualCompName -> Set StackUnqualCompName
filterSkippedComponents Set StackUnqualCompName
benchCandidates
)
nonLibComponents :: Set NamedComponent
nonLibComponents = Set StackUnqualCompName
-> Set StackUnqualCompName
-> Set StackUnqualCompName
-> Set NamedComponent
toComponents Set StackUnqualCompName
exes Set StackUnqualCompName
tests Set StackUnqualCompName
benches
toComponents :: Set StackUnqualCompName
-> Set StackUnqualCompName
-> Set StackUnqualCompName
-> Set NamedComponent
toComponents Set StackUnqualCompName
e Set StackUnqualCompName
t Set StackUnqualCompName
b = [Set NamedComponent] -> Set NamedComponent
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
[ (StackUnqualCompName -> NamedComponent)
-> Set StackUnqualCompName -> Set NamedComponent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map StackUnqualCompName -> NamedComponent
CExe Set StackUnqualCompName
e
, (StackUnqualCompName -> NamedComponent)
-> Set StackUnqualCompName -> Set NamedComponent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map StackUnqualCompName -> NamedComponent
CTest Set StackUnqualCompName
t
, (StackUnqualCompName -> NamedComponent)
-> Set StackUnqualCompName -> Set NamedComponent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map StackUnqualCompName -> NamedComponent
CBench Set StackUnqualCompName
b
]
btconfig :: PackageConfig
btconfig = PackageConfig
config
{ enableTests = not $ Set.null tests
, enableBenchmarks = not $ Set.null benches
}
pkg :: Package
pkg = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg
btpkg :: Maybe Package
btpkg
| Set StackUnqualCompName -> Bool
forall a. Set a -> Bool
Set.null Set StackUnqualCompName
tests Bool -> Bool -> Bool
&& Set StackUnqualCompName -> Bool
forall a. Set a -> Bool
Set.null Set StackUnqualCompName
benches = Maybe Package
forall a. Maybe a
Nothing
| Bool
otherwise = Package -> Maybe Package
forall a. a -> Maybe a
Just (PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
btconfig GenericPackageDescription
gpkg)
MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles <- RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> RIO
env
(MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File))))
forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith (RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> RIO
env
(MemoizedWith
EnvConfig (Map NamedComponent (Set (Path Abs File)))))
-> RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> RIO
env
(MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File))))
forall a b. (a -> b) -> a -> b
$
(Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> Map NamedComponent (Set (Path Abs File))
forall a b. (a, b) -> a
fst ((Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> Map NamedComponent (Set (Path Abs File)))
-> RIO
EnvConfig
(Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package
-> Path Abs File
-> Set NamedComponent
-> RIO
EnvConfig
(Map NamedComponent (Set (Path Abs File)), [PackageWarning])
forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg ProjectPackage
pp.cabalFP Set NamedComponent
nonLibComponents
MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults <- RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
-> RIO
env
(MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))])
forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith (RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
-> RIO
env
(MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]))
-> RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
-> RIO
env
(MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))])
forall a b. (a -> b) -> a -> b
$ do
Map NamedComponent (Set (Path Abs File))
componentFiles' <- MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
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
[(NamedComponent, Set (Path Abs File))]
-> ((NamedComponent, Set (Path Abs File))
-> RIO
EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo)))
-> RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map NamedComponent (Set (Path Abs File))
-> [(NamedComponent, Set (Path Abs File))]
forall k a. Map k a -> [(k, a)]
Map.toList Map NamedComponent (Set (Path Abs File))
componentFiles') (((NamedComponent, Set (Path Abs File))
-> RIO
EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo)))
-> RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))])
-> ((NamedComponent, Set (Path Abs File))
-> RIO
EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo)))
-> RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
forall a b. (a -> b) -> a -> b
$ \(NamedComponent
component, Set (Path Abs File)
files) -> do
Maybe (Map String FileCacheInfo)
mbuildCache <- Path Abs Dir
-> NamedComponent
-> RIO EnvConfig (Maybe (Map String FileCacheInfo))
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 <- Map String FileCacheInfo
-> [Path Abs File]
-> RIO EnvConfig (Set String, Map String FileCacheInfo)
forall env.
HasEnvConfig env =>
Map String FileCacheInfo
-> [Path Abs File]
-> RIO env (Set String, Map String FileCacheInfo)
checkBuildCache
(Map String FileCacheInfo
-> Maybe (Map String FileCacheInfo) -> Map String FileCacheInfo
forall a. a -> Maybe a -> a
fromMaybe Map String FileCacheInfo
forall k a. Map k a
Map.empty Maybe (Map String FileCacheInfo)
mbuildCache)
(Set (Path Abs File) -> [Path Abs File]
forall a. Set a -> [a]
Set.toList Set (Path Abs File)
files)
(NamedComponent, (Set String, Map String FileCacheInfo))
-> RIO
EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo))
forall a. a -> RIO EnvConfig a
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 =
[Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ ((NamedComponent, (Set String, Map String FileCacheInfo))
-> Set String)
-> [(NamedComponent, (Set String, Map String FileCacheInfo))]
-> [Set String]
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'
Maybe (Set String) -> MemoizedWith EnvConfig (Maybe (Set String))
forall a. a -> MemoizedWith EnvConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Set String) -> MemoizedWith EnvConfig (Maybe (Set String)))
-> Maybe (Set String)
-> MemoizedWith EnvConfig (Maybe (Set String))
forall a b. (a -> b) -> a -> b
$
if Bool -> Bool
not (Set String -> Bool
forall a. Set a -> Bool
Set.null Set String
allDirtyFiles)
then let tryStripPrefix :: String -> String
tryStripPrefix String
y =
String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
y (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath (Path Abs Dir -> String) -> Path Abs Dir -> String
forall a b. (a -> b) -> a -> b
$ ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp) String
y)
in Set String -> Maybe (Set String)
forall a. a -> Maybe a
Just (Set String -> Maybe (Set String))
-> Set String -> Maybe (Set String)
forall a b. (a -> b) -> a -> b
$ (String -> String) -> Set String -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map String -> String
tryStripPrefix Set String
allDirtyFiles
else Maybe (Set String)
forall a. Maybe a
Nothing
newBuildCaches :: MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches =
[(NamedComponent, Map String FileCacheInfo)]
-> Map NamedComponent (Map String FileCacheInfo)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(NamedComponent, Map String FileCacheInfo)]
-> Map NamedComponent (Map String FileCacheInfo))
-> ([(NamedComponent, (Set String, Map String FileCacheInfo))]
-> [(NamedComponent, Map String FileCacheInfo)])
-> [(NamedComponent, (Set String, Map String FileCacheInfo))]
-> Map NamedComponent (Map String FileCacheInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NamedComponent, (Set String, Map String FileCacheInfo))
-> (NamedComponent, Map String FileCacheInfo))
-> [(NamedComponent, (Set String, Map String FileCacheInfo))]
-> [(NamedComponent, Map String FileCacheInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(NamedComponent
c, (Set String
_, Map String FileCacheInfo
cache)) -> (NamedComponent
c, Map String FileCacheInfo
cache)) ([(NamedComponent, (Set String, Map String FileCacheInfo))]
-> Map NamedComponent (Map String FileCacheInfo))
-> MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
-> MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults
LocalPackage -> RIO env LocalPackage
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalPackage
{ package :: Package
package = Package
pkg
, testBench :: Maybe Package
testBench = Maybe Package
btpkg
, MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles :: MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles :: MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles
, buildHaddocks :: Bool
buildHaddocks = ProjectPackage
pp.projectCommon.buildHaddocks
, forceDirty :: Bool
forceDirty = BuildOpts
bopts.forceDirty
, MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles :: MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles :: MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles
, MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches :: MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches :: MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches
, cabalFP :: Path Abs File
cabalFP = ProjectPackage
pp.cabalFP
, wanted :: Bool
wanted = Bool
isWanted
, components :: Set NamedComponent
components = Set NamedComponent
nonLibComponents
, unbuildable :: Set NamedComponent
unbuildable = Set StackUnqualCompName
-> Set StackUnqualCompName
-> Set StackUnqualCompName
-> Set NamedComponent
toComponents
(Set StackUnqualCompName
exes Set StackUnqualCompName
-> Set StackUnqualCompName -> Set StackUnqualCompName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set StackUnqualCompName
buildableExes Package
pkg)
(Set StackUnqualCompName
tests Set StackUnqualCompName
-> Set StackUnqualCompName -> Set StackUnqualCompName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set StackUnqualCompName
buildableTestSuites Package
pkg)
(Set StackUnqualCompName
benches Set StackUnqualCompName
-> Set StackUnqualCompName -> Set StackUnqualCompName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set StackUnqualCompName
buildableBenchmarks Package
pkg)
}
checkBuildCache ::
HasEnvConfig env
=> Map FilePath FileCacheInfo
-> [Path Abs File]
-> RIO env (Set FilePath, Map FilePath FileCacheInfo)
checkBuildCache :: forall env.
HasEnvConfig env =>
Map String FileCacheInfo
-> [Path Abs File]
-> RIO env (Set String, Map String FileCacheInfo)
checkBuildCache Map String FileCacheInfo
oldCache [Path Abs File]
files = do
Map String (Maybe SHA256)
fileDigests <- ([(String, Maybe SHA256)] -> Map String (Maybe SHA256))
-> RIO env [(String, Maybe SHA256)]
-> RIO env (Map String (Maybe SHA256))
forall a b. (a -> b) -> RIO env a -> RIO env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, Maybe SHA256)] -> Map String (Maybe SHA256)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (RIO env [(String, Maybe SHA256)]
-> RIO env (Map String (Maybe SHA256)))
-> RIO env [(String, Maybe SHA256)]
-> RIO env (Map String (Maybe SHA256))
forall a b. (a -> b) -> a -> b
$ [Path Abs File]
-> (Path Abs File -> RIO env (String, Maybe SHA256))
-> RIO env [(String, Maybe SHA256)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Abs File]
files ((Path Abs File -> RIO env (String, Maybe SHA256))
-> RIO env [(String, Maybe SHA256)])
-> (Path Abs File -> RIO env (String, Maybe SHA256))
-> RIO env [(String, Maybe SHA256)]
forall a b. (a -> b) -> a -> b
$ \Path Abs File
fp -> do
Maybe SHA256
mdigest <- String -> RIO env (Maybe SHA256)
forall env. HasEnvConfig env => String -> RIO env (Maybe SHA256)
getFileDigestMaybe (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp)
(String, Maybe SHA256) -> RIO env (String, Maybe SHA256)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp, Maybe SHA256
mdigest)
(Map String (Set String, Map String FileCacheInfo)
-> (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo))
-> RIO env (Set String, Map String FileCacheInfo)
forall a b. (a -> b) -> RIO env a -> RIO env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Set String, Map String FileCacheInfo)]
-> (Set String, Map String FileCacheInfo)
forall a. Monoid a => [a] -> a
mconcat ([(Set String, Map String FileCacheInfo)]
-> (Set String, Map String FileCacheInfo))
-> (Map String (Set String, Map String FileCacheInfo)
-> [(Set String, Map String FileCacheInfo)])
-> Map String (Set String, Map String FileCacheInfo)
-> (Set String, Map String FileCacheInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Set String, Map String FileCacheInfo)
-> [(Set String, Map String FileCacheInfo)]
forall k a. Map k a -> [a]
Map.elems) (RIO env (Map String (Set String, Map String FileCacheInfo))
-> RIO env (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo))
-> RIO env (Set String, Map String FileCacheInfo)
forall a b. (a -> b) -> a -> b
$ Map String (RIO env (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Map String (m a) -> m (Map String a)
sequence (Map String (RIO env (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo)))
-> Map String (RIO env (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo))
forall a b. (a -> b) -> a -> b
$
SimpleWhenMissing
String
(Maybe SHA256)
(RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMissing
String
FileCacheInfo
(RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMatched
String
(Maybe SHA256)
FileCacheInfo
(RIO env (Set String, Map String FileCacheInfo))
-> Map String (Maybe SHA256)
-> Map String FileCacheInfo
-> Map String (RIO env (Set String, Map String FileCacheInfo))
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
((String
-> Maybe SHA256 -> RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMissing
String
(Maybe SHA256)
(RIO env (Set String, Map String FileCacheInfo))
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
-> RIO env (Set String, Map String FileCacheInfo)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest Maybe FileCacheInfo
forall a. Maybe a
Nothing))
((String
-> FileCacheInfo -> RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMissing
String
FileCacheInfo
(RIO env (Set String, Map String FileCacheInfo))
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
-> RIO env (Set String, Map String FileCacheInfo)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
forall a. Maybe a
Nothing (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
((String
-> Maybe SHA256
-> FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMatched
String
(Maybe SHA256)
FileCacheInfo
(RIO env (Set String, Map String FileCacheInfo))
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
-> RIO env (Set String, Map String FileCacheInfo)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
Map String (Maybe SHA256)
fileDigests
Map String FileCacheInfo
oldCache
where
go :: FilePath
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set FilePath, Map FilePath FileCacheInfo)
go :: forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
_ Maybe FileCacheInfo
_ | String -> String
takeFileName String
fp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cabal_macros.h" = (Set String, Map String FileCacheInfo)
-> RIO env (Set String, Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set String
forall a. Set a
Set.empty, Map String FileCacheInfo
forall k a. Map k a
Map.empty)
go String
fp (Just SHA256
digest') (Just FileCacheInfo
fci)
| FileCacheInfo
fci.hash SHA256 -> SHA256 -> Bool
forall a. Eq a => a -> a -> Bool
== SHA256
digest' = (Set String, Map String FileCacheInfo)
-> RIO env (Set String, Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set String
forall a. Set a
Set.empty, String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp FileCacheInfo
fci)
| Bool
otherwise =
(Set String, Map String FileCacheInfo)
-> RIO env (Set String, Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Set String
forall a. a -> Set a
Set.singleton String
fp, String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> Map String FileCacheInfo)
-> FileCacheInfo -> Map String FileCacheInfo
forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest')
go String
fp Maybe SHA256
Nothing Maybe FileCacheInfo
_ = (Set String, Map String FileCacheInfo)
-> RIO env (Set String, Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Set String
forall a. a -> Set a
Set.singleton String
fp, Map String FileCacheInfo
forall k a. Map k a
Map.empty)
go String
fp (Just SHA256
digest') Maybe FileCacheInfo
Nothing =
(Set String, Map String FileCacheInfo)
-> RIO env (Set String, Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Set String
forall a. a -> Set a
Set.singleton String
fp, String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> Map String FileCacheInfo)
-> FileCacheInfo -> Map String FileCacheInfo
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) <-
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
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 <- [(NamedComponent, Set (Path Abs File))]
-> ((NamedComponent, Set (Path Abs File))
-> RIO
env
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning]))
-> RIO
env
[((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map NamedComponent (Set (Path Abs File))
-> [(NamedComponent, Set (Path Abs File))]
forall k a. Map k a -> [(k, a)]
M.toList Map NamedComponent (Set (Path Abs File))
componentFiles) (((NamedComponent, Set (Path Abs File))
-> RIO
env
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning]))
-> RIO
env
[((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])])
-> ((NamedComponent, Set (Path Abs File))
-> RIO
env
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning]))
-> RIO
env
[((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
forall a b. (a -> b) -> a -> b
$ \(NamedComponent
component, Set (Path Abs File)
files) -> do
let buildCache :: Map String a
buildCache = Map String a
-> NamedComponent
-> Map NamedComponent (Map String a)
-> Map String a
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Map String a
forall k a. Map k a
M.empty NamedComponent
component Map NamedComponent (Map String a)
buildCaches
newFiles :: [String]
newFiles =
Set String -> [String]
forall a. Set a -> [a]
Set.toList (Set String -> [String]) -> Set String -> [String]
forall a b. (a -> b) -> a -> b
$
(Path Abs File -> String) -> Set (Path Abs File) -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Path Abs File -> String
forall b t. Path b t -> String
toFilePath Set (Path Abs File)
files Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Map String a -> Set String
forall k a. Map k a -> Set k
Map.keysSet Map String a
buildCache
[Map String FileCacheInfo]
addBuildCache <- (String -> RIO env (Map String FileCacheInfo))
-> [String] -> RIO env [Map String FileCacheInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> RIO env (Map String FileCacheInfo)
forall {env}.
HasEnvConfig env =>
String -> RIO env (Map String FileCacheInfo)
addFileToCache [String]
newFiles
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> RIO
env
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((NamedComponent
component, [Map String FileCacheInfo]
addBuildCache), [PackageWarning]
warnings)
(Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
-> RIO
env
(Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(NamedComponent, [Map String FileCacheInfo])]
-> Map NamedComponent [Map String FileCacheInfo]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> (NamedComponent, [Map String FileCacheInfo]))
-> [((NamedComponent, [Map String FileCacheInfo]),
[PackageWarning])]
-> [(NamedComponent, [Map String FileCacheInfo])]
forall a b. (a -> b) -> [a] -> [b]
map ((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> (NamedComponent, [Map String FileCacheInfo])
forall a b. (a, b) -> a
fst [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results), (((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> [PackageWarning])
-> [((NamedComponent, [Map String FileCacheInfo]),
[PackageWarning])]
-> [PackageWarning]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> [PackageWarning]
forall a b. (a, b) -> b
snd [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results)
where
addFileToCache :: String -> RIO env (Map String FileCacheInfo)
addFileToCache String
fp = do
Maybe SHA256
mdigest <- String -> RIO env (Maybe SHA256)
forall env. HasEnvConfig env => String -> RIO env (Maybe SHA256)
getFileDigestMaybe String
fp
case Maybe SHA256
mdigest of
Maybe SHA256
Nothing -> Map String FileCacheInfo -> RIO env (Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map String FileCacheInfo
forall k a. Map k a
Map.empty
Just SHA256
digest' -> Map String FileCacheInfo -> RIO env (Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map String FileCacheInfo -> RIO env (Map String FileCacheInfo))
-> Map String FileCacheInfo -> RIO env (Map String FileCacheInfo)
forall a b. (a -> b) -> a -> b
$ String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> Map String FileCacheInfo)
-> FileCacheInfo -> Map String FileCacheInfo
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
PackageComponentFile Map NamedComponent (Map ModuleName (Path Abs File))
components' Map NamedComponent [DotCabalPath]
compFiles Set (Path Abs File)
otherFiles [PackageWarning]
warnings <-
Package -> Path Abs File -> RIO env PackageComponentFile
forall s (m :: * -> *).
(HasEnvConfig s, MonadReader s m, MonadThrow m, MonadUnliftIO m) =>
Package -> Path Abs File -> m PackageComponentFile
getPackageFile Package
pkg Path Abs File
cabalFP
let necessaryComponents :: Set NamedComponent
necessaryComponents =
NamedComponent -> Set NamedComponent -> Set NamedComponent
forall a. Ord a => a -> Set a -> Set a
Set.insert NamedComponent
CLib (Set NamedComponent -> Set NamedComponent)
-> Set NamedComponent -> Set NamedComponent
forall a b. (a -> b) -> a -> b
$ (NamedComponent -> Bool)
-> Set NamedComponent -> Set NamedComponent
forall a. (a -> Bool) -> Set a -> Set a
Set.filter NamedComponent -> Bool
isCSubLib (Map NamedComponent (Map ModuleName (Path Abs File))
-> Set NamedComponent
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 Set NamedComponent -> Set NamedComponent -> Set NamedComponent
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set NamedComponent
nonLibComponents
componentsFiles :: Map NamedComponent (Set (Path Abs File))
componentsFiles = ([DotCabalPath] -> Set (Path Abs File))
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent (Set (Path Abs File))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map
(\[DotCabalPath]
files ->
Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Path Abs File)
otherFiles ((DotCabalPath -> Path Abs File)
-> Set DotCabalPath -> Set (Path Abs File)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map DotCabalPath -> Path Abs File
dotCabalGetPath (Set DotCabalPath -> Set (Path Abs File))
-> Set DotCabalPath -> Set (Path Abs File)
forall a b. (a -> b) -> a -> b
$ [DotCabalPath] -> Set DotCabalPath
forall a. Ord a => [a] -> Set a
Set.fromList [DotCabalPath]
files)
)
(Map NamedComponent [DotCabalPath]
-> Map NamedComponent (Set (Path Abs File)))
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ (NamedComponent -> [DotCabalPath] -> Bool)
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\NamedComponent
component [DotCabalPath]
_ -> NamedComponent
component NamedComponent -> Set NamedComponent -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set NamedComponent
components) Map NamedComponent [DotCabalPath]
compFiles
(Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NamedComponent (Set (Path Abs File))
componentsFiles, [PackageWarning]
warnings)
getFileDigestMaybe :: HasEnvConfig env => FilePath -> RIO env (Maybe SHA256)
getFileDigestMaybe :: forall env. HasEnvConfig env => String -> RIO env (Maybe SHA256)
getFileDigestMaybe String
fp = do
FileDigestCache
cache <- Getting FileDigestCache env FileDigestCache
-> RIO env FileDigestCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting FileDigestCache env FileDigestCache
-> RIO env FileDigestCache)
-> Getting FileDigestCache env FileDigestCache
-> RIO env FileDigestCache
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const FileDigestCache EnvConfig)
-> env -> Const FileDigestCache env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL ((EnvConfig -> Const FileDigestCache EnvConfig)
-> env -> Const FileDigestCache env)
-> ((FileDigestCache -> Const FileDigestCache FileDigestCache)
-> EnvConfig -> Const FileDigestCache EnvConfig)
-> Getting FileDigestCache env FileDigestCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvConfig -> FileDigestCache)
-> SimpleGetter EnvConfig FileDigestCache
forall s a. (s -> a) -> SimpleGetter s a
to (.fileDigestCache)
RIO env (Maybe SHA256)
-> (IOError -> RIO env (Maybe SHA256)) -> RIO env (Maybe SHA256)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
(SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (SHA256 -> Maybe SHA256)
-> RIO env SHA256 -> RIO env (Maybe SHA256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDigestCache -> String -> RIO env SHA256
forall (m :: * -> *).
MonadIO m =>
FileDigestCache -> String -> m SHA256
readFileDigest FileDigestCache
cache String
fp)
(\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then Maybe SHA256 -> RIO env (Maybe SHA256)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SHA256
forall a. Maybe a
Nothing else IOError -> RIO env (Maybe SHA256)
forall e a. (HasCallStack, Exception e) => e -> RIO env a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM IOError
e)
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 <- Getting Platform env Platform -> RIO env Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
Lens' env Platform
platformL
ActualCompiler
compilerVersion <- Getting ActualCompiler env ActualCompiler -> RIO env ActualCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActualCompiler env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
SimpleGetter env ActualCompiler
actualCompilerVersionL
PackageConfig -> RIO env PackageConfig
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageConfig
{ enableTests :: Bool
enableTests = Bool
False
, enableBenchmarks :: Bool
enableBenchmarks = Bool
False
, flags :: Map FlagName Bool
flags = Map FlagName Bool
flags
, ghcOptions :: [Text]
ghcOptions = [Text]
ghcOptions
, cabalConfigOpts :: [Text]
cabalConfigOpts = [Text]
cabalConfigOpts
, compilerVersion :: ActualCompiler
compilerVersion = ActualCompiler
compilerVersion
, platform :: Platform
platform = Platform
platform
}