{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}

-- Load information on package sources

module Stack.Build.Source
  ( projectLocalPackages
  , localDependencies
  , loadCommonPackage
  , loadLocalPackage
  , loadSourceMap
  , getLocalFlags
  , addUnlistedToBuildCache
  , hashSourceMapData
  ) where

import           Data.ByteString.Builder ( toLazyByteString )
import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Map.Merge.Lazy as Map
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import qualified Distribution.PackageDescription as C
import qualified Pantry.SHA256 as SHA256
import           Stack.Build.Cache ( tryGetBuildCache )
import           Stack.Build.Haddock ( shouldHaddockDeps )
import           Stack.Package ( resolvePackage )
import           Stack.Prelude
import           Stack.SourceMap
                   ( DumpedGlobalPackage, checkFlagsUsedThrowing
                   , getCompilerInfo, immutableLocSha, mkProjectPackage
                   , pruneGlobals
                   )
import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
import           Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
import           Stack.Types.BuildConfig
                   ( BuildConfig (..), HasBuildConfig (..) )
import           Stack.Types.BuildOpts
                   ( ApplyCLIFlag (..), BuildOpts (..), BuildOptsCLI (..)
                   , TestOpts (..), boptsCLIAllProgOptions
                   )
import           Stack.Types.CabalConfigKey ( CabalConfigKey (..) )
import           Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath )
import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
import           Stack.Types.Curator ( Curator (..) )
import           Stack.Types.EnvConfig
                   ( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..)
                   , actualCompilerVersionL
                   )
import           Stack.Types.FileDigestCache ( readFileDigest )
import           Stack.Types.NamedComponent
                   ( NamedComponent (..), isCInternalLib )
import           Stack.Types.Package
                   ( FileCacheInfo (..), LocalPackage (..), Package (..)
                   , PackageConfig (..), PackageLibraries (..)
                   , dotCabalGetPath, memoizeRefWith, runMemoizedWith
                   )
import           Stack.Types.PackageFile ( PackageWarning, getPackageFiles )
import           Stack.Types.Platform ( HasPlatform (..) )
import           Stack.Types.SourceMap
                   ( CommonPackage (..), DepPackage (..), ProjectPackage (..)
                   , SMActual (..), SMTargets (..), SourceMap (..)
                   , SourceMapHash (..), Target (..), ppGPD, ppRoot
                   )
import           Stack.Types.UnusedFlags ( FlagSource (..) )
import           System.FilePath ( takeFileName )
import           System.IO.Error ( isDoesNotExistError )

-- | loads and returns project packages

projectLocalPackages :: HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages :: forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages = do
  SourceMap
sm <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMap env SourceMap -> RIO env SourceMap)
-> Getting SourceMap env SourceMap -> RIO env SourceMap
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL((EnvConfig -> Const SourceMap EnvConfig)
 -> env -> Const SourceMap env)
-> ((SourceMap -> Const SourceMap SourceMap)
    -> EnvConfig -> Const SourceMap EnvConfig)
-> Getting SourceMap env SourceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> SourceMap) -> SimpleGetter EnvConfig SourceMap
forall s a. (s -> a) -> SimpleGetter s a
to 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 a. Map PackageName a -> [a]
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 :: forall env. HasEnvConfig env => RIO env [LocalPackage]
localDependencies = do
  BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting BuildOpts env BuildOpts -> RIO env BuildOpts)
-> Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall a b. (a -> b) -> a -> b
$ (Config -> Const BuildOpts Config) -> env -> Const BuildOpts env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL((Config -> Const BuildOpts Config) -> env -> Const BuildOpts env)
-> ((BuildOpts -> Const BuildOpts BuildOpts)
    -> Config -> Const BuildOpts Config)
-> Getting BuildOpts env BuildOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> BuildOpts) -> SimpleGetter Config BuildOpts
forall s a. (s -> a) -> SimpleGetter s a
to 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
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 a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: forall env.
HasBuildConfig env =>
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
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
-> BuildOptsCLI -> PackageName -> Bool -> Bool -> [Text]
generalCabalConfigOpts BuildConfig
bconfig BuildOptsCLI
boptsCli (CommonPackage -> PackageName
cpName CommonPackage
common) Bool
isTarget Bool
isProjectPackage
        in  CommonPackage
common
              { cpFlags :: Map FlagName Bool
cpFlags =
                  if 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 a. a -> RIO env a
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 (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
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 = (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 a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceMapHash -> RIO env SourceMapHash)
-> SourceMapHash -> RIO env SourceMapHash
forall a b. (a -> b) -> a -> b
$ SHA256 -> SourceMapHash
SourceMapHash (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
dpLocation :: DepPackage -> PackageLocation
dpCommon :: DepPackage -> CommonPackage
dpCommon :: CommonPackage
dpLocation :: PackageLocation
dpHidden :: Bool
dpFromSnapshot :: FromSnapshot
dpHidden :: DepPackage -> Bool
dpFromSnapshot :: DepPackage -> FromSnapshot
..} =
  case PackageLocation
dpLocation of
    PLMutable ResolvedPath Dir
_ -> Builder -> RIO env Builder
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
""
    PLImmutable PackageLocationImmutable
pli -> do
      let flagToBs :: (FlagName, Bool) -> a
flagToBs (FlagName
f, Bool
enabled) =
            if Bool
enabled
              then a
""
              else a
"-" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> a
forall a. IsString a => String -> a
fromString (FlagName -> String
C.unFlagName FlagName
f)
          flags :: [Utf8Builder]
flags = ((FlagName, Bool) -> Utf8Builder)
-> [(FlagName, Bool)] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map (FlagName, Bool) -> Utf8Builder
forall {a}. (IsString a, Semigroup a) => (FlagName, Bool) -> a
flagToBs ([(FlagName, Bool)] -> [Utf8Builder])
-> [(FlagName, Bool)] -> [Utf8Builder]
forall a b. (a -> b) -> a -> b
$ Map FlagName Bool -> [(FlagName, Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList (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 a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Builder -> RIO env Builder) -> Builder -> RIO env Builder
forall a b. (a -> b) -> a -> b
$  Builder
hash
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
haddocks
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
flags)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
ghcOptions)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
cabalConfigOpts)

-- | 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@

generalCabalConfigOpts ::
     BuildConfig
  -> BuildOptsCLI
  -> PackageName
  -> Bool
  -> Bool
  -> [Text]
generalCabalConfigOpts :: BuildConfig
-> BuildOptsCLI -> PackageName -> Bool -> Bool -> [Text]
generalCabalConfigOpts BuildConfig
bconfig BuildOptsCLI
boptsCli PackageName
name Bool
isTarget Bool
isLocal = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKEverything (Config -> 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)
  , if Bool
includeExtraOptions
      then BuildOptsCLI -> [Text]
boptsCLIAllProgOptions BuildOptsCLI
boptsCli
      else []
  ]
 where
  config :: Config
config = Getting Config BuildConfig Config -> BuildConfig -> Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config BuildConfig Config
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL BuildConfig
bconfig
  includeExtraOptions :: Bool
includeExtraOptions =
    case Config -> ApplyProgOptions
configApplyProgOptions Config
config of
      ApplyProgOptions
APOTargets -> Bool
isTarget
      ApplyProgOptions
APOLocals -> Bool
isLocal
      ApplyProgOptions
APOEverything -> Bool
True

-- | 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 []
  , [ Text
"-g" | 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 ]
  , 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
Lens' BuildConfig 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
x:)) [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
  go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CExe Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go ([Text] -> [a]
a ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
x:)) [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
  go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CTest Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a ([Text] -> [a]
b ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
x:)) [Text] -> [a]
c [NamedComponent]
xs
  go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c (CBench Text
x:[NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b ([Text] -> [a]
c ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
x:)) [NamedComponent]
xs

loadCommonPackage ::
     forall env. (HasBuildConfig env, HasSourceMap env)
  => CommonPackage
  -> RIO env Package
loadCommonPackage :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
CommonPackage -> RIO env Package
loadCommonPackage CommonPackage
common = do
  PackageConfig
config <-
    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 a. IO a -> RIO env a
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 a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> RIO env Package) -> Package -> RIO env Package
forall a b. (a -> b) -> a -> b
$ PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg

-- | 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 <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceMap env SourceMap
forall env. HasSourceMap env => Lens' env SourceMap
Lens' env SourceMap
sourceMapL
  let common :: CommonPackage
common = ProjectPackage -> 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
Lens' env BuildOpts
buildOptsL
  Maybe Curator
mcurator <- Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe Curator) env (Maybe Curator)
 -> RIO env (Maybe Curator))
-> Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator)
forall a b. (a -> b) -> a -> b
$ (BuildConfig -> Const (Maybe Curator) BuildConfig)
-> env -> Const (Maybe Curator) env
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL((BuildConfig -> Const (Maybe Curator) BuildConfig)
 -> env -> Const (Maybe Curator) env)
-> ((Maybe Curator -> Const (Maybe Curator) (Maybe Curator))
    -> BuildConfig -> Const (Maybe Curator) BuildConfig)
-> Getting (Maybe Curator) env (Maybe Curator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BuildConfig -> Maybe Curator)
-> SimpleGetter BuildConfig (Maybe Curator)
forall s a. (s -> a) -> SimpleGetter s a
to 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 a. Eq a => a -> [a] -> 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
        }

      -- 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
        | 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)

  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 env.
HasEnvConfig env =>
Map String FileCacheInfo
-> [Path Abs File]
-> RIO env (Set String, Map String FileCacheInfo)
checkBuildCache
        (Map String FileCacheInfo
-> Maybe (Map String FileCacheInfo) -> Map String FileCacheInfo
forall a. a -> Maybe a -> a
fromMaybe Map String FileCacheInfo
forall k a. Map k a
Map.empty Maybe (Map String FileCacheInfo)
mbuildCache)
        (Set (Path Abs File) -> [Path Abs File]
forall a. Set a -> [a]
Set.toList Set (Path Abs File)
files)
      (NamedComponent, (Set String, Map String FileCacheInfo))
-> RIO
     EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo))
forall a. a -> RIO EnvConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedComponent
component, (Set String, Map String FileCacheInfo)
checkCacheResult)

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

  LocalPackage -> RIO env LocalPackage
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalPackage
    { 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 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 ::
     HasEnvConfig env
  => Map FilePath FileCacheInfo -- ^ old cache

  -> [Path Abs File] -- ^ files in package

  -> RIO env (Set FilePath, Map FilePath FileCacheInfo)
checkBuildCache :: forall env.
HasEnvConfig env =>
Map String FileCacheInfo
-> [Path Abs File]
-> RIO env (Set String, Map String FileCacheInfo)
checkBuildCache Map String FileCacheInfo
oldCache [Path Abs File]
files = do
  Map String (Maybe SHA256)
fileDigests <- ([(String, Maybe SHA256)] -> Map String (Maybe SHA256))
-> RIO env [(String, Maybe SHA256)]
-> RIO env (Map String (Maybe SHA256))
forall a b. (a -> b) -> RIO env a -> RIO env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, Maybe SHA256)] -> Map String (Maybe SHA256)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (RIO env [(String, Maybe SHA256)]
 -> RIO env (Map String (Maybe SHA256)))
-> RIO env [(String, Maybe SHA256)]
-> RIO env (Map String (Maybe SHA256))
forall a b. (a -> b) -> a -> b
$ [Path Abs File]
-> (Path Abs File -> RIO env (String, Maybe SHA256))
-> RIO env [(String, Maybe SHA256)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Abs File]
files ((Path Abs File -> RIO env (String, Maybe SHA256))
 -> RIO env [(String, Maybe SHA256)])
-> (Path Abs File -> RIO env (String, Maybe SHA256))
-> RIO env [(String, Maybe SHA256)]
forall a b. (a -> b) -> a -> b
$ \Path Abs File
fp -> do
    Maybe SHA256
mdigest <- String -> RIO env (Maybe SHA256)
forall env. HasEnvConfig env => String -> RIO env (Maybe SHA256)
getFileDigestMaybe (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp)
    (String, Maybe SHA256) -> RIO env (String, Maybe SHA256)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp, Maybe SHA256
mdigest)
  (Map String (Set String, Map String FileCacheInfo)
 -> (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo))
-> RIO env (Set String, Map String FileCacheInfo)
forall a b. (a -> b) -> RIO env a -> RIO env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Set String, Map String FileCacheInfo)]
-> (Set String, Map String FileCacheInfo)
forall a. Monoid a => [a] -> a
mconcat ([(Set String, Map String FileCacheInfo)]
 -> (Set String, Map String FileCacheInfo))
-> (Map String (Set String, Map String FileCacheInfo)
    -> [(Set String, Map String FileCacheInfo)])
-> Map String (Set String, Map String FileCacheInfo)
-> (Set String, Map String FileCacheInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Set String, Map String FileCacheInfo)
-> [(Set String, Map String FileCacheInfo)]
forall k a. Map k a -> [a]
Map.elems) (RIO env (Map String (Set String, Map String FileCacheInfo))
 -> RIO env (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo))
-> RIO env (Set String, Map String FileCacheInfo)
forall a b. (a -> b) -> a -> b
$ Map String (RIO env (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Map String (m a) -> m (Map String a)
sequence (Map String (RIO env (Set String, Map String FileCacheInfo))
 -> RIO env (Map String (Set String, Map String FileCacheInfo)))
-> Map String (RIO env (Set String, Map String FileCacheInfo))
-> RIO env (Map String (Set String, Map String FileCacheInfo))
forall a b. (a -> b) -> a -> b
$
    SimpleWhenMissing
  String
  (Maybe SHA256)
  (RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMissing
     String
     FileCacheInfo
     (RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMatched
     String
     (Maybe SHA256)
     FileCacheInfo
     (RIO env (Set String, Map String FileCacheInfo))
-> Map String (Maybe SHA256)
-> Map String FileCacheInfo
-> Map String (RIO env (Set String, Map String FileCacheInfo))
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
      ((String
 -> Maybe SHA256 -> RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMissing
     String
     (Maybe SHA256)
     (RIO env (Set String, Map String FileCacheInfo))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\String
fp Maybe SHA256
mdigest -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest Maybe FileCacheInfo
forall a. Maybe a
Nothing))
      ((String
 -> FileCacheInfo -> RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMissing
     String
     FileCacheInfo
     (RIO env (Set String, Map String FileCacheInfo))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\String
fp FileCacheInfo
fci -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
forall a. Maybe a
Nothing (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
      ((String
 -> Maybe SHA256
 -> FileCacheInfo
 -> RIO env (Set String, Map String FileCacheInfo))
-> SimpleWhenMatched
     String
     (Maybe SHA256)
     FileCacheInfo
     (RIO env (Set String, Map String FileCacheInfo))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\String
fp Maybe SHA256
mdigest FileCacheInfo
fci -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
mdigest (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
      Map String (Maybe SHA256)
fileDigests
      Map String FileCacheInfo
oldCache
 where
  go :: FilePath
     -> Maybe SHA256
     -> Maybe FileCacheInfo
     -> RIO env (Set FilePath, Map FilePath FileCacheInfo)
  -- Filter out the cabal_macros file to avoid spurious recompilations

  go :: forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, Map String FileCacheInfo)
go String
fp Maybe SHA256
_ Maybe FileCacheInfo
_ | String -> String
takeFileName String
fp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cabal_macros.h" = (Set String, Map String FileCacheInfo)
-> RIO env (Set String, Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set String
forall a. Set a
Set.empty, Map String FileCacheInfo
forall k a. Map k a
Map.empty)
  -- 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)
-> RIO env (Set String, Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set String
forall a. Set a
Set.empty, String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp FileCacheInfo
fci)
      | Bool
otherwise =
          (Set String, Map String FileCacheInfo)
-> RIO env (Set String, Map String FileCacheInfo)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Set String
forall a. a -> Set a
Set.singleton String
fp, String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> Map String FileCacheInfo)
-> FileCacheInfo -> Map String FileCacheInfo
forall a b. (a -> b) -> a -> b
$ SHA256 -> FileCacheInfo
FileCacheInfo SHA256
digest')
  -- Missing file. Add it to dirty files, but no FileCacheInfo.

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

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

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

-- | 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 =
        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 a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set NamedComponent
components) Map NamedComponent [DotCabalPath]
compFiles
  (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> RIO
     env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NamedComponent (Set (Path Abs File))
componentsFiles, [PackageWarning]
warnings)

-- | Get file digest, if it exists

getFileDigestMaybe :: HasEnvConfig env => FilePath -> RIO env (Maybe SHA256)
getFileDigestMaybe :: forall env. HasEnvConfig env => String -> RIO env (Maybe SHA256)
getFileDigestMaybe String
fp = do
  FileDigestCache
cache <- Getting FileDigestCache env FileDigestCache
-> RIO env FileDigestCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting FileDigestCache env FileDigestCache
 -> RIO env FileDigestCache)
-> Getting FileDigestCache env FileDigestCache
-> RIO env FileDigestCache
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const FileDigestCache EnvConfig)
-> env -> Const FileDigestCache env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL((EnvConfig -> Const FileDigestCache EnvConfig)
 -> env -> Const FileDigestCache env)
-> ((FileDigestCache -> Const FileDigestCache FileDigestCache)
    -> EnvConfig -> Const FileDigestCache EnvConfig)
-> Getting FileDigestCache env FileDigestCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> FileDigestCache)
-> SimpleGetter EnvConfig FileDigestCache
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> FileDigestCache
envConfigFileDigestCache
  RIO env (Maybe SHA256)
-> (IOError -> RIO env (Maybe SHA256)) -> RIO env (Maybe SHA256)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
    (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (SHA256 -> Maybe SHA256)
-> RIO env SHA256 -> RIO env (Maybe SHA256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDigestCache -> String -> RIO env SHA256
forall (m :: * -> *).
MonadIO m =>
FileDigestCache -> String -> m SHA256
readFileDigest FileDigestCache
cache String
fp)
    (\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then Maybe SHA256 -> RIO env (Maybe SHA256)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SHA256
forall a. Maybe a
Nothing else IOError -> RIO env (Maybe SHA256)
forall e a. Exception e => e -> RIO env a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM IOError
e)

-- | 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 <- Getting Platform env Platform -> RIO env Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
Lens' env Platform
platformL
  ActualCompiler
compilerVersion <- Getting ActualCompiler env ActualCompiler -> RIO env ActualCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActualCompiler env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
SimpleGetter env ActualCompiler
actualCompilerVersionL
  PackageConfig -> RIO env PackageConfig
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageConfig
    { 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
    }