{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}

-- | Perform a build
module Stack.Build.Execute
  ( printPlan
  , preFetch
  , executePlan
  -- * Running Setup.hs
  , ExecuteEnv
  , withExecuteEnv
  , withSingleContext
  , ExcludeTHLoading (..)
  , KeepOutputOpen (..)
  ) where

import           Control.Concurrent.Execute
import           Control.Concurrent.STM ( check )
import           Crypto.Hash
import           Data.Attoparsec.Text ( char, choice, digit, parseOnly )
import qualified Data.Attoparsec.Text as P ( string )
import qualified Data.ByteArray as Mem ( convert )
import qualified Data.ByteString as S
import qualified Data.ByteString.Builder
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Base64.URL as B64URL
import           Data.Char ( isSpace )
import           Conduit
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.Filesystem as CF
import qualified Data.Conduit.List as CL
import           Data.Conduit.Process.Typed ( createSource )
import qualified Data.Conduit.Text as CT
import qualified Data.List as L
import           Data.List.NonEmpty ( nonEmpty )
import qualified Data.List.NonEmpty as NonEmpty ( toList )
import           Data.List.Split ( chunksOf )
import qualified Data.Map.Strict as M
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import           Data.Text.Encoding ( decodeUtf8 )
import           Data.Tuple
import           Data.Time
                   ( ZonedTime, getZonedTime, formatTime, defaultTimeLocale )
import qualified Data.ByteString.Char8 as S8
import qualified Distribution.PackageDescription as C
import qualified Distribution.Simple.Build.Macros as C
import           Distribution.System ( OS (Windows), Platform (Platform) )
import qualified Distribution.Text as C
import           Distribution.Types.PackageName ( mkPackageName )
import           Distribution.Types.UnqualComponentName
                   ( mkUnqualComponentName )
import           Distribution.Verbosity ( showForCabal )
import           Distribution.Version ( mkVersion )
import           Pantry.Internal.Companion
import           Path
import           Path.CheckInstall
import           Path.Extra ( toFilePathNoTrailingSep, rejectMissingFile )
import           Path.IO
                   hiding ( findExecutable, makeAbsolute, withSystemTempDir )
import           RIO.Process
import           Stack.Build.Cache
import           Stack.Build.Haddock
import           Stack.Build.Installed
import           Stack.Build.Source
import           Stack.Build.Target
import           Stack.Config
import           Stack.Constants
import           Stack.Constants.Config
import           Stack.Coverage
import           Stack.DefaultColorWhen ( defaultColorWhen )
import           Stack.GhcPkg
import           Stack.Package
import           Stack.PackageDump
import           Stack.Prelude
import           Stack.Types.Build
import           Stack.Types.Compiler
import           Stack.Types.Config
import           Stack.Types.GhcPkgId
import           Stack.Types.NamedComponent
import           Stack.Types.Package
import           Stack.Types.PackageFile
import           Stack.Types.Version
import qualified System.Directory as D
import           System.Environment ( getExecutablePath, lookupEnv )
import           System.FileLock
                   ( withTryFileLock, SharedExclusive (Exclusive)
                   , withFileLock
                   )
import qualified System.FilePath as FP
import           System.IO.Error ( isDoesNotExistError )
import           System.PosixCompat.Files
                   ( createLink, modificationTime, getFileStatus )
import           System.Random ( randomIO )

-- | Has an executable been built or not?
data ExecutableBuildStatus
    = ExecutableBuilt
    | ExecutableNotBuilt
  deriving (Show, Eq, Ord)

-- | Fetch the packages necessary for a build, for example in combination with a dry run.
preFetch :: HasEnvConfig env => Plan -> RIO env ()
preFetch plan
    | Set.null pkgLocs = logDebug "Nothing to fetch"
    | otherwise = do
        logDebug $
            "Prefetching: " <>
            mconcat (L.intersperse ", " (display <$> Set.toList pkgLocs))
        fetchPackages pkgLocs
  where
    pkgLocs = Set.unions $ map toPkgLoc $ Map.elems $ planTasks plan

    toPkgLoc task =
        case taskType task of
            TTLocalMutable{} -> Set.empty
            TTRemotePackage _ _ pkgloc -> Set.singleton pkgloc

-- | Print a description of build plan for human consumption.
printPlan :: HasRunner env => Plan -> RIO env ()
printPlan plan = do
    case Map.elems $ planUnregisterLocal plan of
        [] -> logInfo "No packages would be unregistered."
        xs -> do
            logInfo "Would unregister locally:"
            forM_ xs $ \(ident, reason) -> logInfo $
                fromString (packageIdentifierString ident) <>
                if T.null reason
                  then ""
                  else " (" <> display reason <> ")"

    logInfo ""

    case Map.elems $ planTasks plan of
        [] -> logInfo "Nothing to build."
        xs -> do
            logInfo "Would build:"
            mapM_ (logInfo . displayTask) xs

    let hasTests = not . Set.null . testComponents . taskComponents
        hasBenches = not . Set.null . benchComponents . taskComponents
        tests = Map.elems $ Map.filter hasTests $ planFinals plan
        benches = Map.elems $ Map.filter hasBenches $ planFinals plan

    unless (null tests) $ do
        logInfo ""
        logInfo "Would test:"
        mapM_ (logInfo . displayTask) tests
    unless (null benches) $ do
        logInfo ""
        logInfo "Would benchmark:"
        mapM_ (logInfo . displayTask) benches

    logInfo ""

    case Map.toList $ planInstallExes plan of
        [] -> logInfo "No executables to be installed."
        xs -> do
            logInfo "Would install executables:"
            forM_ xs $ \(name, loc) -> logInfo $
                display name <>
                " from " <>
                (case loc of
                   Snap -> "snapshot"
                   Local -> "local") <>
                " database"

-- | For a dry run
displayTask :: Task -> Utf8Builder
displayTask task =
    fromString (packageIdentifierString (taskProvides task)) <>
    ": database=" <>
    (case taskLocation task of
        Snap -> "snapshot"
        Local -> "local") <>
    ", source=" <>
    (case taskType task of
        TTLocalMutable lp -> fromString $ toFilePath $ parent $ lpCabalFile lp
        TTRemotePackage _ _ pl -> display pl) <>
    (if Set.null missing
        then ""
        else ", after: " <>
             mconcat (L.intersperse "," (fromString . packageIdentifierString <$> Set.toList missing)))
  where
    missing = tcoMissing $ taskConfigOpts task

data ExecuteEnv = ExecuteEnv
    { eeConfigureLock  :: !(MVar ())
    , eeInstallLock    :: !(MVar ())
    , eeBuildOpts      :: !BuildOpts
    , eeBuildOptsCLI   :: !BuildOptsCLI
    , eeBaseConfigOpts :: !BaseConfigOpts
    , eeGhcPkgIds      :: !(TVar (Map PackageIdentifier Installed))
    , eeTempDir        :: !(Path Abs Dir)
    , eeSetupHs        :: !(Path Abs File)
    -- ^ Temporary Setup.hs for simple builds
    , eeSetupShimHs    :: !(Path Abs File)
    -- ^ Temporary SetupShim.hs, to provide access to initial-build-steps
    , eeSetupExe       :: !(Maybe (Path Abs File))
    -- ^ Compiled version of eeSetupHs
    , eeCabalPkgVer    :: !Version
    , eeTotalWanted    :: !Int
    , eeLocals         :: ![LocalPackage]
    , eeGlobalDB       :: !(Path Abs Dir)
    , eeGlobalDumpPkgs :: !(Map GhcPkgId DumpPackage)
    , eeSnapshotDumpPkgs :: !(TVar (Map GhcPkgId DumpPackage))
    , eeLocalDumpPkgs  :: !(TVar (Map GhcPkgId DumpPackage))
    , eeLogFiles       :: !(TChan (Path Abs Dir, Path Abs File))
    , eeCustomBuilt    :: !(IORef (Set PackageName))
    -- ^ Stores which packages with custom-setup have already had their
    -- Setup.hs built.
    , eeLargestPackageName :: !(Maybe Int)
    -- ^ For nicer interleaved output: track the largest package name size
    , eePathEnvVar :: !Text
    -- ^ Value of the PATH environment variable
    }

buildSetupArgs :: [String]
buildSetupArgs =
     [ "-rtsopts"
     , "-threaded"
     , "-clear-package-db"
     , "-global-package-db"
     , "-hide-all-packages"
     , "-package"
     , "base"
     , "-main-is"
     , "StackSetupShim.mainOverride"
     ]

simpleSetupCode :: Builder
simpleSetupCode = "import Distribution.Simple\nmain = defaultMain"

simpleSetupHash :: String
simpleSetupHash =
    T.unpack $ decodeUtf8 $ S.take 8 $ B64URL.encode $ Mem.convert $ hashWith SHA256 $
    toStrictBytes $
    Data.ByteString.Builder.toLazyByteString $
    encodeUtf8Builder (T.pack (unwords buildSetupArgs)) <> setupGhciShimCode <> simpleSetupCode

-- | Get a compiled Setup exe
getSetupExe :: HasEnvConfig env
            => Path Abs File -- ^ Setup.hs input file
            -> Path Abs File -- ^ SetupShim.hs input file
            -> Path Abs Dir -- ^ temporary directory
            -> RIO env (Maybe (Path Abs File))
getSetupExe setupHs setupShimHs tmpdir = do
    wc <- view $ actualCompilerVersionL.whichCompilerL
    platformDir <- platformGhcRelDir
    config <- view configL
    cabalVersionString <- view $ cabalVersionL.to versionString
    actualCompilerVersionString <- view $ actualCompilerVersionL.to compilerVersionString
    platform <- view platformL
    let baseNameS = concat
            [ "Cabal-simple_"
            , simpleSetupHash
            , "_"
            , cabalVersionString
            , "_"
            , actualCompilerVersionString
            ]
        exeNameS = baseNameS ++
            case platform of
                Platform _ Windows -> ".exe"
                _ -> ""
        outputNameS =
            case wc of
                Ghc -> exeNameS
        setupDir =
            view stackRootL config </>
            relDirSetupExeCache </>
            platformDir

    exePath <- (setupDir </>) <$> parseRelFile exeNameS

    exists <- liftIO $ D.doesFileExist $ toFilePath exePath

    if exists
        then pure $ Just exePath
        else do
            tmpExePath <- fmap (setupDir </>) $ parseRelFile $ "tmp-" ++ exeNameS
            tmpOutputPath <- fmap (setupDir </>) $ parseRelFile $ "tmp-" ++ outputNameS
            ensureDir setupDir
            let args = buildSetupArgs ++
                    [ "-package"
                    , "Cabal-" ++ cabalVersionString
                    , toFilePath setupHs
                    , toFilePath setupShimHs
                    , "-o"
                    , toFilePath tmpOutputPath
                    ]
            compilerPath <- getCompilerPath
            withWorkingDir (toFilePath tmpdir) $ proc (toFilePath compilerPath) args (\pc0 -> do
              let pc = setStdout (useHandleOpen stderr) pc0
              runProcess_ pc)
                `catch` \ece ->
                    throwM $ PrettyException $
                        SetupHsBuildFailure
                            (eceExitCode ece)
                            Nothing
                            compilerPath
                            args
                            Nothing
                            []
            renameFile tmpExePath exePath
            pure $ Just exePath

-- | Execute a function that takes an 'ExecuteEnv'.
withExecuteEnv :: forall env a. HasEnvConfig env
               => BuildOpts
               -> BuildOptsCLI
               -> BaseConfigOpts
               -> [LocalPackage]
               -> [DumpPackage] -- ^ global packages
               -> [DumpPackage] -- ^ snapshot packages
               -> [DumpPackage] -- ^ local packages
               -> Maybe Int -- ^ largest package name, for nicer interleaved output
               -> (ExecuteEnv -> RIO env a)
               -> RIO env a
withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages mlargestPackageName inner =
    createTempDirFunction stackProgName $ \tmpdir -> do
        configLock <- liftIO $ newMVar ()
        installLock <- liftIO $ newMVar ()
        idMap <- liftIO $ newTVarIO Map.empty
        config <- view configL

        customBuiltRef <- newIORef Set.empty

        -- Create files for simple setup and setup shim, if necessary
        let setupSrcDir =
                view stackRootL config </>
                relDirSetupExeSrc
        ensureDir setupSrcDir
        setupFileName <- parseRelFile ("setup-" ++ simpleSetupHash ++ ".hs")
        let setupHs = setupSrcDir </> setupFileName
        setupHsExists <- doesFileExist setupHs
        unless setupHsExists $ writeBinaryFileAtomic setupHs simpleSetupCode
        setupShimFileName <- parseRelFile ("setup-shim-" ++ simpleSetupHash ++ ".hs")
        let setupShimHs = setupSrcDir </> setupShimFileName
        setupShimHsExists <- doesFileExist setupShimHs
        unless setupShimHsExists $ writeBinaryFileAtomic setupShimHs setupGhciShimCode
        setupExe <- getSetupExe setupHs setupShimHs tmpdir

        cabalPkgVer <- view cabalVersionL
        globalDB <- view $ compilerPathsL.to cpGlobalDB
        snapshotPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId snapshotPackages)
        localPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId localPackages)
        logFilesTChan <- liftIO $ atomically newTChan
        let totalWanted = length $ filter lpWanted locals
        pathEnvVar <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH"
        inner ExecuteEnv
            { eeBuildOpts = bopts
            , eeBuildOptsCLI = boptsCli
             -- Uncertain as to why we cannot run configures in parallel. This
             -- appears to be a Cabal library bug. Original issue:
             -- https://github.com/commercialhaskell/stack/issues/84. Ideally
             -- we'd be able to remove this.
            , eeConfigureLock = configLock
            , eeInstallLock = installLock
            , eeBaseConfigOpts = baseConfigOpts
            , eeGhcPkgIds = idMap
            , eeTempDir = tmpdir
            , eeSetupHs = setupHs
            , eeSetupShimHs = setupShimHs
            , eeSetupExe = setupExe
            , eeCabalPkgVer = cabalPkgVer
            , eeTotalWanted = totalWanted
            , eeLocals = locals
            , eeGlobalDB = globalDB
            , eeGlobalDumpPkgs = toDumpPackagesByGhcPkgId globalPackages
            , eeSnapshotDumpPkgs = snapshotPackagesTVar
            , eeLocalDumpPkgs = localPackagesTVar
            , eeLogFiles = logFilesTChan
            , eeCustomBuilt = customBuiltRef
            , eeLargestPackageName = mlargestPackageName
            , eePathEnvVar = pathEnvVar
            } `finally` dumpLogs logFilesTChan totalWanted
  where
    toDumpPackagesByGhcPkgId = Map.fromList . map (\dp -> (dpGhcPkgId dp, dp))

    createTempDirFunction
        | boptsKeepTmpFiles bopts = withKeepSystemTempDir
        | otherwise = withSystemTempDir

    dumpLogs :: TChan (Path Abs Dir, Path Abs File) -> Int -> RIO env ()
    dumpLogs chan totalWanted = do
        allLogs <- fmap reverse $ liftIO $ atomically drainChan
        case allLogs of
            -- No log files generated, nothing to dump
            [] -> pure ()
            firstLog:_ -> do
                toDump <- view $ configL.to configDumpLogs
                case toDump of
                    DumpAllLogs -> mapM_ (dumpLog "") allLogs
                    DumpWarningLogs -> mapM_ dumpLogIfWarning allLogs
                    DumpNoLogs
                        | totalWanted > 1 ->
                            logInfo $
                                "Build output has been captured to log files, use " <>
                                "--dump-logs to see it on the console"
                        | otherwise -> pure ()
                logInfo $ "Log files have been written to: " <>
                          fromString (toFilePath (parent (snd firstLog)))

        -- We only strip the colors /after/ we've dumped logs, so that
        -- we get pretty colors in our dump output on the terminal.
        colors <- shouldForceGhcColorFlag
        when colors $ liftIO $ mapM_ (stripColors . snd) allLogs
      where
        drainChan :: STM [(Path Abs Dir, Path Abs File)]
        drainChan = do
            mx <- tryReadTChan chan
            case mx of
                Nothing -> pure []
                Just x -> do
                    xs <- drainChan
                    pure $ x:xs

    dumpLogIfWarning :: (Path Abs Dir, Path Abs File) -> RIO env ()
    dumpLogIfWarning (pkgDir, filepath) = do
      firstWarning <- withSourceFile (toFilePath filepath) $ \src ->
            runConduit
          $ src
         .| CT.decodeUtf8Lenient
         .| CT.lines
         .| CL.map stripCR
         .| CL.filter isWarning
         .| CL.take 1
      unless (null firstWarning) $ dumpLog " due to warnings" (pkgDir, filepath)

    isWarning :: Text -> Bool
    isWarning t = ": Warning:" `T.isSuffixOf` t -- prior to GHC 8
               || ": warning:" `T.isInfixOf` t -- GHC 8 is slightly different
               || "mwarning:" `T.isInfixOf` t -- colorized output

    dumpLog :: String -> (Path Abs Dir, Path Abs File) -> RIO env ()
    dumpLog msgSuffix (pkgDir, filepath) = do
        logInfo $
          "\n--  Dumping log file" <>
          fromString msgSuffix <>
          ": " <>
          fromString (toFilePath filepath) <>
          "\n"
        compilerVer <- view actualCompilerVersionL
        withSourceFile (toFilePath filepath) $ \src ->
              runConduit
            $ src
           .| CT.decodeUtf8Lenient
           .| mungeBuildOutput ExcludeTHLoading ConvertPathsToAbsolute pkgDir compilerVer
           .| CL.mapM_ (logInfo . display)
        logInfo $ "\n--  End of log file: " <> fromString (toFilePath filepath) <> "\n"

    stripColors :: Path Abs File -> IO ()
    stripColors fp = do
      let colorfp = toFilePath fp ++ "-color"
      withSourceFile (toFilePath fp) $ \src ->
        withSinkFile colorfp $ \sink ->
        runConduit $ src .| sink
      withSourceFile colorfp $ \src ->
        withSinkFile (toFilePath fp) $ \sink ->
        runConduit $ src .| noColors .| sink

      where
        noColors = do
          CB.takeWhile (/= 27) -- ESC
          mnext <- CB.head
          case mnext of
            Nothing -> pure ()
            Just x -> assert (x == 27) $ do
              -- Color sequences always end with an m
              CB.dropWhile (/= 109) -- m
              CB.drop 1 -- drop the m itself
              noColors

-- | Perform the actual plan
executePlan :: HasEnvConfig env
            => BuildOptsCLI
            -> BaseConfigOpts
            -> [LocalPackage]
            -> [DumpPackage] -- ^ global packages
            -> [DumpPackage] -- ^ snapshot packages
            -> [DumpPackage] -- ^ local packages
            -> InstalledMap
            -> Map PackageName Target
            -> Plan
            -> RIO env ()
executePlan boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap targets plan = do
    logDebug "Executing the build plan"
    bopts <- view buildOptsL
    withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages mlargestPackageName
      (executePlan' installedMap targets plan)

    copyExecutables (planInstallExes plan)

    config <- view configL
    menv' <- liftIO $ configProcessContextSettings config EnvSettings
                    { esIncludeLocals = True
                    , esIncludeGhcPackagePath = True
                    , esStackExe = True
                    , esLocaleUtf8 = False
                    , esKeepGhcRts = False
                    }
    withProcessContext menv' $
      forM_ (boptsCLIExec boptsCli) $ \(cmd, args) ->
      proc cmd args runProcess_
  where
    mlargestPackageName =
      Set.lookupMax $
      Set.map (length . packageNameString) $
      Map.keysSet (planTasks plan) <> Map.keysSet (planFinals plan)

copyExecutables ::
       HasEnvConfig env
    => Map Text InstallLocation
    -> RIO env ()
copyExecutables exes | Map.null exes = pure ()
copyExecutables exes = do
    snapBin <- (</> bindirSuffix) `liftM` installationRootDeps
    localBin <- (</> bindirSuffix) `liftM` installationRootLocal
    compilerSpecific <- boptsInstallCompilerTool <$> view buildOptsL
    destDir <- if compilerSpecific
                   then bindirCompilerTools
                   else view $ configL.to configLocalBin
    ensureDir destDir

    destDir' <- liftIO . D.canonicalizePath . toFilePath $ destDir

    platform <- view platformL
    let ext =
            case platform of
                Platform _ Windows -> ".exe"
                _ -> ""

    currExe <- liftIO getExecutablePath -- needed for windows, see below

    installed <- forMaybeM (Map.toList exes) $ \(name, loc) -> do
        let bindir =
                case loc of
                    Snap -> snapBin
                    Local -> localBin
        mfp <- liftIO $ forgivingAbsence (resolveFile bindir $ T.unpack name ++ ext)
          >>= rejectMissingFile
        case mfp of
            Nothing -> do
                logWarn $
                    "Couldn't find executable " <>
                    display name <>
                    " in directory " <>
                    fromString (toFilePath bindir)
                pure Nothing
            Just file -> do
                let destFile = destDir' FP.</> T.unpack name ++ ext
                logInfo $
                    "Copying from " <>
                    fromString (toFilePath file) <>
                    " to " <>
                    fromString destFile

                liftIO $ case platform of
                    Platform _ Windows | FP.equalFilePath destFile currExe ->
                        windowsRenameCopy (toFilePath file) destFile
                    _ -> D.copyFile (toFilePath file) destFile
                pure $ Just (name <> T.pack ext)

    unless (null installed) $ do
        logInfo ""
        logInfo $
            "Copied executables to " <>
            fromString destDir' <>
            ":"
    forM_ installed $ \exe -> logInfo ("- " <> display exe)
    unless compilerSpecific $ warnInstallSearchPathIssues destDir' installed


-- | Windows can't write over the current executable. Instead, we rename the
-- current executable to something else and then do the copy.
windowsRenameCopy :: FilePath -> FilePath -> IO ()
windowsRenameCopy src dest = do
    D.copyFile src new
    D.renameFile dest old
    D.renameFile new dest
  where
    new = dest ++ ".new"
    old = dest ++ ".old"

-- | Perform the actual plan (internal)
executePlan' :: HasEnvConfig env
             => InstalledMap
             -> Map PackageName Target
             -> Plan
             -> ExecuteEnv
             -> RIO env ()
executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do
    when (toCoverage $ boptsTestOpts eeBuildOpts) deleteHpcReports
    cv <- view actualCompilerVersionL
    case nonEmpty . Map.toList $ planUnregisterLocal plan of
        Nothing -> pure ()
        Just ids -> do
            localDB <- packageDatabaseLocal
            unregisterPackages cv localDB ids

    liftIO $ atomically $ modifyTVar' eeLocalDumpPkgs $ \initMap ->
        foldl' (flip Map.delete) initMap $ Map.keys (planUnregisterLocal plan)

    run <- askRunInIO

    -- If running tests concurrently with each other, then create an MVar
    -- which is empty while each test is being run.
    concurrentTests <- view $ configL.to configConcurrentTests
    mtestLock <- if concurrentTests then pure Nothing else Just <$> liftIO (newMVar ())

    let actions = concatMap (toActions installedMap' mtestLock run ee) $ Map.elems $ Map.mergeWithKey
            (\_ b f -> Just (Just b, Just f))
            (fmap (\b -> (Just b, Nothing)))
            (fmap (\f -> (Nothing, Just f)))
            (planTasks plan)
            (planFinals plan)
    threads <- view $ configL.to configJobs
    let keepGoing =
            fromMaybe (not (M.null (planFinals plan))) (boptsKeepGoing eeBuildOpts)
    terminal <- view terminalL
    errs <- liftIO $ runActions threads keepGoing actions $ \doneVar actionsVar -> do
        let total = length actions
            loop prev
                | prev == total =
                    run $ logStickyDone ("Completed " <> display total <> " action(s).")
                | otherwise = do
                    inProgress <- readTVarIO actionsVar
                    let packageNames = map (\(ActionId pkgID _) -> pkgName pkgID) (toList inProgress)
                        nowBuilding :: [PackageName] -> Utf8Builder
                        nowBuilding []    = ""
                        nowBuilding names = mconcat $ ": " : L.intersperse ", " (map (fromString . packageNameString) names)
                    when terminal $ run $
                        logSticky $
                            "Progress " <> display prev <> "/" <> display total <>
                                nowBuilding packageNames
                    done <- atomically $ do
                        done <- readTVar doneVar
                        check $ done /= prev
                        pure done
                    loop done
        when (total > 1) $ loop 0
    when (toCoverage $ boptsTestOpts eeBuildOpts) $ do
        generateHpcUnifiedReport
        generateHpcMarkupIndex
    unless (null errs) $ throwM $ PrettyException (ExecutionFailure errs)
    when (boptsHaddock eeBuildOpts) $ do
        snapshotDumpPkgs <- liftIO (readTVarIO eeSnapshotDumpPkgs)
        localDumpPkgs <- liftIO (readTVarIO eeLocalDumpPkgs)
        generateLocalHaddockIndex eeBaseConfigOpts localDumpPkgs eeLocals
        generateDepsHaddockIndex eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs localDumpPkgs eeLocals
        generateSnapHaddockIndex eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs
        when (boptsOpenHaddocks eeBuildOpts) $ do
            let planPkgs, localPkgs, installedPkgs, availablePkgs
                    :: Map PackageName (PackageIdentifier, InstallLocation)
                planPkgs = Map.map (taskProvides &&& taskLocation) (planTasks plan)
                localPkgs =
                    Map.fromList
                        [(packageName p, (packageIdentifier p, Local)) | p <- map lpPackage eeLocals]
                installedPkgs = Map.map (swap . second installedPackageIdentifier) installedMap'
                availablePkgs = Map.unions [planPkgs, localPkgs, installedPkgs]
            openHaddocksInBrowser eeBaseConfigOpts availablePkgs (Map.keysSet targets)
  where
    installedMap' = Map.difference installedMap0
                  $ Map.fromList
                  $ map (\(ident, _) -> (pkgName ident, ()))
                  $ Map.elems
                  $ planUnregisterLocal plan

unregisterPackages ::
       (HasProcessContext env, HasLogFunc env, HasPlatform env, HasCompiler env)
    => ActualCompiler
    -> Path Abs Dir
    -> NonEmpty (GhcPkgId, (PackageIdentifier, Text))
    -> RIO env ()
unregisterPackages cv localDB ids = do
    let logReason ident reason =
            logInfo $
            fromString (packageIdentifierString ident) <> ": unregistering" <>
            if T.null reason
                then ""
                else " (" <> display reason <> ")"
    let unregisterSinglePkg select (gid, (ident, reason)) = do
            logReason ident reason
            pkg <- getGhcPkgExe
            unregisterGhcPkgIds pkg localDB $ select ident gid :| []

    case cv of
        -- GHC versions >= 8.2.1 support batch unregistering of packages. See
        -- https://gitlab.haskell.org/ghc/ghc/issues/12637
        ACGhc v | v >= mkVersion [8, 2, 1] -> do
                platform <- view platformL
                -- According to https://support.microsoft.com/en-us/help/830473/command-prompt-cmd-exe-command-line-string-limitation
                -- the maximum command line length on Windows since XP is 8191 characters.
                -- We use conservative batch size of 100 ids on this OS thus argument name '-ipid', package name,
                -- its version and a hash should fit well into this limit.
                -- On Unix-like systems we're limited by ARG_MAX which is normally hundreds
                -- of kilobytes so batch size of 500 should work fine.
                let batchSize = case platform of
                      Platform _ Windows -> 100
                      _ -> 500
                let chunksOfNE size = mapMaybe nonEmpty . chunksOf size . NonEmpty.toList
                for_ (chunksOfNE batchSize ids) $ \batch -> do
                    for_ batch $ \(_, (ident, reason)) -> logReason ident reason
                    pkg <- getGhcPkgExe
                    unregisterGhcPkgIds pkg localDB $ fmap (Right . fst) batch

        -- GHC versions >= 7.9 support unregistering of packages via their
        -- GhcPkgId.
        ACGhc v | v >= mkVersion [7, 9] -> for_ ids . unregisterSinglePkg $ \_ident gid -> Right gid

        _ -> for_ ids . unregisterSinglePkg $ \ident _gid -> Left ident

toActions :: HasEnvConfig env
          => InstalledMap
          -> Maybe (MVar ())
          -> (RIO env () -> IO ())
          -> ExecuteEnv
          -> (Maybe Task, Maybe Task) -- build and final
          -> [Action]
toActions installedMap mtestLock runInBase ee (mbuild, mfinal) =
    abuild ++ afinal
  where
    abuild =
        case mbuild of
            Nothing -> []
            Just task@Task {..} ->
                [ Action
                    { actionId = ActionId taskProvides ATBuild
                    , actionDeps =
                        Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts)
                    , actionDo = \ac -> runInBase $ singleBuild ac ee task installedMap False
                    , actionConcurrency = ConcurrencyAllowed
                    }
                ]
    afinal =
        case mfinal of
            Nothing -> []
            Just task@Task {..} ->
                (if taskAllInOne then id else (:)
                    Action
                        { actionId = ActionId taskProvides ATBuildFinal
                        , actionDeps = addBuild
                            (Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts))
                        , actionDo = \ac -> runInBase $ singleBuild ac ee task installedMap True
                        , actionConcurrency = ConcurrencyAllowed
                        }) $
                -- These are the "final" actions - running tests and benchmarks.
                (if Set.null tests then id else (:)
                    Action
                        { actionId = ActionId taskProvides ATRunTests
                        , actionDeps = finalDeps
                        , actionDo = \ac -> withLock mtestLock $ runInBase $ do
                            singleTest topts (Set.toList tests) ac ee task installedMap
                        -- Always allow tests tasks to run concurrently with
                        -- other tasks, particularly build tasks. Note that
                        -- 'mtestLock' can optionally make it so that only
                        -- one test is run at a time.
                        , actionConcurrency = ConcurrencyAllowed
                        }) $
                (if Set.null benches then id else (:)
                    Action
                        { actionId = ActionId taskProvides ATRunBenchmarks
                        , actionDeps = finalDeps
                        , actionDo = \ac -> runInBase $ do
                            singleBench beopts (Set.toList benches) ac ee task installedMap
                        -- Never run benchmarks concurrently with any other task, see #3663
                        , actionConcurrency = ConcurrencyDisallowed
                        })
                []
              where
                comps = taskComponents task
                tests = testComponents comps
                benches = benchComponents comps
                finalDeps =
                    if taskAllInOne
                        then addBuild mempty
                        else Set.singleton (ActionId taskProvides ATBuildFinal)
                addBuild =
                    case mbuild of
                        Nothing -> id
                        Just _ -> Set.insert $ ActionId taskProvides ATBuild
    withLock Nothing f = f
    withLock (Just lock) f = withMVar lock $ \() -> f
    bopts = eeBuildOpts ee
    topts = boptsTestOpts bopts
    beopts = boptsBenchmarkOpts bopts

-- | Generate the ConfigCache
getConfigCache :: HasEnvConfig env
               => ExecuteEnv -> Task -> InstalledMap -> Bool -> Bool
               -> RIO env (Map PackageIdentifier GhcPkgId, ConfigCache)
getConfigCache ExecuteEnv {..} task@Task {..} installedMap enableTest enableBench = do
    let extra =
            -- We enable tests if the test suite dependencies are already
            -- installed, so that we avoid unnecessary recompilation based on
            -- cabal_macros.h changes when switching between 'stack build' and
            -- 'stack test'. See:
            -- https://github.com/commercialhaskell/stack/issues/805
            case taskType of
                TTLocalMutable _ ->
                  -- FIXME: make this work with exact-configuration.
                  -- Not sure how to plumb the info atm. See
                  -- https://github.com/commercialhaskell/stack/issues/2049
                  [ "--enable-tests" | enableTest] ++
                  [ "--enable-benchmarks" | enableBench]
                TTRemotePackage{} -> []
    idMap <- liftIO $ readTVarIO eeGhcPkgIds
    let getMissing ident =
            case Map.lookup ident idMap of
                Nothing
                    -- Expect to instead find it in installedMap if it's
                    -- an initialBuildSteps target.
                    | boptsCLIInitialBuildSteps eeBuildOptsCLI && taskIsTarget task,
                      Just (_, installed) <- Map.lookup (pkgName ident) installedMap
                        -> installedToGhcPkgId ident installed
                Just installed -> installedToGhcPkgId ident installed
                _ -> throwM $ PackageIdMissingBug ident
        installedToGhcPkgId ident (Library ident' x _) = assert (ident == ident') $ Just (ident, x)
        installedToGhcPkgId _ (Executable _) = Nothing
        missing' = Map.fromList $ mapMaybe getMissing $ Set.toList missing
        TaskConfigOpts missing mkOpts = taskConfigOpts
        opts = mkOpts missing'
        allDeps = Set.fromList $ Map.elems missing' ++ Map.elems taskPresent
        cache = ConfigCache
            { configCacheOpts = opts
                { coNoDirs = coNoDirs opts ++ map T.unpack extra
                }
            , configCacheDeps = allDeps
            , configCacheComponents =
                case taskType of
                    TTLocalMutable lp -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
                    TTRemotePackage{} -> Set.empty
            , configCacheHaddock = taskBuildHaddock
            , configCachePkgSrc = taskCachePkgSrc
            , configCachePathEnvVar = eePathEnvVar
            }
        allDepsMap = Map.union missing' taskPresent
    pure (allDepsMap, cache)

-- | Ensure that the configuration for the package matches what is given
ensureConfig :: HasEnvConfig env
             => ConfigCache -- ^ newConfigCache
             -> Path Abs Dir -- ^ package directory
             -> ExecuteEnv
             -> RIO env () -- ^ announce
             -> (ExcludeTHLoading -> [String] -> RIO env ()) -- ^ cabal
             -> Path Abs File -- ^ Cabal file
             -> Task
             -> RIO env Bool
ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = do
    newCabalMod <- liftIO $ modificationTime <$> getFileStatus (toFilePath cabalfp)
    setupConfigfp <- setupConfigFromDir pkgDir
    let getNewSetupConfigMod =
          liftIO $ either (const Nothing) (Just . modificationTime) <$>
          tryJust (guard . isDoesNotExistError) (getFileStatus (toFilePath setupConfigfp))
    newSetupConfigMod <- getNewSetupConfigMod
    newProjectRoot <- S8.pack . toFilePath <$> view projectRootL
    -- See https://github.com/commercialhaskell/stack/issues/3554
    taskAnyMissingHack <- view $ actualCompilerVersionL.to getGhcVersion.to (< mkVersion [8, 4])
    needConfig <-
        if boptsReconfigure eeBuildOpts || (taskAnyMissing task && taskAnyMissingHack)
            then pure True
            else do
                -- We can ignore the components portion of the config
                -- cache, because it's just used to inform 'construct
                -- plan that we need to plan to build additional
                -- components. These components don't affect the actual
                -- package configuration.
                let ignoreComponents cc = cc { configCacheComponents = Set.empty }
                -- Determine the old and new configuration in the local directory, to
                -- determine if we need to reconfigure.
                mOldConfigCache <- tryGetConfigCache pkgDir

                mOldCabalMod <- tryGetCabalMod pkgDir

                -- Cabal's setup-config is created per OS/Cabal version, multiple
                -- projects using the same package could get a conflict because of this
                mOldSetupConfigMod <- tryGetSetupConfigMod pkgDir
                mOldProjectRoot <- tryGetPackageProjectRoot pkgDir

                pure $ fmap ignoreComponents mOldConfigCache /= Just (ignoreComponents newConfigCache)
                      || mOldCabalMod /= Just newCabalMod
                      || mOldSetupConfigMod /= newSetupConfigMod
                      || mOldProjectRoot /= Just newProjectRoot
    let ConfigureOpts dirs nodirs = configCacheOpts newConfigCache

    when (taskBuildTypeConfig task) ensureConfigureScript

    when needConfig $ withMVar eeConfigureLock $ \_ -> do
        deleteCaches pkgDir
        announce
        cp <- view compilerPathsL
        let (GhcPkgExe pkgPath) = cpPkg cp
        let programNames =
              case cpWhich cp of
                Ghc ->
                  [ ("ghc", toFilePath (cpCompiler cp))
                  , ("ghc-pkg", toFilePath pkgPath)
                  ]
        exes <- forM programNames $ \(name, file) -> do
            mpath <- findExecutable file
            pure $ case mpath of
                Left _ -> []
                Right x -> pure $ concat ["--with-", name, "=", x]
        -- Configure cabal with arguments determined by
        -- Stack.Types.Build.configureOpts
        cabal KeepTHLoading $ "configure" : concat
            [ concat exes
            , dirs
            , nodirs
            ]
        -- Only write the cache for local packages.  Remote packages are built
        -- in a temporary directory so the cache would never be used anyway.
        case taskType task of
            TTLocalMutable{} -> writeConfigCache pkgDir newConfigCache
            TTRemotePackage{} -> pure ()
        writeCabalMod pkgDir newCabalMod
        -- This file gets updated one more time by the configure step, so get
        -- the most recent value. We could instead change our logic above to
        -- check if our config mod file is newer than the file above, but this
        -- seems reasonable too.
        getNewSetupConfigMod >>= writeSetupConfigMod pkgDir
        writePackageProjectRoot pkgDir newProjectRoot

    pure needConfig
  where
    -- When build-type is Configure, we need to have a configure
    -- script in the local directory. If it doesn't exist, build it
    -- with autoreconf -i. See:
    -- https://github.com/commercialhaskell/stack/issues/3534
    ensureConfigureScript = do
      let fp = pkgDir </> relFileConfigure
      exists <- doesFileExist fp
      unless exists $ do
        logInfo $ "Trying to generate configure with autoreconf in " <> fromString (toFilePath pkgDir)
        let autoreconf = if osIsWindows
                           then readProcessNull "sh" ["autoreconf", "-i"]
                           else readProcessNull "autoreconf" ["-i"]
            -- On Windows 10, an upstream issue with the `sh autoreconf -i`
            -- command means that command clears, but does not then restore, the
            -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals. The
            -- following hack re-enables the lost ANSI-capability.
            fixupOnWindows = when osIsWindows (void $ liftIO defaultColorWhen)
        withWorkingDir (toFilePath pkgDir) $ autoreconf `catchAny` \ex -> do
          fixupOnWindows
          logWarn $ "Unable to run autoreconf: " <> displayShow ex
          when osIsWindows $ do
            logInfo $ "Check that executable perl is on the path in Stack's " <>
              "MSYS2 \\usr\\bin folder, and working, and that script file " <>
              "autoreconf is on the path in that location. To check that " <>
              "perl or autoreconf are on the path in the required location, " <>
              "run commands:"
            logInfo ""
            logInfo "  stack exec where -- perl"
            logInfo "  stack exec where -- autoreconf"
            logInfo ""
            logInfo $ "If perl or autoreconf is not on the path in the " <>
              "required location, add them with command (note that the " <>
              "relevant package name is 'autoconf' not 'autoreconf'):"
            logInfo ""
            logInfo "  stack exec pacman -- --sync --refresh autoconf"
            logInfo ""
            logInfo $ "Some versions of perl from MSYS2 are broken. See " <>
              "https://github.com/msys2/MSYS2-packages/issues/1611 and " <>
              "https://github.com/commercialhaskell/stack/pull/4781. To " <>
              "test if perl in the required location is working, try command:"
            logInfo ""
            logInfo "  stack exec perl -- --version"
            logInfo ""
        fixupOnWindows

-- | Make a padded prefix for log messages
packageNamePrefix :: ExecuteEnv -> PackageName -> Utf8Builder
packageNamePrefix ee name' =
  let name = packageNameString name'
      paddedName =
        case eeLargestPackageName ee of
          Nothing -> name
          Just len -> assert (len >= length name) $ take len $ name ++ L.repeat ' '
   in fromString paddedName <> "> "

announceTask :: HasLogFunc env => ExecuteEnv -> Task -> Utf8Builder -> RIO env ()
announceTask ee task action = logInfo $
    packageNamePrefix ee (pkgName (taskProvides task)) <>
    action

-- | Ensure we're the only action using the directory.  See
-- <https://github.com/commercialhaskell/stack/issues/2730>
withLockedDistDir ::
     HasEnvConfig env
  => (Utf8Builder -> RIO env ()) -- ^ announce
  -> Path Abs Dir -- ^ root directory for package
  -> RIO env a
  -> RIO env a
withLockedDistDir announce root inner = do
  distDir <- distRelativeDir
  let lockFP = root </> distDir </> relFileBuildLock
  ensureDir $ parent lockFP

  mres <-
    withRunInIO $ \run ->
    withTryFileLock (toFilePath lockFP) Exclusive $ \_lock ->
    run inner

  case mres of
    Just res -> pure res
    Nothing -> do
      let complainer delay = do
            delay 5000000 -- 5 seconds
            announce $ "blocking for directory lock on " <> fromString (toFilePath lockFP)
            forever $ do
              delay 30000000 -- 30 seconds
              announce $ "still blocking for directory lock on " <>
                         fromString (toFilePath lockFP) <>
                         "; maybe another Stack process is running?"
      withCompanion (\x -> complainer x) $
        \stopComplaining ->
        withRunInIO $ \run ->
        withFileLock (toFilePath lockFP) Exclusive $ \_ ->
        run $ stopComplaining *> inner

-- | How we deal with output from GHC, either dumping to a log file or the
-- console (with some prefix).
data OutputType
  = OTLogFile !(Path Abs File) !Handle
  | OTConsole !(Maybe Utf8Builder)

-- | This sets up a context for executing build steps which need to run
-- Cabal (via a compiled Setup.hs).  In particular it does the following:
--
-- * Ensures the package exists in the file system, downloading if necessary.
--
-- * Opens a log file if the built output shouldn't go to stderr.
--
-- * Ensures that either a simple Setup.hs is built, or the package's
--   custom setup is built.
--
-- * Provides the user a function with which run the Cabal process.
withSingleContext :: forall env a. HasEnvConfig env
                  => ActionContext
                  -> ExecuteEnv
                  -> Task
                  -> Map PackageIdentifier GhcPkgId
                  -- ^ All dependencies' package ids to provide to Setup.hs.
                  -> Maybe String
                  -> (  Package                                -- Package info
                     -> Path Abs File                          -- Cabal file path
                     -> Path Abs Dir                           -- Package root directory file path
                     -- Note that the `Path Abs Dir` argument is redundant with the `Path Abs File`
                     -- argument, but we provide both to avoid recalculating `parent` of the `File`.
                     -> (KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ())
                                                               -- Function to run Cabal with args
                     -> (Utf8Builder -> RIO env ())      -- An 'announce' function, for different build phases
                     -> OutputType
                     -> RIO env a)
                  -> RIO env a
withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} allDeps msuffix inner0 =
    withPackage $ \package cabalfp pkgDir ->
    withOutputType pkgDir package $ \outputType ->
    withCabal package pkgDir outputType $ \cabal ->
    inner0 package cabalfp pkgDir cabal announce outputType
  where
    announce = announceTask ee task

    wanted =
        case taskType of
            TTLocalMutable lp -> lpWanted lp
            TTRemotePackage{} -> False

    -- Output to the console if this is the last task, and the user
    -- asked to build it specifically. When the action is a
    -- 'ConcurrencyDisallowed' action (benchmarks), then we can also be
    -- sure to have exclusive access to the console, so output is also
    -- sent to the console in this case.
    --
    -- See the discussion on #426 for thoughts on sending output to the
    -- console from concurrent tasks.
    console =
      (wanted &&
       all (\(ActionId ident _) -> ident == taskProvides) (Set.toList acRemaining) &&
       eeTotalWanted == 1
      ) || (acConcurrency == ConcurrencyDisallowed)

    withPackage inner =
        case taskType of
            TTLocalMutable lp -> do
              let root = parent $ lpCabalFile lp
              withLockedDistDir announce root $
                inner (lpPackage lp) (lpCabalFile lp) root
            TTRemotePackage _ package pkgloc -> do
                suffix <- parseRelDir $ packageIdentifierString $ packageIdent package
                let dir = eeTempDir </> suffix
                unpackPackageLocation dir pkgloc

                -- See: https://github.com/commercialhaskell/stack/issues/157
                distDir <- distRelativeDir
                let oldDist = dir </> relDirDist
                    newDist = dir </> distDir
                exists <- doesDirExist oldDist
                when exists $ do
                  -- Previously used takeDirectory, but that got confused
                  -- by trailing slashes, see:
                  -- https://github.com/commercialhaskell/stack/issues/216
                  --
                  -- Instead, use Path which is a bit more resilient
                  ensureDir $ parent newDist
                  renameDir oldDist newDist

                let name = pkgName taskProvides
                cabalfpRel <- parseRelFile $ packageNameString name ++ ".cabal"
                let cabalfp = dir </> cabalfpRel
                inner package cabalfp dir

    withOutputType pkgDir package inner
        -- Not in interleaved mode. When building a single wanted package, dump
        -- to the console with no prefix.
        | console = inner $ OTConsole Nothing

        -- If the user requested interleaved output, dump to the console with a
        -- prefix.
        | boptsInterleavedOutput eeBuildOpts =
             inner $ OTConsole $ Just $ packageNamePrefix ee $ packageName package

        -- Neither condition applies, dump to a file.
        | otherwise = do
            logPath <- buildLogPath package msuffix
            ensureDir (parent logPath)
            let fp = toFilePath logPath

            -- We only want to dump logs for local non-dependency packages
            case taskType of
                TTLocalMutable lp | lpWanted lp ->
                    liftIO $ atomically $ writeTChan eeLogFiles (pkgDir, logPath)
                _ -> pure ()

            withBinaryFile fp WriteMode $ \h -> inner $ OTLogFile logPath h

    withCabal ::
           Package
        -> Path Abs Dir
        -> OutputType
        -> ((KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ()) -> RIO env a)
        -> RIO env a
    withCabal package pkgDir outputType inner = do
        config <- view configL
        unless (configAllowDifferentUser config) $
            checkOwnership (pkgDir </> configWorkDir config)
        let envSettings = EnvSettings
                { esIncludeLocals = taskLocation task == Local
                , esIncludeGhcPackagePath = False
                , esStackExe = False
                , esLocaleUtf8 = True
                , esKeepGhcRts = False
                }
        menv <- liftIO $ configProcessContextSettings config envSettings
        distRelativeDir' <- distRelativeDir
        esetupexehs <-
            -- Avoid broken Setup.hs files causing problems for simple build
            -- types, see:
            -- https://github.com/commercialhaskell/stack/issues/370
            case (packageBuildType package, eeSetupExe) of
                (C.Simple, Just setupExe) -> pure $ Left setupExe
                _ -> liftIO $ Right <$> getSetupHs pkgDir
        inner $ \keepOutputOpen stripTHLoading args -> do
            let cabalPackageArg
                    -- Omit cabal package dependency when building
                    -- Cabal. See
                    -- https://github.com/commercialhaskell/stack/issues/1356
                    | packageName package == mkPackageName "Cabal" = []
                    | otherwise =
                        ["-package=" ++ packageIdentifierString
                                            (PackageIdentifier cabalPackageName
                                                              eeCabalPkgVer)]
                packageDBArgs =
                    ( "-clear-package-db"
                    : "-global-package-db"
                    : map (("-package-db=" ++) . toFilePathNoTrailingSep) (bcoExtraDBs eeBaseConfigOpts)
                    ) ++
                    ( ("-package-db=" ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts))
                    : ("-package-db=" ++ toFilePathNoTrailingSep (bcoLocalDB eeBaseConfigOpts))
                    : ["-hide-all-packages"]
                    )

                warnCustomNoDeps :: RIO env ()
                warnCustomNoDeps =
                    case (taskType, packageBuildType package) of
                        (TTLocalMutable lp, C.Custom) | lpWanted lp -> do
                            prettyWarnL
                                [ flow "Package"
                                , fromString $ packageNameString $ packageName package
                                , flow "uses a custom Cabal build, but does not use a custom-setup stanza"
                                ]
                        _ -> pure ()

                getPackageArgs :: Path Abs Dir -> RIO env [String]
                getPackageArgs setupDir =
                    case packageSetupDeps package of
                        -- The package is using the Cabal custom-setup
                        -- configuration introduced in Cabal 1.24. In
                        -- this case, the package is providing an
                        -- explicit list of dependencies, and we
                        -- should simply use all of them.
                        Just customSetupDeps -> do
                            unless (Map.member (mkPackageName "Cabal") customSetupDeps) $
                                prettyWarnL
                                    [ fromString $ packageNameString $ packageName package
                                    , "has a setup-depends field, but it does not mention a Cabal dependency. This is likely to cause build errors."
                                    ]
                            matchedDeps <- forM (Map.toList customSetupDeps) $ \(name, range) -> do
                                let matches (PackageIdentifier name' version) =
                                        name == name' &&
                                        version `withinRange` range
                                case filter (matches . fst) (Map.toList allDeps) of
                                    x:xs -> do
                                        unless (null xs)
                                            (logWarn ("Found multiple installed packages for custom-setup dep: " <> fromString (packageNameString name)))
                                        pure ("-package-id=" ++ ghcPkgIdString (snd x), Just (fst x))
                                    [] -> do
                                        logWarn ("Could not find custom-setup dep: " <> fromString (packageNameString name))
                                        pure ("-package=" ++ packageNameString name, Nothing)
                            let depsArgs = map fst matchedDeps
                            -- Generate setup_macros.h and provide it to ghc
                            let macroDeps = mapMaybe snd matchedDeps
                                cppMacrosFile = setupDir </> relFileSetupMacrosH
                                cppArgs = ["-optP-include", "-optP" ++ toFilePath cppMacrosFile]
                            writeBinaryFileAtomic cppMacrosFile (encodeUtf8Builder (T.pack (C.generatePackageVersionMacros (packageVersion package) macroDeps)))
                            pure (packageDBArgs ++ depsArgs ++ cppArgs)

                        -- This branch is usually taken for builds, and
                        -- is always taken for `stack sdist`.
                        --
                        -- This approach is debatable. It adds access to the
                        -- snapshot package database for Cabal. There are two
                        -- possible objections:
                        --
                        -- 1. This doesn't isolate the build enough; arbitrary
                        -- other packages available could cause the build to
                        -- succeed or fail.
                        --
                        -- 2. This doesn't provide enough packages: we should also
                        -- include the local database when building local packages.
                        --
                        -- Currently, this branch is only taken via `stack
                        -- sdist` or when explicitly requested in the
                        -- stack.yaml file.
                        Nothing -> do
                            warnCustomNoDeps
                            pure $ cabalPackageArg ++
                                    -- NOTE: This is different from
                                    -- packageDBArgs above in that it does not
                                    -- include the local database and does not
                                    -- pass in the -hide-all-packages argument
                                    ("-clear-package-db"
                                    : "-global-package-db"
                                    : map (("-package-db=" ++) . toFilePathNoTrailingSep) (bcoExtraDBs eeBaseConfigOpts)
                                ++ ["-package-db=" ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts)])

                setupArgs = ("--builddir=" ++ toFilePathNoTrailingSep distRelativeDir') : args

                runExe :: Path Abs File -> [String] -> RIO env ()
                runExe exeName fullArgs = do
                    compilerVer <- view actualCompilerVersionL
                    runAndOutput compilerVer `catch` \ece -> do
                        (mlogFile, bss) <-
                            case outputType of
                                OTConsole _ -> pure (Nothing, [])
                                OTLogFile logFile h ->
                                    if keepOutputOpen == KeepOpen
                                    then pure (Nothing, []) -- expected failure build continues further
                                    else do
                                        liftIO $ hClose h
                                        fmap (Just logFile,) $ withSourceFile (toFilePath logFile) $ \src ->
                                               runConduit
                                             $ src
                                            .| CT.decodeUtf8Lenient
                                            .| mungeBuildOutput stripTHLoading makeAbsolute pkgDir compilerVer
                                            .| CL.consume
                        throwM $ PrettyException $ CabalExitedUnsuccessfully
                            (eceExitCode ece)
                            taskProvides
                            exeName
                            fullArgs
                            mlogFile
                            bss
                  where
                    runAndOutput :: ActualCompiler -> RIO env ()
                    runAndOutput compilerVer = withWorkingDir (toFilePath pkgDir) $ withProcessContext menv $ case outputType of
                        OTLogFile _ h -> do
                          let prefixWithTimestamps =
                                if configPrefixTimestamps config
                                   then PrefixWithTimestamps
                                   else WithoutTimestamps
                          void $ sinkProcessStderrStdout (toFilePath exeName) fullArgs
                              (sinkWithTimestamps prefixWithTimestamps h)
                              (sinkWithTimestamps prefixWithTimestamps h)
                        OTConsole mprefix ->
                            let prefix = fold mprefix in
                            void $ sinkProcessStderrStdout (toFilePath exeName) fullArgs
                                (outputSink KeepTHLoading LevelWarn compilerVer prefix)
                                (outputSink stripTHLoading LevelInfo compilerVer prefix)
                    outputSink ::
                           HasCallStack
                        => ExcludeTHLoading
                        -> LogLevel
                        -> ActualCompiler
                        -> Utf8Builder
                        -> ConduitM S.ByteString Void (RIO env) ()
                    outputSink excludeTH level compilerVer prefix =
                        CT.decodeUtf8Lenient
                        .| mungeBuildOutput excludeTH makeAbsolute pkgDir compilerVer
                        .| CL.mapM_ (logGeneric "" level . (prefix <>) . display)
                    -- If users want control, we should add a config option for this
                    makeAbsolute :: ConvertPathsToAbsolute
                    makeAbsolute = case stripTHLoading of
                        ExcludeTHLoading -> ConvertPathsToAbsolute
                        KeepTHLoading    -> KeepPathsAsIs

            exeName <- case esetupexehs of
                Left setupExe -> pure setupExe
                Right setuphs -> do
                    distDir <- distDirFromDir pkgDir
                    let setupDir = distDir </> relDirSetup
                        outputFile = setupDir </> relFileSetupLower
                    customBuilt <- liftIO $ readIORef eeCustomBuilt
                    if Set.member (packageName package) customBuilt
                        then pure outputFile
                        else do
                            ensureDir setupDir
                            compilerPath <- view $ compilerPathsL.to cpCompiler
                            packageArgs <- getPackageArgs setupDir
                            runExe compilerPath $
                                [ "--make"
                                , "-odir", toFilePathNoTrailingSep setupDir
                                , "-hidir", toFilePathNoTrailingSep setupDir
                                , "-i", "-i."
                                ] ++ packageArgs ++
                                [ toFilePath setuphs
                                , toFilePath eeSetupShimHs
                                , "-main-is"
                                , "StackSetupShim.mainOverride"
                                , "-o", toFilePath outputFile
                                , "-threaded"
                                ] ++

                                -- Apply GHC options
                                -- https://github.com/commercialhaskell/stack/issues/4526
                                map T.unpack (
                                  Map.findWithDefault [] AGOEverything (configGhcOptionsByCat config) ++
                                  case configApplyGhcOptions config of
                                    AGOEverything -> boptsCLIGhcOptions eeBuildOptsCLI
                                    AGOTargets -> []
                                    AGOLocals -> [])

                            liftIO $ atomicModifyIORef' eeCustomBuilt $
                                \oldCustomBuilt -> (Set.insert (packageName package) oldCustomBuilt, ())
                            pure outputFile
            let cabalVerboseArg =
                  let CabalVerbosity cv = boptsCabalVerbose eeBuildOpts
                  in  "--verbose=" <> showForCabal cv
            runExe exeName $ cabalVerboseArg:setupArgs

-- Implements running a package's build, used to implement 'ATBuild' and
-- 'ATBuildFinal' tasks.  In particular this does the following:
--
-- * Checks if the package exists in the precompiled cache, and if so,
--   add it to the database instead of performing the build.
--
-- * Runs the configure step if needed ('ensureConfig')
--
-- * Runs the build step
--
-- * Generates haddocks
--
-- * Registers the library and copies the built executables into the
--   local install directory. Note that this is literally invoking Cabal
--   with @copy@, and not the copying done by @stack install@ - that is
--   handled by 'copyExecutables'.
singleBuild :: forall env. (HasEnvConfig env, HasRunner env)
            => ActionContext
            -> ExecuteEnv
            -> Task
            -> InstalledMap
            -> Bool             -- ^ Is this a final build?
            -> RIO env ()
singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap isFinalBuild = do
    (allDepsMap, cache) <- getConfigCache ee task installedMap enableTests enableBenchmarks
    mprecompiled <- getPrecompiled cache
    minstalled <-
        case mprecompiled of
            Just precompiled -> copyPreCompiled precompiled
            Nothing -> do
                mcurator <- view $ buildConfigL.to bcCurator
                realConfigAndBuild cache mcurator allDepsMap
    case minstalled of
        Nothing -> pure ()
        Just installed -> do
            writeFlagCache installed cache
            liftIO $ atomically $ modifyTVar eeGhcPkgIds $ Map.insert taskProvides installed
  where
    pname = pkgName taskProvides
    doHaddock mcurator package
                      = taskBuildHaddock &&
                        not isFinalBuild &&
                        -- Works around haddock failing on bytestring-builder since it has no modules
                        -- when bytestring is new enough.
                        packageHasExposedModules package &&
                        -- Special help for the curator tool to avoid haddocks that are known to fail
                        maybe True (Set.notMember pname . curatorSkipHaddock) mcurator
    expectHaddockFailure mcurator =
        maybe False (Set.member pname . curatorExpectHaddockFailure) mcurator
    fulfillHaddockExpectations mcurator action | expectHaddockFailure mcurator = do
        eres <- tryAny $ action KeepOpen
        case eres of
          Right () -> logWarn $ fromString (packageNameString pname) <> ": unexpected Haddock success"
          Left _ -> pure ()
    fulfillHaddockExpectations _ action = do
        action CloseOnException

    buildingFinals = isFinalBuild || taskAllInOne
    enableTests = buildingFinals && any isCTest (taskComponents task)
    enableBenchmarks = buildingFinals && any isCBench (taskComponents task)

    annSuffix executableBuildStatuses = if result == "" then "" else " (" <> result <> ")"
      where
        result = T.intercalate " + " $ concat
            [ ["lib" | taskAllInOne && hasLib]
            , ["internal-lib" | taskAllInOne && hasSubLib]
            , ["exe" | taskAllInOne && hasExe]
            , ["test" | enableTests]
            , ["bench" | enableBenchmarks]
            ]
        (hasLib, hasSubLib, hasExe) = case taskType of
            TTLocalMutable lp ->
              let package = lpPackage lp
                  hasLibrary =
                    case packageLibraries package of
                      NoLibraries -> False
                      HasLibraries _ -> True
                  hasSubLibrary = not . Set.null $ packageInternalLibraries package
                  hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp
               in (hasLibrary, hasSubLibrary, hasExecutables)
            -- This isn't true, but we don't want to have this info for
            -- upstream deps.
            _ -> (False, False, False)

    getPrecompiled cache =
        case taskType of
            TTRemotePackage Immutable _ loc -> do
                mpc <- readPrecompiledCache
                       loc
                       (configCacheOpts cache)
                       (configCacheHaddock cache)
                       (configCacheDeps cache)
                case mpc of
                    Nothing -> pure Nothing
                    -- Only pay attention to precompiled caches that refer to packages within
                    -- the snapshot.
                    Just pc | maybe False
                                    (bcoSnapInstallRoot eeBaseConfigOpts `isProperPrefixOf`)
                                    (pcLibrary pc) ->
                        pure Nothing
                    -- If old precompiled cache files are left around but snapshots are deleted,
                    -- it is possible for the precompiled file to refer to the very library
                    -- we're building, and if flags are changed it may try to copy the library
                    -- to itself. This check prevents that from happening.
                    Just pc -> do
                        let allM _ [] = pure True
                            allM f (x:xs) = do
                                b <- f x
                                if b then allM f xs else pure False
                        b <- liftIO $ allM doesFileExist $ maybe id (:) (pcLibrary pc) $ pcExes pc
                        pure $ if b then Just pc else Nothing
            _ -> pure Nothing

    copyPreCompiled (PrecompiledCache mlib sublibs exes) = do
        wc <- view $ actualCompilerVersionL.whichCompilerL
        announceTask ee task "using precompiled package"

        -- We need to copy .conf files for the main library and all sublibraries which exist in the cache,
        -- from their old snapshot to the new one. However, we must unregister any such library in the new
        -- snapshot, in case it was built with different flags.
        let
          subLibNames = map T.unpack . Set.toList $ case taskType of
            TTLocalMutable lp -> packageInternalLibraries $ lpPackage lp
            TTRemotePackage _ p _ -> packageInternalLibraries p
          PackageIdentifier name version = taskProvides
          mainLibName = packageNameString name
          mainLibVersion = versionString version
          pkgName = mainLibName ++ "-" ++ mainLibVersion
          -- z-package-z-internal for internal lib internal of package package
          toCabalInternalLibName n = concat ["z-", mainLibName, "-z-", n, "-", mainLibVersion]
          allToUnregister = map (const pkgName) (maybeToList mlib) ++ map toCabalInternalLibName subLibNames
          allToRegister = maybeToList mlib ++ sublibs

        unless (null allToRegister) $ do
            withMVar eeInstallLock $ \() -> do
                -- We want to ignore the global and user databases.
                -- Unfortunately, ghc-pkg doesn't take such arguments on the
                -- command line. Instead, we'll set GHC_PACKAGE_PATH. See:
                -- https://github.com/commercialhaskell/stack/issues/1146

                let modifyEnv = Map.insert
                      (ghcPkgPathEnvVar wc)
                      (T.pack $ toFilePathNoTrailingSep $ bcoSnapDB eeBaseConfigOpts)

                withModifyEnvVars modifyEnv $ do
                  GhcPkgExe ghcPkgExe <- getGhcPkgExe

                  -- first unregister everything that needs to be unregistered
                  forM_ allToUnregister $ \packageName -> catchAny
                      (readProcessNull (toFilePath ghcPkgExe) [ "unregister", "--force", packageName])
                      (const (pure ()))

                  -- now, register the cached conf files
                  forM_ allToRegister $ \libpath ->
                    proc (toFilePath ghcPkgExe) [ "register", "--force", toFilePath libpath] readProcess_

        liftIO $ forM_ exes $ \exe -> do
            ensureDir bindir
            let dst = bindir </> filename exe
            createLink (toFilePath exe) (toFilePath dst) `catchIO` \_ -> copyFile exe dst
        case (mlib, exes) of
            (Nothing, _:_) -> markExeInstalled (taskLocation task) taskProvides
            _ -> pure ()

        -- Find the package in the database
        let pkgDbs = [bcoSnapDB eeBaseConfigOpts]

        case mlib of
            Nothing -> pure $ Just $ Executable taskProvides
            Just _ -> do
                mpkgid <- loadInstalledPkg pkgDbs eeSnapshotDumpPkgs pname

                pure $ Just $
                    case mpkgid of
                        Nothing -> assert False $ Executable taskProvides
                        Just pkgid -> Library taskProvides pkgid Nothing
      where
        bindir = bcoSnapInstallRoot eeBaseConfigOpts </> bindirSuffix

    realConfigAndBuild cache mcurator allDepsMap = withSingleContext ac ee task allDepsMap Nothing
        $ \package cabalfp pkgDir cabal0 announce _outputType -> do
            let cabal = cabal0 CloseOnException
            executableBuildStatuses <- getExecutableBuildStatuses package pkgDir
            when (not (cabalIsSatisfied executableBuildStatuses) && taskIsTarget task)
                 (logInfo
                      ("Building all executables for `" <> fromString (packageNameString (packageName package)) <>
                       "' once. After a successful build of all of them, only specified executables will be rebuilt."))

            _neededConfig <- ensureConfig cache pkgDir ee (announce ("configure" <> display (annSuffix executableBuildStatuses))) cabal cabalfp task
            let installedMapHasThisPkg :: Bool
                installedMapHasThisPkg =
                    case Map.lookup (packageName package) installedMap of
                        Just (_, Library ident _ _) -> ident == taskProvides
                        Just (_, Executable _) -> True
                        _ -> False

            case ( boptsCLIOnlyConfigure eeBuildOptsCLI
                 , boptsCLIInitialBuildSteps eeBuildOptsCLI && taskIsTarget task) of
                -- A full build is done if there are downstream actions,
                -- because their configure step will require that this
                -- package is built. See
                -- https://github.com/commercialhaskell/stack/issues/2787
                (True, _) | null acDownstream -> pure Nothing
                (_, True) | null acDownstream || installedMapHasThisPkg -> do
                    initialBuildSteps executableBuildStatuses cabal announce
                    pure Nothing
                _ -> fulfillCuratorBuildExpectations pname mcurator enableTests enableBenchmarks Nothing $
                     Just <$> realBuild cache package pkgDir cabal0 announce executableBuildStatuses

    initialBuildSteps executableBuildStatuses cabal announce = do
        announce ("initial-build-steps" <> display (annSuffix executableBuildStatuses))
        cabal KeepTHLoading ["repl", "stack-initial-build-steps"]

    realBuild ::
           ConfigCache
        -> Package
        -> Path Abs Dir
        -> (KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ())
        -> (Utf8Builder -> RIO env ())
        -> Map Text ExecutableBuildStatus
        -> RIO env Installed
    realBuild cache package pkgDir cabal0 announce executableBuildStatuses = do
        let cabal = cabal0 CloseOnException
        wc <- view $ actualCompilerVersionL.whichCompilerL

        markExeNotInstalled (taskLocation task) taskProvides
        case taskType of
            TTLocalMutable lp -> do
                when enableTests $ setTestStatus pkgDir TSUnknown
                caches <- runMemoizedWith $ lpNewBuildCaches lp
                mapM_ (uncurry (writeBuildCache pkgDir))
                      (Map.toList caches)
            TTRemotePackage{} -> pure ()

        -- FIXME: only output these if they're in the build plan.

        let postBuildCheck _succeeded = do
                mlocalWarnings <- case taskType of
                    TTLocalMutable lp -> do
                        warnings <- checkForUnlistedFiles taskType pkgDir
                        -- TODO: Perhaps only emit these warnings for non extra-dep?
                        pure (Just (lpCabalFile lp, warnings))
                    _ -> pure Nothing
                -- NOTE: once
                -- https://github.com/commercialhaskell/stack/issues/2649
                -- is resolved, we will want to partition the warnings
                -- based on variety, and output in different lists.
                let showModuleWarning (UnlistedModulesWarning comp modules) =
                      "- In" <+>
                      fromString (T.unpack (renderComponent comp)) <>
                      ":" <> line <>
                      indent 4 ( mconcat
                               $ L.intersperse line
                               $ map
                                   (style Good . fromString . C.display)
                                   modules
                               )
                forM_ mlocalWarnings $ \(cabalfp, warnings) -> do
                    unless (null warnings) $ prettyWarn $
                           flow "The following modules should be added to \
                                \exposed-modules or other-modules in" <+>
                                pretty cabalfp
                        <> ":"
                        <> line
                        <> indent 4 ( mconcat
                                    $ L.intersperse line
                                    $ map showModuleWarning warnings
                                    )
                        <> blankLine
                        <> flow "Missing modules in the Cabal file are likely \
                                \to cause undefined reference errors from the \
                                \linker, along with other problems."

        () <- announce ("build" <> display (annSuffix executableBuildStatuses))
        config <- view configL
        extraOpts <- extraBuildOptions wc eeBuildOpts
        let stripTHLoading
                | configHideTHLoading config = ExcludeTHLoading
                | otherwise                  = KeepTHLoading
        cabal stripTHLoading (("build" :) $ (++ extraOpts) $
            case (taskType, taskAllInOne, isFinalBuild) of
                (_, True, True) -> throwM AllInOneBuildBug
                (TTLocalMutable lp, False, False) -> primaryComponentOptions executableBuildStatuses lp
                (TTLocalMutable lp, False, True) -> finalComponentOptions lp
                (TTLocalMutable lp, True, False) -> primaryComponentOptions executableBuildStatuses lp ++ finalComponentOptions lp
                (TTRemotePackage{}, _, _) -> [])
          `catch` \ex -> case ex of
              CabalExitedUnsuccessfully{} ->
                  postBuildCheck False >> throwM (PrettyException ex)
              _ -> throwM ex
        postBuildCheck True

        mcurator <- view $ buildConfigL.to bcCurator
        when (doHaddock mcurator package) $ do
            announce "haddock"
            sourceFlag <- if not (boptsHaddockHyperlinkSource eeBuildOpts) then pure [] else do
                -- See #2429 for why the temp dir is used
                ec
                  <- withWorkingDir (toFilePath eeTempDir)
                   $ proc "haddock" ["--hyperlinked-source"]
                   $ \pc -> withProcessWait
                     (setStdout createSource $ setStderr createSource pc) $ \p ->
                       runConcurrently
                         $ Concurrently (runConduit $ getStdout p .| CL.sinkNull)
                        *> Concurrently (runConduit $ getStderr p .| CL.sinkNull)
                        *> Concurrently (waitExitCode p)
                case ec of
                    -- Fancy crosslinked source
                    ExitSuccess -> pure ["--haddock-option=--hyperlinked-source"]
                    -- Older hscolour colouring
                    ExitFailure _ -> do
                        hscolourExists <- doesExecutableExist "HsColour"
                        unless hscolourExists $ logWarn
                            ("Warning: haddock not generating hyperlinked sources because 'HsColour' not\n" <>
                             "found on PATH (use 'stack install hscolour' to install).")
                        pure ["--hyperlink-source" | hscolourExists]

            -- For GHC 8.4 and later, provide the --quickjump option.
            actualCompiler <- view actualCompilerVersionL
            let quickjump =
                  case actualCompiler of
                    ACGhc ghcVer
                      | ghcVer >= mkVersion [8, 4] -> ["--haddock-option=--quickjump"]
                    _ -> []

            fulfillHaddockExpectations mcurator $ \keep -> cabal0 keep KeepTHLoading $ concat
                [ ["haddock", "--html", "--hoogle", "--html-location=../$pkg-$version/"]
                , sourceFlag
                , ["--internal" | boptsHaddockInternal eeBuildOpts]
                , [ "--haddock-option=" <> opt
                  | opt <- hoAdditionalArgs (boptsHaddockOpts eeBuildOpts) ]
                , quickjump
                ]

        let hasLibrary =
              case packageLibraries package of
                NoLibraries -> False
                HasLibraries _ -> True
            packageHasComponentSet f = not $ Set.null $ f package
            hasInternalLibrary = packageHasComponentSet packageInternalLibraries
            hasExecutables = packageHasComponentSet packageExes
            shouldCopy = not isFinalBuild && (hasLibrary || hasInternalLibrary || hasExecutables)
        when shouldCopy $ withMVar eeInstallLock $ \() -> do
            announce "copy/register"
            eres <- try $ cabal KeepTHLoading ["copy"]
            case eres of
                Left err@CabalExitedUnsuccessfully{} ->
                    throwM $ CabalCopyFailed
                               (packageBuildType package == C.Simple)
                               (displayException err)
                _ -> pure ()
            when hasLibrary $ cabal KeepTHLoading ["register"]

        -- copy ddump-* files
        case T.unpack <$> boptsDdumpDir eeBuildOpts of
          Just ddumpPath | buildingFinals && not (null ddumpPath) -> do
            distDir <- distRelativeDir
            ddumpDir <- parseRelDir ddumpPath

            logDebug $ fromString ("ddump-dir: " <> toFilePath ddumpDir)
            logDebug $ fromString ("dist-dir: " <> toFilePath distDir)

            runConduitRes
              $ CF.sourceDirectoryDeep False (toFilePath distDir)
             .| CL.filter (L.isInfixOf ".dump-")
             .| CL.mapM_ (\src -> liftIO $ do
                  parentDir <- parent <$> parseRelDir src
                  destBaseDir <- (ddumpDir </>) <$> stripProperPrefix distDir parentDir
                  -- exclude .stack-work dir
                  unless (".stack-work" `L.isInfixOf` toFilePath destBaseDir) $ do
                    ensureDir destBaseDir
                    src' <- parseRelFile src
                    copyFile src' (destBaseDir </> filename src'))
          _ -> pure ()

        let (installedPkgDb, installedDumpPkgsTVar) =
                case taskLocation task of
                    Snap ->
                         ( bcoSnapDB eeBaseConfigOpts
                         , eeSnapshotDumpPkgs )
                    Local ->
                        ( bcoLocalDB eeBaseConfigOpts
                        , eeLocalDumpPkgs )
        let ident = PackageIdentifier (packageName package) (packageVersion package)
        -- only pure the sublibs to cache them if we also cache the main lib (that is, if it exists)
        (mpkgid, sublibsPkgIds) <- case packageLibraries package of
            HasLibraries _ -> do
                sublibsPkgIds <- fmap catMaybes $
                  forM (Set.toList $ packageInternalLibraries package) $ \sublib -> do
                    -- z-haddock-library-z-attoparsec for internal lib attoparsec of haddock-library
                    let sublibName = T.concat ["z-", T.pack $ packageNameString $ packageName package, "-z-", sublib]
                    case parsePackageName $ T.unpack sublibName of
                      Nothing -> pure Nothing -- invalid lib, ignored
                      Just subLibName -> loadInstalledPkg [installedPkgDb] installedDumpPkgsTVar subLibName

                mpkgid <- loadInstalledPkg [installedPkgDb] installedDumpPkgsTVar (packageName package)
                case mpkgid of
                    Nothing -> throwM $ Couldn'tFindPkgId $ packageName package
                    Just pkgid -> pure (Library ident pkgid Nothing, sublibsPkgIds)
            NoLibraries -> do
                markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache?
                pure (Executable ident, []) -- don't pure sublibs in this case

        case taskType of
            TTRemotePackage Immutable _ loc ->
              writePrecompiledCache
                eeBaseConfigOpts
                loc
                (configCacheOpts cache)
                (configCacheHaddock cache)
                (configCacheDeps cache)
                mpkgid sublibsPkgIds (packageExes package)
            _ -> pure ()

        case taskType of
            -- For packages from a package index, pkgDir is in the tmp
            -- directory. We eagerly delete it if no other tasks
            -- require it, to reduce space usage in tmp (#3018).
            TTRemotePackage{} -> do
                let remaining = filter (\(ActionId x _) -> x == taskProvides) (Set.toList acRemaining)
                when (null remaining) $ removeDirRecur pkgDir
            TTLocalMutable{} -> pure ()

        pure mpkgid

    loadInstalledPkg pkgDbs tvar name = do
        pkgexe <- getGhcPkgExe
        dps <- ghcPkgDescribe pkgexe name pkgDbs $ conduitDumpPackage .| CL.consume
        case dps of
            [] -> pure Nothing
            [dp] -> do
                liftIO $ atomically $ modifyTVar' tvar (Map.insert (dpGhcPkgId dp) dp)
                pure $ Just (dpGhcPkgId dp)
            _ -> throwM $ MulipleResultsBug name dps

-- | Get the build status of all the package executables. Do so by
-- testing whether their expected output file exists, e.g.
--
-- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha
-- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha.exe
-- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha.jsexe/ (NOTE: a dir)
getExecutableBuildStatuses ::
       HasEnvConfig env
    => Package -> Path Abs Dir -> RIO env (Map Text ExecutableBuildStatus)
getExecutableBuildStatuses package pkgDir = do
    distDir <- distDirFromDir pkgDir
    platform <- view platformL
    fmap
        M.fromList
        (mapM (checkExeStatus platform distDir) (Set.toList (packageExes package)))

-- | Check whether the given executable is defined in the given dist directory.
checkExeStatus ::
       HasLogFunc env
    => Platform
    -> Path b Dir
    -> Text
    -> RIO env (Text, ExecutableBuildStatus)
checkExeStatus platform distDir name = do
    exename <- parseRelDir (T.unpack name)
    exists <- checkPath (distDir </> relDirBuild </> exename)
    pure
        ( name
        , if exists
              then ExecutableBuilt
              else ExecutableNotBuilt)
  where
    checkPath base =
        case platform of
            Platform _ Windows -> do
                fileandext <- parseRelFile (file ++ ".exe")
                doesFileExist (base </> fileandext)
            _ -> do
                fileandext <- parseRelFile file
                doesFileExist (base </> fileandext)
      where
        file = T.unpack name

-- | Check if any unlisted files have been found, and add them to the build cache.
checkForUnlistedFiles ::
     HasEnvConfig env
  => TaskType
  -> Path Abs Dir
  -> RIO env [PackageWarning]
checkForUnlistedFiles (TTLocalMutable lp) pkgDir = do
    caches <- runMemoizedWith $ lpNewBuildCaches lp
    (addBuildCache,warnings) <-
        addUnlistedToBuildCache
            (lpPackage lp)
            (lpCabalFile lp)
            (lpComponents lp)
            caches
    forM_ (M.toList addBuildCache) $ \(component, newToCache) -> do
        let cache = Map.findWithDefault Map.empty component caches
        writeBuildCache pkgDir component $
            Map.unions (cache : newToCache)
    pure warnings
checkForUnlistedFiles TTRemotePackage{} _ = pure []

-- | Implements running a package's tests. Also handles producing
-- coverage reports if coverage is enabled.
singleTest :: HasEnvConfig env
           => TestOpts
           -> [Text]
           -> ActionContext
           -> ExecuteEnv
           -> Task
           -> InstalledMap
           -> RIO env ()
singleTest topts testsToRun ac ee task installedMap = do
    -- FIXME: Since this doesn't use cabal, we should be able to avoid using a
    -- full blown 'withSingleContext'.
    (allDepsMap, _cache) <- getConfigCache ee task installedMap True False
    mcurator <- view $ buildConfigL.to bcCurator
    let pname = pkgName $ taskProvides task
        expectFailure = expectTestFailure pname mcurator
    withSingleContext ac ee task allDepsMap (Just "test") $ \package _cabalfp pkgDir _cabal announce outputType -> do
        config <- view configL
        let needHpc = toCoverage topts

        toRun <-
            if toDisableRun topts
              then do
                  announce "Test running disabled by --no-run-tests flag."
                  pure False
              else if toRerunTests topts
                  then pure True
                  else do
                    status <- getTestStatus pkgDir
                    case status of
                      TSSuccess -> do
                        unless (null testsToRun) $ announce "skipping already passed test"
                        pure False
                      TSFailure
                        | expectFailure -> do
                            announce "skipping already failed test that's expected to fail"
                            pure False
                        | otherwise -> do
                            announce "rerunning previously failed test"
                            pure True
                      TSUnknown -> pure True

        when toRun $ do
            buildDir <- distDirFromDir pkgDir
            hpcDir <- hpcDirFromDir pkgDir
            when needHpc (ensureDir hpcDir)

            let suitesToRun
                  = [ testSuitePair
                    | testSuitePair <- Map.toList $ packageTests package
                    , let testName = fst testSuitePair
                    , testName `elem` testsToRun
                    ]

            errs <- liftM Map.unions $ forM suitesToRun $ \(testName, suiteInterface) -> do
                let stestName = T.unpack testName
                (testName', isTestTypeLib) <-
                    case suiteInterface of
                        C.TestSuiteLibV09{} -> pure (stestName ++ "Stub", True)
                        C.TestSuiteExeV10{} -> pure (stestName, False)
                        interface -> throwM (TestSuiteTypeUnsupported interface)

                let exeName = testName' ++
                        case configPlatform config of
                            Platform _ Windows -> ".exe"
                            _ -> ""
                tixPath <- liftM (pkgDir </>) $ parseRelFile $ exeName ++ ".tix"
                exePath <- liftM (buildDir </>) $ parseRelFile $ "build/" ++ testName' ++ "/" ++ exeName
                exists <- doesFileExist exePath
                -- in Stack.Package.packageFromPackageDescription we filter out
                -- package itself of any dependencies so any tests requiring loading
                -- of their own package library will fail
                -- so to prevent this we return it back here but unfortunately unconditionally
                installed <- case Map.lookup pname installedMap of
                  Just (_, installed) -> pure $ Just installed
                  Nothing -> do
                    idMap <- liftIO $ readTVarIO (eeGhcPkgIds ee)
                    pure $ Map.lookup (taskProvides task) idMap
                let pkgGhcIdList = case installed of
                                       Just (Library _ ghcPkgId _) -> [ghcPkgId]
                                       _ -> []
                -- doctest relies on template-haskell in QuickCheck-based tests
                thGhcId <- case L.find ((== "template-haskell") . pkgName . dpPackageIdent. snd)
                                (Map.toList $ eeGlobalDumpPkgs ee) of
                  Just (ghcId, _) -> pure ghcId
                  Nothing -> throwIO TemplateHaskellNotFoundBug
                -- env variable GHC_ENVIRONMENT is set for doctest so module names for
                -- packages with proper dependencies should no longer get ambiguous
                -- see e.g. https://github.com/doctest/issues/119
                -- also we set HASKELL_DIST_DIR to a package dist directory so
                -- doctest will be able to load modules autogenerated by Cabal
                let setEnv f pc = modifyEnvVars pc $ \envVars ->
                      Map.insert "HASKELL_DIST_DIR" (T.pack $ toFilePath buildDir) $
                      Map.insert "GHC_ENVIRONMENT" (T.pack f) envVars
                    fp' = eeTempDir ee </> testGhcEnvRelFile
                -- Add a random suffix to avoid conflicts between parallel jobs
                -- See https://github.com/commercialhaskell/stack/issues/5024
                randomInt <- liftIO (randomIO :: IO Int)
                let randomSuffix = "." <> show (abs randomInt)
                fp <- toFilePath <$> addExtension randomSuffix fp'
                let snapDBPath = toFilePathNoTrailingSep (bcoSnapDB $ eeBaseConfigOpts ee)
                    localDBPath = toFilePathNoTrailingSep (bcoLocalDB $ eeBaseConfigOpts ee)
                    ghcEnv =
                        "clear-package-db\n" <>
                        "global-package-db\n" <>
                        "package-db " <> fromString snapDBPath <> "\n" <>
                        "package-db " <> fromString localDBPath <> "\n" <>
                        foldMap (\ghcId -> "package-id " <> display (unGhcPkgId ghcId) <> "\n")
                            (pkgGhcIdList ++ thGhcId:M.elems allDepsMap)
                writeFileUtf8Builder fp ghcEnv
                menv <- liftIO $ setEnv fp =<< configProcessContextSettings config EnvSettings
                    { esIncludeLocals = taskLocation task == Local
                    , esIncludeGhcPackagePath = True
                    , esStackExe = True
                    , esLocaleUtf8 = False
                    , esKeepGhcRts = False
                    }
                let emptyResult = Map.singleton testName Nothing
                withProcessContext menv $ if exists
                    then do
                        -- We clear out the .tix files before doing a run.
                        when needHpc $ do
                            tixexists <- doesFileExist tixPath
                            when tixexists $
                                logWarn ("Removing HPC file " <> fromString (toFilePath tixPath))
                            liftIO $ ignoringAbsence (removeFile tixPath)

                        let args = toAdditionalArgs topts
                            argsDisplay = case args of
                                            [] -> ""
                                            _ -> ", args: " <> T.intercalate " " (map showProcessArgDebug args)
                        announce $ "test (suite: " <> display testName <> display argsDisplay <> ")"

                        -- Clear "Progress: ..." message before
                        -- redirecting output.
                        case outputType of
                          OTConsole _ -> do
                            logStickyDone ""
                            liftIO $ hFlush stdout
                            liftIO $ hFlush stderr
                          OTLogFile _ _ -> pure ()

                        let output =
                                case outputType of
                                    OTConsole Nothing -> Nothing <$ inherit
                                    OTConsole (Just prefix) -> fmap
                                      (\src -> Just $ runConduit $ src .|
                                               CT.decodeUtf8Lenient .|
                                               CT.lines .|
                                               CL.map stripCR .|
                                               CL.mapM_ (\t -> logInfo $ prefix <> display t))
                                      createSource
                                    OTLogFile _ h -> Nothing <$ useHandleOpen h
                            optionalTimeout action
                                | Just maxSecs <- toMaximumTimeSeconds topts, maxSecs > 0 = do
                                    timeout (maxSecs * 1000000) action
                                | otherwise = Just <$> action

                        mec <- withWorkingDir (toFilePath pkgDir) $
                          optionalTimeout $ proc (toFilePath exePath) args $ \pc0 -> do
                            changeStdin <-
                              if isTestTypeLib
                                then do
                                  logPath <- buildLogPath package (Just stestName)
                                  ensureDir (parent logPath)
                                  pure $ setStdin
                                       $ byteStringInput
                                       $ BL.fromStrict
                                       $ encodeUtf8 $ fromString $
                                       show (logPath, mkUnqualComponentName (T.unpack testName))
                                else do
                                  isTerminal <- view $ globalOptsL.to globalTerminal
                                  if toAllowStdin topts && isTerminal
                                    then pure id
                                    else pure $ setStdin $ byteStringInput mempty
                            let pc = changeStdin
                                   $ setStdout output
                                   $ setStderr output
                                     pc0
                            withProcessWait pc $ \p -> do
                              case (getStdout p, getStderr p) of
                                (Nothing, Nothing) -> pure ()
                                (Just x, Just y) -> concurrently_ x y
                                (x, y) -> assert False $ concurrently_ (fromMaybe (pure ()) x) (fromMaybe (pure ()) y)
                              waitExitCode p
                        -- Add a trailing newline, incase the test
                        -- output didn't finish with a newline.
                        case outputType of
                          OTConsole Nothing -> logInfo ""
                          _ -> pure ()
                        -- Move the .tix file out of the package
                        -- directory into the hpc work dir, for
                        -- tidiness.
                        when needHpc $
                            updateTixFile (packageName package) tixPath testName'
                        let announceResult result = announce $ "Test suite " <> display testName <> " " <> result
                        case mec of
                            Just ExitSuccess -> do
                                announceResult "passed"
                                pure Map.empty
                            Nothing -> do
                                announceResult "timed out"
                                if expectFailure
                                then pure Map.empty
                                else pure $ Map.singleton testName Nothing
                            Just ec -> do
                                announceResult "failed"
                                if expectFailure
                                then pure Map.empty
                                else pure $ Map.singleton testName (Just ec)
                    else do
                        unless expectFailure $ logError $ displayShow $ TestSuiteExeMissing
                            (packageBuildType package == C.Simple)
                            exeName
                            (packageNameString (packageName package))
                            (T.unpack testName)
                        pure emptyResult

            when needHpc $ do
                let testsToRun' = map f testsToRun
                    f tName =
                        case Map.lookup tName (packageTests package) of
                            Just C.TestSuiteLibV09{} -> tName <> "Stub"
                            _ -> tName
                generateHpcReport pkgDir package testsToRun'

            bs <- liftIO $
                case outputType of
                    OTConsole _ -> pure ""
                    OTLogFile logFile h -> do
                        hClose h
                        S.readFile $ toFilePath logFile

            let succeeded = Map.null errs
            unless (succeeded || expectFailure) $ throwM $ TestSuiteFailure
                (taskProvides task)
                errs
                (case outputType of
                   OTLogFile fp _ -> Just fp
                   OTConsole _ -> Nothing)
                bs

            setTestStatus pkgDir $ if succeeded then TSSuccess else TSFailure

-- | Implements running a package's benchmarks.
singleBench :: HasEnvConfig env
            => BenchmarkOpts
            -> [Text]
            -> ActionContext
            -> ExecuteEnv
            -> Task
            -> InstalledMap
            -> RIO env ()
singleBench beopts benchesToRun ac ee task installedMap = do
    (allDepsMap, _cache) <- getConfigCache ee task installedMap False True
    withSingleContext ac ee task allDepsMap (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _outputType -> do
        let args = map T.unpack benchesToRun <> maybe []
                         ((:[]) . ("--benchmark-options=" <>))
                         (beoAdditionalArgs beopts)

        toRun <-
            if beoDisableRun beopts
              then do
                  announce "Benchmark running disabled by --no-run-benchmarks flag."
                  pure False
              else do
                  pure True

        when toRun $ do
            announce "benchmarks"
            cabal CloseOnException KeepTHLoading ("bench" : args)

data ExcludeTHLoading = ExcludeTHLoading | KeepTHLoading
data ConvertPathsToAbsolute = ConvertPathsToAbsolute | KeepPathsAsIs
-- | special marker for expected failures in curator builds, using those
-- we need to keep log handle open as build continues further even after a failure
data KeepOutputOpen = KeepOpen | CloseOnException deriving Eq

-- | Strip Template Haskell "Loading package" lines and making paths absolute.
mungeBuildOutput :: forall m. MonadIO m
                 => ExcludeTHLoading       -- ^ exclude TH loading?
                 -> ConvertPathsToAbsolute -- ^ convert paths to absolute?
                 -> Path Abs Dir           -- ^ package's root directory
                 -> ActualCompiler         -- ^ compiler we're building with
                 -> ConduitM Text Text m ()
mungeBuildOutput excludeTHLoading makeAbsolute pkgDir compilerVer = void $
    CT.lines
    .| CL.map stripCR
    .| CL.filter (not . isTHLoading)
    .| filterLinkerWarnings
    .| toAbsolute
  where
    -- | Is this line a Template Haskell "Loading package" line
    -- ByteString
    isTHLoading :: Text -> Bool
    isTHLoading = case excludeTHLoading of
        KeepTHLoading    -> const False
        ExcludeTHLoading -> \bs ->
            "Loading package " `T.isPrefixOf` bs &&
            ("done." `T.isSuffixOf` bs || "done.\r" `T.isSuffixOf` bs)

    filterLinkerWarnings :: ConduitM Text Text m ()
    filterLinkerWarnings
        -- Check for ghc 7.8 since it's the only one prone to producing
        -- linker warnings on Windows x64
        | getGhcVersion compilerVer >= mkVersion [7, 8] = doNothing
        | otherwise = CL.filter (not . isLinkerWarning)

    isLinkerWarning :: Text -> Bool
    isLinkerWarning str =
        ("ghc.exe: warning:" `T.isPrefixOf` str || "ghc.EXE: warning:" `T.isPrefixOf` str) &&
        "is linked instead of __imp_" `T.isInfixOf` str

    -- | Convert GHC error lines with file paths to have absolute file paths
    toAbsolute :: ConduitM Text Text m ()
    toAbsolute = case makeAbsolute of
        KeepPathsAsIs          -> doNothing
        ConvertPathsToAbsolute -> CL.mapM toAbsolutePath

    toAbsolutePath :: Text -> m Text
    toAbsolutePath bs = do
        let (x, y) = T.break (== ':') bs
        mabs <-
            if isValidSuffix y
                then liftIO $ liftM (fmap ((T.takeWhile isSpace x <>) . T.pack . toFilePath)) $
                         forgivingAbsence (resolveFile pkgDir (T.unpack $ T.dropWhile isSpace x)) `catch`
                             \(_ :: PathException) -> pure Nothing
                else pure Nothing
        case mabs of
            Nothing -> pure bs
            Just fp -> pure $ fp `T.append` y

    doNothing :: ConduitM Text Text m ()
    doNothing = awaitForever yield

    -- | Match the error location format at the end of lines
    isValidSuffix = isRight . parseOnly lineCol
    lineCol = char ':'
           >> choice
                [ num >> char ':' >> num >> optional (char '-' >> num) >> pure ()
                , char '(' >> num >> char ',' >> num >> P.string ")-(" >> num >> char ',' >> num >> char ')' >> pure ()
                ]
           >> char ':'
           >> pure ()
        where num = some digit

-- | Whether to prefix log lines with timestamps.
data PrefixWithTimestamps = PrefixWithTimestamps | WithoutTimestamps

-- | Write stream of lines to handle, but adding timestamps.
sinkWithTimestamps :: MonadIO m => PrefixWithTimestamps -> Handle -> ConduitT ByteString Void m ()
sinkWithTimestamps prefixWithTimestamps h =
    case prefixWithTimestamps of
        PrefixWithTimestamps ->
            CB.lines .| CL.mapM addTimestamp .| CL.map (<> "\n") .| sinkHandle h
        WithoutTimestamps -> sinkHandle h
  where
    addTimestamp theLine = do
        now <- liftIO getZonedTime
        pure (formatZonedTimeForLog now <> " " <> theLine)

-- | Format a time in ISO8601 format. We choose ZonedTime over UTCTime
-- because a user expects to see logs in their local time, and would
-- be confused to see UTC time. Stack's debug logs also use the local
-- time zone.
formatZonedTimeForLog :: ZonedTime -> ByteString
formatZonedTimeForLog = S8.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6Q"

-- | Find the Setup.hs or Setup.lhs in the given directory. If none exists,
-- throw an exception.
getSetupHs :: Path Abs Dir -- ^ project directory
           -> IO (Path Abs File)
getSetupHs dir = do
    exists1 <- doesFileExist fp1
    if exists1
        then pure fp1
        else do
            exists2 <- doesFileExist fp2
            if exists2
                then pure fp2
                else throwM $ NoSetupHsFound dir
  where
    fp1 = dir </> relFileSetupHs
    fp2 = dir </> relFileSetupLhs

-- Do not pass `-hpcdir` as GHC option if the coverage is not enabled.
-- This helps running stack-compiled programs with dynamic interpreters like `hint`.
-- Cfr: https://github.com/commercialhaskell/stack/issues/997
extraBuildOptions :: (HasEnvConfig env, HasRunner env)
                  => WhichCompiler -> BuildOpts -> RIO env [String]
extraBuildOptions wc bopts = do
    colorOpt <- appropriateGhcColorFlag
    let optsFlag = compilerOptionsCabalFlag wc
        baseOpts = maybe "" (" " ++) colorOpt
    if toCoverage (boptsTestOpts bopts)
      then do
        hpcIndexDir <- toFilePathNoTrailingSep <$> hpcRelativeDir
        pure [optsFlag, "-hpcdir " ++ hpcIndexDir ++ baseOpts]
      else
        pure [optsFlag, baseOpts]

-- Library, internal and foreign libraries and executable build components.
primaryComponentOptions :: Map Text ExecutableBuildStatus -> LocalPackage -> [String]
primaryComponentOptions executableBuildStatuses lp =
      -- TODO: get this information from target parsing instead,
      -- which will allow users to turn off library building if
      -- desired
      (case packageLibraries package of
         NoLibraries -> []
         HasLibraries names ->
             map T.unpack
           $ T.append "lib:" (T.pack (packageNameString (packageName package)))
           : map (T.append "flib:") (Set.toList names)) ++
      map (T.unpack . T.append "lib:") (Set.toList $ packageInternalLibraries package) ++
      map (T.unpack . T.append "exe:") (Set.toList $ exesToBuild executableBuildStatuses lp)
  where
    package = lpPackage lp

-- | History of this function:
--
-- * Normally it would do either all executables or if the user
--   specified requested components, just build them. Afterwards, due
--   to this Cabal bug <https://github.com/haskell/cabal/issues/2780>,
--   we had to make Stack build all executables every time.
--
-- * In <https://github.com/commercialhaskell/stack/issues/3229> this
--   was flagged up as very undesirable behavior on a large project,
--   hence the behavior below that we build all executables once
--   (modulo success), and thereafter pay attention to user-wanted
--   components.
--
exesToBuild :: Map Text ExecutableBuildStatus -> LocalPackage -> Set Text
exesToBuild executableBuildStatuses lp =
    if cabalIsSatisfied executableBuildStatuses && lpWanted lp
        then exeComponents (lpComponents lp)
        else packageExes (lpPackage lp)

-- | Do the current executables satisfy Cabal's bugged out requirements?
cabalIsSatisfied :: Map k ExecutableBuildStatus -> Bool
cabalIsSatisfied = all (== ExecutableBuilt) . M.elems

-- Test-suite and benchmark build components.
finalComponentOptions :: LocalPackage -> [String]
finalComponentOptions lp =
    map (T.unpack . renderComponent) $
    Set.toList $
    Set.filter (\c -> isCTest c || isCBench c) (lpComponents lp)

taskComponents :: Task -> Set NamedComponent
taskComponents task =
    case taskType task of
        TTLocalMutable lp -> lpComponents lp -- FIXME probably just want lpWanted
        TTRemotePackage{} -> Set.empty

expectTestFailure :: PackageName -> Maybe Curator -> Bool
expectTestFailure pname mcurator =
    maybe False (Set.member pname . curatorExpectTestFailure) mcurator

expectBenchmarkFailure :: PackageName -> Maybe Curator -> Bool
expectBenchmarkFailure pname mcurator =
    maybe False (Set.member pname . curatorExpectBenchmarkFailure) mcurator

fulfillCuratorBuildExpectations ::
       (HasLogFunc env, HasCallStack)
    => PackageName
    -> Maybe Curator
    -> Bool
    -> Bool
    -> b
    -> RIO env b
    -> RIO env b
fulfillCuratorBuildExpectations pname mcurator enableTests _ defValue action | enableTests &&
                                                                          expectTestFailure pname mcurator = do
    eres <- tryAny action
    case eres of
      Right res -> do
          logWarn $ fromString (packageNameString pname) <> ": unexpected test build success"
          pure res
      Left _ -> pure defValue
fulfillCuratorBuildExpectations pname mcurator _ enableBench defValue action | enableBench &&
                                                                          expectBenchmarkFailure pname mcurator = do
    eres <- tryAny action
    case eres of
      Right res -> do
          logWarn $ fromString (packageNameString pname) <> ": unexpected benchmark build success"
          pure res
      Left _ -> pure defValue
fulfillCuratorBuildExpectations _ _ _ _ _ action = do
    action
