{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}

-- 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 qualified    Data.List as L
import qualified    Data.Map as Map
import qualified    Data.Map.Strict as M
import qualified    Data.Set as Set
import              Stack.Build.Cache
import              Stack.Build.Haddock (shouldHaddockDeps)
import              Stack.Build.Target
import              Stack.Package
import              Stack.SourceMap
import              Stack.Types.Build
import              Stack.Types.Config
import              Stack.Types.NamedComponent
import              Stack.Types.Package
import              Stack.Types.PackageFile
import              Stack.Types.SourceMap
import              System.FilePath (takeFileName)
import              System.IO.Error (isDoesNotExistError)

-- | loads and returns project packages

projectLocalPackages :: HasEnvConfig env
              => RIO env [LocalPackage]
projectLocalPackages :: forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages = do
    SourceMap
sm <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sm) forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage

-- | loads all local dependencies - project packages and local extra-deps

localDependencies :: HasEnvConfig env => RIO env [LocalPackage]
localDependencies :: forall env. HasEnvConfig env => RIO env [LocalPackage]
localDependencies = do
    BuildOpts
bopts <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> BuildOpts
configBuild
    SourceMap
sourceMap <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
    forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM (forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sourceMap) forall a b. (a -> b) -> a -> b
$ \DepPackage
dp ->
        case DepPackage -> PackageLocation
dpLocation DepPackage
dp of
            PLMutable ResolvedPath Dir
dir -> do
                ProjectPackage
pp <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
mkProjectPackage PrintWarnings
YesPrintWarnings ResolvedPath Dir
dir (BuildOpts -> Bool
shouldHaddockDeps BuildOpts
bopts)
                forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage ProjectPackage
pp
            PackageLocation
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- | Given the parsed targets and build command line options constructs

--   a source map

loadSourceMap :: HasBuildConfig env
              => SMTargets
              -> BuildOptsCLI
              -> SMActual DumpedGlobalPackage
              -> RIO env SourceMap
loadSourceMap :: forall env.
HasBuildConfig env =>
SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap SMTargets
smt BuildOptsCLI
boptsCli SMActual DumpedGlobalPackage
sma = do
    BuildConfig
bconfig <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
    let compiler :: ActualCompiler
compiler = forall global. SMActual global -> ActualCompiler
smaCompiler SMActual DumpedGlobalPackage
sma
        project :: Map PackageName ProjectPackage
project = forall a b k. (a -> b) -> Map k a -> Map k b
M.map ProjectPackage -> ProjectPackage
applyOptsFlagsPP forall a b. (a -> b) -> a -> b
$ forall global. SMActual global -> Map PackageName ProjectPackage
smaProject SMActual DumpedGlobalPackage
sma
        bopts :: BuildOpts
bopts = Config -> BuildOpts
configBuild (BuildConfig -> Config
bcConfig BuildConfig
bconfig)
        applyOptsFlagsPP :: ProjectPackage -> ProjectPackage
applyOptsFlagsPP p :: ProjectPackage
p@ProjectPackage{ppCommon :: ProjectPackage -> CommonPackage
ppCommon = CommonPackage
c} =
          ProjectPackage
p{ppCommon :: CommonPackage
ppCommon = Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags (forall k a. Ord k => k -> Map k a -> Bool
M.member (CommonPackage -> PackageName
cpName CommonPackage
c) (SMTargets -> Map PackageName Target
smtTargets SMTargets
smt)) Bool
True CommonPackage
c}
        deps0 :: Map PackageName DepPackage
deps0 = SMTargets -> Map PackageName DepPackage
smtDeps SMTargets
smt forall a. Semigroup a => a -> a -> a
<> forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual DumpedGlobalPackage
sma
        deps :: Map PackageName DepPackage
deps = forall a b k. (a -> b) -> Map k a -> Map k b
M.map DepPackage -> DepPackage
applyOptsFlagsDep Map PackageName DepPackage
deps0
        applyOptsFlagsDep :: DepPackage -> DepPackage
applyOptsFlagsDep d :: DepPackage
d@DepPackage{dpCommon :: DepPackage -> CommonPackage
dpCommon = CommonPackage
c} =
          DepPackage
d{dpCommon :: CommonPackage
dpCommon = Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags (forall k a. Ord k => k -> Map k a -> Bool
M.member (CommonPackage -> PackageName
cpName CommonPackage
c) (SMTargets -> Map PackageName DepPackage
smtDeps SMTargets
smt)) Bool
False CommonPackage
c}
        applyOptsFlags :: Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags Bool
isTarget Bool
isProjectPackage CommonPackage
common =
            let name :: PackageName
name = CommonPackage -> PackageName
cpName CommonPackage
common
                flags :: Map FlagName Bool
flags = BuildOptsCLI -> PackageName -> Map FlagName Bool
getLocalFlags BuildOptsCLI
boptsCli PackageName
name
                ghcOptions :: [Text]
ghcOptions =
                  BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bconfig BuildOptsCLI
boptsCli Bool
isTarget Bool
isProjectPackage
                cabalConfigOpts :: [Text]
cabalConfigOpts =
                  BuildConfig -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts BuildConfig
bconfig (CommonPackage -> PackageName
cpName CommonPackage
common) Bool
isTarget Bool
isProjectPackage
            in CommonPackage
common
               { cpFlags :: Map FlagName Bool
cpFlags =
                     if forall k a. Map k a -> Bool
M.null Map FlagName Bool
flags
                         then CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common
                         else Map FlagName Bool
flags
               , cpGhcOptions :: [Text]
cpGhcOptions =
                     [Text]
ghcOptions forall a. [a] -> [a] -> [a]
++ CommonPackage -> [Text]
cpGhcOptions CommonPackage
common
               , cpCabalConfigOpts :: [Text]
cpCabalConfigOpts =
                     [Text]
cabalConfigOpts forall a. [a] -> [a] -> [a]
++ CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common
               , cpHaddocks :: Bool
cpHaddocks =
                     if Bool
isTarget
                         then BuildOpts -> Bool
boptsHaddock BuildOpts
bopts
                         else BuildOpts -> Bool
shouldHaddockDeps BuildOpts
bopts
               }
        packageCliFlags :: Map PackageName (Map FlagName Bool)
packageCliFlags = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. (ApplyCLIFlag, b) -> Maybe (PackageName, b)
maybeProjectFlags forall a b. (a -> b) -> a -> b
$
          forall k a. Map k a -> [(k, a)]
Map.toList (BuildOptsCLI -> Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags BuildOptsCLI
boptsCli)
        maybeProjectFlags :: (ApplyCLIFlag, b) -> Maybe (PackageName, b)
maybeProjectFlags (ACFByName PackageName
name, b
fs) = forall a. a -> Maybe a
Just (PackageName
name, b
fs)
        maybeProjectFlags (ApplyCLIFlag, b)
_ = forall a. Maybe a
Nothing
        globals :: Map PackageName GlobalPackage
globals = Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals (forall global. SMActual global -> Map PackageName global
smaGlobal SMActual DumpedGlobalPackage
sma) (forall k a. Map k a -> Set k
Map.keysSet Map PackageName DepPackage
deps)
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Checking flags"
    forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Map PackageName (Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> m ()
checkFlagsUsedThrowing Map PackageName (Map FlagName Bool)
packageCliFlags FlagSource
FSCommandLine Map PackageName ProjectPackage
project Map PackageName DepPackage
deps
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"SourceMap constructed"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
        SourceMap
        { smTargets :: SMTargets
smTargets = SMTargets
smt
        , smCompiler :: ActualCompiler
smCompiler = ActualCompiler
compiler
        , smProject :: Map PackageName ProjectPackage
smProject = Map PackageName ProjectPackage
project
        , smDeps :: Map PackageName DepPackage
smDeps = Map PackageName DepPackage
deps
        , smGlobal :: Map PackageName GlobalPackage
smGlobal = Map PackageName GlobalPackage
globals
        }

-- | 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 :: forall env.
(HasBuildConfig env, HasCompiler env) =>
BuildOptsCLI -> SourceMap -> RIO env SourceMapHash
hashSourceMapData BuildOptsCLI
boptsCli SourceMap
sm = do
    Builder
compilerPath <- Utf8Builder -> Builder
getUtf8Builder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env. HasCompiler env => RIO env (Path Abs File)
getCompilerPath
    Builder
compilerInfo <- forall env. (HasConfig env, HasCompiler env) => RIO env Builder
getCompilerInfo
    [Builder]
immDeps <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [a]
Map.elems (SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sm)) forall env. HasConfig env => DepPackage -> RIO env Builder
depPackageHashableContent
    BuildConfig
bc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
    let -- extra bytestring specifying GHC options supposed to be applied to

        -- GHC boot packages so we'll have different 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a. Display a => a -> Utf8Builder
display (BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bc BuildOptsCLI
boptsCli Bool
False Bool
False)
        hashedContent :: ByteString
hashedContent = Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ Builder
compilerPath forall a. Semigroup a => a -> a -> a
<> Builder
compilerInfo forall a. Semigroup a => a -> a -> a
<>
            Utf8Builder -> Builder
getUtf8Builder (forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
bootGhcOpts) forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [Builder]
immDeps
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SHA256 -> SourceMapHash
SourceMapHash (ByteString -> SHA256
SHA256.hashLazyBytes ByteString
hashedContent)

depPackageHashableContent :: (HasConfig env) => DepPackage -> RIO env Builder
depPackageHashableContent :: forall env. HasConfig env => DepPackage -> RIO env Builder
depPackageHashableContent DepPackage {Bool
PackageLocation
FromSnapshot
CommonPackage
dpFromSnapshot :: DepPackage -> FromSnapshot
dpHidden :: DepPackage -> Bool
dpFromSnapshot :: FromSnapshot
dpHidden :: Bool
dpLocation :: PackageLocation
dpCommon :: CommonPackage
dpCommon :: DepPackage -> CommonPackage
dpLocation :: DepPackage -> PackageLocation
..} = do
    case PackageLocation
dpLocation of
        PLMutable ResolvedPath Dir
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
""
        PLImmutable PackageLocationImmutable
pli -> do
            let flagToBs :: (FlagName, Bool) -> a
flagToBs (FlagName
f, Bool
enabled) =
                    if Bool
enabled
                        then a
""
                        else a
"-" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (FlagName -> String
C.unFlagName FlagName
f)
                flags :: [Utf8Builder]
flags = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (IsString a, Semigroup a) => (FlagName, Bool) -> a
flagToBs forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList (CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
dpCommon)
                ghcOptions :: [Utf8Builder]
ghcOptions = forall a b. (a -> b) -> [a] -> [b]
map forall a. Display a => a -> Utf8Builder
display (CommonPackage -> [Text]
cpGhcOptions CommonPackage
dpCommon)
                cabalConfigOpts :: [Utf8Builder]
cabalConfigOpts = forall a b. (a -> b) -> [a] -> [b]
map forall a. Display a => a -> Utf8Builder
display (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
dpCommon)
                haddocks :: Builder
haddocks = if CommonPackage -> Bool
cpHaddocks CommonPackage
dpCommon then Builder
"haddocks" else Builder
""
                hash :: Builder
hash = PackageLocationImmutable -> Builder
immutableLocSha PackageLocationImmutable
pli
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Builder
hash forall a. Semigroup a => a -> a -> a
<> Builder
haddocks forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder (forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
flags) forall a. Semigroup a => a -> a -> a
<>
                Utf8Builder -> Builder
getUtf8Builder (forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
ghcOptions) forall a. Semigroup a => a -> a -> a
<>
                Utf8Builder -> Builder
getUtf8Builder (forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
cabalConfigOpts)

-- | All flags for a local package.

getLocalFlags
    :: BuildOptsCLI
    -> PackageName
    -> Map FlagName Bool
getLocalFlags :: BuildOptsCLI -> PackageName -> Map FlagName Bool
getLocalFlags BuildOptsCLI
boptsCli PackageName
name = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
    [ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty (PackageName -> ApplyCLIFlag
ACFByName PackageName
name) Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
    , forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty ApplyCLIFlag
ACFAllProjectPackages Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
    ]
  where
    cliFlags :: Map ApplyCLIFlag (Map FlagName Bool)
cliFlags = BuildOptsCLI -> Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags BuildOptsCLI
boptsCli

-- | 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKEverything (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
    , if Bool
isLocal
        then forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKLocals (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
        else []
    , if Bool
isTarget
        then forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKTargets (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
        else []
    , forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (PackageName -> CabalConfigKey
CCKPackage PackageName
name) (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
    ]
  where
    config :: Config
config = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL BuildConfig
bconfig

-- | 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOEverything (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
    , if Bool
isLocal
        then forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOLocals (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
        else []
    , if Bool
isTarget
        then forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOTargets (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
        else []
    , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text
"-fhpc"] | Bool
isLocal Bool -> Bool -> Bool
&& TestOpts -> Bool
toCoverage (BuildOpts -> TestOpts
boptsTestOpts BuildOpts
bopts)]
    , if BuildOpts -> Bool
boptsLibProfile BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeProfile BuildOpts
bopts
         then [Text
"-fprof-auto",Text
"-fprof-cafs"]
         else []
    , if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
boptsLibStrip BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeStrip BuildOpts
bopts
         then [Text
"-g"]
         else []
    , if Bool
includeExtraOptions
         then BuildOptsCLI -> [Text]
boptsCLIGhcOptions BuildOptsCLI
boptsCli
         else []
    ]
  where
    bopts :: BuildOpts
bopts = Config -> BuildOpts
configBuild Config
config
    config :: Config
config = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL BuildConfig
bconfig
    includeExtraOptions :: Bool
includeExtraOptions =
        case Config -> ApplyGhcOptions
configApplyGhcOptions Config
config of
            ApplyGhcOptions
AGOTargets -> Bool
isTarget
            ApplyGhcOptions
AGOLocals -> Bool
isLocal
            ApplyGhcOptions
AGOEverything -> Bool
True

splitComponents :: [NamedComponent]
                -> (Set Text, Set Text, Set Text)
splitComponents :: [NamedComponent] -> (Set Text, Set Text, Set Text)
splitComponents =
    forall {a} {a} {a}.
(Ord a, Ord a, Ord a) =>
([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id
  where
    go :: ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c [] = (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
a [], forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
b [], forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
c [])
    go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (NamedComponent
CLib:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
    go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CInternalLib Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go ([Text] -> [a]
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xforall a. a -> [a] -> [a]
:)) [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
    go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CExe Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go ([Text] -> [a]
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xforall a. a -> [a] -> [a]
:)) [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
    go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CTest Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a ([Text] -> [a]
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xforall a. a -> [a] -> [a]
:)) [Text] -> [a]
c [NamedComponent]
xs
    go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CBench Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b ([Text] -> [a]
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xforall a. a -> [a] -> [a]
:)) [NamedComponent]
xs

loadCommonPackage ::
       forall env. (HasBuildConfig env, HasSourceMap env)
    => CommonPackage
    -> RIO env Package
loadCommonPackage :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
CommonPackage -> RIO env Package
loadCommonPackage CommonPackage
common = do
    PackageConfig
config <- forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig (CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common) (CommonPackage -> [Text]
cpGhcOptions CommonPackage
common) (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common)
    GenericPackageDescription
gpkg <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD CommonPackage
common
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg

-- | 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 :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage ProjectPackage
pp = do
    SourceMap
sm <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => Lens' env SourceMap
sourceMapL
    let common :: CommonPackage
common = ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp
    BuildOpts
bopts <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
    Maybe Curator
mcurator <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to BuildConfig -> Maybe Curator
bcCurator
    PackageConfig
config <- forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig (CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common) (CommonPackage -> [Text]
cpGhcOptions CommonPackage
common) (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common)
    GenericPackageDescription
gpkg <- forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m GenericPackageDescription
ppGPD ProjectPackage
pp
    let name :: PackageName
name = CommonPackage -> PackageName
cpName CommonPackage
common
        mtarget :: Maybe Target
mtarget = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name (SMTargets -> Map PackageName Target
smtTargets forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sm)
        (Set Text
exeCandidates, Set Text
testCandidates, Set Text
benchCandidates) =
            case Maybe Target
mtarget of
                Just (TargetComps Set NamedComponent
comps) -> [NamedComponent] -> (Set Text, Set Text, Set Text)
splitComponents forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set NamedComponent
comps
                Just (TargetAll PackageType
_packageType) ->
                    ( Package -> Set Text
packageExes Package
pkg
                    , if BuildOpts -> Bool
boptsTests BuildOpts
bopts Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curator -> Set PackageName
curatorSkipTest) Maybe Curator
mcurator
                        then forall k a. Map k a -> Set k
Map.keysSet (Package -> Map Text TestSuiteInterface
packageTests Package
pkg)
                        else forall a. Set a
Set.empty
                    , if BuildOpts -> Bool
boptsBenchmarks BuildOpts
bopts Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curator -> Set PackageName
curatorSkipBenchmark) Maybe Curator
mcurator
                        then Package -> Set Text
packageBenchmarks Package
pkg
                        else forall a. Set a
Set.empty
                    )
                Maybe Target
Nothing -> forall a. Monoid a => a
mempty

        -- 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 (forall a. Set a -> Bool
Set.null Set NamedComponent
nonLibComponents)
               Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Set a -> Bool
Set.null forall a b. (a -> b) -> a -> b
$ Package -> Set Text
packageInternalLibraries Package
pkg)

        filterSkippedComponents :: Set Text -> Set Text
filterSkippedComponents = forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildOpts -> [Text]
boptsSkipComponents BuildOpts
bopts))

        (Set Text
exes, Set Text
tests, Set Text
benches) = (Set Text -> Set Text
filterSkippedComponents Set Text
exeCandidates,
                                  Set Text -> Set Text
filterSkippedComponents Set Text
testCandidates,
                                  Set Text -> Set Text
filterSkippedComponents Set Text
benchCandidates)

        nonLibComponents :: Set NamedComponent
nonLibComponents = Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents Set Text
exes Set Text
tests Set Text
benches

        toComponents :: Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents Set Text
e Set Text
t Set Text
b = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
            [ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CExe Set Text
e
            , forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CTest Set Text
t
            , forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CBench Set Text
b
            ]

        btconfig :: PackageConfig
btconfig = PackageConfig
config
            { packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
Set.null Set Text
tests
            , packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
Set.null Set Text
benches
            }

        -- We resolve the package in 2 different configurations:

        --

        -- - pkg doesn't have tests or benchmarks enabled.

        --

        -- - btpkg has them enabled if they are present.

        --

        -- 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
            | forall a. Set a -> Bool
Set.null Set Text
tests Bool -> Bool -> Bool
&& forall a. Set a -> Bool
Set.null Set Text
benches = forall a. Maybe a
Nothing
            | Bool
otherwise = forall a. a -> Maybe a
Just (PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
btconfig GenericPackageDescription
gpkg)

    MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles <- forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
     env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg (ProjectPackage -> Path Abs File
ppCabalFP ProjectPackage
pp) Set NamedComponent
nonLibComponents

    MemoizedWith
  EnvConfig
  [(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults <- forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith forall a b. (a -> b) -> a -> b
$ do
      Map NamedComponent (Set (Path Abs File))
componentFiles' <- forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
Map.toList Map NamedComponent (Set (Path Abs File))
componentFiles') forall a b. (a -> b) -> a -> b
$ \(NamedComponent
component, Set (Path Abs File)
files) -> do
        Maybe (Map String FileCacheInfo)
mbuildCache <- forall env.
HasEnvConfig env =>
Path Abs Dir
-> NamedComponent -> RIO env (Maybe (Map String FileCacheInfo))
tryGetBuildCache (ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp) NamedComponent
component
        (Set String, Map String FileCacheInfo)
checkCacheResult <- forall (m :: * -> *).
MonadIO m =>
Map String FileCacheInfo
-> [Path Abs File] -> m (Set String, Map String FileCacheInfo)
checkBuildCache
            (forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
Map.empty Maybe (Map String FileCacheInfo)
mbuildCache)
            (forall a. Set a -> [a]
Set.toList Set (Path Abs File)
files)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedComponent
component, (Set String, Map String FileCacheInfo)
checkCacheResult)

    let dirtyFiles :: MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles = do
          [(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults' <- MemoizedWith
  EnvConfig
  [(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults
          let allDirtyFiles :: Set String
allDirtyFiles = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(NamedComponent
_, (Set String
x, Map String FileCacheInfo
_)) -> Set String
x) [(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults'
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            if Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set String
allDirtyFiles)
                then let tryStripPrefix :: String -> String
tryStripPrefix String
y =
                          forall a. a -> Maybe a -> a
fromMaybe String
y (forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix (forall b t. Path b t -> String
toFilePath forall a b. (a -> b) -> a -> b
$ ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp) String
y)
                      in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map String -> String
tryStripPrefix Set String
allDirtyFiles
                else forall a. Maybe a
Nothing
        newBuildCaches :: MemoizedWith
  EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches =
            forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(NamedComponent
c, (Set String
_, Map String FileCacheInfo
cache)) -> (NamedComponent
c, Map String FileCacheInfo
cache))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoizedWith
  EnvConfig
  [(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults

    forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalPackage
        { lpPackage :: Package
lpPackage = Package
pkg
        , lpTestBench :: Maybe Package
lpTestBench = Maybe Package
btpkg
        , lpComponentFiles :: MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
lpComponentFiles = MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles
        , lpBuildHaddocks :: Bool
lpBuildHaddocks = CommonPackage -> Bool
cpHaddocks (ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp)
        , lpForceDirty :: Bool
lpForceDirty = BuildOpts -> Bool
boptsForceDirty BuildOpts
bopts
        , lpDirtyFiles :: MemoizedWith EnvConfig (Maybe (Set String))
lpDirtyFiles = MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles
        , lpNewBuildCaches :: MemoizedWith
  EnvConfig (Map NamedComponent (Map String FileCacheInfo))
lpNewBuildCaches = MemoizedWith
  EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches
        , lpCabalFile :: Path Abs File
lpCabalFile = ProjectPackage -> Path Abs File
ppCabalFP ProjectPackage
pp
        , lpWanted :: Bool
lpWanted = Bool
isWanted
        , lpComponents :: Set NamedComponent
lpComponents = Set NamedComponent
nonLibComponents
        -- 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 forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set Text
packageExes Package
pkg)
            (Set Text
tests forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` forall k a. Map k a -> Set k
Map.keysSet (Package -> Map Text TestSuiteInterface
packageTests Package
pkg))
            (Set Text
benches forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set Text
packageBenchmarks Package
pkg)
        }

-- | 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 :: forall (m :: * -> *).
MonadIO m =>
Map String FileCacheInfo
-> [Path Abs File] -> m (Set String, Map String FileCacheInfo)
checkBuildCache Map String FileCacheInfo
oldCache [Path Abs File]
files = do
    Map String (Maybe SHA256)
fileTimes <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Abs File]
files forall a b. (a -> b) -> a -> b
$ \Path Abs File
fp -> do
        Maybe SHA256
mdigest <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *). MonadIO m => String -> m (Maybe SHA256)
getFileDigestMaybe (forall b t. Path b t -> String
toFilePath Path Abs File
fp))
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b t. Path b t -> String
toFilePath Path Abs File
fp, Maybe SHA256
mdigest)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
        forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey
            (\String
fp Maybe SHA256
mdigest FileCacheInfo
fci -> forall a. a -> Maybe a
Just (String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest (forall a. a -> Maybe a
Just FileCacheInfo
fci)))
            (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\String
fp Maybe SHA256
mdigest -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest forall a. Maybe a
Nothing))
            (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\String
fp FileCacheInfo
fci -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just FileCacheInfo
fci)))
            Map String (Maybe SHA256)
fileTimes
            Map String FileCacheInfo
oldCache
  where
    go :: FilePath -> Maybe SHA256 -> Maybe FileCacheInfo -> m (Set FilePath, Map FilePath FileCacheInfo)
    -- 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 forall a. Eq a => a -> a -> Bool
== String
"cabal_macros.h" = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
Set.empty, forall k a. Map k a
Map.empty)
    -- 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 forall a. Eq a => a -> a -> Bool
== SHA256
digest' = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
Set.empty, forall k a. k -> a -> Map k a
Map.singleton String
fp FileCacheInfo
fci)
        | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
Set.singleton String
fp, forall k a. k -> a -> Map k a
Map.singleton String
fp forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest')
    -- Missing file. Add it to dirty files, but no FileCacheInfo.

    go String
fp Maybe SHA256
Nothing Maybe FileCacheInfo
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
Set.singleton String
fp, forall k a. Map k a
Map.empty)
    -- Missing cache. Add it to dirty files and compute FileCacheInfo.

    go String
fp (Just SHA256
digest') Maybe FileCacheInfo
Nothing =
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
Set.singleton String
fp, forall k a. k -> a -> Map k a
Map.singleton String
fp forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest')

-- | 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 :: forall env a.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> Map NamedComponent (Map String a)
-> RIO
     env
     (Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
addUnlistedToBuildCache Package
pkg Path Abs File
cabalFP Set NamedComponent
nonLibComponents Map NamedComponent (Map String a)
buildCaches = do
    (Map NamedComponent (Set (Path Abs File))
componentFiles, [PackageWarning]
warnings) <- forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
     env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg Path Abs File
cabalFP Set NamedComponent
nonLibComponents
    [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
M.toList Map NamedComponent (Set (Path Abs File))
componentFiles) forall a b. (a -> b) -> a -> b
$ \(NamedComponent
component, Set (Path Abs File)
files) -> do
        let buildCache :: Map String a
buildCache = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall k a. Map k a
M.empty NamedComponent
component Map NamedComponent (Map String a)
buildCaches
            newFiles :: [String]
newFiles =
                forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$
                forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall b t. Path b t -> String
toFilePath Set (Path Abs File)
files forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` forall k a. Map k a -> Set k
Map.keysSet Map String a
buildCache
        [Map String FileCacheInfo]
addBuildCache <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
MonadIO m =>
String -> m (Map String FileCacheInfo)
addFileToCache [String]
newFiles
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ((NamedComponent
component, [Map String FileCacheInfo]
addBuildCache), [PackageWarning]
warnings)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results), forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results)
  where
    addFileToCache :: String -> m (Map String FileCacheInfo)
addFileToCache String
fp = do
        Maybe SHA256
mdigest <- forall (m :: * -> *). MonadIO m => String -> m (Maybe SHA256)
getFileDigestMaybe String
fp
        case Maybe SHA256
mdigest of
            Maybe SHA256
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
            Just SHA256
digest' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. k -> a -> Map k a
Map.singleton String
fp forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest'

-- | 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 :: forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
     env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg Path Abs File
cabalFP Set NamedComponent
nonLibComponents = do
    (Map NamedComponent (Map ModuleName (Path Abs File))
components',Map NamedComponent [DotCabalPath]
compFiles,Set (Path Abs File)
otherFiles,[PackageWarning]
warnings) <-
        GetPackageFiles
-> forall env.
   HasEnvConfig env =>
   Path Abs File
   -> RIO
        env
        (Map NamedComponent (Map ModuleName (Path Abs File)),
         Map NamedComponent [DotCabalPath], Set (Path Abs File),
         [PackageWarning])
getPackageFiles (Package -> GetPackageFiles
packageFiles Package
pkg) Path Abs File
cabalFP
    let necessaryComponents :: Set NamedComponent
necessaryComponents = forall a. Ord a => a -> Set a -> Set a
Set.insert NamedComponent
CLib forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Set a -> Set a
Set.filter NamedComponent -> Bool
isCInternalLib (forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
components')
        components :: Set NamedComponent
components = Set NamedComponent
necessaryComponents forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set NamedComponent
nonLibComponents
        componentsFiles :: Map NamedComponent (Set (Path Abs File))
componentsFiles =
            forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\[DotCabalPath]
files -> forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Path Abs File)
otherFiles (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map DotCabalPath -> Path Abs File
dotCabalGetPath forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [DotCabalPath]
files)) forall a b. (a -> b) -> a -> b
$
                forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\NamedComponent
component [DotCabalPath]
_ -> NamedComponent
component forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set NamedComponent
components) Map NamedComponent [DotCabalPath]
compFiles
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NamedComponent (Set (Path Abs File))
componentsFiles, [PackageWarning]
warnings)

-- | Get file digest, if it exists

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

-- | 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 :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig Map FlagName Bool
flags [Text]
ghcOptions [Text]
cabalConfigOpts = do
  Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
  ActualCompiler
compilerVersion <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
  forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageConfig
    { packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
False
    , packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
False
    , packageConfigFlags :: Map FlagName Bool
packageConfigFlags = Map FlagName Bool
flags
    , packageConfigGhcOptions :: [Text]
packageConfigGhcOptions = [Text]
ghcOptions
    , packageConfigCabalConfigOpts :: [Text]
packageConfigCabalConfigOpts = [Text]
cabalConfigOpts
    , packageConfigCompilerVersion :: ActualCompiler
packageConfigCompilerVersion = ActualCompiler
compilerVersion
    , packageConfigPlatform :: Platform
packageConfigPlatform = Platform
platform
    }