{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot   #-}
{-# LANGUAGE OverloadedStrings     #-}

{-|
Module      : Stack.Build.Source
Description : Load information on package sources.
License     : BSD-3-Clause

Load information on package sources.
-}

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

import           Data.ByteString.Builder ( toLazyByteString )
import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Map.Merge.Lazy as Map
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import qualified Distribution.PackageDescription as C
import qualified Pantry.SHA256 as SHA256
import           Stack.Build.Cache ( tryGetBuildCache )
import           Stack.Build.Haddock ( shouldHaddockDeps )
import           Stack.Package
                   ( buildableBenchmarks, buildableExes, buildableTestSuites
                   , hasBuildableMainLibrary, resolvePackage
                   )
import           Stack.PackageFile ( getPackageFile )
import           Stack.Prelude
import           Stack.SourceMap
                   ( getCompilerInfo, immutableLocSha, mkProjectPackage
                   , pruneGlobals
                   )
import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
import           Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
import           Stack.Types.Build.Exception ( BuildPrettyException (..) )
import           Stack.Types.BuildConfig
                   ( BuildConfig (..), HasBuildConfig (..) )
import           Stack.Types.BuildOpts ( BuildOpts (..), TestOpts (..) )
import           Stack.Types.BuildOptsCLI
                   ( ApplyCLIFlag (..), BuildOptsCLI (..)
                   , boptsCLIAllProgOptions
                   )
import           Stack.Types.CabalConfigKey ( CabalConfigKey (..) )
import           Stack.Types.Cache ( FileCache, FileCacheInfo (..) )
import           Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath )
import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
import           Stack.Types.Curator ( Curator (..) )
import           Stack.Types.DumpPackage ( DumpedGlobalPackage )
import           Stack.Types.EnvConfig
                   ( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..)
                   , actualCompilerVersionL
                   )
import           Stack.Types.FileDigestCache ( readFileDigest )
import           Stack.Types.NamedComponent
                   ( NamedComponent (..), isCSubLib, splitComponents )
import           Stack.Types.Package
                   ( LocalPackage (..), Package (..), PackageConfig (..)
                   , dotCabalGetPath, memoizeRefWith, runMemoizedWith
                   )
import           Stack.Types.PackageFile
                   ( PackageComponentFile (..), PackageWarning )
import           Stack.Types.Platform ( HasPlatform (..) )
import           Stack.Types.SourceMap
                   ( CommonPackage (..), DepPackage (..), ProjectPackage (..)
                   , SMActual (..), SMTargets (..), SourceMap (..)
                   , SourceMapHash (..), Target (..), ppRoot
                   )
import           Stack.Types.UnusedFlags ( FlagSource (..), UnusedFlags (..) )
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
  sm <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMap env SourceMap -> RIO env SourceMap)
-> Getting SourceMap env SourceMap -> RIO env SourceMap
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL ((EnvConfig -> Const SourceMap EnvConfig)
 -> env -> Const SourceMap env)
-> ((SourceMap -> Const SourceMap SourceMap)
    -> EnvConfig -> Const SourceMap EnvConfig)
-> Getting SourceMap env SourceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvConfig -> SourceMap) -> SimpleGetter EnvConfig SourceMap
forall s a. (s -> a) -> SimpleGetter s a
to (.sourceMap)
  for (toList sm.project) 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
  bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting BuildOpts env BuildOpts -> RIO env BuildOpts)
-> Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall a b. (a -> b) -> a -> b
$ (Config -> Const BuildOpts Config) -> env -> Const BuildOpts env
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL ((Config -> Const BuildOpts Config) -> env -> Const BuildOpts env)
-> ((BuildOpts -> Const BuildOpts BuildOpts)
    -> Config -> Const BuildOpts Config)
-> Getting BuildOpts env BuildOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> BuildOpts) -> SimpleGetter Config BuildOpts
forall s a. (s -> a) -> SimpleGetter s a
to (.build)
  sourceMap <- view $ envConfigL . to (.sourceMap)
  forMaybeM (Map.elems sourceMap.deps) $ \DepPackage
dp ->
    case DepPackage
dp.location of
      PLMutable ResolvedPath Dir
dir -> do
        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)
        Just <$> loadLocalPackage 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 ::
     forall env. HasBuildConfig env
  => SMTargets
  -> BuildOptsCLI
  -> SMActual DumpedGlobalPackage
  -> RIO env SourceMap
loadSourceMap :: forall env.
HasBuildConfig env =>
SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap SMTargets
targets BuildOptsCLI
boptsCli SMActual DumpedGlobalPackage
sma = do
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Applying and checking flags"
  let errsPackages :: [UnusedFlags]
errsPackages = (PackageName -> Maybe UnusedFlags)
-> [PackageName] -> [UnusedFlags]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PackageName -> Maybe UnusedFlags
checkPackage [PackageName]
packagesWithCliFlags
  eProject <- ((PackageName, ProjectPackage)
 -> RIO env (Either UnusedFlags (PackageName, ProjectPackage)))
-> [(PackageName, ProjectPackage)]
-> RIO env [Either UnusedFlags (PackageName, ProjectPackage)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PackageName, ProjectPackage)
-> RIO env (Either UnusedFlags (PackageName, ProjectPackage))
forall a.
(a, ProjectPackage)
-> RIO env (Either UnusedFlags (a, ProjectPackage))
applyOptsFlagsPP (Map PackageName ProjectPackage -> [(PackageName, ProjectPackage)]
forall k a. Map k a -> [(k, a)]
M.toList SMActual DumpedGlobalPackage
sma.project)
  eDeps <- mapM applyOptsFlagsDep (M.toList targetsAndSmaDeps)
  let (errsProject, project') = partitionEithers eProject
      (errsDeps, deps') = partitionEithers eDeps
      errs = [UnusedFlags]
errsPackages [UnusedFlags] -> [UnusedFlags] -> [UnusedFlags]
forall a. Semigroup a => a -> a -> a
<> [UnusedFlags]
errsProject [UnusedFlags] -> [UnusedFlags] -> [UnusedFlags]
forall a. Semigroup a => a -> a -> a
<> [UnusedFlags]
errsDeps
  unless (null errs) $ prettyThrowM $ InvalidFlagSpecification errs
  let compiler = SMActual DumpedGlobalPackage
sma.compiler
      project = [(PackageName, ProjectPackage)] -> Map PackageName ProjectPackage
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(PackageName, ProjectPackage)]
project'
      deps = [(PackageName, DepPackage)] -> Map PackageName DepPackage
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(PackageName, DepPackage)]
deps'
      globalPkgs = Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals SMActual DumpedGlobalPackage
sma.globals (Map PackageName DepPackage -> Set PackageName
forall k a. Map k a -> Set k
Map.keysSet Map PackageName DepPackage
deps)
  logDebug "SourceMap constructed"
  pure SourceMap
    { targets
    , compiler
    , project
    , deps
    , globalPkgs
    }
 where
  cliFlags :: Map ApplyCLIFlag (Map FlagName Bool)
cliFlags = BuildOptsCLI
boptsCli.flags
  targetsAndSmaDeps :: Map PackageName DepPackage
targetsAndSmaDeps = SMTargets
targets.deps Map PackageName DepPackage
-> Map PackageName DepPackage -> Map PackageName DepPackage
forall a. Semigroup a => a -> a -> a
<> SMActual DumpedGlobalPackage
sma.deps
  packagesWithCliFlags :: [PackageName]
packagesWithCliFlags = ((ApplyCLIFlag, Map FlagName Bool) -> Maybe PackageName)
-> [(ApplyCLIFlag, Map FlagName Bool)] -> [PackageName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ApplyCLIFlag, Map FlagName Bool) -> Maybe PackageName
forall {b}. (ApplyCLIFlag, b) -> Maybe PackageName
maybeProjectWithCliFlags ([(ApplyCLIFlag, Map FlagName Bool)] -> [PackageName])
-> [(ApplyCLIFlag, Map FlagName Bool)] -> [PackageName]
forall a b. (a -> b) -> a -> b
$ Map ApplyCLIFlag (Map FlagName Bool)
-> [(ApplyCLIFlag, Map FlagName Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
   where
    maybeProjectWithCliFlags :: (ApplyCLIFlag, b) -> Maybe PackageName
maybeProjectWithCliFlags (ACFByName PackageName
name, b
_) = PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just PackageName
name
    maybeProjectWithCliFlags (ApplyCLIFlag, b)
_ = Maybe PackageName
forall a. Maybe a
Nothing
  checkPackage :: PackageName -> Maybe UnusedFlags
  checkPackage :: PackageName -> Maybe UnusedFlags
checkPackage PackageName
name =
    let maybeCommon :: Maybe CommonPackage
maybeCommon =
              (ProjectPackage -> CommonPackage)
-> Maybe ProjectPackage -> Maybe CommonPackage
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.projectCommon) (PackageName
-> Map PackageName ProjectPackage -> Maybe ProjectPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name SMActual DumpedGlobalPackage
sma.project)
          Maybe CommonPackage -> Maybe CommonPackage -> Maybe CommonPackage
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (DepPackage -> CommonPackage)
-> Maybe DepPackage -> Maybe CommonPackage
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.depCommon) (PackageName -> Map PackageName DepPackage -> Maybe DepPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName DepPackage
targetsAndSmaDeps)
    in  Maybe UnusedFlags
-> (CommonPackage -> Maybe UnusedFlags)
-> Maybe CommonPackage
-> Maybe UnusedFlags
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (UnusedFlags -> Maybe UnusedFlags
forall a. a -> Maybe a
Just (UnusedFlags -> Maybe UnusedFlags)
-> UnusedFlags -> Maybe UnusedFlags
forall a b. (a -> b) -> a -> b
$ FlagSource -> PackageName -> UnusedFlags
UFNoPackage FlagSource
FSCommandLine PackageName
name)
          (Maybe UnusedFlags -> CommonPackage -> Maybe UnusedFlags
forall a b. a -> b -> a
const Maybe UnusedFlags
forall a. Maybe a
Nothing)
           Maybe CommonPackage
maybeCommon
  applyOptsFlagsPP ::
       (a, ProjectPackage)
    -> RIO env (Either UnusedFlags (a, ProjectPackage))
  applyOptsFlagsPP :: forall a.
(a, ProjectPackage)
-> RIO env (Either UnusedFlags (a, ProjectPackage))
applyOptsFlagsPP (a
name, p :: ProjectPackage
p@ProjectPackage{ projectCommon :: ProjectPackage -> CommonPackage
projectCommon = CommonPackage
common }) = do
    let isTarget :: Bool
isTarget = PackageName -> Map PackageName Target -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member CommonPackage
common.name SMTargets
targets.targets
    eCommon <- Bool
-> Bool
-> CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
applyOptsFlags Bool
isTarget Bool
True CommonPackage
common
    pure $ (\CommonPackage
common' -> (a
name, ProjectPackage
p { projectCommon = common' })) <$> eCommon
  applyOptsFlagsDep ::
       (a, DepPackage)
    -> RIO env (Either UnusedFlags (a, DepPackage))
  applyOptsFlagsDep :: forall a.
(a, DepPackage) -> RIO env (Either UnusedFlags (a, DepPackage))
applyOptsFlagsDep (a
name, d :: DepPackage
d@DepPackage{ depCommon :: DepPackage -> CommonPackage
depCommon = CommonPackage
common }) = do
    let isTarget :: Bool
isTarget = PackageName -> Map PackageName DepPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member CommonPackage
common.name SMTargets
targets.deps
    eCommon <- Bool
-> Bool
-> CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
applyOptsFlags Bool
isTarget Bool
False CommonPackage
common
    pure $ (\CommonPackage
common' -> (a
name, DepPackage
d { depCommon = common' })) <$> eCommon
  applyOptsFlags ::
       Bool
    -> Bool
    -> CommonPackage
    -> RIO env (Either UnusedFlags CommonPackage)
  applyOptsFlags :: Bool
-> Bool
-> CommonPackage
-> RIO env (Either UnusedFlags CommonPackage)
applyOptsFlags Bool
isTarget Bool
isProjectPackage CommonPackage
common = do
    let name :: PackageName
name = CommonPackage
common.name
        cliFlagsByName :: Map FlagName Bool
cliFlagsByName = Map FlagName Bool
-> ApplyCLIFlag
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Map FlagName Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map FlagName Bool
forall k a. Map k a
Map.empty (PackageName -> ApplyCLIFlag
ACFByName PackageName
name) Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
        cliFlagsAll :: Map FlagName Bool
cliFlagsAll =
          Map FlagName Bool
-> ApplyCLIFlag
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Map FlagName Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map FlagName Bool
forall k a. Map k a
Map.empty ApplyCLIFlag
ACFAllProjectPackages Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
        noOptsToApply :: Bool
noOptsToApply = Map FlagName Bool -> Bool
forall k a. Map k a -> Bool
Map.null Map FlagName Bool
cliFlagsByName Bool -> Bool -> Bool
&& Map FlagName Bool -> Bool
forall k a. Map k a -> Bool
Map.null Map FlagName Bool
cliFlagsAll
    (flags, unusedByName, pkgFlags) <- if Bool
noOptsToApply
      then
        (Map FlagName Bool, Set FlagName, Set FlagName)
-> RIO env (Map FlagName Bool, Set FlagName, Set FlagName)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FlagName Bool
forall k a. Map k a
Map.empty, Set FlagName
forall a. Set a
Set.empty, Set FlagName
forall a. Set a
Set.empty)
      else do
        gpd <-
          -- This action is expensive. We want to avoid it if we can.

          IO GenericPackageDescription -> RIO env GenericPackageDescription
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO CommonPackage
common.gpd
        let pkgFlags = [FlagName] -> Set FlagName
forall a. Ord a => [a] -> Set a
Set.fromList ([FlagName] -> Set FlagName) -> [FlagName] -> Set FlagName
forall a b. (a -> b) -> a -> b
$ (PackageFlag -> FlagName) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> FlagName
C.flagName ([PackageFlag] -> [FlagName]) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> [PackageFlag]
C.genPackageFlags GenericPackageDescription
gpd
            unusedByName = Map FlagName Bool -> Set FlagName
forall k a. Map k a -> Set k
Map.keysSet (Map FlagName Bool -> Set FlagName)
-> Map FlagName Bool -> Set FlagName
forall a b. (a -> b) -> a -> b
$ Map FlagName Bool -> Set FlagName -> Map FlagName Bool
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map FlagName Bool
cliFlagsByName Set FlagName
pkgFlags
            cliFlagsAllRelevant =
              (FlagName -> Bool -> Bool)
-> Map FlagName Bool -> Map FlagName Bool
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\FlagName
k Bool
_ -> FlagName
k FlagName -> Set FlagName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FlagName
pkgFlags) Map FlagName Bool
cliFlagsAll
            flags = Map FlagName Bool
cliFlagsByName Map FlagName Bool -> Map FlagName Bool -> Map FlagName Bool
forall a. Semigroup a => a -> a -> a
<> Map FlagName Bool
cliFlagsAllRelevant
        pure (flags, unusedByName, pkgFlags)
    if Set.null unusedByName
      -- All flags are defined, nothing to do

      then do
        bconfig <- view buildConfigL
        let bopts = BuildConfig
bconfig.config.build
            ghcOptions =
              BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bconfig BuildOptsCLI
boptsCli Bool
isTarget Bool
isProjectPackage
            cabalConfigOpts = BuildConfig
-> BuildOptsCLI -> PackageName -> Bool -> Bool -> [Text]
generalCabalConfigOpts
              BuildConfig
bconfig
              BuildOptsCLI
boptsCli
              PackageName
name
              Bool
isTarget
              Bool
isProjectPackage
        pure $ Right common
          { flags =
              if M.null flags
                then common.flags
                else flags
          , ghcOptions =
              ghcOptions ++ common.ghcOptions
          , cabalConfigOpts =
              cabalConfigOpts ++ common.cabalConfigOpts
          , buildHaddocks =
              if isTarget
                then bopts.buildHaddocks
                else shouldHaddockDeps bopts
          }
      -- Error about the undefined flags

      else
        pure $ Left $ UFFlagsNotDefined FSCommandLine name pkgFlags unusedByName

-- | Get a t'SourceMapHash' for a given t'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
  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
  compilerInfo <- getCompilerInfo
  immDeps <- forM (Map.elems sm.deps) depPackageHashableContent
  bc <- view buildConfigL
  let -- extra bytestring specifying GHC options supposed to be applied to GHC

      -- boot packages so we'll have different hashes when bare snapshot

      -- 'ghc-X.Y.Z' is used, no extra-deps and e.g. user wants builds with

      -- profiling or without

      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 =
           Builder -> LazyByteString
toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
forall a b. (a -> b) -> a -> b
$ Builder
compilerPath
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
compilerInfo
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
bootGhcOpts)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
immDeps
  pure $ SourceMapHash (SHA256.hashLazyBytes hashedContent)

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

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

-- | 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
config.ghcOptionsByCat
  , if Bool
isLocal
      then [Text] -> ApplyGhcOptions -> Map ApplyGhcOptions [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOLocals Config
config.ghcOptionsByCat
      else []
  , if Bool
isTarget
      then [Text] -> ApplyGhcOptions -> Map ApplyGhcOptions [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOTargets Config
config.ghcOptionsByCat
      else []
  , [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text
"-fhpc"] | Bool
isLocal Bool -> Bool -> Bool
&& BuildOpts
bopts.testOpts.coverage]
  , if BuildOpts
bopts.libProfile Bool -> Bool -> Bool
|| BuildOpts
bopts.exeProfile
      then [Text
"-fprof-auto", Text
"-fprof-cafs"]
      else []
  , [ Text
"-g" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BuildOpts
bopts.libStrip Bool -> Bool -> Bool
|| BuildOpts
bopts.exeStrip ]
  , if Bool
includeExtraOptions
      then BuildOptsCLI
boptsCli.ghcOptions
      else []
  ]
 where
  bopts :: BuildOpts
bopts =  Config
config.build
  config :: Config
config = Getting Config BuildConfig Config -> BuildConfig -> Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config BuildConfig Config
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL BuildConfig
bconfig
  includeExtraOptions :: Bool
includeExtraOptions =
    case Config
config.applyGhcOptions of
      ApplyGhcOptions
AGOTargets -> Bool
isTarget
      ApplyGhcOptions
AGOLocals -> Bool
isLocal
      ApplyGhcOptions
AGOEverything -> Bool
True

-- | Yield a t'Package' from the settings common to dependency and project

-- packages.

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
  (_, _, pkg) <- CommonPackage
-> RIO env (PackageConfig, GenericPackageDescription, Package)
forall env.
(HasBuildConfig env, HasSourceMap env) =>
CommonPackage
-> RIO env (PackageConfig, GenericPackageDescription, Package)
loadCommonPackage' CommonPackage
common
  pure pkg

loadCommonPackage' ::
     forall env. (HasBuildConfig env, HasSourceMap env)
  => CommonPackage
  -> RIO env (PackageConfig, C.GenericPackageDescription, Package)
loadCommonPackage' :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
CommonPackage
-> RIO env (PackageConfig, GenericPackageDescription, Package)
loadCommonPackage' CommonPackage
common = do
  config <-
    Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig
      CommonPackage
common.flags
      CommonPackage
common.ghcOptions
      CommonPackage
common.cabalConfigOpts
  gpkg <- liftIO common.gpd
  pure (config, gpkg, resolvePackage config 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
  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 = ProjectPackage
pp.projectCommon
  bopts <- view buildOptsL
  mcurator <- view $ buildConfigL . to (.curator)
  (config, gpkg, pkg) <- loadCommonPackage' common
  let name = CommonPackage
common.name
      mtarget = PackageName -> Map PackageName Target -> Maybe Target
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name SourceMap
sm.targets.targets
      (exeCandidates, testCandidates, benchCandidates) =
        case mtarget of
          Just (TargetComps Set NamedComponent
comps) ->
            -- Currently, a named library component (a sub-library) cannot be

            -- specified as a build target.

            let (Set StackUnqualCompName
_s, Set StackUnqualCompName
e, Set StackUnqualCompName
t, Set StackUnqualCompName
b) = [NamedComponent]
-> (Set StackUnqualCompName, Set StackUnqualCompName,
    Set StackUnqualCompName, Set StackUnqualCompName)
splitComponents ([NamedComponent]
 -> (Set StackUnqualCompName, Set StackUnqualCompName,
     Set StackUnqualCompName, Set StackUnqualCompName))
-> [NamedComponent]
-> (Set StackUnqualCompName, Set StackUnqualCompName,
    Set StackUnqualCompName, Set StackUnqualCompName)
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList Set NamedComponent
comps
            in  (Set StackUnqualCompName
e, Set StackUnqualCompName
t, Set StackUnqualCompName
b)
          Just (TargetAll PackageType
_packageType) ->
            ( Package -> Set StackUnqualCompName
buildableExes Package
pkg
            , if    BuildOpts
bopts.tests
                 Bool -> Bool -> Bool
&& Bool -> (Curator -> Bool) -> Maybe Curator -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name (Set PackageName -> Bool)
-> (Curator -> Set PackageName) -> Curator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.skipTest)) Maybe Curator
mcurator
                then Package -> Set StackUnqualCompName
buildableTestSuites Package
pkg
                else Set StackUnqualCompName
forall a. Set a
Set.empty
            , if    BuildOpts
bopts.benchmarks
                 Bool -> Bool -> Bool
&& Bool -> (Curator -> Bool) -> Maybe Curator -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                      Bool
True
                      (PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name (Set PackageName -> Bool)
-> (Curator -> Set PackageName) -> Curator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.skipBenchmark))
                      Maybe Curator
mcurator
                then Package -> Set StackUnqualCompName
buildableBenchmarks Package
pkg
                else Set StackUnqualCompName
forall a. Set a
Set.empty
            )
          Maybe Target
Nothing -> (Set StackUnqualCompName, Set StackUnqualCompName,
 Set StackUnqualCompName)
forall a. Monoid a => a
mempty

      -- See https://github.com/commercialhaskell/stack/issues/2862

      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
_ ->
             Package -> Bool
hasBuildableMainLibrary Package
pkg
          Bool -> Bool -> Bool
|| Bool -> Bool
not (Set NamedComponent -> Bool
forall a. Set a -> Bool
Set.null Set NamedComponent
nonLibComponents)
          Bool -> Bool -> Bool
|| Bool -> Bool
not (CompCollection StackLibrary -> Bool
forall a. CompCollection a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Package
pkg.subLibraries)

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

      (exes, tests, benches) = ( filterSkippedComponents exeCandidates
                               , filterSkippedComponents testCandidates
                               , filterSkippedComponents benchCandidates
                               )

      nonLibComponents = Set StackUnqualCompName
-> Set StackUnqualCompName
-> Set StackUnqualCompName
-> Set NamedComponent
toComponents Set StackUnqualCompName
exes Set StackUnqualCompName
tests Set StackUnqualCompName
benches

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

      btconfig = PackageConfig
config
        { enableTests = not $ Set.null tests
        , enableBenchmarks = not $ Set.null 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.

      btpkg
        | Set StackUnqualCompName -> Bool
forall a. Set a -> Bool
Set.null Set StackUnqualCompName
tests Bool -> Bool -> Bool
&& Set StackUnqualCompName -> Bool
forall a. Set a -> Bool
Set.null Set StackUnqualCompName
benches = Maybe Package
forall a. Maybe a
Nothing
        | Bool
otherwise = Package -> Maybe Package
forall a. a -> Maybe a
Just (PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
btconfig GenericPackageDescription
gpkg)

  componentFiles <- memoizeRefWith $
    fst <$> getPackageFilesForTargets pkg pp.cabalFP nonLibComponents

  checkCacheResults <- memoizeRefWith $ do
    componentFiles' <- runMemoizedWith componentFiles
    forM (Map.toList componentFiles') $ \(NamedComponent
component, Set (Path Abs File)
files) -> do
      mbuildCache <- Path Abs Dir -> NamedComponent -> RIO EnvConfig (Maybe FileCache)
forall env.
HasEnvConfig env =>
Path Abs Dir -> NamedComponent -> RIO env (Maybe FileCache)
tryGetBuildCache (ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp) NamedComponent
component
      checkCacheResult <- checkBuildCache
        (fromMaybe Map.empty mbuildCache)
        (Set.toList files)
      pure (component, checkCacheResult)

  let dirtyFiles = do
        checkCacheResults' <- MemoizedWith EnvConfig [(NamedComponent, (Set String, FileCache))]
checkCacheResults
        let 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, FileCache)) -> Set String)
-> [(NamedComponent, (Set String, FileCache))] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map (\(NamedComponent
_, (Set String
x, FileCache
_)) -> Set String
x) [(NamedComponent, (Set String, FileCache))]
checkCacheResults'
        pure $
          if not (Set.null allDirtyFiles)
            then let 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  Just $ Set.map tryStripPrefix allDirtyFiles
            else Nothing
      newBuildCaches =
        [(NamedComponent, FileCache)] -> Map NamedComponent FileCache
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(NamedComponent, FileCache)] -> Map NamedComponent FileCache)
-> ([(NamedComponent, (Set String, FileCache))]
    -> [(NamedComponent, FileCache)])
-> [(NamedComponent, (Set String, FileCache))]
-> Map NamedComponent FileCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NamedComponent, (Set String, FileCache))
 -> (NamedComponent, FileCache))
-> [(NamedComponent, (Set String, FileCache))]
-> [(NamedComponent, FileCache)]
forall a b. (a -> b) -> [a] -> [b]
map (\(NamedComponent
c, (Set String
_, FileCache
cache)) -> (NamedComponent
c, FileCache
cache)) ([(NamedComponent, (Set String, FileCache))]
 -> Map NamedComponent FileCache)
-> MemoizedWith
     EnvConfig [(NamedComponent, (Set String, FileCache))]
-> MemoizedWith EnvConfig (Map NamedComponent FileCache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoizedWith EnvConfig [(NamedComponent, (Set String, FileCache))]
checkCacheResults

  pure LocalPackage
    { package = pkg
    , testBench = btpkg
    , componentFiles
    , buildHaddocks = pp.projectCommon.buildHaddocks
    , forceDirty = bopts.forceDirty
    , dirtyFiles
    , newBuildCaches
    , cabalFP = pp.cabalFP
    , wanted = isWanted
    , components = 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.

    , unbuildable = toComponents
        (exes `Set.difference` buildableExes pkg)
        (tests `Set.difference` buildableTestSuites pkg)
        (benches `Set.difference` buildableBenchmarks 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
  => FileCache -- ^ old cache

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

  -> RIO env (Set FilePath, FileCache)
checkBuildCache :: forall env.
HasEnvConfig env =>
FileCache -> [Path Abs File] -> RIO env (Set String, FileCache)
checkBuildCache FileCache
oldCache [Path Abs File]
files = do
  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
    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)
    pure (toFilePath fp, mdigest)
  fmap (mconcat . Map.elems) $ sequence $
    Map.merge
      (Map.mapMissing (\String
fp Maybe SHA256
mdigest -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, FileCache)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, FileCache)
go String
fp Maybe SHA256
mdigest Maybe FileCacheInfo
forall a. Maybe a
Nothing))
      (Map.mapMissing (\String
fp FileCacheInfo
fci -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, FileCache)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, FileCache)
go String
fp Maybe SHA256
forall a. Maybe a
Nothing (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
      (Map.zipWithMatched (\String
fp Maybe SHA256
mdigest FileCacheInfo
fci -> String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, FileCache)
forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, FileCache)
go String
fp Maybe SHA256
mdigest (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
      fileDigests
      oldCache
 where
  go ::
       FilePath
    -> Maybe SHA256
    -> Maybe FileCacheInfo
    -> RIO env (Set FilePath, FileCache)
  -- Filter out the cabal_macros file to avoid spurious recompilations

  go :: forall env.
String
-> Maybe SHA256
-> Maybe FileCacheInfo
-> RIO env (Set String, FileCache)
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, FileCache) -> RIO env (Set String, FileCache)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set String
forall a. Set a
Set.empty, FileCache
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
fci.hash SHA256 -> SHA256 -> Bool
forall a. Eq a => a -> a -> Bool
== SHA256
digest' = (Set String, FileCache) -> RIO env (Set String, FileCache)
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 -> FileCache
forall k a. k -> a -> Map k a
Map.singleton String
fp FileCacheInfo
fci)
      | Bool
otherwise =
          (Set String, FileCache) -> RIO env (Set String, FileCache)
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 -> FileCache
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> FileCache) -> FileCacheInfo -> FileCache
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, FileCache) -> RIO env (Set String, FileCache)
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, FileCache
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, FileCache) -> RIO env (Set String, FileCache)
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 -> FileCache
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> FileCache) -> FileCacheInfo -> FileCache
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 [FileCache], [PackageWarning])
addUnlistedToBuildCache :: forall env a.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> Map NamedComponent (Map String a)
-> RIO env (Map NamedComponent [FileCache], [PackageWarning])
addUnlistedToBuildCache Package
pkg Path Abs File
cabalFP Set NamedComponent
nonLibComponents Map NamedComponent (Map String a)
buildCaches = do
  (componentFiles, 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
  results <- forM (M.toList componentFiles) $ \(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
    addBuildCache <- (String -> RIO env FileCache) -> [String] -> RIO env [FileCache]
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 FileCache
forall {env}. HasEnvConfig env => String -> RIO env FileCache
addFileToCache [String]
newFiles
    pure ((component, addBuildCache), warnings)
  pure (M.fromList (map fst results), concatMap snd results)
 where
  addFileToCache :: String -> RIO env FileCache
addFileToCache String
fp =
    String -> RIO env (Maybe SHA256)
forall env. HasEnvConfig env => String -> RIO env (Maybe SHA256)
getFileDigestMaybe String
fp RIO env (Maybe SHA256)
-> (Maybe SHA256 -> RIO env FileCache) -> RIO env FileCache
forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe SHA256
Nothing -> FileCache -> RIO env FileCache
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileCache
forall k a. Map k a
Map.empty
      Just SHA256
digest' -> FileCache -> RIO env FileCache
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileCache -> RIO env FileCache) -> FileCache -> RIO env FileCache
forall a b. (a -> b) -> a -> b
$ String -> FileCacheInfo -> FileCache
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> FileCache) -> FileCacheInfo -> FileCache
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
  PackageComponentFile components' compFiles otherFiles warnings <-
    Package -> Path Abs File -> RIO env PackageComponentFile
forall s (m :: * -> *).
(HasEnvConfig s, MonadReader s m, MonadThrow m, MonadUnliftIO m) =>
Package -> Path Abs File -> m PackageComponentFile
getPackageFile Package
pkg Path Abs File
cabalFP
  let necessaryComponents =
        NamedComponent -> Set NamedComponent -> Set NamedComponent
forall a. Ord a => a -> Set a -> Set a
Set.insert NamedComponent
CLib (Set NamedComponent -> Set NamedComponent)
-> Set NamedComponent -> Set NamedComponent
forall a b. (a -> b) -> a -> b
$ (NamedComponent -> Bool)
-> Set NamedComponent -> Set NamedComponent
forall a. (a -> Bool) -> Set a -> Set a
Set.filter NamedComponent -> Bool
isCSubLib (Map NamedComponent (Map ModuleName (Path Abs File))
-> Set NamedComponent
forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
components')
      components = Set NamedComponent
necessaryComponents Set NamedComponent -> Set NamedComponent -> Set NamedComponent
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set NamedComponent
nonLibComponents
      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
  pure (componentsFiles, 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
  cache <- Getting FileDigestCache env FileDigestCache
-> RIO env FileDigestCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting FileDigestCache env FileDigestCache
 -> RIO env FileDigestCache)
-> Getting FileDigestCache env FileDigestCache
-> RIO env FileDigestCache
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const FileDigestCache EnvConfig)
-> env -> Const FileDigestCache env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL ((EnvConfig -> Const FileDigestCache EnvConfig)
 -> env -> Const FileDigestCache env)
-> ((FileDigestCache -> Const FileDigestCache FileDigestCache)
    -> EnvConfig -> Const FileDigestCache EnvConfig)
-> Getting FileDigestCache env FileDigestCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvConfig -> FileDigestCache)
-> SimpleGetter EnvConfig FileDigestCache
forall s a. (s -> a) -> SimpleGetter s a
to (.fileDigestCache)
  catch
    (Just <$> readFileDigest cache fp)
    (\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then Maybe SHA256 -> RIO env (Maybe SHA256)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SHA256
forall a. Maybe a
Nothing else IOError -> RIO env (Maybe SHA256)
forall e a. (HasCallStack, Exception e) => e -> RIO env a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM IOError
e)

-- | Get t'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 <- 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
  compilerVersion <- view actualCompilerVersionL
  pure PackageConfig
    { enableTests = False
    , enableBenchmarks = False
    , flags = flags
    , ghcOptions = ghcOptions
    , cabalConfigOpts = cabalConfigOpts
    , compilerVersion = compilerVersion
    , platform = platform
    }