{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE ConstraintKinds #-}
-- Load information on package sources
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              Data.List
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.SourceMap
import              System.FilePath (takeFileName)
import              System.IO.Error (isDoesNotExistError)

-- | loads and returns project packages
projectLocalPackages :: HasEnvConfig env
              => RIO env [LocalPackage]
projectLocalPackages :: 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
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 EnvConfig -> SourceMap
envConfigSourceMap
    [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 (t :: * -> *) a. Foldable t => t a -> [a]
toList (Map PackageName ProjectPackage -> [ProjectPackage])
-> Map PackageName ProjectPackage -> [ProjectPackage]
forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sm) ProjectPackage -> RIO env LocalPackage
forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage

-- | loads all local dependencies - project packages and local extra-deps
localDependencies :: HasEnvConfig env => RIO env [LocalPackage]
localDependencies :: 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
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 Config -> BuildOpts
configBuild
    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
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 EnvConfig -> SourceMap
envConfigSourceMap
    [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 (Map PackageName DepPackage -> [DepPackage])
-> Map PackageName DepPackage -> [DepPackage]
forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sourceMap) ((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 -> PackageLocation
dpLocation DepPackage
dp 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 (m :: * -> *) a. Monad m => a -> m a
return Maybe LocalPackage
forall a. Maybe a
Nothing

-- | Given the parsed targets and build command line options constructs
--   a source map
loadSourceMap :: HasBuildConfig env
              => SMTargets
              -> BuildOptsCLI
              -> SMActual DumpedGlobalPackage
              -> RIO env SourceMap
loadSourceMap :: SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap SMTargets
smt BuildOptsCLI
boptsCli SMActual DumpedGlobalPackage
sma = 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
buildConfigL
    let compiler :: ActualCompiler
compiler = SMActual DumpedGlobalPackage -> ActualCompiler
forall global. SMActual global -> ActualCompiler
smaCompiler SMActual DumpedGlobalPackage
sma
        project :: Map PackageName ProjectPackage
project = (ProjectPackage -> ProjectPackage)
-> Map PackageName ProjectPackage -> Map PackageName ProjectPackage
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ProjectPackage -> ProjectPackage
applyOptsFlagsPP (Map PackageName ProjectPackage -> Map PackageName ProjectPackage)
-> Map PackageName ProjectPackage -> Map PackageName ProjectPackage
forall a b. (a -> b) -> a -> b
$ SMActual DumpedGlobalPackage -> Map PackageName ProjectPackage
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 (PackageName -> Map PackageName Target -> Bool
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 Map PackageName DepPackage
-> Map PackageName DepPackage -> Map PackageName DepPackage
forall a. Semigroup a => a -> a -> a
<> SMActual DumpedGlobalPackage -> Map PackageName DepPackage
forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual DumpedGlobalPackage
sma
        deps :: Map PackageName DepPackage
deps = (DepPackage -> DepPackage)
-> Map PackageName DepPackage -> Map PackageName DepPackage
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 (PackageName -> Map PackageName DepPackage -> Bool
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 Map FlagName Bool -> Bool
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 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ CommonPackage -> [Text]
cpGhcOptions CommonPackage
common
               , cpCabalConfigOpts :: [Text]
cpCabalConfigOpts =
                     [Text]
cabalConfigOpts [Text] -> [Text] -> [Text]
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 = [(PackageName, Map FlagName Bool)]
-> Map PackageName (Map FlagName Bool)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PackageName, Map FlagName Bool)]
 -> Map PackageName (Map FlagName Bool))
-> [(PackageName, Map FlagName Bool)]
-> Map PackageName (Map FlagName Bool)
forall a b. (a -> b) -> a -> b
$
          ((ApplyCLIFlag, Map FlagName Bool)
 -> Maybe (PackageName, Map FlagName Bool))
-> [(ApplyCLIFlag, Map FlagName Bool)]
-> [(PackageName, Map FlagName Bool)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ApplyCLIFlag, Map FlagName Bool)
-> Maybe (PackageName, Map FlagName Bool)
forall b. (ApplyCLIFlag, b) -> Maybe (PackageName, b)
maybeProjectFlags ([(ApplyCLIFlag, Map FlagName Bool)]
 -> [(PackageName, Map FlagName Bool)])
-> [(ApplyCLIFlag, Map FlagName Bool)]
-> [(PackageName, Map FlagName Bool)]
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 (BuildOptsCLI -> Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags BuildOptsCLI
boptsCli)
        maybeProjectFlags :: (ApplyCLIFlag, b) -> Maybe (PackageName, b)
maybeProjectFlags (ACFByName PackageName
name, b
fs) = (PackageName, b) -> Maybe (PackageName, b)
forall a. a -> Maybe a
Just (PackageName
name, b
fs)
        maybeProjectFlags (ApplyCLIFlag, b)
_ = Maybe (PackageName, b)
forall a. Maybe a
Nothing
        globals :: Map PackageName GlobalPackage
globals = Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals (SMActual DumpedGlobalPackage -> Map PackageName DumpedGlobalPackage
forall global. SMActual global -> Map PackageName global
smaGlobal SMActual DumpedGlobalPackage
sma) (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
"Checking flags"
    Map PackageName (Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> RIO env ()
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
    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 (m :: * -> *) a. Monad m => a -> m a
return
        SourceMap :: SMTargets
-> ActualCompiler
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> Map PackageName GlobalPackage
-> SourceMap
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
        }

-- | Get a 'SourceMapHash' for a given 'SourceMap'
--
-- Basic rules:
--
-- * If someone modifies a GHC installation in any way after Stack
--   looks at it, they voided the warranty. This includes installing a
--   brand new build to the same directory, or registering new
--   packages to the global database.
--
-- * We should include everything in the hash that would relate to
--   immutable packages and identifying the compiler itself. Mutable
--   packages (both project packages and dependencies) will never make
--   it into the snapshot database, and can be ignored.
--
-- * Target information is only relevant insofar as it effects the
--   dependency map. The actual current targets for this build are
--   irrelevant to the cache mechanism, and can be ignored.
--
-- * Make sure things like profiling and haddocks are included in the hash
--
hashSourceMapData
    :: (HasBuildConfig env, HasCompiler env)
    => BuildOptsCLI
    -> SourceMap
    -> RIO env SourceMapHash
hashSourceMapData :: 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 -> Map PackageName DepPackage
smDeps SourceMap
sm)) 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
buildConfigL
    let -- extra bytestring specifying GHC options supposed to be applied to
        -- GHC boot packages so we'll have differrent hashes when bare
        -- resolver 'ghc-X.Y.Z' is used, no extra-deps and e.g. user wants builds
        -- with profiling or without
        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 :: ByteString
hashedContent = Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
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 (m :: * -> *) a. Monad m => a -> m a
return (SourceMapHash -> RIO env SourceMapHash)
-> SourceMapHash -> RIO env SourceMapHash
forall a b. (a -> b) -> a -> b
$ SHA256 -> SourceMapHash
SourceMapHash (ByteString -> SHA256
SHA256.hashLazyBytes ByteString
hashedContent)

depPackageHashableContent :: (HasConfig env) => DepPackage -> RIO env Builder
depPackageHashableContent :: 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
_ -> Builder -> RIO env Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
""
        PLImmutable PackageLocationImmutable
pli -> do
            let flagToBs :: (FlagName, Bool) -> p
flagToBs (FlagName
f, Bool
enabled) =
                    if Bool
enabled
                        then p
""
                        else p
"-" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> String -> p
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 p. (IsString p, Semigroup p) => (FlagName, Bool) -> p
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 (CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
dpCommon)
                ghcOptions :: [Utf8Builder]
ghcOptions = (Text -> Utf8Builder) -> [Text] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (CommonPackage -> [Text]
cpGhcOptions CommonPackage
dpCommon)
                cabalConfigOpts :: [Utf8Builder]
cabalConfigOpts = (Text -> Utf8Builder) -> [Text] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Utf8Builder
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
            Builder -> RIO env Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (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)

-- | All flags for a local package.
getLocalFlags
    :: BuildOptsCLI
    -> PackageName
    -> Map FlagName Bool
getLocalFlags :: BuildOptsCLI -> PackageName -> Map FlagName Bool
getLocalFlags BuildOptsCLI
boptsCli PackageName
name = [Map FlagName Bool] -> Map FlagName Bool
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
    [ 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
    , 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
    ]
  where
    cliFlags :: Map ApplyCLIFlag (Map FlagName Bool)
cliFlags = BuildOptsCLI -> Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags BuildOptsCLI
boptsCli

-- | Get the options to pass to @./Setup.hs configure@
loadCabalConfigOpts :: BuildConfig -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts :: BuildConfig -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts BuildConfig
bconfig 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 -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
    , 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 -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
        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 -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
        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 -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
    ]
  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
configL BuildConfig
bconfig

-- | Get the configured options to pass from GHC, based on the build
-- configuration and commandline.
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 -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
    , 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 -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
        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 -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
        else []
    , [[Text]] -> [Text]
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 (Bool -> Bool) -> Bool -> Bool
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 = 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
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 =
    ([Text] -> [Text])
-> ([Text] -> [Text])
-> ([Text] -> [Text])
-> [NamedComponent]
-> (Set Text, Set Text, Set Text)
forall a a a.
(Ord a, Ord a, Ord a) =>
([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [Text]
forall a. a -> a
id [Text] -> [Text]
forall a. a -> a
id [Text] -> [Text]
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 [] = ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
a [], [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
b [], [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
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 ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xText -> [Text] -> [Text]
forall 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 ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xText -> [Text] -> [Text]
forall 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 ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xText -> [Text] -> [Text]
forall 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 ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) [NamedComponent]
xs

loadCommonPackage ::
       forall env. (HasBuildConfig env, HasSourceMap env)
    => CommonPackage
    -> RIO env Package
loadCommonPackage :: 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 -> Map FlagName Bool
cpFlags CommonPackage
common) (CommonPackage -> [Text]
cpGhcOptions CommonPackage
common) (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common)
    GenericPackageDescription
gpkg <- IO GenericPackageDescription -> RIO env GenericPackageDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GenericPackageDescription -> RIO env GenericPackageDescription)
-> IO GenericPackageDescription
-> RIO env GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD CommonPackage
common
    Package -> RIO env Package
forall (m :: * -> *) a. Monad m => a -> m a
return (Package -> RIO env Package) -> Package -> RIO env Package
forall a b. (a -> b) -> a -> b
$ PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg

-- | Upgrade the initial project package info to a full-blown @LocalPackage@
-- based on the selected components
loadLocalPackage ::
       forall env. (HasBuildConfig env, HasSourceMap env)
    => ProjectPackage
    -> RIO env LocalPackage
loadLocalPackage :: 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
sourceMapL
    let common :: CommonPackage
common = ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp
    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
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
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 BuildConfig -> Maybe Curator
bcCurator
    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 -> Map FlagName Bool
cpFlags CommonPackage
common) (CommonPackage -> [Text]
cpGhcOptions CommonPackage
common) (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common)
    GenericPackageDescription
gpkg <- ProjectPackage -> RIO env GenericPackageDescription
forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m GenericPackageDescription
ppGPD ProjectPackage
pp
    let name :: PackageName
name = CommonPackage -> PackageName
cpName CommonPackage
common
        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 (SMTargets -> Map PackageName Target
smtTargets (SMTargets -> Map PackageName Target)
-> SMTargets -> Map PackageName Target
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 ([NamedComponent] -> (Set Text, Set Text, Set Text))
-> [NamedComponent] -> (Set Text, Set Text, Set Text)
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> [NamedComponent]
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
&& 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
. Curator -> Set PackageName
curatorSkipTest) Maybe Curator
mcurator
                        then Map Text TestSuiteInterface -> Set Text
forall k a. Map k a -> Set k
Map.keysSet (Package -> Map Text TestSuiteInterface
packageTests Package
pkg)
                        else Set Text
forall a. Set a
Set.empty
                    , if BuildOpts -> Bool
boptsBenchmarks BuildOpts
bopts 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
. Curator -> Set PackageName
curatorSkipBenchmark) Maybe Curator
mcurator
                        then Package -> Set Text
packageBenchmarks Package
pkg
                        else Set Text
forall a. Set a
Set.empty
                    )
                Maybe Target
Nothing -> (Set Text, Set Text, Set Text)
forall a. Monoid a => a
mempty

        -- See https://github.com/commercialhaskell/stack/issues/2862
        isWanted :: Bool
isWanted = case Maybe Target
mtarget of
            Maybe Target
Nothing -> Bool
False
            -- FIXME: When issue #1406 ("stack 0.1.8 lost ability to
            -- build individual executables or library") is resolved,
            -- 'hasLibrary' is only relevant if the library is
            -- part of the target spec.
            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 (Set NamedComponent -> Bool
forall a. Set a -> Bool
Set.null Set NamedComponent
nonLibComponents)
               Bool -> Bool -> Bool
|| Bool -> Bool
not (Set Text -> Bool
forall a. Set a -> Bool
Set.null (Set Text -> Bool) -> Set Text -> Bool
forall a b. (a -> b) -> a -> b
$ Package -> Set Text
packageInternalLibraries Package
pkg)

        filterSkippedComponents :: Set Text -> Set Text
filterSkippedComponents = (Text -> Bool) -> Set Text -> Set Text
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text] -> Bool
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 = [Set NamedComponent] -> Set NamedComponent
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
            [ (Text -> NamedComponent) -> Set Text -> Set NamedComponent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CExe Set Text
e
            , (Text -> NamedComponent) -> Set Text -> Set NamedComponent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CTest Set Text
t
            , (Text -> NamedComponent) -> Set Text -> Set NamedComponent
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
tests
            , packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
benches
            }
        testconfig :: PackageConfig
testconfig = PackageConfig
config
            { packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
True
            , packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
False
            }
        benchconfig :: PackageConfig
benchconfig = PackageConfig
config
            { packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
False
            , packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
True
            }

        -- We resolve the package in 4 different configurations:
        --
        -- - pkg doesn't have tests or benchmarks enabled.
        --
        -- - btpkg has them enabled if they are present.
        --
        -- - testpkg has tests enabled, but not benchmarks.
        --
        -- - benchpkg has benchmarks enablde, but not tests.
        --
        -- The latter two configurations are used to compute the deps
        -- when --enable-benchmarks or --enable-tests are configured.
        -- This allows us to do an optimization where these are passed
        -- if the deps are present. This can avoid doing later
        -- unnecessary reconfigures.
        pkg :: Package
pkg = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg
        btpkg :: Maybe Package
btpkg
            | Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
tests Bool -> Bool -> Bool
&& Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
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)
        testpkg :: Package
testpkg = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
testconfig GenericPackageDescription
gpkg
        benchpkg :: Package
benchpkg = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
benchconfig 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 -> Path Abs File
ppCabalFP ProjectPackage
pp) 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 (m :: * -> *).
MonadIO m =>
Map String FileCacheInfo
-> [Path Abs File] -> m (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 (m :: * -> *) a. Monad m => a -> m a
return (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 (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]
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 (m :: * -> *) a. Monad m => a -> m a
return LocalPackage :: Package
-> Set NamedComponent
-> Set NamedComponent
-> Bool
-> Map PackageName VersionRange
-> Map PackageName VersionRange
-> Maybe Package
-> Path Abs File
-> Bool
-> Bool
-> MemoizedWith EnvConfig (Maybe (Set String))
-> MemoizedWith
     EnvConfig (Map NamedComponent (Map String FileCacheInfo))
-> MemoizedWith
     EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> LocalPackage
LocalPackage
        { lpPackage :: Package
lpPackage = Package
pkg
        , lpTestDeps :: Map PackageName VersionRange
lpTestDeps = DepValue -> VersionRange
dvVersionRange (DepValue -> VersionRange)
-> Map PackageName DepValue -> Map PackageName VersionRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Map PackageName DepValue
packageDeps Package
testpkg
        , lpBenchDeps :: Map PackageName VersionRange
lpBenchDeps = DepValue -> VersionRange
dvVersionRange (DepValue -> VersionRange)
-> Map PackageName DepValue -> Map PackageName VersionRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Map PackageName DepValue
packageDeps Package
benchpkg
        , 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
        -- TODO: refactor this so that it's easier to be sure that these
        -- components are indeed unbuildable.
        --
        -- The reasoning here is that if the STLocalComps specification
        -- made it through component parsing, but the components aren't
        -- present, then they must not be buildable.
        , lpUnbuildable :: Set NamedComponent
lpUnbuildable = Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents
            (Set Text
exes Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set Text
packageExes Package
pkg)
            (Set Text
tests Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Map Text TestSuiteInterface -> Set Text
forall k a. Map k a -> Set k
Map.keysSet (Package -> Map Text TestSuiteInterface
packageTests Package
pkg))
            (Set Text
benches Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set Text
packageBenchmarks Package
pkg)
        }

-- | Compare the current filesystem state to the cached information, and
-- determine (1) if the files are dirty, and (2) the new cache values.
checkBuildCache :: forall m. (MonadIO m)
                => Map FilePath FileCacheInfo -- ^ old cache
                -> [Path Abs File] -- ^ files in package
                -> m (Set FilePath, Map FilePath FileCacheInfo)
checkBuildCache :: 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 <- ([(String, Maybe SHA256)] -> Map String (Maybe SHA256))
-> m [(String, Maybe SHA256)] -> m (Map String (Maybe SHA256))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(String, Maybe SHA256)] -> Map String (Maybe SHA256)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(String, Maybe SHA256)] -> m (Map String (Maybe SHA256)))
-> m [(String, Maybe SHA256)] -> m (Map String (Maybe SHA256))
forall a b. (a -> b) -> a -> b
$ [Path Abs File]
-> (Path Abs File -> m (String, Maybe SHA256))
-> m [(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 -> m (String, Maybe SHA256))
 -> m [(String, Maybe SHA256)])
-> (Path Abs File -> m (String, Maybe SHA256))
-> m [(String, Maybe SHA256)]
forall a b. (a -> b) -> a -> b
$ \Path Abs File
fp -> do
        Maybe SHA256
mdigest <- IO (Maybe SHA256) -> m (Maybe SHA256)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe SHA256)
forall (m :: * -> *). MonadIO m => String -> m (Maybe SHA256)
getFileDigestMaybe (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp))
        (String, Maybe SHA256) -> m (String, Maybe SHA256)
forall (m :: * -> *) a. Monad m => a -> m a
return (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))
-> m (Map String (Set String, Map String FileCacheInfo))
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([(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) (m (Map String (Set String, Map String FileCacheInfo))
 -> m (Set String, Map String FileCacheInfo))
-> m (Map String (Set String, Map String FileCacheInfo))
-> m (Set String, Map String FileCacheInfo)
forall a b. (a -> b) -> a -> b
$ Map String (m (Set String, Map String FileCacheInfo))
-> m (Map String (Set String, Map String FileCacheInfo))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Map String (m (Set String, Map String FileCacheInfo))
 -> m (Map String (Set String, Map String FileCacheInfo)))
-> Map String (m (Set String, Map String FileCacheInfo))
-> m (Map String (Set String, Map String FileCacheInfo))
forall a b. (a -> b) -> a -> b
$
        (String
 -> Maybe SHA256
 -> FileCacheInfo
 -> Maybe (m (Set String, Map String FileCacheInfo)))
-> (Map String (Maybe SHA256)
    -> Map String (m (Set String, Map String FileCacheInfo)))
-> (Map String FileCacheInfo
    -> Map String (m (Set String, Map String FileCacheInfo)))
-> Map String (Maybe SHA256)
-> Map String FileCacheInfo
-> Map String (m (Set String, Map String FileCacheInfo))
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 -> m (Set String, Map String FileCacheInfo)
-> Maybe (m (Set String, Map String FileCacheInfo))
forall a. a -> Maybe a
Just (String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
            ((String
 -> Maybe SHA256 -> m (Set String, Map String FileCacheInfo))
-> Map String (Maybe SHA256)
-> Map String (m (Set String, Map String FileCacheInfo))
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 Maybe FileCacheInfo
forall a. Maybe a
Nothing))
            ((String
 -> FileCacheInfo -> m (Set String, Map String FileCacheInfo))
-> Map String FileCacheInfo
-> Map String (m (Set String, Map String FileCacheInfo))
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 Maybe SHA256
forall a. Maybe a
Nothing (FileCacheInfo -> Maybe FileCacheInfo
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)
    -- Filter out the cabal_macros file to avoid spurious recompilations
    go :: String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (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)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set String
forall a. Set a
Set.empty, Map String FileCacheInfo
forall k a. Map k a
Map.empty)
    -- Common case where it's in the cache and on the filesystem.
    go String
fp (Just SHA256
digest') (Just FileCacheInfo
fci)
        | FileCacheInfo -> SHA256
fciHash FileCacheInfo
fci SHA256 -> SHA256 -> Bool
forall a. Eq a => a -> a -> Bool
== SHA256
digest' = (Set String, Map String FileCacheInfo)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (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)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (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')
    -- Missing file. Add it to dirty files, but no FileCacheInfo.
    go String
fp Maybe SHA256
Nothing Maybe FileCacheInfo
_ = (Set String, Map String FileCacheInfo)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Set String
forall a. a -> Set a
Set.singleton String
fp, Map String FileCacheInfo
forall k a. Map k a
Map.empty)
    -- Missing cache. Add it to dirty files and compute FileCacheInfo.
    go String
fp (Just SHA256
digest') Maybe FileCacheInfo
Nothing =
        (Set String, Map String FileCacheInfo)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (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')

-- | Returns entries to add to the build cache for any newly found unlisted modules
addUnlistedToBuildCache
    :: HasEnvConfig env
    => Package
    -> Path Abs File
    -> Set NamedComponent
    -> Map NamedComponent (Map FilePath a)
    -> RIO env (Map NamedComponent [Map FilePath FileCacheInfo], [PackageWarning])
addUnlistedToBuildCache :: 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)
mapM String -> RIO env (Map String FileCacheInfo)
forall (m :: * -> *).
MonadIO m =>
String -> m (Map String FileCacheInfo)
addFileToCache [String]
newFiles
        ((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> RIO
     env
     ((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamedComponent
component, [Map String FileCacheInfo]
addBuildCache), [PackageWarning]
warnings)
    (Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
-> RIO
     env
     (Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(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 -> m (Map String FileCacheInfo)
addFileToCache String
fp = do
        Maybe SHA256
mdigest <- String -> m (Maybe SHA256)
forall (m :: * -> *). MonadIO m => String -> m (Maybe SHA256)
getFileDigestMaybe String
fp
        case Maybe SHA256
mdigest of
            Maybe SHA256
Nothing -> Map String FileCacheInfo -> m (Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Map String FileCacheInfo
forall k a. Map k a
Map.empty
            Just SHA256
digest' -> Map String FileCacheInfo -> m (Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String FileCacheInfo -> m (Map String FileCacheInfo))
-> (FileCacheInfo -> Map String FileCacheInfo)
-> FileCacheInfo
-> m (Map String FileCacheInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> m (Map String FileCacheInfo))
-> FileCacheInfo -> m (Map String FileCacheInfo)
forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest'

-- | Gets list of Paths for files relevant to a set of components in a package.
--   Note that the library component, if any, is always automatically added to the
--   set of components.
getPackageFilesForTargets
    :: HasEnvConfig env
    => Package
    -> Path Abs File
    -> Set NamedComponent
    -> RIO env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets :: 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
-> Path Abs File
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
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 = 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
isCInternalLib (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Map NamedComponent (Set (Path Abs File))
componentsFiles, [PackageWarning]
warnings)

-- | Get file digest, if it exists
getFileDigestMaybe :: MonadIO m => FilePath -> m (Maybe SHA256)
getFileDigestMaybe :: String -> m (Maybe SHA256)
getFileDigestMaybe String
fp = do
    IO (Maybe SHA256) -> m (Maybe SHA256)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO (Maybe SHA256)
-> (IOError -> IO (Maybe SHA256)) -> IO (Maybe SHA256)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
             ((SHA256 -> Maybe SHA256) -> IO SHA256 -> IO (Maybe SHA256)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (IO SHA256 -> IO (Maybe SHA256))
-> ((ConduitM () ByteString IO () -> IO SHA256) -> IO SHA256)
-> (ConduitM () ByteString IO () -> IO SHA256)
-> IO (Maybe SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (ConduitM () ByteString IO () -> IO SHA256) -> IO SHA256
forall (m :: * -> *) (n :: * -> *) i a.
(MonadUnliftIO m, MonadIO n) =>
String -> (ConduitM i ByteString n () -> m a) -> m a
withSourceFile String
fp ((ConduitM () ByteString IO () -> IO SHA256) -> IO (Maybe SHA256))
-> (ConduitM () ByteString IO () -> IO SHA256) -> IO (Maybe SHA256)
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString IO () -> IO SHA256
forall (m :: * -> *).
Monad m =>
ConduitM () ByteString m () -> m SHA256
getDigest)
             (\IOError
e ->
                   if IOError -> Bool
isDoesNotExistError IOError
e
                       then Maybe SHA256 -> IO (Maybe SHA256)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SHA256
forall a. Maybe a
Nothing
                       else IOError -> IO (Maybe SHA256)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM IOError
e))
  where
    getDigest :: ConduitM () ByteString m () -> m SHA256
getDigest ConduitM () ByteString m ()
src = ConduitT () Void m SHA256 -> m SHA256
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m SHA256 -> m SHA256)
-> ConduitT () Void m SHA256 -> m SHA256
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString m ()
src ConduitM () ByteString m ()
-> ConduitM ByteString Void m SHA256 -> ConduitT () Void m SHA256
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ZipSink ByteString m SHA256 -> ConduitM ByteString Void m SHA256
forall i (m :: * -> *) r. ZipSink i m r -> Sink i m r
getZipSink (ConduitM ByteString Void m SHA256 -> ZipSink ByteString m SHA256
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink ConduitM ByteString Void m SHA256
forall (m :: * -> *) o. Monad m => ConduitT ByteString o m SHA256
SHA256.sinkHash)

-- | Get 'PackageConfig' for package given its name.
getPackageConfig
  :: (HasBuildConfig env, HasSourceMap env)
  => Map FlagName Bool
  -> [Text] -- ^ GHC options
  -> [Text] -- ^ cabal config opts
  -> RIO env PackageConfig
getPackageConfig :: 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
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
actualCompilerVersionL
  PackageConfig -> RIO env PackageConfig
forall (m :: * -> *) a. Monad m => a -> m a
return PackageConfig :: Bool
-> Bool
-> Map FlagName Bool
-> [Text]
-> [Text]
-> ActualCompiler
-> Platform
-> PackageConfig
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
    }