{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE NoMonoLocalBinds    #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

-- |
--
module Distribution.Client.ProjectBuilding (
    -- * Dry run phase
    -- | What bits of the plan will we execute? The dry run does not change
    -- anything but tells us what will need to be built.
    rebuildTargetsDryRun,
    improveInstallPlanWithUpToDatePackages,

    -- ** Build status
    -- | This is the detailed status information we get from the dry run.
    BuildStatusMap,
    BuildStatus(..),
    BuildStatusRebuild(..),
    BuildReason(..),
    MonitorChangedReason(..),
    buildStatusToString,

    -- * Build phase
    -- | Now we actually execute the plan.
    rebuildTargets,
    -- ** Build outcomes
    -- | This is the outcome for each package of executing the plan.
    -- For each package, did the build succeed or fail?
    BuildOutcomes,
    BuildOutcome,
    BuildResult(..),
    BuildFailure(..),
    BuildFailureReason(..),
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import           Distribution.Client.PackageHash (renderPackageHashInputs)
import           Distribution.Client.RebuildMonad
import           Distribution.Client.ProjectConfig
import           Distribution.Client.ProjectPlanning
import           Distribution.Client.ProjectPlanning.Types
import           Distribution.Client.ProjectBuilding.Types
import           Distribution.Client.Store

import           Distribution.Client.Types
                   hiding (BuildOutcomes, BuildOutcome,
                           BuildResult(..), BuildFailure(..))
import           Distribution.Client.InstallPlan
                   ( GenericInstallPlan, GenericPlanPackage, IsUnit )
import qualified Distribution.Client.InstallPlan as InstallPlan
import           Distribution.Client.DistDirLayout
import           Distribution.Client.FileMonitor
import           Distribution.Client.SetupWrapper
import           Distribution.Client.JobControl
import           Distribution.Client.FetchUtils
import           Distribution.Client.GlobalFlags (RepoContext)
import qualified Distribution.Client.Tar as Tar
import           Distribution.Client.Setup
                   ( filterConfigureFlags, filterHaddockArgs
                   , filterHaddockFlags, filterTestFlags )
import           Distribution.Client.SourceFiles
import           Distribution.Client.SrcDist (allPackageSourceFiles)
import           Distribution.Client.Utils
                   ( ProgressPhase(..), findOpenProgramLocation, progressMessage, removeExistingFile )

import           Distribution.Compat.Lens
import           Distribution.Package
import qualified Distribution.PackageDescription as PD
import           Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as Installed
import           Distribution.Simple.BuildPaths (haddockDirName)
import qualified Distribution.Simple.InstallDirs as InstallDirs
import           Distribution.Types.BuildType
import           Distribution.Types.PackageDescription.Lens (componentModules)
import           Distribution.Simple.Program
import qualified Distribution.Simple.Setup as Cabal
import           Distribution.Simple.Command (CommandUI)
import qualified Distribution.Simple.Register as Cabal
import           Distribution.Simple.LocalBuildInfo
                   ( ComponentName(..), LibraryName(..) )
import           Distribution.Simple.Compiler
                   ( Compiler, compilerId, PackageDB(..) )

import           Distribution.Simple.Utils
import           Distribution.Version
import           Distribution.Compat.Graph (IsNode(..))

import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS.Char8

import Control.Exception (Handler (..), SomeAsyncException, assert, catches, handle)
import System.Directory  (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile, renameDirectory)
import System.FilePath   (dropDrive, makeRelative, normalise, takeDirectory, (<.>), (</>))
import System.IO         (IOMode (AppendMode), Handle, withFile)

import Distribution.Compat.Directory (listDirectory)


------------------------------------------------------------------------------
-- * Overall building strategy.
------------------------------------------------------------------------------
--
-- We start with an 'ElaboratedInstallPlan' that has already been improved by
-- reusing packages from the store, and pruned to include only the targets of
-- interest and their dependencies. So the remaining packages in the
-- 'InstallPlan.Configured' state are ones we either need to build or rebuild.
--
-- First, we do a preliminary dry run phase where we work out which packages
-- we really need to (re)build, and for the ones we do need to build which
-- build phase to start at.
--
-- We use this to improve the 'ElaboratedInstallPlan' again by changing
-- up-to-date 'InstallPlan.Configured' packages to 'InstallPlan.Installed'
-- so that the build phase will skip them.
--
-- Then we execute the plan, that is actually build packages. The outcomes of
-- trying to build all the packages are collected and returned.
--
-- We split things like this (dry run and execute) for a couple reasons.
-- Firstly we need to be able to do dry runs anyway, and these need to be
-- reasonably accurate in terms of letting users know what (and why) things
-- are going to be (re)built.
--
-- Given that we need to be able to do dry runs, it would not be great if
-- we had to repeat all the same work when we do it for real. Not only is
-- it duplicate work, but it's duplicate code which is likely to get out of
-- sync. So we do things only once. We preserve info we discover in the dry
-- run phase and rely on it later when we build things for real. This also
-- somewhat simplifies the build phase. So this way the dry run can't so
-- easily drift out of sync with the real thing since we're relying on the
-- info it produces.
--
-- An additional advantage is that it makes it easier to debug rebuild
-- errors (ie rebuilding too much or too little), since all the rebuild
-- decisions are made without making any state changes at the same time
-- (that would make it harder to reproduce the problem situation).
--
-- Finally, we can use the dry run build status and the build outcomes to
-- give us some information on the overall status of packages in the project.
-- This includes limited information about the status of things that were
-- not actually in the subset of the plan that was used for the dry run or
-- execution phases. In particular we may know that some packages are now
-- definitely out of date. See "Distribution.Client.ProjectPlanOutput" for
-- details.


------------------------------------------------------------------------------
-- * Dry run: what bits of the 'ElaboratedInstallPlan' will we execute?
------------------------------------------------------------------------------

-- Refer to ProjectBuilding.Types for details of these important types:

-- type BuildStatusMap     = ...
-- data BuildStatus        = ...
-- data BuildStatusRebuild = ...
-- data BuildReason        = ...

-- | Do the dry run pass. This is a prerequisite of 'rebuildTargets'.
--
-- It gives us the 'BuildStatusMap'. This should be used with
-- 'improveInstallPlanWithUpToDatePackages' to give an improved version of
-- the 'ElaboratedInstallPlan' with packages switched to the
-- 'InstallPlan.Installed' state when we find that they're already up to date.
--
rebuildTargetsDryRun :: DistDirLayout
                     -> ElaboratedSharedConfig
                     -> ElaboratedInstallPlan
                     -> IO BuildStatusMap
rebuildTargetsDryRun :: DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> IO BuildStatusMap
rebuildTargetsDryRun distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
FilePath -> FilePath
PackageIdentifier -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: DistDirLayout -> CompilerId -> PackageDB
distBinDirectory :: DistDirLayout -> FilePath
distTempDirectory :: DistDirLayout -> FilePath
distSdistDirectory :: DistDirLayout -> FilePath
distSdistFile :: DistDirLayout -> PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageIdentifier -> FilePath
distDownloadSrcDirectory :: DistDirLayout -> FilePath
distBuildRootDirectory :: DistDirLayout -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distDirectory :: DistDirLayout -> FilePath
distProjectFile :: DistDirLayout -> FilePath -> FilePath
distProjectRootDirectory :: DistDirLayout -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageIdentifier -> FilePath
distDownloadSrcDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
..} ElaboratedSharedConfig
shared =
    -- Do the various checks to work out the 'BuildStatus' of each package
    forall (m :: * -> *) ipkg srcpkg b.
(Monad m, IsUnit ipkg, IsUnit srcpkg) =>
(GenericPlanPackage ipkg srcpkg -> [b] -> m b)
-> GenericInstallPlan ipkg srcpkg -> m (Map UnitId b)
foldMInstallPlanDepOrder ElaboratedPlanPackage -> [BuildStatus] -> IO BuildStatus
dryRunPkg
  where
    dryRunPkg :: ElaboratedPlanPackage
              -> [BuildStatus]
              -> IO BuildStatus
    dryRunPkg :: ElaboratedPlanPackage -> [BuildStatus] -> IO BuildStatus
dryRunPkg (InstallPlan.PreExisting InstalledPackageInfo
_pkg) [BuildStatus]
_depsBuildStatus =
      forall (m :: * -> *) a. Monad m => a -> m a
return BuildStatus
BuildStatusPreExisting

    dryRunPkg (InstallPlan.Installed ElaboratedConfiguredPackage
_pkg) [BuildStatus]
_depsBuildStatus =
      forall (m :: * -> *) a. Monad m => a -> m a
return BuildStatus
BuildStatusInstalled

    dryRunPkg (InstallPlan.Configured ElaboratedConfiguredPackage
pkg) [BuildStatus]
depsBuildStatus = do
      Maybe ResolvedPkgLoc
mloc <- UnresolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
checkFetched (ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgSourceLocation ElaboratedConfiguredPackage
pkg)
      case Maybe ResolvedPkgLoc
mloc of
        Maybe ResolvedPkgLoc
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return BuildStatus
BuildStatusDownload

        Just (LocalUnpackedPackage FilePath
srcdir) ->
          -- For the case of a user-managed local dir, irrespective of the
          -- build style, we build from that directory and put build
          -- artifacts under the shared dist directory.
          ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunLocalPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
srcdir

        -- The rest cases are all tarball cases are,
        -- and handled the same as each other though depending on the build style.
        Just (LocalTarballPackage    FilePath
tarball) ->
          ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunTarballPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
tarball

        Just (RemoteTarballPackage URI
_ FilePath
tarball) ->
          ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunTarballPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
tarball

        Just (RepoTarballPackage Repo
_ PackageIdentifier
_ FilePath
tarball) ->
          ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunTarballPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
tarball

        Just (RemoteSourceRepoPackage SourceRepoMaybe
_repo FilePath
tarball) ->
          ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunTarballPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
tarball


    dryRunTarballPkg :: ElaboratedConfiguredPackage
                     -> [BuildStatus]
                     -> FilePath
                     -> IO BuildStatus
    dryRunTarballPkg :: ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunTarballPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
tarball =
      case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg of
        BuildStyle
BuildAndInstall  -> forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatus
BuildStatusUnpack FilePath
tarball)
        BuildStyle
BuildInplaceOnly -> do
          -- TODO: [nice to have] use a proper file monitor rather
          -- than this dir exists test
          Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
srcdir
          if Bool
exists
            then ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunLocalPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
srcdir
            else forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatus
BuildStatusUnpack FilePath
tarball)
      where
        srcdir :: FilePath
        srcdir :: FilePath
srcdir = PackageIdentifier -> FilePath
distUnpackedSrcDirectory (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
pkg)

    dryRunLocalPkg :: ElaboratedConfiguredPackage
                   -> [BuildStatus]
                   -> FilePath
                   -> IO BuildStatus
    dryRunLocalPkg :: ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunLocalPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
srcdir = do
        -- Go and do lots of I/O, reading caches and probing files to work out
        -- if anything has changed
        Either BuildStatusRebuild BuildResult
change <- PackageFileMonitor
-> ElaboratedConfiguredPackage
-> FilePath
-> [BuildStatus]
-> IO (Either BuildStatusRebuild BuildResult)
checkPackageFileMonitorChanged
                    PackageFileMonitor
packageFileMonitor ElaboratedConfiguredPackage
pkg FilePath
srcdir [BuildStatus]
depsBuildStatus
        case Either BuildStatusRebuild BuildResult
change of
          -- It did change, giving us 'BuildStatusRebuild' info on why
          Left BuildStatusRebuild
rebuild ->
            forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatusRebuild -> BuildStatus
BuildStatusRebuild FilePath
srcdir BuildStatusRebuild
rebuild)

          -- No changes, the package is up to date. Use the saved build results.
          Right BuildResult
buildResult ->
            forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResult -> BuildStatus
BuildStatusUpToDate BuildResult
buildResult)
      where
        packageFileMonitor :: PackageFileMonitor
        packageFileMonitor :: PackageFileMonitor
packageFileMonitor =
          ElaboratedSharedConfig
-> DistDirLayout -> DistDirParams -> PackageFileMonitor
newPackageFileMonitor ElaboratedSharedConfig
shared DistDirLayout
distDirLayout
          (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
shared ElaboratedConfiguredPackage
pkg)


-- | A specialised traversal over the packages in an install plan.
--
-- The packages are visited in dependency order, starting with packages with no
-- dependencies. The result for each package is accumulated into a 'Map' and
-- returned as the final result. In addition, when visiting a package, the
-- visiting function is passed the results for all the immediate package
-- dependencies. This can be used to propagate information from dependencies.
--
foldMInstallPlanDepOrder
  :: forall m ipkg srcpkg b.
     (Monad m, IsUnit ipkg, IsUnit srcpkg)
  => (GenericPlanPackage ipkg srcpkg ->
      [b] -> m b)
  -> GenericInstallPlan ipkg srcpkg
  -> m (Map UnitId b)
foldMInstallPlanDepOrder :: forall (m :: * -> *) ipkg srcpkg b.
(Monad m, IsUnit ipkg, IsUnit srcpkg) =>
(GenericPlanPackage ipkg srcpkg -> [b] -> m b)
-> GenericInstallPlan ipkg srcpkg -> m (Map UnitId b)
foldMInstallPlanDepOrder GenericPlanPackage ipkg srcpkg -> [b] -> m b
visit =
    Map UnitId b
-> [GenericPlanPackage ipkg srcpkg] -> m (Map UnitId b)
go forall k a. Map k a
Map.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.reverseTopologicalOrder
  where
    go :: Map UnitId b
       -> [GenericPlanPackage ipkg srcpkg]
       -> m (Map UnitId b)
    go :: Map UnitId b
-> [GenericPlanPackage ipkg srcpkg] -> m (Map UnitId b)
go !Map UnitId b
results [] = forall (m :: * -> *) a. Monad m => a -> m a
return Map UnitId b
results

    go !Map UnitId b
results (GenericPlanPackage ipkg srcpkg
pkg : [GenericPlanPackage ipkg srcpkg]
pkgs) = do
      -- we go in the right order so the results map has entries for all deps
      let depresults :: [b]
          depresults :: [b]
depresults =
            forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
ipkgid -> let result :: b
result = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"foldMInstallPlanDepOrder") UnitId
ipkgid Map UnitId b
results
                              in b
result)
                (forall a. IsUnit a => a -> [UnitId]
InstallPlan.depends GenericPlanPackage ipkg srcpkg
pkg)
      b
result <- GenericPlanPackage ipkg srcpkg -> [b] -> m b
visit GenericPlanPackage ipkg srcpkg
pkg [b]
depresults
      let results' :: Map UnitId b
results' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall a. IsNode a => a -> Key a
nodeKey GenericPlanPackage ipkg srcpkg
pkg) b
result Map UnitId b
results
      Map UnitId b
-> [GenericPlanPackage ipkg srcpkg] -> m (Map UnitId b)
go Map UnitId b
results' [GenericPlanPackage ipkg srcpkg]
pkgs

improveInstallPlanWithUpToDatePackages :: BuildStatusMap
                                       -> ElaboratedInstallPlan
                                       -> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages :: BuildStatusMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages BuildStatusMap
pkgsBuildStatus =
    forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
(srcpkg -> Bool)
-> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg
InstallPlan.installed ElaboratedConfiguredPackage -> Bool
canPackageBeImproved
  where
    canPackageBeImproved :: ElaboratedConfiguredPackage -> Bool
    canPackageBeImproved :: ElaboratedConfiguredPackage -> Bool
canPackageBeImproved ElaboratedConfiguredPackage
pkg =
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg) BuildStatusMap
pkgsBuildStatus of
        Just BuildStatusUpToDate {} -> Bool
True
        Just BuildStatus
_                      -> Bool
False
        Maybe BuildStatus
Nothing -> forall a. (?callStack::CallStack) => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"improveInstallPlanWithUpToDatePackages: "
                        forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
pkg) forall a. [a] -> [a] -> [a]
++ FilePath
" not in status map"


-----------------------------
-- Package change detection
--

-- | As part of the dry run for local unpacked packages we have to check if the
-- package config or files have changed. That is the purpose of
-- 'PackageFileMonitor' and 'checkPackageFileMonitorChanged'.
--
-- When a package is (re)built, the monitor must be updated to reflect the new
-- state of the package. Because we sometimes build without reconfiguring the
-- state updates are split into two, one for package config changes and one
-- for other changes. This is the purpose of 'updatePackageConfigFileMonitor'
-- and 'updatePackageBuildFileMonitor'.
--
data PackageFileMonitor = PackageFileMonitor {
       PackageFileMonitor -> FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage (),
       PackageFileMonitor
-> FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild  :: FileMonitor (Set ComponentName) BuildResultMisc,
       PackageFileMonitor -> FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg    :: FileMonitor () (Maybe InstalledPackageInfo)
     }

-- | This is all the components of the 'BuildResult' other than the
-- @['InstalledPackageInfo']@.
--
-- We have to split up the 'BuildResult' components since they get produced
-- at different times (or rather, when different things change).
--
type BuildResultMisc = (DocsResult, TestsResult)

newPackageFileMonitor :: ElaboratedSharedConfig
                      -> DistDirLayout
                      -> DistDirParams
                      -> PackageFileMonitor
newPackageFileMonitor :: ElaboratedSharedConfig
-> DistDirLayout -> DistDirParams -> PackageFileMonitor
newPackageFileMonitor ElaboratedSharedConfig
shared
                      DistDirLayout{DistDirParams -> FilePath -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distPackageCacheFile}
                      DistDirParams
dparams =
    PackageFileMonitor {
      pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig =
        FileMonitor {
          fileMonitorCacheFile :: FilePath
fileMonitorCacheFile = DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
dparams FilePath
"config",
          fileMonitorKeyValid :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
fileMonitorKeyValid = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
normaliseConfiguredPackage ElaboratedSharedConfig
shared,
          fileMonitorCheckIfOnlyValueChanged :: Bool
fileMonitorCheckIfOnlyValueChanged = Bool
False
        },

      pkgFileMonitorBuild :: FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild =
        FileMonitor {
          fileMonitorCacheFile :: FilePath
fileMonitorCacheFile = DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
dparams FilePath
"build",
          fileMonitorKeyValid :: Set ComponentName -> Set ComponentName -> Bool
fileMonitorKeyValid  = \Set ComponentName
componentsToBuild Set ComponentName
componentsAlreadyBuilt ->
            Set ComponentName
componentsToBuild forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set ComponentName
componentsAlreadyBuilt,
          fileMonitorCheckIfOnlyValueChanged :: Bool
fileMonitorCheckIfOnlyValueChanged = Bool
True
        },

      pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg =
        forall a b. Eq a => FilePath -> FileMonitor a b
newFileMonitor (DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
dparams FilePath
"registration")
    }

-- | Helper function for 'checkPackageFileMonitorChanged',
-- 'updatePackageConfigFileMonitor' and 'updatePackageBuildFileMonitor'.
--
-- It selects the info from a 'ElaboratedConfiguredPackage' that are used by
-- the 'FileMonitor's (in the 'PackageFileMonitor') to detect value changes.
--
packageFileMonitorKeyValues :: ElaboratedConfiguredPackage
                            -> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues :: ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues ElaboratedConfiguredPackage
elab =
    (ElaboratedConfiguredPackage
elab_config, Set ComponentName
buildComponents)
  where
    -- The first part is the value used to guard (re)configuring the package.
    -- That is, if this value changes then we will reconfigure.
    -- The ElaboratedConfiguredPackage consists mostly (but not entirely) of
    -- information that affects the (re)configure step. But those parts that
    -- do not affect the configure step need to be nulled out. Those parts are
    -- the specific targets that we're going to build.
    --

    -- Additionally we null out the parts that don't affect the configure step because they're simply
    -- about how tests or benchmarks are run

    -- TODO there may be more things to null here too, in the future.

    elab_config :: ElaboratedConfiguredPackage
    elab_config :: ElaboratedConfiguredPackage
elab_config =
        ElaboratedConfiguredPackage
elab {
            elabBuildTargets :: [ComponentTarget]
elabBuildTargets   = [],
            elabTestTargets :: [ComponentTarget]
elabTestTargets    = [],
            elabBenchTargets :: [ComponentTarget]
elabBenchTargets   = [],
            elabReplTarget :: Maybe ComponentTarget
elabReplTarget     = forall a. Maybe a
Nothing,
            elabHaddockTargets :: [ComponentTarget]
elabHaddockTargets = [],
            elabBuildHaddocks :: Bool
elabBuildHaddocks  = Bool
False,

            elabTestMachineLog :: Maybe PathTemplate
elabTestMachineLog   = forall a. Maybe a
Nothing,
            elabTestHumanLog :: Maybe PathTemplate
elabTestHumanLog     = forall a. Maybe a
Nothing,
            elabTestShowDetails :: Maybe TestShowDetails
elabTestShowDetails  = forall a. Maybe a
Nothing,
            elabTestKeepTix :: Bool
elabTestKeepTix      = Bool
False,
            elabTestTestOptions :: [PathTemplate]
elabTestTestOptions  = [],
            elabBenchmarkOptions :: [PathTemplate]
elabBenchmarkOptions = []
        }

    -- The second part is the value used to guard the build step. So this is
    -- more or less the opposite of the first part, as it's just the info about
    -- what targets we're going to build.
    --
    buildComponents :: Set ComponentName
    buildComponents :: Set ComponentName
buildComponents = ElaboratedConfiguredPackage -> Set ComponentName
elabBuildTargetWholeComponents ElaboratedConfiguredPackage
elab

-- | Do all the checks on whether a package has changed and thus needs either
-- rebuilding or reconfiguring and rebuilding.
--
checkPackageFileMonitorChanged :: PackageFileMonitor
                               -> ElaboratedConfiguredPackage
                               -> FilePath
                               -> [BuildStatus]
                               -> IO (Either BuildStatusRebuild BuildResult)
checkPackageFileMonitorChanged :: PackageFileMonitor
-> ElaboratedConfiguredPackage
-> FilePath
-> [BuildStatus]
-> IO (Either BuildStatusRebuild BuildResult)
checkPackageFileMonitorChanged PackageFileMonitor{FileMonitor () (Maybe InstalledPackageInfo)
FileMonitor (Set ComponentName) BuildResultMisc
FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorBuild :: FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorReg :: PackageFileMonitor -> FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorBuild :: PackageFileMonitor
-> FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorConfig :: PackageFileMonitor -> FileMonitor ElaboratedConfiguredPackage ()
..}
                               ElaboratedConfiguredPackage
pkg FilePath
srcdir [BuildStatus]
depsBuildStatus = do
    --TODO: [nice to have] some debug-level message about file
    --changes, like rerunIfChanged
    MonitorChanged ElaboratedConfiguredPackage ()
configChanged <- forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged
                       FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig FilePath
srcdir ElaboratedConfiguredPackage
pkgconfig
    case MonitorChanged ElaboratedConfiguredPackage ()
configChanged of
      MonitorChanged MonitorChangedReason ElaboratedConfiguredPackage
monitorReason ->
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (MonitorChangedReason () -> BuildStatusRebuild
BuildStatusConfigure MonitorChangedReason ()
monitorReason'))
        where
          monitorReason' :: MonitorChangedReason ()
monitorReason' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) MonitorChangedReason ElaboratedConfiguredPackage
monitorReason

      MonitorUnchanged () [MonitorFilePath]
_
          -- The configChanged here includes the identity of the dependencies,
          -- so depsBuildStatus is just needed for the changes in the content
          -- of dependencies.
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BuildStatus -> Bool
buildStatusRequiresBuild [BuildStatus]
depsBuildStatus -> do
            MonitorChanged () (Maybe InstalledPackageInfo)
regChanged <- forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg FilePath
srcdir ()
            let mreg :: Maybe (Maybe InstalledPackageInfo)
mreg = forall a b. MonitorChanged a b -> Maybe b
changedToMaybe MonitorChanged () (Maybe InstalledPackageInfo)
regChanged
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
mreg BuildReason
BuildReasonDepsRebuilt))

        | Bool
otherwise -> do
            MonitorChanged (Set ComponentName) BuildResultMisc
buildChanged  <- forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged
                               FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild FilePath
srcdir Set ComponentName
buildComponents
            MonitorChanged () (Maybe InstalledPackageInfo)
regChanged    <- forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged
                               FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg FilePath
srcdir ()
            let mreg :: Maybe (Maybe InstalledPackageInfo)
mreg = forall a b. MonitorChanged a b -> Maybe b
changedToMaybe MonitorChanged () (Maybe InstalledPackageInfo)
regChanged
            case (MonitorChanged (Set ComponentName) BuildResultMisc
buildChanged, MonitorChanged () (Maybe InstalledPackageInfo)
regChanged) of
              (MonitorChanged (MonitoredValueChanged Set ComponentName
prevBuildComponents), MonitorChanged () (Maybe InstalledPackageInfo)
_) ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
mreg BuildReason
buildReason))
                where
                  buildReason :: BuildReason
buildReason = Set ComponentName -> BuildReason
BuildReasonExtraTargets Set ComponentName
prevBuildComponents

              (MonitorChanged MonitorChangedReason (Set ComponentName)
monitorReason, MonitorChanged () (Maybe InstalledPackageInfo)
_) ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
mreg BuildReason
buildReason))
                where
                  buildReason :: BuildReason
buildReason    = MonitorChangedReason () -> BuildReason
BuildReasonFilesChanged MonitorChangedReason ()
monitorReason'
                  monitorReason' :: MonitorChangedReason ()
monitorReason' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) MonitorChangedReason (Set ComponentName)
monitorReason

              (MonitorUnchanged BuildResultMisc
_ [MonitorFilePath]
_, MonitorChanged MonitorChangedReason ()
monitorReason) ->
                -- this should only happen if the file is corrupt or been
                -- manually deleted. We don't want to bother with another
                -- phase just for this, so we'll reregister by doing a build.
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild forall a. Maybe a
Nothing BuildReason
buildReason))
                where
                  buildReason :: BuildReason
buildReason    = MonitorChangedReason () -> BuildReason
BuildReasonFilesChanged MonitorChangedReason ()
monitorReason'
                  monitorReason' :: MonitorChangedReason ()
monitorReason' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) MonitorChangedReason ()
monitorReason

              (MonitorUnchanged BuildResultMisc
_ [MonitorFilePath]
_, MonitorUnchanged Maybe InstalledPackageInfo
_ [MonitorFilePath]
_)
                | ElaboratedConfiguredPackage -> Bool
pkgHasEphemeralBuildTargets ElaboratedConfiguredPackage
pkg ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
mreg BuildReason
buildReason))
                where
                  buildReason :: BuildReason
buildReason = BuildReason
BuildReasonEphemeralTargets

              (MonitorUnchanged BuildResultMisc
buildResult [MonitorFilePath]
_, MonitorUnchanged Maybe InstalledPackageInfo
_ [MonitorFilePath]
_) ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right BuildResult {
                    buildResultDocs :: DocsResult
buildResultDocs    = DocsResult
docsResult,
                    buildResultTests :: TestsResult
buildResultTests   = TestsResult
testsResult,
                    buildResultLogFile :: Maybe FilePath
buildResultLogFile = forall a. Maybe a
Nothing
                  }
                where
                  (DocsResult
docsResult, TestsResult
testsResult) = BuildResultMisc
buildResult
  where
    (ElaboratedConfiguredPackage
pkgconfig, Set ComponentName
buildComponents) = ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues ElaboratedConfiguredPackage
pkg
    changedToMaybe :: MonitorChanged a b -> Maybe b
    changedToMaybe :: forall a b. MonitorChanged a b -> Maybe b
changedToMaybe (MonitorChanged     MonitorChangedReason a
_) = forall a. Maybe a
Nothing
    changedToMaybe (MonitorUnchanged b
x [MonitorFilePath]
_) = forall a. a -> Maybe a
Just b
x


updatePackageConfigFileMonitor :: PackageFileMonitor
                               -> FilePath
                               -> ElaboratedConfiguredPackage
                               -> IO ()
updatePackageConfigFileMonitor :: PackageFileMonitor
-> FilePath -> ElaboratedConfiguredPackage -> IO ()
updatePackageConfigFileMonitor PackageFileMonitor{FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig :: PackageFileMonitor -> FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig}
                               FilePath
srcdir ElaboratedConfiguredPackage
pkg =
    forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig FilePath
srcdir forall a. Maybe a
Nothing
                      [] ElaboratedConfiguredPackage
pkgconfig ()
  where
    (ElaboratedConfiguredPackage
pkgconfig, Set ComponentName
_buildComponents) = ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues ElaboratedConfiguredPackage
pkg

updatePackageBuildFileMonitor :: PackageFileMonitor
                              -> FilePath
                              -> MonitorTimestamp
                              -> ElaboratedConfiguredPackage
                              -> BuildStatusRebuild
                              -> [MonitorFilePath]
                              -> BuildResultMisc
                              -> IO ()
updatePackageBuildFileMonitor :: PackageFileMonitor
-> FilePath
-> MonitorTimestamp
-> ElaboratedConfiguredPackage
-> BuildStatusRebuild
-> [MonitorFilePath]
-> BuildResultMisc
-> IO ()
updatePackageBuildFileMonitor PackageFileMonitor{FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild :: FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild :: PackageFileMonitor
-> FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild}
                              FilePath
srcdir MonitorTimestamp
timestamp ElaboratedConfiguredPackage
pkg BuildStatusRebuild
pkgBuildStatus
                              [MonitorFilePath]
monitors BuildResultMisc
buildResult =
    forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild FilePath
srcdir (forall a. a -> Maybe a
Just MonitorTimestamp
timestamp)
                      [MonitorFilePath]
monitors Set ComponentName
buildComponents' BuildResultMisc
buildResult
  where
    (ElaboratedConfiguredPackage
_pkgconfig, Set ComponentName
buildComponents) = ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues ElaboratedConfiguredPackage
pkg

    -- If the only thing that's changed is that we're now building extra
    -- components, then we can avoid later unnecessary rebuilds by saving the
    -- total set of components that have been built, namely the union of the
    -- existing ones plus the new ones. If files also changed this would be
    -- the wrong thing to do. Note that we rely on the
    -- fileMonitorCheckIfOnlyValueChanged = True mode to get this guarantee
    -- that it's /only/ the value that changed not any files that changed.
    buildComponents' :: Set ComponentName
buildComponents' =
      case BuildStatusRebuild
pkgBuildStatus of
        BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
_ (BuildReasonExtraTargets Set ComponentName
prevBuildComponents)
          -> Set ComponentName
buildComponents forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set ComponentName
prevBuildComponents
        BuildStatusRebuild
_ -> Set ComponentName
buildComponents

updatePackageRegFileMonitor :: PackageFileMonitor
                            -> FilePath
                            -> Maybe InstalledPackageInfo
                            -> IO ()
updatePackageRegFileMonitor :: PackageFileMonitor
-> FilePath -> Maybe InstalledPackageInfo -> IO ()
updatePackageRegFileMonitor PackageFileMonitor{FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: PackageFileMonitor -> FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg}
                            FilePath
srcdir Maybe InstalledPackageInfo
mipkg =
    forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg FilePath
srcdir forall a. Maybe a
Nothing
                      [] () Maybe InstalledPackageInfo
mipkg

invalidatePackageRegFileMonitor :: PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor :: PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor PackageFileMonitor{FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: PackageFileMonitor -> FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg} =
    FilePath -> IO ()
removeExistingFile (forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg)


------------------------------------------------------------------------------
-- * Doing it: executing an 'ElaboratedInstallPlan'
------------------------------------------------------------------------------

-- Refer to ProjectBuilding.Types for details of these important types:

-- type BuildOutcomes = ...
-- type BuildOutcome  = ...
-- data BuildResult   = ...
-- data BuildFailure  = ...
-- data BuildFailureReason = ...

-- | Build things for real.
--
-- It requires the 'BuildStatusMap' gathered by 'rebuildTargetsDryRun'.
--
rebuildTargets :: Verbosity
               -> DistDirLayout
               -> StoreDirLayout
               -> ElaboratedInstallPlan
               -> ElaboratedSharedConfig
               -> BuildStatusMap
               -> BuildTimeSettings
               -> IO BuildOutcomes
rebuildTargets :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> BuildStatusMap
-> BuildTimeSettings
-> IO BuildOutcomes
rebuildTargets Verbosity
verbosity
               distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
FilePath -> FilePath
PackageIdentifier -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageIdentifier -> FilePath
distDownloadSrcDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
distPackageDB :: DistDirLayout -> CompilerId -> PackageDB
distBinDirectory :: DistDirLayout -> FilePath
distTempDirectory :: DistDirLayout -> FilePath
distSdistDirectory :: DistDirLayout -> FilePath
distSdistFile :: DistDirLayout -> PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageIdentifier -> FilePath
distDownloadSrcDirectory :: DistDirLayout -> FilePath
distBuildRootDirectory :: DistDirLayout -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distDirectory :: DistDirLayout -> FilePath
distProjectFile :: DistDirLayout -> FilePath -> FilePath
distProjectRootDirectory :: DistDirLayout -> FilePath
..}
               StoreDirLayout
storeDirLayout
               ElaboratedInstallPlan
installPlan
               sharedPackageConfig :: ElaboratedSharedConfig
sharedPackageConfig@ElaboratedSharedConfig {
                 pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler      = Compiler
compiler,
                 pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs = ProgramDb
progdb
               }
               BuildStatusMap
pkgsBuildStatus
               buildSettings :: BuildTimeSettings
buildSettings@BuildTimeSettings{
                 Int
buildSettingNumJobs :: BuildTimeSettings -> Int
buildSettingNumJobs :: Int
buildSettingNumJobs,
                 Bool
buildSettingKeepGoing :: BuildTimeSettings -> Bool
buildSettingKeepGoing :: Bool
buildSettingKeepGoing
               } = do

    -- Concurrency control: create the job controller and concurrency limits
    -- for downloading, building and installing.
    JobControl IO (UnitId, Either BuildFailure BuildResult)
jobControl    <- if Bool
isParallelBuild
                       then forall a. WithCallStack (Int -> IO (JobControl IO a))
newParallelJobControl Int
buildSettingNumJobs
                       else forall a. IO (JobControl IO a)
newSerialJobControl
    Lock
registerLock  <- IO Lock
newLock -- serialise registration
    Lock
cacheLock     <- IO Lock
newLock -- serialise access to setup exe cache
                             --TODO: [code cleanup] eliminate setup exe cache

    Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
        FilePath
"Executing install plan "
     forall a. [a] -> [a] -> [a]
++ if Bool
isParallelBuild
          then FilePath
" in parallel using " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
buildSettingNumJobs forall a. [a] -> [a] -> [a]
++ FilePath
" threads."
          else FilePath
" serially."

    Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
distBuildRootDirectory
    Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
distTempDirectory
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> Compiler -> ProgramDb -> PackageDB -> IO ()
createPackageDBIfMissing Verbosity
verbosity Compiler
compiler ProgramDb
progdb) PackageDBStack
packageDBsToUse

    -- Before traversing the install plan, preemptively find all packages that
    -- will need to be downloaded and start downloading them.
    forall a.
Verbosity
-> ((RepoContext -> IO a) -> IO a)
-> ElaboratedInstallPlan
-> BuildStatusMap
-> (AsyncFetchMap -> IO a)
-> IO a
asyncDownloadPackages Verbosity
verbosity (RepoContext -> IO BuildOutcomes) -> IO BuildOutcomes
withRepoCtx
                          ElaboratedInstallPlan
installPlan BuildStatusMap
pkgsBuildStatus forall a b. (a -> b) -> a -> b
$ \AsyncFetchMap
downloadMap ->

      -- For each package in the plan, in dependency order, but in parallel...
      forall (m :: * -> *) ipkg srcpkg result failure.
(IsUnit ipkg, IsUnit srcpkg, Monad m) =>
JobControl m (UnitId, Either failure result)
-> Bool
-> (srcpkg -> failure)
-> GenericInstallPlan ipkg srcpkg
-> (GenericReadyPackage srcpkg -> m (Either failure result))
-> m (BuildOutcomes failure result)
InstallPlan.execute JobControl IO (UnitId, Either BuildFailure BuildResult)
jobControl Bool
keepGoing
                          (Maybe FilePath -> BuildFailureReason -> BuildFailure
BuildFailure forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> BuildFailureReason
DependentFailed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageIdentifier
packageId)
                          ElaboratedInstallPlan
installPlan forall a b. (a -> b) -> a -> b
$ \ElaboratedReadyPackage
pkg ->
        --TODO: review exception handling
        forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(BuildFailure
e :: BuildFailure) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left BuildFailure
e)) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$

        let uid :: UnitId
uid = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedReadyPackage
pkg
            pkgBuildStatus :: BuildStatus
pkgBuildStatus = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"rebuildTargets") UnitId
uid BuildStatusMap
pkgsBuildStatus in

        Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> AsyncFetchMap
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatus
-> IO BuildResult
rebuildTarget
          Verbosity
verbosity
          DistDirLayout
distDirLayout
          StoreDirLayout
storeDirLayout
          BuildTimeSettings
buildSettings AsyncFetchMap
downloadMap
          Lock
registerLock Lock
cacheLock
          ElaboratedSharedConfig
sharedPackageConfig
          ElaboratedInstallPlan
installPlan ElaboratedReadyPackage
pkg
          BuildStatus
pkgBuildStatus
  where
    isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs forall a. Ord a => a -> a -> Bool
>= Int
2
    keepGoing :: Bool
keepGoing       = Bool
buildSettingKeepGoing
    withRepoCtx :: (RepoContext -> IO BuildOutcomes) -> IO BuildOutcomes
withRepoCtx     = forall a.
Verbosity -> BuildTimeSettings -> (RepoContext -> IO a) -> IO a
projectConfigWithBuilderRepoContext Verbosity
verbosity
                        BuildTimeSettings
buildSettings
    packageDBsToUse :: PackageDBStack
packageDBsToUse = -- all the package dbs we may need to create
      (forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList)
        [ PackageDB
pkgdb
        | InstallPlan.Configured ElaboratedConfiguredPackage
elab <- forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
installPlan
        , PackageDB
pkgdb <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack ElaboratedConfiguredPackage
elab
                          , ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack ElaboratedConfiguredPackage
elab
                          , ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack ElaboratedConfiguredPackage
elab ]
        ]


-- | Create a package DB if it does not currently exist. Note that this action
-- is /not/ safe to run concurrently.
--
createPackageDBIfMissing :: Verbosity -> Compiler -> ProgramDb
                         -> PackageDB -> IO ()
createPackageDBIfMissing :: Verbosity -> Compiler -> ProgramDb -> PackageDB -> IO ()
createPackageDBIfMissing Verbosity
verbosity Compiler
compiler ProgramDb
progdb
                         (SpecificPackageDB FilePath
dbPath) = do
    Bool
exists <- FilePath -> IO Bool
Cabal.doesPackageDBExist FilePath
dbPath
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ do
      Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (FilePath -> FilePath
takeDirectory FilePath
dbPath)
      Verbosity -> Compiler -> ProgramDb -> Bool -> FilePath -> IO ()
Cabal.createPackageDB Verbosity
verbosity Compiler
compiler ProgramDb
progdb Bool
False FilePath
dbPath
createPackageDBIfMissing Verbosity
_ Compiler
_ ProgramDb
_ PackageDB
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- | Given all the context and resources, (re)build an individual package.
--
rebuildTarget :: Verbosity
              -> DistDirLayout
              -> StoreDirLayout
              -> BuildTimeSettings
              -> AsyncFetchMap
              -> Lock -> Lock
              -> ElaboratedSharedConfig
              -> ElaboratedInstallPlan
              -> ElaboratedReadyPackage
              -> BuildStatus
              -> IO BuildResult
rebuildTarget :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> AsyncFetchMap
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatus
-> IO BuildResult
rebuildTarget Verbosity
verbosity
              distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{DistDirParams -> FilePath
distBuildDirectory :: DistDirParams -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory}
              StoreDirLayout
storeDirLayout
              BuildTimeSettings
buildSettings AsyncFetchMap
downloadMap
              Lock
registerLock Lock
cacheLock
              ElaboratedSharedConfig
sharedPackageConfig
              ElaboratedInstallPlan
plan rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
              BuildStatus
pkgBuildStatus
    -- Technically, doing the --only-download filtering only in this function is
    -- not perfect. We could also prune the plan at an earlier stage, like it's
    -- done with --only-dependencies. But...
    --   * the benefit would be minimal (practically just avoiding to print the
    --     "requires build" parts of the plan)
    --   * we currently don't have easy access to the BuildStatus of packages
    --     in the pruning phase
    --   * we still have to check it here to avoid performing successive phases
    | BuildTimeSettings -> Bool
buildSettingOnlyDownload BuildTimeSettings
buildSettings = do
        case BuildStatus
pkgBuildStatus of
          BuildStatus
BuildStatusDownload ->
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Verbosity
-> AsyncFetchMap
-> ElaboratedConfiguredPackage
-> IO DownloadedSourceLocation
waitAsyncPackageDownload Verbosity
verbosity AsyncFetchMap
downloadMap ElaboratedConfiguredPackage
pkg
          BuildStatus
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DocsResult -> TestsResult -> Maybe FilePath -> BuildResult
BuildResult DocsResult
DocsNotTried TestsResult
TestsNotTried forall a. Maybe a
Nothing
    | Bool
otherwise =
    -- We rely on the 'BuildStatus' to decide which phase to start from:
    case BuildStatus
pkgBuildStatus of
      BuildStatus
BuildStatusDownload              -> IO BuildResult
downloadPhase
      BuildStatusUnpack FilePath
tarball        -> FilePath -> IO BuildResult
unpackTarballPhase FilePath
tarball
      BuildStatusRebuild FilePath
srcdir BuildStatusRebuild
status -> BuildStatusRebuild -> FilePath -> IO BuildResult
rebuildPhase BuildStatusRebuild
status FilePath
srcdir

      -- TODO: perhaps re-nest the types to make these impossible
      BuildStatusPreExisting {} -> forall {a}. a
unexpectedState
      BuildStatusInstalled   {} -> forall {a}. a
unexpectedState
      BuildStatusUpToDate    {} -> forall {a}. a
unexpectedState
  where
    unexpectedState :: a
unexpectedState = forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"rebuildTarget: unexpected package status"

    downloadPhase :: IO BuildResult
    downloadPhase :: IO BuildResult
downloadPhase = do
        DownloadedSourceLocation
downsrcloc <- forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
DownloadFailed forall a b. (a -> b) -> a -> b
$
                        Verbosity
-> AsyncFetchMap
-> ElaboratedConfiguredPackage
-> IO DownloadedSourceLocation
waitAsyncPackageDownload Verbosity
verbosity AsyncFetchMap
downloadMap ElaboratedConfiguredPackage
pkg
        case DownloadedSourceLocation
downsrcloc of
          DownloadedTarball FilePath
tarball -> FilePath -> IO BuildResult
unpackTarballPhase FilePath
tarball
          --TODO: [nice to have] git/darcs repos etc


    unpackTarballPhase :: FilePath -> IO BuildResult
    unpackTarballPhase :: FilePath -> IO BuildResult
unpackTarballPhase FilePath
tarball =
        forall a.
Verbosity
-> DistDirLayout
-> FilePath
-> PackageIdentifier
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath -> FilePath -> IO a)
-> IO a
withTarballLocalDirectory
          Verbosity
verbosity DistDirLayout
distDirLayout FilePath
tarball
          (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
pkg) (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
sharedPackageConfig ElaboratedConfiguredPackage
pkg)
          (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg)
          (ElaboratedConfiguredPackage -> Maybe CabalFileText
elabPkgDescriptionOverride ElaboratedConfiguredPackage
pkg) forall a b. (a -> b) -> a -> b
$

          case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg of
            BuildStyle
BuildAndInstall  -> FilePath -> FilePath -> IO BuildResult
buildAndInstall
            BuildStyle
BuildInplaceOnly -> BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
buildInplace BuildStatusRebuild
buildStatus
              where
                buildStatus :: BuildStatusRebuild
buildStatus = MonitorChangedReason () -> BuildStatusRebuild
BuildStatusConfigure forall a. MonitorChangedReason a
MonitorFirstRun

    -- Note that this really is rebuild, not build. It can only happen for
    -- 'BuildInplaceOnly' style packages. 'BuildAndInstall' style packages
    -- would only start from download or unpack phases.
    --
    rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult
    rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult
rebuildPhase BuildStatusRebuild
buildStatus FilePath
srcdir =
        forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly) forall a b. (a -> b) -> a -> b
$

          BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
buildInplace BuildStatusRebuild
buildStatus FilePath
srcdir FilePath
builddir
      where
        builddir :: FilePath
builddir = DistDirParams -> FilePath
distBuildDirectory
                   (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
sharedPackageConfig ElaboratedConfiguredPackage
pkg)

    buildAndInstall :: FilePath -> FilePath -> IO BuildResult
    buildAndInstall :: FilePath -> FilePath -> IO BuildResult
buildAndInstall FilePath
srcdir FilePath
builddir =
        Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> FilePath
-> FilePath
-> IO BuildResult
buildAndInstallUnpackedPackage
          Verbosity
verbosity DistDirLayout
distDirLayout StoreDirLayout
storeDirLayout
          BuildTimeSettings
buildSettings Lock
registerLock Lock
cacheLock
          ElaboratedSharedConfig
sharedPackageConfig
          ElaboratedInstallPlan
plan ElaboratedReadyPackage
rpkg
          FilePath
srcdir FilePath
builddir'
      where
        builddir' :: FilePath
builddir' = FilePath -> FilePath -> FilePath
makeRelative FilePath
srcdir FilePath
builddir
        --TODO: [nice to have] ^^ do this relative stuff better

    buildInplace :: BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
    buildInplace :: BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
buildInplace BuildStatusRebuild
buildStatus FilePath
srcdir FilePath
builddir =
        --TODO: [nice to have] use a relative build dir rather than absolute
        Verbosity
-> DistDirLayout
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatusRebuild
-> FilePath
-> FilePath
-> IO BuildResult
buildInplaceUnpackedPackage
          Verbosity
verbosity DistDirLayout
distDirLayout
          BuildTimeSettings
buildSettings Lock
registerLock Lock
cacheLock
          ElaboratedSharedConfig
sharedPackageConfig
          ElaboratedInstallPlan
plan ElaboratedReadyPackage
rpkg
          BuildStatusRebuild
buildStatus
          FilePath
srcdir FilePath
builddir

-- TODO: [nice to have] do we need to use a with-style for the temp
-- files for downloading http packages, or are we going to cache them
-- persistently?

-- | Given the current 'InstallPlan' and 'BuildStatusMap', select all the
-- packages we have to download and fork off an async action to download them.
-- We download them in dependency order so that the one's we'll need
-- first are the ones we will start downloading first.
--
-- The body action is passed a map from those packages (identified by their
-- location) to a completion var for that package. So the body action should
-- lookup the location and use 'waitAsyncPackageDownload' to get the result.
--
asyncDownloadPackages :: Verbosity
                      -> ((RepoContext -> IO a) -> IO a)
                      -> ElaboratedInstallPlan
                      -> BuildStatusMap
                      -> (AsyncFetchMap -> IO a)
                      -> IO a
asyncDownloadPackages :: forall a.
Verbosity
-> ((RepoContext -> IO a) -> IO a)
-> ElaboratedInstallPlan
-> BuildStatusMap
-> (AsyncFetchMap -> IO a)
-> IO a
asyncDownloadPackages Verbosity
verbosity (RepoContext -> IO a) -> IO a
withRepoCtx ElaboratedInstallPlan
installPlan BuildStatusMap
pkgsBuildStatus AsyncFetchMap -> IO a
body
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnresolvedPkgLoc]
pkgsToDownload = AsyncFetchMap -> IO a
body forall k a. Map k a
Map.empty
  | Bool
otherwise           = (RepoContext -> IO a) -> IO a
withRepoCtx forall a b. (a -> b) -> a -> b
$ \RepoContext
repoctx ->
                            forall a.
Verbosity
-> RepoContext
-> [UnresolvedPkgLoc]
-> (AsyncFetchMap -> IO a)
-> IO a
asyncFetchPackages Verbosity
verbosity RepoContext
repoctx
                                               [UnresolvedPkgLoc]
pkgsToDownload AsyncFetchMap -> IO a
body
  where
    pkgsToDownload :: [PackageLocation (Maybe FilePath)]
    pkgsToDownload :: [UnresolvedPkgLoc]
pkgsToDownload =
      forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$
      [ ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgSourceLocation ElaboratedConfiguredPackage
elab
      | InstallPlan.Configured ElaboratedConfiguredPackage
elab
         <- forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.reverseTopologicalOrder ElaboratedInstallPlan
installPlan
      , let uid :: UnitId
uid = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab
            pkgBuildStatus :: BuildStatus
pkgBuildStatus = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"asyncDownloadPackages") UnitId
uid BuildStatusMap
pkgsBuildStatus
      , BuildStatus
BuildStatusDownload <- [BuildStatus
pkgBuildStatus]
      ]


-- | Check if a package needs downloading, and if so expect to find a download
-- in progress in the given 'AsyncFetchMap' and wait on it to finish.
--
waitAsyncPackageDownload :: Verbosity
                         -> AsyncFetchMap
                         -> ElaboratedConfiguredPackage
                         -> IO DownloadedSourceLocation
waitAsyncPackageDownload :: Verbosity
-> AsyncFetchMap
-> ElaboratedConfiguredPackage
-> IO DownloadedSourceLocation
waitAsyncPackageDownload Verbosity
verbosity AsyncFetchMap
downloadMap ElaboratedConfiguredPackage
elab = do
    ResolvedPkgLoc
pkgloc <- Verbosity -> AsyncFetchMap -> UnresolvedPkgLoc -> IO ResolvedPkgLoc
waitAsyncFetchPackage Verbosity
verbosity AsyncFetchMap
downloadMap
                                    (ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgSourceLocation ElaboratedConfiguredPackage
elab)
    case ResolvedPkgLoc -> Maybe DownloadedSourceLocation
downloadedSourceLocation ResolvedPkgLoc
pkgloc of
      Just DownloadedSourceLocation
loc -> forall (m :: * -> *) a. Monad m => a -> m a
return DownloadedSourceLocation
loc
      Maybe DownloadedSourceLocation
Nothing  -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"waitAsyncPackageDownload: unexpected source location"

data DownloadedSourceLocation = DownloadedTarball FilePath
                              --TODO: [nice to have] git/darcs repos etc

downloadedSourceLocation :: PackageLocation FilePath
                         -> Maybe DownloadedSourceLocation
downloadedSourceLocation :: ResolvedPkgLoc -> Maybe DownloadedSourceLocation
downloadedSourceLocation ResolvedPkgLoc
pkgloc =
    case ResolvedPkgLoc
pkgloc of
      RemoteTarballPackage URI
_ FilePath
tarball -> forall a. a -> Maybe a
Just (FilePath -> DownloadedSourceLocation
DownloadedTarball FilePath
tarball)
      RepoTarballPackage Repo
_ PackageIdentifier
_ FilePath
tarball -> forall a. a -> Maybe a
Just (FilePath -> DownloadedSourceLocation
DownloadedTarball FilePath
tarball)
      ResolvedPkgLoc
_                              -> forall a. Maybe a
Nothing




-- | Ensure that the package is unpacked in an appropriate directory, either
-- a temporary one or a persistent one under the shared dist directory.
--
withTarballLocalDirectory
  :: Verbosity
  -> DistDirLayout
  -> FilePath
  -> PackageId
  -> DistDirParams
  -> BuildStyle
  -> Maybe CabalFileText
  -> (FilePath -> -- Source directory
      FilePath -> -- Build directory
      IO a)
  -> IO a
withTarballLocalDirectory :: forall a.
Verbosity
-> DistDirLayout
-> FilePath
-> PackageIdentifier
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath -> FilePath -> IO a)
-> IO a
withTarballLocalDirectory Verbosity
verbosity distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
FilePath -> FilePath
PackageIdentifier -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageIdentifier -> FilePath
distDownloadSrcDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
distPackageDB :: DistDirLayout -> CompilerId -> PackageDB
distBinDirectory :: DistDirLayout -> FilePath
distTempDirectory :: DistDirLayout -> FilePath
distSdistDirectory :: DistDirLayout -> FilePath
distSdistFile :: DistDirLayout -> PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageIdentifier -> FilePath
distDownloadSrcDirectory :: DistDirLayout -> FilePath
distBuildRootDirectory :: DistDirLayout -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distDirectory :: DistDirLayout -> FilePath
distProjectFile :: DistDirLayout -> FilePath -> FilePath
distProjectRootDirectory :: DistDirLayout -> FilePath
..}
                          FilePath
tarball PackageIdentifier
pkgid DistDirParams
dparams BuildStyle
buildstyle Maybe CabalFileText
pkgTextOverride
                          FilePath -> FilePath -> IO a
buildPkg  =
      case BuildStyle
buildstyle of
        -- In this case we make a temp dir (e.g. tmp/src2345/), unpack
        -- the tarball to it (e.g. tmp/src2345/foo-1.0/), and for
        -- compatibility we put the dist dir within it
        -- (i.e. tmp/src2345/foo-1.0/dist/).
        --
        -- Unfortunately, a few custom Setup.hs scripts do not respect
        -- the --builddir flag and always look for it at ./dist/ so
        -- this way we avoid breaking those packages
        BuildStyle
BuildAndInstall ->
          let tmpdir :: FilePath
tmpdir = FilePath
distTempDirectory in
          forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
tmpdir FilePath
"src"   forall a b. (a -> b) -> a -> b
$ \FilePath
unpackdir -> do
            Verbosity
-> FilePath
-> FilePath
-> PackageIdentifier
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
unpackdir
                                 PackageIdentifier
pkgid Maybe CabalFileText
pkgTextOverride
            let srcdir :: FilePath
srcdir   = FilePath
unpackdir FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
                builddir :: FilePath
builddir = FilePath
srcdir FilePath -> FilePath -> FilePath
</> FilePath
"dist"
            FilePath -> FilePath -> IO a
buildPkg FilePath
srcdir FilePath
builddir

        -- In this case we make sure the tarball has been unpacked to the
        -- appropriate location under the shared dist dir, and then build it
        -- inplace there
        BuildStyle
BuildInplaceOnly -> do
          let srcrootdir :: FilePath
srcrootdir = FilePath
distUnpackedSrcRootDirectory
              srcdir :: FilePath
srcdir     = PackageIdentifier -> FilePath
distUnpackedSrcDirectory PackageIdentifier
pkgid
              builddir :: FilePath
builddir   = DistDirParams -> FilePath
distBuildDirectory DistDirParams
dparams
          -- TODO: [nice to have] use a proper file monitor rather
          -- than this dir exists test
          Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
srcdir
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ do
            Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
srcrootdir
            Verbosity
-> FilePath
-> FilePath
-> PackageIdentifier
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
srcrootdir
                                 PackageIdentifier
pkgid Maybe CabalFileText
pkgTextOverride
            Verbosity
-> DistDirLayout
-> FilePath
-> PackageIdentifier
-> DistDirParams
-> IO ()
moveTarballShippedDistDirectory Verbosity
verbosity DistDirLayout
distDirLayout
                                            FilePath
srcrootdir PackageIdentifier
pkgid DistDirParams
dparams
          FilePath -> FilePath -> IO a
buildPkg FilePath
srcdir FilePath
builddir


unpackPackageTarball :: Verbosity -> FilePath -> FilePath
                     -> PackageId -> Maybe CabalFileText
                     -> IO ()
unpackPackageTarball :: Verbosity
-> FilePath
-> FilePath
-> PackageIdentifier
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
parentdir PackageIdentifier
pkgid Maybe CabalFileText
pkgTextOverride =
    --TODO: [nice to have] switch to tar package and catch tar exceptions
    forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
UnpackFailed forall a b. (a -> b) -> a -> b
$ do

      -- Unpack the tarball
      --
      Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Extracting " forall a. [a] -> [a] -> [a]
++ FilePath
tarball forall a. [a] -> [a] -> [a]
++ FilePath
" to " forall a. [a] -> [a] -> [a]
++ FilePath
parentdir forall a. [a] -> [a] -> [a]
++ FilePath
"..."
      FilePath -> FilePath -> FilePath -> IO ()
Tar.extractTarGzFile FilePath
parentdir FilePath
pkgsubdir FilePath
tarball

      -- Sanity check
      --
      Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
cabalFile
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
        FilePath
"Package .cabal file not found in the tarball: " forall a. [a] -> [a] -> [a]
++ FilePath
cabalFile

      -- Overwrite the .cabal with the one from the index, when appropriate
      --
      case Maybe CabalFileText
pkgTextOverride of
        Maybe CabalFileText
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just CabalFileText
pkgtxt -> do
          Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Updating " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkgname FilePath -> FilePath -> FilePath
<.> FilePath
"cabal"
                        forall a. [a] -> [a] -> [a]
++ FilePath
" with the latest revision from the index."
          FilePath -> CabalFileText -> IO ()
writeFileAtomic FilePath
cabalFile CabalFileText
pkgtxt

  where
    cabalFile :: FilePath
    cabalFile :: FilePath
cabalFile = FilePath
parentdir FilePath -> FilePath -> FilePath
</> FilePath
pkgsubdir
                          FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkgname FilePath -> FilePath -> FilePath
<.> FilePath
"cabal"
    pkgsubdir :: FilePath
pkgsubdir = forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
    pkgname :: PackageName
pkgname   = forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgid


-- | This is a bit of a hacky workaround. A number of packages ship
-- pre-processed .hs files in a dist directory inside the tarball. We don't
-- use the standard 'dist' location so unless we move this dist dir to the
-- right place then we'll miss the shipped pre-processed files. This hacky
-- approach to shipped pre-processed files ought to be replaced by a proper
-- system, though we'll still need to keep this hack for older packages.
--
moveTarballShippedDistDirectory :: Verbosity -> DistDirLayout
                                -> FilePath -> PackageId -> DistDirParams
                                -> IO ()
moveTarballShippedDistDirectory :: Verbosity
-> DistDirLayout
-> FilePath
-> PackageIdentifier
-> DistDirParams
-> IO ()
moveTarballShippedDistDirectory Verbosity
verbosity DistDirLayout{DistDirParams -> FilePath
distBuildDirectory :: DistDirParams -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory}
                                FilePath
parentdir PackageIdentifier
pkgid DistDirParams
dparams = do
    Bool
distDirExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
tarballDistDir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
distDirExists forall a b. (a -> b) -> a -> b
$ do
      Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Moving '" forall a. [a] -> [a] -> [a]
++ FilePath
tarballDistDir forall a. [a] -> [a] -> [a]
++ FilePath
"' to '"
                                   forall a. [a] -> [a] -> [a]
++ FilePath
targetDistDir forall a. [a] -> [a] -> [a]
++ FilePath
"'"
      --TODO: [nice to have] or perhaps better to copy, and use a file monitor
      FilePath -> FilePath -> IO ()
renameDirectory FilePath
tarballDistDir FilePath
targetDistDir
  where
    tarballDistDir :: FilePath
tarballDistDir = FilePath
parentdir FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid FilePath -> FilePath -> FilePath
</> FilePath
"dist"
    targetDistDir :: FilePath
targetDistDir  = DistDirParams -> FilePath
distBuildDirectory DistDirParams
dparams


buildAndInstallUnpackedPackage :: Verbosity
                               -> DistDirLayout
                               -> StoreDirLayout
                               -> BuildTimeSettings -> Lock -> Lock
                               -> ElaboratedSharedConfig
                               -> ElaboratedInstallPlan
                               -> ElaboratedReadyPackage
                               -> FilePath -> FilePath
                               -> IO BuildResult
buildAndInstallUnpackedPackage :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> FilePath
-> FilePath
-> IO BuildResult
buildAndInstallUnpackedPackage Verbosity
verbosity
                               distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
distTempDirectory :: FilePath
distTempDirectory :: DistDirLayout -> FilePath
distTempDirectory}
                               storeDirLayout :: StoreDirLayout
storeDirLayout@StoreDirLayout {
                                 CompilerId -> PackageDBStack
storePackageDBStack :: StoreDirLayout -> CompilerId -> PackageDBStack
storePackageDBStack :: CompilerId -> PackageDBStack
storePackageDBStack
                               }
                               BuildTimeSettings {
                                 Int
buildSettingNumJobs :: Int
buildSettingNumJobs :: BuildTimeSettings -> Int
buildSettingNumJobs,
                                 Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile :: BuildTimeSettings
-> Maybe
     (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile :: Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile
                               }
                               Lock
registerLock Lock
cacheLock
                               pkgshared :: ElaboratedSharedConfig
pkgshared@ElaboratedSharedConfig {
                                 pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigPlatform      = Platform
platform,
                                 pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler      = Compiler
compiler,
                                 pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs = ProgramDb
progdb
                               }
                               ElaboratedInstallPlan
plan rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
                               FilePath
srcdir FilePath
builddir = do

    Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (FilePath
srcdir FilePath -> FilePath -> FilePath
</> FilePath
builddir)
    IO ()
initLogFile

    --TODO: [code cleanup] deal consistently with talking to older
    --      Setup.hs versions, much like we do for ghc, with a proper
    --      options type and rendering step which will also let us
    --      call directly into the lib, rather than always going via
    --      the lib's command line interface, which would also allow
    --      passing data like installed packages, compiler, and
    --      program db for a quicker configure.

    --TODO: [required feature] docs and tests
    --TODO: [required feature] sudo re-exec

    -- Configure phase
    ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressStarting

    forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
ConfigureFailed forall a b. (a -> b) -> a -> b
$
      forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI ConfigFlags
configureCommand Version -> ConfigFlags
configureFlags Version -> [FilePath]
configureArgs

    -- Build phase
    ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressBuilding

    forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
BuildFailed forall a b. (a -> b) -> a -> b
$
      forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI BuildFlags
buildCommand Version -> BuildFlags
buildFlags

    -- Haddock phase
    IO () -> IO ()
whenHaddock forall a b. (a -> b) -> a -> b
$ do
      ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressHaddock
      forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
HaddocksFailed forall a b. (a -> b) -> a -> b
$
        forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI HaddockFlags
haddockCommand Version -> HaddockFlags
haddockFlags

    -- Install phase
    ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressInstalling
    forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
InstallFailed forall a b. (a -> b) -> a -> b
$ do

      let copyPkgFiles :: FilePath -> IO (FilePath, [FilePath])
copyPkgFiles FilePath
tmpDir = do
            let tmpDirNormalised :: FilePath
tmpDirNormalised = FilePath -> FilePath
normalise FilePath
tmpDir
            forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI CopyFlags
Cabal.copyCommand (FilePath -> Version -> CopyFlags
copyFlags FilePath
tmpDirNormalised)
            -- Note that the copy command has put the files into
            -- @$tmpDir/$prefix@ so we need to return this dir so
            -- the store knows which dir will be the final store entry.
            let prefix :: FilePath
prefix   = FilePath -> FilePath
normalise forall a b. (a -> b) -> a -> b
$
                           FilePath -> FilePath
dropDrive (forall dir. InstallDirs dir -> dir
InstallDirs.prefix (ElaboratedConfiguredPackage -> InstallDirs FilePath
elabInstallDirs ElaboratedConfiguredPackage
pkg))
                entryDir :: FilePath
entryDir = FilePath
tmpDirNormalised FilePath -> FilePath -> FilePath
</> FilePath
prefix

            -- if there weren't anything to build, it might be that directory is not created
            -- the @setup Cabal.copyCommand@ above might do nothing.
            -- https://github.com/haskell/cabal/issues/4130
            Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
entryDir

            let hashFileName :: FilePath
hashFileName     = FilePath
entryDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal-hash.txt"
                outPkgHashInputs :: CabalFileText
outPkgHashInputs = PackageHashInputs -> CabalFileText
renderPackageHashInputs (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashInputs
packageHashInputs ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg)

            Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
              FilePath
"creating file with the inputs used to compute the package hash: " forall a. [a] -> [a] -> [a]
++ FilePath
hashFileName

            FilePath -> CabalFileText -> IO ()
LBS.writeFile FilePath
hashFileName CabalFileText
outPkgHashInputs

            Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity FilePath
"Package hash inputs:"
            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
              (Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"> " forall a. [a] -> [a] -> [a]
++))
              (FilePath -> [FilePath]
lines forall a b. (a -> b) -> a -> b
$ CabalFileText -> FilePath
LBS.Char8.unpack CabalFileText
outPkgHashInputs)

            -- Ensure that there are no files in `tmpDir`, that are
            -- not in `entryDir`. While this breaks the
            -- prefix-relocatable property of the libraries, it is
            -- necessary on macOS to stay under the load command limit
            -- of the macOS mach-o linker. See also
            -- @PackageHash.hashedInstalledPackageIdVeryShort@.
            --
            -- We also normalise paths to ensure that there are no
            -- different representations for the same path. Like / and
            -- \\ on windows under msys.
            [FilePath]
otherFiles <- forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
entryDir) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          FilePath -> IO [FilePath]
listFilesRecursive FilePath
tmpDirNormalised
            -- Here's where we could keep track of the installed files
            -- ourselves if we wanted to by making a manifest of the
            -- files in the tmp dir.
            forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
entryDir, [FilePath]
otherFiles)
            where
              listFilesRecursive :: FilePath -> IO [FilePath]
              listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive FilePath
path = do
                [FilePath]
files <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
path FilePath -> FilePath -> FilePath
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]
listDirectory FilePath
path)
                [[FilePath]]
allFiles <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FilePath]
files forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
                  Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
file
                  if Bool
isDir
                    then FilePath -> IO [FilePath]
listFilesRecursive FilePath
file
                    else forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
file]
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
allFiles)

          registerPkg :: IO ()
registerPkg
            | Bool -> Bool
not (ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg) =
              Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
                FilePath
"registerPkg: elab does NOT require registration for "
                forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow UnitId
uid
            | Bool
otherwise = do
            -- We register ourselves rather than via Setup.hs. We need to
            -- grab and modify the InstalledPackageInfo. We decide what
            -- the installed package id is, not the build system.
            InstalledPackageInfo
ipkg0 <- IO InstalledPackageInfo
generateInstalledPackageInfo
            let ipkg :: InstalledPackageInfo
ipkg = InstalledPackageInfo
ipkg0 { installedUnitId :: UnitId
Installed.installedUnitId = UnitId
uid }
            forall a. (?callStack::CallStack) => Bool -> a -> a
assert (   ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg
                    forall a. Eq a => a -> a -> Bool
== CompilerId -> PackageDBStack
storePackageDBStack CompilerId
compid) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
            forall a. Lock -> IO a -> IO a
criticalSection Lock
registerLock forall a b. (a -> b) -> a -> b
$
              Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
Cabal.registerPackage
                Verbosity
verbosity Compiler
compiler ProgramDb
progdb
                (CompilerId -> PackageDBStack
storePackageDBStack CompilerId
compid) InstalledPackageInfo
ipkg
                RegisterOptions
Cabal.defaultRegisterOptions {
                  registerMultiInstance :: Bool
Cabal.registerMultiInstance      = Bool
True,
                  registerSuppressFilesCheck :: Bool
Cabal.registerSuppressFilesCheck = Bool
True
                }


      -- Actual installation
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Verbosity
-> StoreDirLayout
-> CompilerId
-> UnitId
-> (FilePath -> IO (FilePath, [FilePath]))
-> IO ()
-> IO NewStoreEntryOutcome
newStoreEntry Verbosity
verbosity StoreDirLayout
storeDirLayout
                           CompilerId
compid UnitId
uid
                           FilePath -> IO (FilePath, [FilePath])
copyPkgFiles IO ()
registerPkg

    --TODO: [nice to have] we currently rely on Setup.hs copy to do the right
    -- thing. Although we do copy into an image dir and do the move into the
    -- final location ourselves, perhaps we ought to do some sanity checks on
    -- the image dir first.

    -- TODO: [required eventually] note that for nix-style
    -- installations it is not necessary to do the
    -- 'withWin32SelfUpgrade' dance, but it would be necessary for a
    -- shared bin dir.

    --TODO: [required feature] docs and test phases
    let docsResult :: DocsResult
docsResult  = DocsResult
DocsNotTried
        testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried

    ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressCompleted

    forall (m :: * -> *) a. Monad m => a -> m a
return BuildResult {
       buildResultDocs :: DocsResult
buildResultDocs    = DocsResult
docsResult,
       buildResultTests :: TestsResult
buildResultTests   = TestsResult
testsResult,
       buildResultLogFile :: Maybe FilePath
buildResultLogFile = Maybe FilePath
mlogFile
    }

  where
    pkgid :: PackageIdentifier
pkgid  = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedReadyPackage
rpkg
    uid :: UnitId
uid    = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedReadyPackage
rpkg
    compid :: CompilerId
compid = Compiler -> CompilerId
compilerId Compiler
compiler

    dispname :: String
    dispname :: FilePath
dispname = case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
pkg of
        ElabPackage ElaboratedPackage
_ -> forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
            forall a. [a] -> [a] -> [a]
++ FilePath
" (all, legacy fallback)"
        ElabComponent ElaboratedComponent
comp -> forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
            forall a. [a] -> [a] -> [a]
++ FilePath
" (" forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"custom" forall a. Pretty a => a -> FilePath
prettyShow (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp) forall a. [a] -> [a] -> [a]
++ FilePath
")"

    noticeProgress :: ProgressPhase -> IO ()
    noticeProgress :: ProgressPhase -> IO ()
noticeProgress ProgressPhase
phase = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isParallelBuild forall a b. (a -> b) -> a -> b
$
        Verbosity -> ProgressPhase -> FilePath -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
phase FilePath
dispname

    isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs forall a. Ord a => a -> a -> Bool
>= Int
2

    whenHaddock :: IO () -> IO ()
whenHaddock IO ()
action
      | ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage
pkg = IO ()
action
      | Bool
otherwise                  = forall (m :: * -> *) a. Monad m => a -> m a
return ()

    configureCommand :: CommandUI ConfigFlags
configureCommand = ProgramDb -> CommandUI ConfigFlags
Cabal.configureCommand ProgramDb
defaultProgramDb
    configureFlags :: Version -> ConfigFlags
configureFlags Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags Version
v forall a b. (a -> b) -> a -> b
$
                       ElaboratedReadyPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> ConfigFlags
setupHsConfigureFlags ElaboratedReadyPackage
rpkg ElaboratedSharedConfig
pkgshared
                                             Verbosity
verbosity FilePath
builddir
    configureArgs :: Version -> [FilePath]
configureArgs Version
_  = ElaboratedConfiguredPackage -> [FilePath]
setupHsConfigureArgs ElaboratedConfiguredPackage
pkg

    buildCommand :: CommandUI BuildFlags
buildCommand     = ProgramDb -> CommandUI BuildFlags
Cabal.buildCommand ProgramDb
defaultProgramDb
    buildFlags :: Version -> BuildFlags
buildFlags   Version
_   = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> BuildFlags
setupHsBuildFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared Verbosity
verbosity FilePath
builddir

    haddockCommand :: CommandUI HaddockFlags
haddockCommand   = CommandUI HaddockFlags
Cabal.haddockCommand
    haddockFlags :: Version -> HaddockFlags
haddockFlags Version
_   = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> HaddockFlags
setupHsHaddockFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
                                           Verbosity
verbosity FilePath
builddir

    generateInstalledPackageInfo :: IO InstalledPackageInfo
    generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
      Verbosity
-> FilePath -> (FilePath -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile
        Verbosity
verbosity FilePath
distTempDirectory forall a b. (a -> b) -> a -> b
$ \FilePath
pkgConfDest -> do
        let registerFlags :: Version -> RegisterFlags
registerFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> FilePath
-> FilePath
-> RegisterFlags
setupHsRegisterFlags
                                ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
                                Verbosity
verbosity FilePath
builddir
                                FilePath
pkgConfDest
        forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI RegisterFlags
Cabal.registerCommand Version -> RegisterFlags
registerFlags

    copyFlags :: FilePath -> Version -> CopyFlags
copyFlags FilePath
destdir Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> FilePath
-> FilePath
-> CopyFlags
setupHsCopyFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared Verbosity
verbosity
                                           FilePath
builddir FilePath
destdir

    scriptOptions :: SetupScriptOptions
scriptOptions = ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> FilePath
-> FilePath
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions ElaboratedReadyPackage
rpkg ElaboratedInstallPlan
plan ElaboratedSharedConfig
pkgshared
                                         DistDirLayout
distDirLayout FilePath
srcdir FilePath
builddir
                                         Bool
isParallelBuild Lock
cacheLock

    setup :: CommandUI flags -> (Version -> flags) -> IO ()
    setup :: forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI flags
cmd Version -> flags
flags = forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI flags
cmd Version -> flags
flags (forall a b. a -> b -> a
const [])

    setup' :: CommandUI flags -> (Version -> flags) -> (Version -> [String])
           -> IO ()
    setup' :: forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
      forall r. (Maybe Handle -> IO r) -> IO r
withLogging forall a b. (a -> b) -> a -> b
$ \Maybe Handle
mLogFileHandle ->
        forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper
          Verbosity
verbosity
          SetupScriptOptions
scriptOptions
            { useLoggingHandle :: Maybe Handle
useLoggingHandle     = Maybe Handle
mLogFileHandle
            , useExtraEnvOverrides :: [(FilePath, Maybe FilePath)]
useExtraEnvOverrides = DistDirLayout
-> ElaboratedInstallPlan -> [(FilePath, Maybe FilePath)]
dataDirsEnvironmentForPlan
                                     DistDirLayout
distDirLayout ElaboratedInstallPlan
plan }
          (forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
          CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args

    mlogFile :: Maybe FilePath
    mlogFile :: Maybe FilePath
mlogFile =
      case Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile of
        Maybe
  (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
Nothing        -> forall a. Maybe a
Nothing
        Just Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath
mkLogFile -> forall a. a -> Maybe a
Just (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath
mkLogFile Compiler
compiler Platform
platform PackageIdentifier
pkgid UnitId
uid)

    initLogFile :: IO ()
    initLogFile :: IO ()
initLogFile =
      case Maybe FilePath
mlogFile of
        Maybe FilePath
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just FilePath
logFile -> do
          Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
logFile)
          Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
logFile
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
logFile

    withLogging :: (Maybe Handle -> IO r) -> IO r
    withLogging :: forall r. (Maybe Handle -> IO r) -> IO r
withLogging Maybe Handle -> IO r
action =
      case Maybe FilePath
mlogFile of
        Maybe FilePath
Nothing      -> Maybe Handle -> IO r
action forall a. Maybe a
Nothing
        Just FilePath
logFile -> forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
logFile IOMode
AppendMode (Maybe Handle -> IO r
action forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)


hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage{Bool
[FilePath]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe FilePath
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
ComponentId
Map FilePath FilePath
Map FilePath [FilePath]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs FilePath
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [FilePath]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [FilePath]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map FilePath [FilePath]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map FilePath FilePath
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> ComponentId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe FilePath
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe FilePath
elabHaddockBaseUrl :: Maybe FilePath
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe FilePath
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe FilePath
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe FilePath
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs FilePath
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [FilePath]
elabExtraFrameworkDirs :: [FilePath]
elabExtraLibDirsStatic :: [FilePath]
elabExtraLibDirs :: [FilePath]
elabConfigureScriptArgs :: [FilePath]
elabProgramPathExtra :: [FilePath]
elabProgramArgs :: Map FilePath [FilePath]
elabProgramPaths :: Map FilePath FilePath
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: ComponentId
elabUnitId :: UnitId
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs FilePath
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
..}
  | Bool -> Bool
not Bool
elabBuildHaddocks = Bool
False
  | Bool
otherwise             = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ComponentTarget -> Bool
componentHasHaddocks [ComponentTarget]
components
  where
    components :: [ComponentTarget]
    components :: [ComponentTarget]
components = [ComponentTarget]
elabBuildTargets forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabTestTargets forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabBenchTargets
              forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe ComponentTarget
elabReplTarget forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabHaddockTargets

    componentHasHaddocks :: ComponentTarget -> Bool
    componentHasHaddocks :: ComponentTarget -> Bool
componentHasHaddocks (ComponentTarget ComponentName
name SubComponentTarget
_) =
      case ComponentName
name of
        CLibName LibraryName
LMainLibName    ->                           Bool
hasHaddocks
        CLibName (LSubLibName UnqualComponentName
_) -> Bool
elabHaddockInternal    Bool -> Bool -> Bool
&& Bool
hasHaddocks
        CFLibName              UnqualComponentName
_ -> Bool
elabHaddockForeignLibs Bool -> Bool -> Bool
&& Bool
hasHaddocks
        CExeName               UnqualComponentName
_ -> Bool
elabHaddockExecutables Bool -> Bool -> Bool
&& Bool
hasHaddocks
        CTestName              UnqualComponentName
_ -> Bool
elabHaddockTestSuites  Bool -> Bool -> Bool
&& Bool
hasHaddocks
        CBenchName             UnqualComponentName
_ -> Bool
elabHaddockBenchmarks  Bool -> Bool -> Bool
&& Bool
hasHaddocks
      where
        hasHaddocks :: Bool
hasHaddocks = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription
elabPkgDescription forall s a. s -> Getting a s a -> a
^. forall r.
Monoid r =>
ComponentName -> Getting r PackageDescription [ModuleName]
componentModules ComponentName
name))


buildInplaceUnpackedPackage :: Verbosity
                            -> DistDirLayout
                            -> BuildTimeSettings -> Lock -> Lock
                            -> ElaboratedSharedConfig
                            -> ElaboratedInstallPlan
                            -> ElaboratedReadyPackage
                            -> BuildStatusRebuild
                            -> FilePath -> FilePath
                            -> IO BuildResult
buildInplaceUnpackedPackage :: Verbosity
-> DistDirLayout
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatusRebuild
-> FilePath
-> FilePath
-> IO BuildResult
buildInplaceUnpackedPackage Verbosity
verbosity
                            distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout {
                              FilePath
distTempDirectory :: FilePath
distTempDirectory :: DistDirLayout -> FilePath
distTempDirectory,
                              DistDirParams -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheDirectory,
                              FilePath
distDirectory :: FilePath
distDirectory :: DistDirLayout -> FilePath
distDirectory
                            }
                            BuildTimeSettings{Int
buildSettingNumJobs :: Int
buildSettingNumJobs :: BuildTimeSettings -> Int
buildSettingNumJobs, Bool
buildSettingHaddockOpen :: BuildTimeSettings -> Bool
buildSettingHaddockOpen :: Bool
buildSettingHaddockOpen}
                            Lock
registerLock Lock
cacheLock
                            pkgshared :: ElaboratedSharedConfig
pkgshared@ElaboratedSharedConfig {
                              pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler      = Compiler
compiler,
                              pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs = ProgramDb
progdb,
                              pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigPlatform      = Platform
platform
                            }
                            ElaboratedInstallPlan
plan
                            rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
                            BuildStatusRebuild
buildStatus
                            FilePath
srcdir FilePath
builddir = do

        --TODO: [code cleanup] there is duplication between the
        --      distdirlayout and the builddir here builddir is not
        --      enough, we also need the per-package cachedir
        Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
builddir
        Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True
          (DistDirParams -> FilePath
distPackageCacheDirectory DistDirParams
dparams)

        -- Configure phase
        --
        IO () -> IO ()
whenReConfigure forall a b. (a -> b) -> a -> b
$ do
          forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
ConfigureFailed forall a b. (a -> b) -> a -> b
$
            forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI ConfigFlags
configureCommand Version -> ConfigFlags
configureFlags Version -> [FilePath]
configureArgs
          PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor PackageFileMonitor
packageFileMonitor
          PackageFileMonitor
-> FilePath -> ElaboratedConfiguredPackage -> IO ()
updatePackageConfigFileMonitor PackageFileMonitor
packageFileMonitor FilePath
srcdir ElaboratedConfiguredPackage
pkg

        -- Build phase
        --
        let docsResult :: DocsResult
docsResult  = DocsResult
DocsNotTried
            testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried

            buildResult :: BuildResultMisc
            buildResult :: BuildResultMisc
buildResult = (DocsResult
docsResult, TestsResult
testsResult)

        IO () -> IO ()
whenRebuild forall a b. (a -> b) -> a -> b
$ do
          MonitorTimestamp
timestamp <- IO MonitorTimestamp
beginUpdateFileMonitor
          forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
BuildFailed forall a b. (a -> b) -> a -> b
$
            forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI BuildFlags
buildCommand Version -> BuildFlags
buildFlags Version -> [FilePath]
buildArgs

          let listSimple :: IO [MonitorFilePath]
listSimple =
                forall a. FilePath -> Rebuild a -> IO [MonitorFilePath]
execRebuild FilePath
srcdir (ElaboratedConfiguredPackage -> Rebuild ()
needElaboratedConfiguredPackage ElaboratedConfiguredPackage
pkg)
              listSdist :: IO [MonitorFilePath]
listSdist =
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorFileHashed) forall a b. (a -> b) -> a -> b
$
                    Verbosity -> FilePath -> IO [FilePath]
allPackageSourceFiles Verbosity
verbosity FilePath
srcdir
              ifNullThen :: m (t a) -> m (t a) -> m (t a)
ifNullThen m (t a)
m m (t a)
m' = do t a
xs <- m (t a)
m
                                   if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs then m (t a)
m' else forall (m :: * -> *) a. Monad m => a -> m a
return t a
xs
          [MonitorFilePath]
monitors <- case PackageDescription -> BuildType
PD.buildType (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg) of
            BuildType
Simple -> IO [MonitorFilePath]
listSimple
            -- If a Custom setup was used, AND the Cabal is recent
            -- enough to have sdist --list-sources, use that to
            -- determine the files that we need to track.  This can
            -- cause unnecessary rebuilding (for example, if README
            -- is edited, we will try to rebuild) but there isn't
            -- a more accurate Custom interface we can use to get
            -- this info.  We prefer not to use listSimple here
            -- as it can miss extra source files that are considered
            -- by the Custom setup.
            BuildType
_ | ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion ElaboratedConfiguredPackage
pkg forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1,Int
17]
              -- However, sometimes sdist --list-sources will fail
              -- and return an empty list.  In that case, fall
              -- back on the (inaccurate) simple tracking.
              -> IO [MonitorFilePath]
listSdist forall {m :: * -> *} {t :: * -> *} {a}.
(Monad m, Foldable t) =>
m (t a) -> m (t a) -> m (t a)
`ifNullThen` IO [MonitorFilePath]
listSimple
              | Bool
otherwise
              -> IO [MonitorFilePath]
listSimple

          let dep_monitors :: [MonitorFilePath]
dep_monitors = forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorFileHashed
                           forall a b. (a -> b) -> a -> b
$ DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedConfiguredPackage
-> [FilePath]
elabInplaceDependencyBuildCacheFiles
                                DistDirLayout
distDirLayout ElaboratedSharedConfig
pkgshared ElaboratedInstallPlan
plan ElaboratedConfiguredPackage
pkg
          PackageFileMonitor
-> FilePath
-> MonitorTimestamp
-> ElaboratedConfiguredPackage
-> BuildStatusRebuild
-> [MonitorFilePath]
-> BuildResultMisc
-> IO ()
updatePackageBuildFileMonitor PackageFileMonitor
packageFileMonitor FilePath
srcdir MonitorTimestamp
timestamp
                                        ElaboratedConfiguredPackage
pkg BuildStatusRebuild
buildStatus
                                        ([MonitorFilePath]
monitors forall a. [a] -> [a] -> [a]
++ [MonitorFilePath]
dep_monitors) BuildResultMisc
buildResult

        -- PURPOSELY omitted: no copy!

        IO () -> IO ()
whenReRegister forall a b. (a -> b) -> a -> b
$ forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
InstallFailed forall a b. (a -> b) -> a -> b
$ do
          -- Register locally
          Maybe InstalledPackageInfo
mipkg <- if ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg
            then do
                InstalledPackageInfo
ipkg0 <- IO InstalledPackageInfo
generateInstalledPackageInfo
                -- We register ourselves rather than via Setup.hs. We need to
                -- grab and modify the InstalledPackageInfo. We decide what
                -- the installed package id is, not the build system.
                let ipkg :: InstalledPackageInfo
ipkg = InstalledPackageInfo
ipkg0 { installedUnitId :: UnitId
Installed.installedUnitId = UnitId
ipkgid }
                forall a. Lock -> IO a -> IO a
criticalSection Lock
registerLock forall a b. (a -> b) -> a -> b
$
                    Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
Cabal.registerPackage Verbosity
verbosity Compiler
compiler ProgramDb
progdb
                                          (ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg)
                                          InstalledPackageInfo
ipkg RegisterOptions
Cabal.defaultRegisterOptions
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just InstalledPackageInfo
ipkg)

           else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

          PackageFileMonitor
-> FilePath -> Maybe InstalledPackageInfo -> IO ()
updatePackageRegFileMonitor PackageFileMonitor
packageFileMonitor FilePath
srcdir Maybe InstalledPackageInfo
mipkg

        IO () -> IO ()
whenTest forall a b. (a -> b) -> a -> b
$ do
          forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
TestsFailed forall a b. (a -> b) -> a -> b
$
            forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI TestFlags
testCommand Version -> TestFlags
testFlags Version -> [FilePath]
testArgs

        IO () -> IO ()
whenBench forall a b. (a -> b) -> a -> b
$
          forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
BenchFailed forall a b. (a -> b) -> a -> b
$
            forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI BenchmarkFlags
benchCommand Version -> BenchmarkFlags
benchFlags Version -> [FilePath]
benchArgs

        -- Repl phase
        --
        IO () -> IO ()
whenRepl forall a b. (a -> b) -> a -> b
$
          forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
ReplFailed forall a b. (a -> b) -> a -> b
$
          forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setupInteractive CommandUI ReplFlags
replCommand Version -> ReplFlags
replFlags Version -> [FilePath]
replArgs

        -- Haddock phase
        IO () -> IO ()
whenHaddock forall a b. (a -> b) -> a -> b
$
          forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
HaddocksFailed forall a b. (a -> b) -> a -> b
$ do
            forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI HaddockFlags
haddockCommand Version -> HaddockFlags
haddockFlags Version -> [FilePath]
haddockArgs
            let haddockTarget :: HaddockTarget
haddockTarget = ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForHackage ElaboratedConfiguredPackage
pkg
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HaddockTarget
haddockTarget forall a. Eq a => a -> a -> Bool
== HaddockTarget
Cabal.ForHackage) forall a b. (a -> b) -> a -> b
$ do
              let dest :: FilePath
dest = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"
                  name :: FilePath
name = HaddockTarget -> PackageDescription -> FilePath
haddockDirName HaddockTarget
haddockTarget (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
                  docDir :: FilePath
docDir = DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory DistDirLayout
distDirLayout DistDirParams
dparams
                           FilePath -> FilePath -> FilePath
</> FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath
"html"
              FilePath -> FilePath -> FilePath -> IO ()
Tar.createTarGzFile FilePath
dest FilePath
docDir FilePath
name
              Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Documentation tarball created: " forall a. [a] -> [a] -> [a]
++ FilePath
dest

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
buildSettingHaddockOpen Bool -> Bool -> Bool
&& HaddockTarget
haddockTarget forall a. Eq a => a -> a -> Bool
/= HaddockTarget
Cabal.ForHackage) forall a b. (a -> b) -> a -> b
$ do
              let dest :: FilePath
dest = FilePath
docDir FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
</> FilePath
"index.html"
                  name :: FilePath
name = HaddockTarget -> PackageDescription -> FilePath
haddockDirName HaddockTarget
haddockTarget (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
                  docDir :: FilePath
docDir = DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory DistDirLayout
distDirLayout DistDirParams
dparams
                           FilePath -> FilePath -> FilePath
</> FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath
"html"
              Either FilePath FilePath
exe <- Platform -> IO (Either FilePath FilePath)
findOpenProgramLocation Platform
platform
              case Either FilePath FilePath
exe of
                Right FilePath
open -> Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (FilePath -> [FilePath] -> ProgramInvocation
simpleProgramInvocation FilePath
open [FilePath
dest])
                Left FilePath
err -> forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
err


        forall (m :: * -> *) a. Monad m => a -> m a
return BuildResult {
          buildResultDocs :: DocsResult
buildResultDocs    = DocsResult
docsResult,
          buildResultTests :: TestsResult
buildResultTests   = TestsResult
testsResult,
          buildResultLogFile :: Maybe FilePath
buildResultLogFile = forall a. Maybe a
Nothing
        }

  where
    ipkgid :: UnitId
ipkgid  = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg
    dparams :: DistDirParams
dparams = ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg

    isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs forall a. Ord a => a -> a -> Bool
>= Int
2

    packageFileMonitor :: PackageFileMonitor
packageFileMonitor = ElaboratedSharedConfig
-> DistDirLayout -> DistDirParams -> PackageFileMonitor
newPackageFileMonitor ElaboratedSharedConfig
pkgshared DistDirLayout
distDirLayout DistDirParams
dparams

    whenReConfigure :: IO () -> IO ()
whenReConfigure IO ()
action = case BuildStatusRebuild
buildStatus of
      BuildStatusConfigure MonitorChangedReason ()
_ -> IO ()
action
      BuildStatusRebuild
_                      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    whenRebuild :: IO () -> IO ()
whenRebuild IO ()
action
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
pkg)
      -- NB: we have to build the test/bench suite!
      , forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg)
      , forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise                   = IO ()
action

    whenTest :: IO () -> IO ()
whenTest IO ()
action
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise                  = IO ()
action

    whenBench :: IO () -> IO ()
whenBench IO ()
action
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise                   = IO ()
action

    whenRepl :: IO () -> IO ()
whenRepl IO ()
action
      | forall a. Maybe a -> Bool
isNothing (ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabReplTarget ElaboratedConfiguredPackage
pkg) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise                     = IO ()
action

    whenHaddock :: IO () -> IO ()
whenHaddock IO ()
action
      | ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage
pkg = IO ()
action
      | Bool
otherwise                  = forall (m :: * -> *) a. Monad m => a -> m a
return ()

    whenReRegister :: IO () -> IO ()
whenReRegister  IO ()
action
      = case BuildStatusRebuild
buildStatus of
          -- We registered the package already
          BuildStatusBuild (Just Maybe InstalledPackageInfo
_) BuildReason
_     ->
            Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"whenReRegister: previously registered"
          -- There is nothing to register
          BuildStatusRebuild
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
pkg) ->
              Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"whenReRegister: nothing to register"
            | Bool
otherwise                   -> IO ()
action

    configureCommand :: CommandUI ConfigFlags
configureCommand = ProgramDb -> CommandUI ConfigFlags
Cabal.configureCommand ProgramDb
defaultProgramDb
    configureFlags :: Version -> ConfigFlags
configureFlags Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags Version
v forall a b. (a -> b) -> a -> b
$
                       ElaboratedReadyPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> ConfigFlags
setupHsConfigureFlags ElaboratedReadyPackage
rpkg ElaboratedSharedConfig
pkgshared
                                             Verbosity
verbosity FilePath
builddir
    configureArgs :: Version -> [FilePath]
configureArgs Version
_  = ElaboratedConfiguredPackage -> [FilePath]
setupHsConfigureArgs ElaboratedConfiguredPackage
pkg

    buildCommand :: CommandUI BuildFlags
buildCommand     = ProgramDb -> CommandUI BuildFlags
Cabal.buildCommand ProgramDb
defaultProgramDb
    buildFlags :: Version -> BuildFlags
buildFlags   Version
_   = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> BuildFlags
setupHsBuildFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
                                         Verbosity
verbosity FilePath
builddir
    buildArgs :: Version -> [FilePath]
buildArgs     Version
_  = ElaboratedConfiguredPackage -> [FilePath]
setupHsBuildArgs  ElaboratedConfiguredPackage
pkg

    testCommand :: CommandUI TestFlags
testCommand      = CommandUI TestFlags
Cabal.testCommand -- defaultProgramDb
    testFlags :: Version -> TestFlags
testFlags      Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip TestFlags -> Version -> TestFlags
filterTestFlags Version
v forall a b. (a -> b) -> a -> b
$
                       ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> TestFlags
setupHsTestFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
                                         Verbosity
verbosity FilePath
builddir
    testArgs :: Version -> [FilePath]
testArgs      Version
_  = ElaboratedConfiguredPackage -> [FilePath]
setupHsTestArgs  ElaboratedConfiguredPackage
pkg

    benchCommand :: CommandUI BenchmarkFlags
benchCommand     = CommandUI BenchmarkFlags
Cabal.benchmarkCommand
    benchFlags :: Version -> BenchmarkFlags
benchFlags    Version
_  = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> FilePath
-> BenchmarkFlags
setupHsBenchFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
                                          Verbosity
verbosity FilePath
builddir
    benchArgs :: Version -> [FilePath]
benchArgs     Version
_  = ElaboratedConfiguredPackage -> [FilePath]
setupHsBenchArgs  ElaboratedConfiguredPackage
pkg

    replCommand :: CommandUI ReplFlags
replCommand      = ProgramDb -> CommandUI ReplFlags
Cabal.replCommand ProgramDb
defaultProgramDb
    replFlags :: Version -> ReplFlags
replFlags Version
_      = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> ReplFlags
setupHsReplFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
                                        Verbosity
verbosity FilePath
builddir
    replArgs :: Version -> [FilePath]
replArgs Version
_       = ElaboratedConfiguredPackage -> [FilePath]
setupHsReplArgs  ElaboratedConfiguredPackage
pkg

    haddockCommand :: CommandUI HaddockFlags
haddockCommand   = CommandUI HaddockFlags
Cabal.haddockCommand
    haddockFlags :: Version -> HaddockFlags
haddockFlags Version
v   = forall a b c. (a -> b -> c) -> b -> a -> c
flip HaddockFlags -> Version -> HaddockFlags
filterHaddockFlags Version
v forall a b. (a -> b) -> a -> b
$
                       ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> HaddockFlags
setupHsHaddockFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
                                           Verbosity
verbosity FilePath
builddir
    haddockArgs :: Version -> [FilePath]
haddockArgs    Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip [FilePath] -> Version -> [FilePath]
filterHaddockArgs Version
v forall a b. (a -> b) -> a -> b
$
                       ElaboratedConfiguredPackage -> [FilePath]
setupHsHaddockArgs ElaboratedConfiguredPackage
pkg

    scriptOptions :: SetupScriptOptions
scriptOptions    = ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> FilePath
-> FilePath
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions ElaboratedReadyPackage
rpkg ElaboratedInstallPlan
plan ElaboratedSharedConfig
pkgshared
                                            DistDirLayout
distDirLayout FilePath
srcdir FilePath
builddir
                                            Bool
isParallelBuild Lock
cacheLock

    setupInteractive :: CommandUI flags
                     -> (Version -> flags) -> (Version -> [String]) -> IO ()
    setupInteractive :: forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setupInteractive CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
      forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper Verbosity
verbosity
                   SetupScriptOptions
scriptOptions { isInteractive :: Bool
isInteractive = Bool
True }
                   (forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
                   CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args

    setup :: CommandUI flags -> (Version -> flags) -> (Version -> [String])
          -> IO ()
    setup :: forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
      forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper Verbosity
verbosity
                   SetupScriptOptions
scriptOptions
                   (forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
                   CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args

    generateInstalledPackageInfo :: IO InstalledPackageInfo
    generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
      Verbosity
-> FilePath -> (FilePath -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile
        Verbosity
verbosity FilePath
distTempDirectory forall a b. (a -> b) -> a -> b
$ \FilePath
pkgConfDest -> do
        let registerFlags :: Version -> RegisterFlags
registerFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> FilePath
-> FilePath
-> RegisterFlags
setupHsRegisterFlags
                                ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
                                Verbosity
verbosity FilePath
builddir
                                FilePath
pkgConfDest
        forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI RegisterFlags
Cabal.registerCommand Version -> RegisterFlags
registerFlags (forall a b. a -> b -> a
const [])

withTempInstalledPackageInfoFile :: Verbosity -> FilePath
                                  -> (FilePath -> IO ())
                                  -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile :: Verbosity
-> FilePath -> (FilePath -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile Verbosity
verbosity FilePath
tempdir FilePath -> IO ()
action =
    forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
tempdir FilePath
"package-registration-" forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
      -- make absolute since @action@ will often change directory
      FilePath
abs_dir <- FilePath -> IO FilePath
canonicalizePath FilePath
dir

      let pkgConfDest :: FilePath
pkgConfDest = FilePath
abs_dir FilePath -> FilePath -> FilePath
</> FilePath
"pkgConf"
      FilePath -> IO ()
action FilePath
pkgConfDest

      FilePath -> FilePath -> IO InstalledPackageInfo
readPkgConf FilePath
"." FilePath
pkgConfDest
  where
    pkgConfParseFailed :: String -> IO a
    pkgConfParseFailed :: forall a. FilePath -> IO a
pkgConfParseFailed FilePath
perror =
      forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
      FilePath
"Couldn't parse the output of 'setup register --gen-pkg-config':"
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
perror

    readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
    readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
readPkgConf FilePath
pkgConfDir FilePath
pkgConfFile = do
      ByteString
pkgConfStr <- FilePath -> IO ByteString
BS.readFile (FilePath
pkgConfDir FilePath -> FilePath -> FilePath
</> FilePath
pkgConfFile)
      ([FilePath]
warns, InstalledPackageInfo
ipkg) <- case ByteString
-> Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)
Installed.parseInstalledPackageInfo ByteString
pkgConfStr of
        Left NonEmpty FilePath
perrors -> forall a. FilePath -> IO a
pkgConfParseFailed forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
perrors
        Right ([FilePath]
warns, InstalledPackageInfo
ipkg) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
warns, InstalledPackageInfo
ipkg)

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
warns) forall a b. (a -> b) -> a -> b
$
        Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
warns

      forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
ipkg


------------------------------------------------------------------------------
-- * Utilities
------------------------------------------------------------------------------

annotateFailureNoLog :: (SomeException -> BuildFailureReason)
                     -> IO a -> IO a
annotateFailureNoLog :: forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
annotate IO a
action =
  forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure forall a. Maybe a
Nothing SomeException -> BuildFailureReason
annotate IO a
action

annotateFailure :: Maybe FilePath
                -> (SomeException -> BuildFailureReason)
                -> IO a -> IO a
annotateFailure :: forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
annotate IO a
action =
  IO a
action forall a. IO a -> [Handler a] -> IO a
`catches`
    -- It's not just IOException and ExitCode we have to deal with, there's
    -- lots, including exceptions from the hackage-security and tar packages.
    -- So we take the strategy of catching everything except async exceptions.
    [
#if MIN_VERSION_base(4,7,0)
      forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \SomeAsyncException
async -> forall e a. Exception e => e -> IO a
throwIO (SomeAsyncException
async :: SomeAsyncException)
#else
      Handler $ \async -> throwIO (async :: AsyncException)
#endif
    , forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \SomeException
other -> forall e a. Exception e => e -> IO a
handler (SomeException
other :: SomeException)
    ]
  where
    handler :: Exception e => e -> IO a
    handler :: forall e a. Exception e => e -> IO a
handler = forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> BuildFailureReason -> BuildFailure
BuildFailure Maybe FilePath
mlogFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> BuildFailureReason
annotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toException