{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Distribution.Client.ProjectBuilding (
rebuildTargetsDryRun,
improveInstallPlanWithUpToDatePackages,
BuildStatusMap,
BuildStatus(..),
BuildStatusRebuild(..),
BuildReason(..),
MonitorChangedReason(..),
buildStatusToString,
rebuildTargets,
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)
rebuildTargetsDryRun :: DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> IO BuildStatusMap
rebuildTargetsDryRun :: DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> IO BuildStatusMap
rebuildTargetsDryRun distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
FilePath -> FilePath
PackageId -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: DistDirLayout -> CompilerId -> PackageDB
distBinDirectory :: DistDirLayout -> FilePath
distTempDirectory :: DistDirLayout -> FilePath
distSdistDirectory :: DistDirLayout -> FilePath
distSdistFile :: DistDirLayout -> PackageId -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageId -> 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 :: PackageId -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageId -> FilePath
distDownloadSrcDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
..} ElaboratedSharedConfig
shared =
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> [BuildStatus] -> IO BuildStatus)
-> ElaboratedInstallPlan -> IO BuildStatusMap
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 InstalledPackageInfo ElaboratedConfiguredPackage
-> [BuildStatus] -> IO BuildStatus
dryRunPkg
where
dryRunPkg :: ElaboratedPlanPackage
-> [BuildStatus]
-> IO BuildStatus
dryRunPkg :: GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> [BuildStatus] -> IO BuildStatus
dryRunPkg (InstallPlan.PreExisting InstalledPackageInfo
_pkg) [BuildStatus]
_depsBuildStatus =
BuildStatus -> IO BuildStatus
forall (m :: * -> *) a. Monad m => a -> m a
return BuildStatus
BuildStatusPreExisting
dryRunPkg (InstallPlan.Installed ElaboratedConfiguredPackage
_pkg) [BuildStatus]
_depsBuildStatus =
BuildStatus -> IO BuildStatus
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 -> BuildStatus -> IO BuildStatus
forall (m :: * -> *) a. Monad m => a -> m a
return BuildStatus
BuildStatusDownload
Just (LocalUnpackedPackage FilePath
srcdir) ->
ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunLocalPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
srcdir
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
_ PackageId
_ 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 -> BuildStatus -> IO BuildStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatus
BuildStatusUnpack FilePath
tarball)
BuildStyle
BuildInplaceOnly -> do
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 BuildStatus -> IO BuildStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatus
BuildStatusUnpack FilePath
tarball)
where
srcdir :: FilePath
srcdir :: FilePath
srcdir = PackageId -> FilePath
distUnpackedSrcDirectory (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
pkg)
dryRunLocalPkg :: ElaboratedConfiguredPackage
-> [BuildStatus]
-> FilePath
-> IO BuildStatus
dryRunLocalPkg :: ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunLocalPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
srcdir = do
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
Left BuildStatusRebuild
rebuild ->
BuildStatus -> IO BuildStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatusRebuild -> BuildStatus
BuildStatusRebuild FilePath
srcdir BuildStatusRebuild
rebuild)
Right BuildResult
buildResult ->
BuildStatus -> IO BuildStatus
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)
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)
-> 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 Map UnitId b
forall k a. Map k a
Map.empty ([GenericPlanPackage ipkg srcpkg] -> m (Map UnitId b))
-> (GenericInstallPlan ipkg srcpkg
-> [GenericPlanPackage ipkg srcpkg])
-> GenericInstallPlan ipkg srcpkg
-> m (Map UnitId b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
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 [] = Map UnitId b -> m (Map UnitId b)
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
let depresults :: [b]
depresults :: [b]
depresults =
(UnitId -> b) -> [UnitId] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
ipkgid -> let result :: b
result = b -> UnitId -> Map UnitId b -> b
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (FilePath -> b
forall a. HasCallStack => FilePath -> a
error FilePath
"foldMInstallPlanDepOrder") UnitId
ipkgid Map UnitId b
results
in b
result)
(GenericPlanPackage ipkg srcpkg -> [UnitId]
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' = UnitId -> b -> Map UnitId b -> Map UnitId b
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (GenericPlanPackage ipkg srcpkg
-> Key (GenericPlanPackage ipkg srcpkg)
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 =
(ElaboratedConfiguredPackage -> Bool)
-> ElaboratedInstallPlan -> ElaboratedInstallPlan
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 UnitId -> BuildStatusMap -> Maybe BuildStatus
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg) BuildStatusMap
pkgsBuildStatus of
Just BuildStatusUpToDate {} -> Bool
True
Just BuildStatus
_ -> Bool
False
Maybe BuildStatus
Nothing -> FilePath -> Bool
forall a. HasCallStack => FilePath -> a
error (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"improveInstallPlanWithUpToDatePackages: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
pkg) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" not in status map"
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)
}
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 :: FileMonitor ElaboratedConfiguredPackage ()
-> FileMonitor (Set ComponentName) BuildResultMisc
-> FileMonitor () (Maybe InstalledPackageInfo)
-> PackageFileMonitor
PackageFileMonitor {
pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig =
FileMonitor :: forall a b. FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
FileMonitor {
fileMonitorCacheFile :: FilePath
fileMonitorCacheFile = DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
dparams FilePath
"config",
fileMonitorKeyValid :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
fileMonitorKeyValid = ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ElaboratedConfiguredPackage
-> ElaboratedConfiguredPackage -> Bool)
-> (ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage)
-> ElaboratedConfiguredPackage
-> ElaboratedConfiguredPackage
-> 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 :: forall a b. FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
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 Set ComponentName -> Set ComponentName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set ComponentName
componentsAlreadyBuilt,
fileMonitorCheckIfOnlyValueChanged :: Bool
fileMonitorCheckIfOnlyValueChanged = Bool
True
},
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg =
FilePath -> FileMonitor () (Maybe InstalledPackageInfo)
forall a b. Eq a => FilePath -> FileMonitor a b
newFileMonitor (DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
dparams FilePath
"registration")
}
packageFileMonitorKeyValues :: ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues :: ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues ElaboratedConfiguredPackage
elab =
(ElaboratedConfiguredPackage
elab_config, Set ComponentName
buildComponents)
where
elab_config :: ElaboratedConfiguredPackage
elab_config :: ElaboratedConfiguredPackage
elab_config =
ElaboratedConfiguredPackage
elab {
elabBuildTargets :: [ComponentTarget]
elabBuildTargets = [],
elabTestTargets :: [ComponentTarget]
elabTestTargets = [],
elabBenchTargets :: [ComponentTarget]
elabBenchTargets = [],
elabReplTarget :: Maybe ComponentTarget
elabReplTarget = Maybe ComponentTarget
forall a. Maybe a
Nothing,
elabHaddockTargets :: [ComponentTarget]
elabHaddockTargets = [],
elabBuildHaddocks :: Bool
elabBuildHaddocks = Bool
False,
elabTestMachineLog :: Maybe PathTemplate
elabTestMachineLog = Maybe PathTemplate
forall a. Maybe a
Nothing,
elabTestHumanLog :: Maybe PathTemplate
elabTestHumanLog = Maybe PathTemplate
forall a. Maybe a
Nothing,
elabTestShowDetails :: Maybe TestShowDetails
elabTestShowDetails = Maybe TestShowDetails
forall a. Maybe a
Nothing,
elabTestKeepTix :: Bool
elabTestKeepTix = Bool
False,
elabTestTestOptions :: [PathTemplate]
elabTestTestOptions = [],
elabBenchmarkOptions :: [PathTemplate]
elabBenchmarkOptions = []
}
buildComponents :: Set ComponentName
buildComponents :: Set ComponentName
buildComponents = ElaboratedConfiguredPackage -> Set ComponentName
elabBuildTargetWholeComponents ElaboratedConfiguredPackage
elab
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
MonitorChanged ElaboratedConfiguredPackage ()
configChanged <- FileMonitor ElaboratedConfiguredPackage ()
-> FilePath
-> ElaboratedConfiguredPackage
-> IO (MonitorChanged ElaboratedConfiguredPackage ())
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 ->
Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildStatusRebuild -> Either BuildStatusRebuild BuildResult
forall a b. a -> Either a b
Left (MonitorChangedReason () -> BuildStatusRebuild
BuildStatusConfigure MonitorChangedReason ()
monitorReason'))
where
monitorReason' :: MonitorChangedReason ()
monitorReason' = (ElaboratedConfiguredPackage -> ())
-> MonitorChangedReason ElaboratedConfiguredPackage
-> MonitorChangedReason ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> ElaboratedConfiguredPackage -> ()
forall a b. a -> b -> a
const ()) MonitorChangedReason ElaboratedConfiguredPackage
monitorReason
MonitorUnchanged () [MonitorFilePath]
_
| (BuildStatus -> Bool) -> [BuildStatus] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BuildStatus -> Bool
buildStatusRequiresBuild [BuildStatus]
depsBuildStatus -> do
MonitorChanged () (Maybe InstalledPackageInfo)
regChanged <- FileMonitor () (Maybe InstalledPackageInfo)
-> FilePath
-> ()
-> IO (MonitorChanged () (Maybe InstalledPackageInfo))
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 = MonitorChanged () (Maybe InstalledPackageInfo)
-> Maybe (Maybe InstalledPackageInfo)
forall a b. MonitorChanged a b -> Maybe b
changedToMaybe MonitorChanged () (Maybe InstalledPackageInfo)
regChanged
Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildStatusRebuild -> Either BuildStatusRebuild BuildResult
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 <- FileMonitor (Set ComponentName) BuildResultMisc
-> FilePath
-> Set ComponentName
-> IO (MonitorChanged (Set ComponentName) BuildResultMisc)
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 <- FileMonitor () (Maybe InstalledPackageInfo)
-> FilePath
-> ()
-> IO (MonitorChanged () (Maybe InstalledPackageInfo))
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 = MonitorChanged () (Maybe InstalledPackageInfo)
-> Maybe (Maybe InstalledPackageInfo)
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)
_) ->
Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildStatusRebuild -> Either BuildStatusRebuild BuildResult
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)
_) ->
Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildStatusRebuild -> Either BuildStatusRebuild BuildResult
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' = (Set ComponentName -> ())
-> MonitorChangedReason (Set ComponentName)
-> MonitorChangedReason ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> Set ComponentName -> ()
forall a b. a -> b -> a
const ()) MonitorChangedReason (Set ComponentName)
monitorReason
(MonitorUnchanged BuildResultMisc
_ [MonitorFilePath]
_, MonitorChanged MonitorChangedReason ()
monitorReason) ->
Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildStatusRebuild -> Either BuildStatusRebuild BuildResult
forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
forall a. Maybe a
Nothing BuildReason
buildReason))
where
buildReason :: BuildReason
buildReason = MonitorChangedReason () -> BuildReason
BuildReasonFilesChanged MonitorChangedReason ()
monitorReason'
monitorReason' :: MonitorChangedReason ()
monitorReason' = (() -> ()) -> MonitorChangedReason () -> MonitorChangedReason ()
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 ->
Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildStatusRebuild -> Either BuildStatusRebuild BuildResult
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]
_) ->
Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult))
-> Either BuildStatusRebuild BuildResult
-> IO (Either BuildStatusRebuild BuildResult)
forall a b. (a -> b) -> a -> b
$ BuildResult -> Either BuildStatusRebuild BuildResult
forall a b. b -> Either a b
Right BuildResult :: DocsResult -> TestsResult -> Maybe FilePath -> BuildResult
BuildResult {
buildResultDocs :: DocsResult
buildResultDocs = DocsResult
docsResult,
buildResultTests :: TestsResult
buildResultTests = TestsResult
testsResult,
buildResultLogFile :: Maybe FilePath
buildResultLogFile = Maybe FilePath
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 :: MonitorChanged a b -> Maybe b
changedToMaybe (MonitorChanged MonitorChangedReason a
_) = Maybe b
forall a. Maybe a
Nothing
changedToMaybe (MonitorUnchanged b
x [MonitorFilePath]
_) = b -> Maybe b
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 =
FileMonitor ElaboratedConfiguredPackage ()
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> ElaboratedConfiguredPackage
-> ()
-> IO ()
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 Maybe MonitorTimestamp
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 =
FileMonitor (Set ComponentName) BuildResultMisc
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> Set ComponentName
-> BuildResultMisc
-> IO ()
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 (MonitorTimestamp -> Maybe MonitorTimestamp
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
buildComponents' :: Set ComponentName
buildComponents' =
case BuildStatusRebuild
pkgBuildStatus of
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
_ (BuildReasonExtraTargets Set ComponentName
prevBuildComponents)
-> Set ComponentName
buildComponents Set ComponentName -> Set ComponentName -> Set ComponentName
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 =
FileMonitor () (Maybe InstalledPackageInfo)
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> ()
-> Maybe InstalledPackageInfo
-> IO ()
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 Maybe MonitorTimestamp
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 (FileMonitor () (Maybe InstalledPackageInfo) -> FilePath
forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg)
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
PackageId -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageId -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageId -> 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 -> PackageId -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageId -> 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
JobControl IO (UnitId, Either BuildFailure BuildResult)
jobControl <- if Bool
isParallelBuild
then Int -> IO (JobControl IO (UnitId, Either BuildFailure BuildResult))
forall a. WithCallStack (Int -> IO (JobControl IO a))
newParallelJobControl Int
buildSettingNumJobs
else IO (JobControl IO (UnitId, Either BuildFailure BuildResult))
forall a. IO (JobControl IO a)
newSerialJobControl
Lock
registerLock <- IO Lock
newLock
Lock
cacheLock <- IO Lock
newLock
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Executing install plan "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ if Bool
isParallelBuild
then FilePath
" in parallel using " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
buildSettingNumJobs FilePath -> FilePath -> FilePath
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
(PackageDB -> IO ()) -> [PackageDB] -> IO ()
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) [PackageDB]
packageDBsToUse
Verbosity
-> ((RepoContext -> IO BuildOutcomes) -> IO BuildOutcomes)
-> ElaboratedInstallPlan
-> BuildStatusMap
-> (AsyncFetchMap -> IO BuildOutcomes)
-> IO BuildOutcomes
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 ((AsyncFetchMap -> IO BuildOutcomes) -> IO BuildOutcomes)
-> (AsyncFetchMap -> IO BuildOutcomes) -> IO BuildOutcomes
forall a b. (a -> b) -> a -> b
$ \AsyncFetchMap
downloadMap ->
JobControl IO (UnitId, Either BuildFailure BuildResult)
-> Bool
-> (ElaboratedConfiguredPackage -> BuildFailure)
-> ElaboratedInstallPlan
-> (GenericReadyPackage ElaboratedConfiguredPackage
-> IO (Either BuildFailure BuildResult))
-> IO BuildOutcomes
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 Maybe FilePath
forall a. Maybe a
Nothing (BuildFailureReason -> BuildFailure)
-> (ElaboratedConfiguredPackage -> BuildFailureReason)
-> ElaboratedConfiguredPackage
-> BuildFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> BuildFailureReason
DependentFailed (PackageId -> BuildFailureReason)
-> (ElaboratedConfiguredPackage -> PackageId)
-> ElaboratedConfiguredPackage
-> BuildFailureReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId)
ElaboratedInstallPlan
installPlan ((GenericReadyPackage ElaboratedConfiguredPackage
-> IO (Either BuildFailure BuildResult))
-> IO BuildOutcomes)
-> (GenericReadyPackage ElaboratedConfiguredPackage
-> IO (Either BuildFailure BuildResult))
-> IO BuildOutcomes
forall a b. (a -> b) -> a -> b
$ \GenericReadyPackage ElaboratedConfiguredPackage
pkg ->
(BuildFailure -> IO (Either BuildFailure BuildResult))
-> IO (Either BuildFailure BuildResult)
-> IO (Either BuildFailure BuildResult)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(BuildFailure
e :: BuildFailure) -> Either BuildFailure BuildResult
-> IO (Either BuildFailure BuildResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildFailure -> Either BuildFailure BuildResult
forall a b. a -> Either a b
Left BuildFailure
e)) (IO (Either BuildFailure BuildResult)
-> IO (Either BuildFailure BuildResult))
-> IO (Either BuildFailure BuildResult)
-> IO (Either BuildFailure BuildResult)
forall a b. (a -> b) -> a -> b
$ (BuildResult -> Either BuildFailure BuildResult)
-> IO BuildResult -> IO (Either BuildFailure BuildResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BuildResult -> Either BuildFailure BuildResult
forall a b. b -> Either a b
Right (IO BuildResult -> IO (Either BuildFailure BuildResult))
-> IO BuildResult -> IO (Either BuildFailure BuildResult)
forall a b. (a -> b) -> a -> b
$
let uid :: UnitId
uid = GenericReadyPackage ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId GenericReadyPackage ElaboratedConfiguredPackage
pkg
pkgBuildStatus :: BuildStatus
pkgBuildStatus = BuildStatus -> UnitId -> BuildStatusMap -> BuildStatus
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (FilePath -> BuildStatus
forall a. HasCallStack => FilePath -> a
error FilePath
"rebuildTargets") UnitId
uid BuildStatusMap
pkgsBuildStatus in
Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> AsyncFetchMap
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> GenericReadyPackage ElaboratedConfiguredPackage
-> BuildStatus
-> IO BuildResult
rebuildTarget
Verbosity
verbosity
DistDirLayout
distDirLayout
StoreDirLayout
storeDirLayout
BuildTimeSettings
buildSettings AsyncFetchMap
downloadMap
Lock
registerLock Lock
cacheLock
ElaboratedSharedConfig
sharedPackageConfig
ElaboratedInstallPlan
installPlan GenericReadyPackage ElaboratedConfiguredPackage
pkg
BuildStatus
pkgBuildStatus
where
isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
keepGoing :: Bool
keepGoing = Bool
buildSettingKeepGoing
withRepoCtx :: (RepoContext -> IO BuildOutcomes) -> IO BuildOutcomes
withRepoCtx = Verbosity
-> BuildTimeSettings
-> (RepoContext -> IO BuildOutcomes)
-> IO BuildOutcomes
forall a.
Verbosity -> BuildTimeSettings -> (RepoContext -> IO a) -> IO a
projectConfigWithBuilderRepoContext Verbosity
verbosity
BuildTimeSettings
buildSettings
packageDBsToUse :: [PackageDB]
packageDBsToUse =
(Set PackageDB -> [PackageDB]
forall a. Set a -> [a]
Set.toList (Set PackageDB -> [PackageDB])
-> ([PackageDB] -> Set PackageDB) -> [PackageDB] -> [PackageDB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackageDB] -> Set PackageDB
forall a. Ord a => [a] -> Set a
Set.fromList)
[ PackageDB
pkgdb
| InstallPlan.Configured ElaboratedConfiguredPackage
elab <- ElaboratedInstallPlan
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
installPlan
, PackageDB
pkgdb <- [[PackageDB]] -> [PackageDB]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ ElaboratedConfiguredPackage -> [PackageDB]
elabBuildPackageDBStack ElaboratedConfiguredPackage
elab
, ElaboratedConfiguredPackage -> [PackageDB]
elabRegisterPackageDBStack ElaboratedConfiguredPackage
elab
, ElaboratedConfiguredPackage -> [PackageDB]
elabSetupPackageDBStack ElaboratedConfiguredPackage
elab ]
]
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
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
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
rebuildTarget :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> AsyncFetchMap
-> Lock -> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatus
-> IO BuildResult
rebuildTarget :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> AsyncFetchMap
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> GenericReadyPackage ElaboratedConfiguredPackage
-> 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 :: GenericReadyPackage ElaboratedConfiguredPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
BuildStatus
pkgBuildStatus
| BuildTimeSettings -> Bool
buildSettingOnlyDownload BuildTimeSettings
buildSettings = do
case BuildStatus
pkgBuildStatus of
BuildStatus
BuildStatusDownload ->
IO DownloadedSourceLocation -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO DownloadedSourceLocation -> IO ())
-> IO DownloadedSourceLocation -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity
-> AsyncFetchMap
-> ElaboratedConfiguredPackage
-> IO DownloadedSourceLocation
waitAsyncPackageDownload Verbosity
verbosity AsyncFetchMap
downloadMap ElaboratedConfiguredPackage
pkg
BuildStatus
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResult -> IO BuildResult) -> BuildResult -> IO BuildResult
forall a b. (a -> b) -> a -> b
$ DocsResult -> TestsResult -> Maybe FilePath -> BuildResult
BuildResult DocsResult
DocsNotTried TestsResult
TestsNotTried Maybe FilePath
forall a. Maybe a
Nothing
| Bool
otherwise =
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
BuildStatusPreExisting {} -> IO BuildResult
forall a. a
unexpectedState
BuildStatusInstalled {} -> IO BuildResult
forall a. a
unexpectedState
BuildStatusUpToDate {} -> IO BuildResult
forall a. a
unexpectedState
where
unexpectedState :: a
unexpectedState = FilePath -> a
forall a. HasCallStack => FilePath -> a
error FilePath
"rebuildTarget: unexpected package status"
downloadPhase :: IO BuildResult
downloadPhase :: IO BuildResult
downloadPhase = do
DownloadedSourceLocation
downsrcloc <- (SomeException -> BuildFailureReason)
-> IO DownloadedSourceLocation -> IO DownloadedSourceLocation
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
DownloadFailed (IO DownloadedSourceLocation -> IO DownloadedSourceLocation)
-> IO DownloadedSourceLocation -> IO DownloadedSourceLocation
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
unpackTarballPhase :: FilePath -> IO BuildResult
unpackTarballPhase :: FilePath -> IO BuildResult
unpackTarballPhase FilePath
tarball =
Verbosity
-> DistDirLayout
-> FilePath
-> PackageId
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath -> FilePath -> IO BuildResult)
-> IO BuildResult
forall a.
Verbosity
-> DistDirLayout
-> FilePath
-> PackageId
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath -> FilePath -> IO a)
-> IO a
withTarballLocalDirectory
Verbosity
verbosity DistDirLayout
distDirLayout FilePath
tarball
(ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ElaboratedConfiguredPackage
pkg) (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
sharedPackageConfig ElaboratedConfiguredPackage
pkg)
(ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg)
(ElaboratedConfiguredPackage -> Maybe CabalFileText
elabPkgDescriptionOverride ElaboratedConfiguredPackage
pkg) ((FilePath -> FilePath -> IO BuildResult) -> IO BuildResult)
-> (FilePath -> FilePath -> IO BuildResult) -> IO BuildResult
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 MonitorChangedReason ()
forall a. MonitorChangedReason a
MonitorFirstRun
rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult
rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult
rebuildPhase BuildStatusRebuild
buildStatus FilePath
srcdir =
Bool -> IO BuildResult -> IO BuildResult
forall a. HasCallStack => Bool -> a -> a
assert (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly) (IO BuildResult -> IO BuildResult)
-> IO BuildResult -> IO BuildResult
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
-> GenericReadyPackage ElaboratedConfiguredPackage
-> FilePath
-> FilePath
-> IO BuildResult
buildAndInstallUnpackedPackage
Verbosity
verbosity DistDirLayout
distDirLayout StoreDirLayout
storeDirLayout
BuildTimeSettings
buildSettings Lock
registerLock Lock
cacheLock
ElaboratedSharedConfig
sharedPackageConfig
ElaboratedInstallPlan
plan GenericReadyPackage ElaboratedConfiguredPackage
rpkg
FilePath
srcdir FilePath
builddir'
where
builddir' :: FilePath
builddir' = FilePath -> FilePath -> FilePath
makeRelative FilePath
srcdir FilePath
builddir
buildInplace :: BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
buildInplace :: BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
buildInplace BuildStatusRebuild
buildStatus FilePath
srcdir FilePath
builddir =
Verbosity
-> DistDirLayout
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> GenericReadyPackage ElaboratedConfiguredPackage
-> BuildStatusRebuild
-> FilePath
-> FilePath
-> IO BuildResult
buildInplaceUnpackedPackage
Verbosity
verbosity DistDirLayout
distDirLayout
BuildTimeSettings
buildSettings Lock
registerLock Lock
cacheLock
ElaboratedSharedConfig
sharedPackageConfig
ElaboratedInstallPlan
plan GenericReadyPackage ElaboratedConfiguredPackage
rpkg
BuildStatusRebuild
buildStatus
FilePath
srcdir FilePath
builddir
asyncDownloadPackages :: Verbosity
-> ((RepoContext -> IO a) -> IO a)
-> ElaboratedInstallPlan
-> BuildStatusMap
-> (AsyncFetchMap -> IO a)
-> IO a
asyncDownloadPackages :: 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
| [UnresolvedPkgLoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnresolvedPkgLoc]
pkgsToDownload = AsyncFetchMap -> IO a
body AsyncFetchMap
forall k a. Map k a
Map.empty
| Bool
otherwise = (RepoContext -> IO a) -> IO a
withRepoCtx ((RepoContext -> IO a) -> IO a) -> (RepoContext -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \RepoContext
repoctx ->
Verbosity
-> RepoContext
-> [UnresolvedPkgLoc]
-> (AsyncFetchMap -> IO a)
-> IO a
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 =
[UnresolvedPkgLoc] -> [UnresolvedPkgLoc]
forall a. Ord a => [a] -> [a]
ordNub ([UnresolvedPkgLoc] -> [UnresolvedPkgLoc])
-> [UnresolvedPkgLoc] -> [UnresolvedPkgLoc]
forall a b. (a -> b) -> a -> b
$
[ ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgSourceLocation ElaboratedConfiguredPackage
elab
| InstallPlan.Configured ElaboratedConfiguredPackage
elab
<- ElaboratedInstallPlan
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.reverseTopologicalOrder ElaboratedInstallPlan
installPlan
, let uid :: UnitId
uid = ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab
pkgBuildStatus :: BuildStatus
pkgBuildStatus = BuildStatus -> UnitId -> BuildStatusMap -> BuildStatus
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (FilePath -> BuildStatus
forall a. HasCallStack => FilePath -> a
error FilePath
"asyncDownloadPackages") UnitId
uid BuildStatusMap
pkgsBuildStatus
, BuildStatus
BuildStatusDownload <- [BuildStatus
pkgBuildStatus]
]
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 -> DownloadedSourceLocation -> IO DownloadedSourceLocation
forall (m :: * -> *) a. Monad m => a -> m a
return DownloadedSourceLocation
loc
Maybe DownloadedSourceLocation
Nothing -> FilePath -> IO DownloadedSourceLocation
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"waitAsyncPackageDownload: unexpected source location"
data DownloadedSourceLocation = DownloadedTarball FilePath
downloadedSourceLocation :: PackageLocation FilePath
-> Maybe DownloadedSourceLocation
downloadedSourceLocation :: ResolvedPkgLoc -> Maybe DownloadedSourceLocation
downloadedSourceLocation ResolvedPkgLoc
pkgloc =
case ResolvedPkgLoc
pkgloc of
RemoteTarballPackage URI
_ FilePath
tarball -> DownloadedSourceLocation -> Maybe DownloadedSourceLocation
forall a. a -> Maybe a
Just (FilePath -> DownloadedSourceLocation
DownloadedTarball FilePath
tarball)
RepoTarballPackage Repo
_ PackageId
_ FilePath
tarball -> DownloadedSourceLocation -> Maybe DownloadedSourceLocation
forall a. a -> Maybe a
Just (FilePath -> DownloadedSourceLocation
DownloadedTarball FilePath
tarball)
ResolvedPkgLoc
_ -> Maybe DownloadedSourceLocation
forall a. Maybe a
Nothing
withTarballLocalDirectory
:: Verbosity
-> DistDirLayout
-> FilePath
-> PackageId
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath ->
FilePath ->
IO a)
-> IO a
withTarballLocalDirectory :: Verbosity
-> DistDirLayout
-> FilePath
-> PackageId
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath -> FilePath -> IO a)
-> IO a
withTarballLocalDirectory Verbosity
verbosity distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
FilePath -> FilePath
PackageId -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageId -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageId -> 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 -> PackageId -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageId -> FilePath
distDownloadSrcDirectory :: DistDirLayout -> FilePath
distBuildRootDirectory :: DistDirLayout -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distDirectory :: DistDirLayout -> FilePath
distProjectFile :: DistDirLayout -> FilePath -> FilePath
distProjectRootDirectory :: DistDirLayout -> FilePath
..}
FilePath
tarball PackageId
pkgid DistDirParams
dparams BuildStyle
buildstyle Maybe CabalFileText
pkgTextOverride
FilePath -> FilePath -> IO a
buildPkg =
case BuildStyle
buildstyle of
BuildStyle
BuildAndInstall ->
let tmpdir :: FilePath
tmpdir = FilePath
distTempDirectory in
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
tmpdir FilePath
"src" ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FilePath
unpackdir -> do
Verbosity
-> FilePath
-> FilePath
-> PackageId
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
unpackdir
PackageId
pkgid Maybe CabalFileText
pkgTextOverride
let srcdir :: FilePath
srcdir = FilePath
unpackdir FilePath -> FilePath -> FilePath
</> PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid
builddir :: FilePath
builddir = FilePath
srcdir FilePath -> FilePath -> FilePath
</> FilePath
"dist"
FilePath -> FilePath -> IO a
buildPkg FilePath
srcdir FilePath
builddir
BuildStyle
BuildInplaceOnly -> do
let srcrootdir :: FilePath
srcrootdir = FilePath
distUnpackedSrcRootDirectory
srcdir :: FilePath
srcdir = PackageId -> FilePath
distUnpackedSrcDirectory PackageId
pkgid
builddir :: FilePath
builddir = DistDirParams -> FilePath
distBuildDirectory DistDirParams
dparams
Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
srcdir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
srcrootdir
Verbosity
-> FilePath
-> FilePath
-> PackageId
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
srcrootdir
PackageId
pkgid Maybe CabalFileText
pkgTextOverride
Verbosity
-> DistDirLayout -> FilePath -> PackageId -> DistDirParams -> IO ()
moveTarballShippedDistDirectory Verbosity
verbosity DistDirLayout
distDirLayout
FilePath
srcrootdir PackageId
pkgid DistDirParams
dparams
FilePath -> FilePath -> IO a
buildPkg FilePath
srcdir FilePath
builddir
unpackPackageTarball :: Verbosity -> FilePath -> FilePath
-> PackageId -> Maybe CabalFileText
-> IO ()
unpackPackageTarball :: Verbosity
-> FilePath
-> FilePath
-> PackageId
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
parentdir PackageId
pkgid Maybe CabalFileText
pkgTextOverride =
(SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
UnpackFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Extracting " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tarball FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
parentdir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"..."
FilePath -> FilePath -> FilePath -> IO ()
Tar.extractTarGzFile FilePath
parentdir FilePath
pkgsubdir FilePath
tarball
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
cabalFile
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Package .cabal file not found in the tarball: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cabalFile
case Maybe CabalFileText
pkgTextOverride of
Maybe CabalFileText
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just CabalFileText
pkgtxt -> do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Updating " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkgname FilePath -> FilePath -> FilePath
<.> FilePath
"cabal"
FilePath -> FilePath -> FilePath
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
</> PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkgname FilePath -> FilePath -> FilePath
<.> FilePath
"cabal"
pkgsubdir :: FilePath
pkgsubdir = PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid
pkgname :: PackageName
pkgname = PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid
moveTarballShippedDistDirectory :: Verbosity -> DistDirLayout
-> FilePath -> PackageId -> DistDirParams
-> IO ()
moveTarballShippedDistDirectory :: Verbosity
-> DistDirLayout -> FilePath -> PackageId -> DistDirParams -> IO ()
moveTarballShippedDistDirectory Verbosity
verbosity DistDirLayout{DistDirParams -> FilePath
distBuildDirectory :: DistDirParams -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory}
FilePath
parentdir PackageId
pkgid DistDirParams
dparams = do
Bool
distDirExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
tarballDistDir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
distDirExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Moving '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tarballDistDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' to '"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
targetDistDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
FilePath -> FilePath -> IO ()
renameDirectory FilePath
tarballDistDir FilePath
targetDistDir
where
tarballDistDir :: FilePath
tarballDistDir = FilePath
parentdir FilePath -> FilePath -> FilePath
</> PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
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
-> GenericReadyPackage ElaboratedConfiguredPackage
-> FilePath
-> FilePath
-> IO BuildResult
buildAndInstallUnpackedPackage Verbosity
verbosity
distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
distTempDirectory :: FilePath
distTempDirectory :: DistDirLayout -> FilePath
distTempDirectory}
storeDirLayout :: StoreDirLayout
storeDirLayout@StoreDirLayout {
CompilerId -> [PackageDB]
storePackageDBStack :: StoreDirLayout -> CompilerId -> [PackageDB]
storePackageDBStack :: CompilerId -> [PackageDB]
storePackageDBStack
}
BuildTimeSettings {
Int
buildSettingNumJobs :: Int
buildSettingNumJobs :: BuildTimeSettings -> Int
buildSettingNumJobs,
Maybe (Compiler -> Platform -> PackageId -> UnitId -> FilePath)
buildSettingLogFile :: BuildTimeSettings
-> Maybe (Compiler -> Platform -> PackageId -> UnitId -> FilePath)
buildSettingLogFile :: Maybe (Compiler -> Platform -> PackageId -> 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 :: GenericReadyPackage ElaboratedConfiguredPackage
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
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressStarting
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
ConfigureFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CommandUI ConfigFlags
-> (Version -> ConfigFlags) -> (Version -> [FilePath]) -> IO ()
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI ConfigFlags
configureCommand Version -> ConfigFlags
configureFlags Version -> [FilePath]
configureArgs
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressBuilding
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
BuildFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CommandUI BuildFlags -> (Version -> BuildFlags) -> IO ()
forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI BuildFlags
buildCommand Version -> BuildFlags
buildFlags
IO () -> IO ()
whenHaddock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressHaddock
(SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
HaddocksFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CommandUI HaddockFlags -> (Version -> HaddockFlags) -> IO ()
forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI HaddockFlags
haddockCommand Version -> HaddockFlags
haddockFlags
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressInstalling
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
InstallFailed (IO () -> IO ()) -> IO () -> IO ()
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
CommandUI CopyFlags -> (Version -> CopyFlags) -> IO ()
forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI CopyFlags
Cabal.copyCommand (FilePath -> Version -> CopyFlags
copyFlags FilePath
tmpDirNormalised)
let prefix :: FilePath
prefix = FilePath -> FilePath
normalise (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath
dropDrive (InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
InstallDirs.prefix (ElaboratedConfiguredPackage -> InstallDirs FilePath
elabInstallDirs ElaboratedConfiguredPackage
pkg))
entryDir :: FilePath
entryDir = FilePath
tmpDirNormalised FilePath -> FilePath -> FilePath
</> FilePath
prefix
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 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"creating file with the inputs used to compute the package hash: " FilePath -> FilePath -> FilePath
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:"
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
(Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++))
(FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ CabalFileText -> FilePath
LBS.Char8.unpack CabalFileText
outPkgHashInputs)
[FilePath]
otherFiles <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
entryDir) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
FilePath -> IO [FilePath]
listFilesRecursive FilePath
tmpDirNormalised
(FilePath, [FilePath]) -> IO (FilePath, [FilePath])
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 <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
path FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]
listDirectory FilePath
path)
[[FilePath]]
allFiles <- [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FilePath]
files ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
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 [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
file]
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[FilePath]] -> [FilePath]
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 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"registerPkg: elab does NOT require registration for "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnitId
uid
| Bool
otherwise = do
InstalledPackageInfo
ipkg0 <- IO InstalledPackageInfo
generateInstalledPackageInfo
let ipkg :: InstalledPackageInfo
ipkg = InstalledPackageInfo
ipkg0 { installedUnitId :: UnitId
Installed.installedUnitId = UnitId
uid }
Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert ( ElaboratedConfiguredPackage -> [PackageDB]
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg
[PackageDB] -> [PackageDB] -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerId -> [PackageDB]
storePackageDBStack CompilerId
compid) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
criticalSection Lock
registerLock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity
-> Compiler
-> ProgramDb
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
Cabal.registerPackage
Verbosity
verbosity Compiler
compiler ProgramDb
progdb
(CompilerId -> [PackageDB]
storePackageDBStack CompilerId
compid) InstalledPackageInfo
ipkg
RegisterOptions
Cabal.defaultRegisterOptions {
registerMultiInstance :: Bool
Cabal.registerMultiInstance = Bool
True,
registerSuppressFilesCheck :: Bool
Cabal.registerSuppressFilesCheck = Bool
True
}
IO NewStoreEntryOutcome -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO NewStoreEntryOutcome -> IO ())
-> IO NewStoreEntryOutcome -> IO ()
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
let docsResult :: DocsResult
docsResult = DocsResult
DocsNotTried
testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressCompleted
BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return BuildResult :: DocsResult -> TestsResult -> Maybe FilePath -> BuildResult
BuildResult {
buildResultDocs :: DocsResult
buildResultDocs = DocsResult
docsResult,
buildResultTests :: TestsResult
buildResultTests = TestsResult
testsResult,
buildResultLogFile :: Maybe FilePath
buildResultLogFile = Maybe FilePath
mlogFile
}
where
pkgid :: PackageId
pkgid = GenericReadyPackage ElaboratedConfiguredPackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId GenericReadyPackage ElaboratedConfiguredPackage
rpkg
uid :: UnitId
uid = GenericReadyPackage ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId GenericReadyPackage ElaboratedConfiguredPackage
rpkg
compid :: CompilerId
compid = Compiler -> CompilerId
compilerId Compiler
compiler
dispname :: String
dispname :: FilePath
dispname = case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
pkg of
ElabPackage ElaboratedPackage
_ -> PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (all, legacy fallback)"
ElabComponent ElaboratedComponent
comp -> PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
-> (ComponentName -> FilePath) -> Maybe ComponentName -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"custom" ComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
noticeProgress :: ProgressPhase -> IO ()
noticeProgress :: ProgressPhase -> IO ()
noticeProgress ProgressPhase
phase = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isParallelBuild (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> ProgressPhase -> FilePath -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
phase FilePath
dispname
isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
whenHaddock :: IO () -> IO ()
whenHaddock IO ()
action
| ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage
pkg = IO ()
action
| Bool
otherwise = () -> IO ()
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 = (ConfigFlags -> Version -> ConfigFlags)
-> Version -> ConfigFlags -> ConfigFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags Version
v (ConfigFlags -> ConfigFlags) -> ConfigFlags -> ConfigFlags
forall a b. (a -> b) -> a -> b
$
GenericReadyPackage ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> ConfigFlags
setupHsConfigureFlags GenericReadyPackage ElaboratedConfiguredPackage
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 ((FilePath -> IO ()) -> IO InstalledPackageInfo)
-> (FilePath -> IO ()) -> IO InstalledPackageInfo
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
CommandUI RegisterFlags -> (Version -> RegisterFlags) -> IO ()
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 = GenericReadyPackage ElaboratedConfiguredPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> FilePath
-> FilePath
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions GenericReadyPackage ElaboratedConfiguredPackage
rpkg ElaboratedInstallPlan
plan ElaboratedSharedConfig
pkgshared
DistDirLayout
distDirLayout FilePath
srcdir FilePath
builddir
Bool
isParallelBuild Lock
cacheLock
setup :: CommandUI flags -> (Version -> flags) -> IO ()
setup :: CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI flags
cmd Version -> flags
flags = CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI flags
cmd Version -> flags
flags ([FilePath] -> Version -> [FilePath]
forall a b. a -> b -> a
const [])
setup' :: CommandUI flags -> (Version -> flags) -> (Version -> [String])
-> IO ()
setup' :: CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
(Maybe Handle -> IO ()) -> IO ()
forall r. (Maybe Handle -> IO r) -> IO r
withLogging ((Maybe Handle -> IO ()) -> IO ())
-> (Maybe Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
mLogFileHandle ->
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
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 }
(PackageDescription -> Maybe PackageDescription
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 -> PackageId -> UnitId -> FilePath)
buildSettingLogFile of
Maybe (Compiler -> Platform -> PackageId -> UnitId -> FilePath)
Nothing -> Maybe FilePath
forall a. Maybe a
Nothing
Just Compiler -> Platform -> PackageId -> UnitId -> FilePath
mkLogFile -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Compiler -> Platform -> PackageId -> UnitId -> FilePath
mkLogFile Compiler
compiler Platform
platform PackageId
pkgid UnitId
uid)
initLogFile :: IO ()
initLogFile :: IO ()
initLogFile =
case Maybe FilePath
mlogFile of
Maybe FilePath
Nothing -> () -> IO ()
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
logFile
withLogging :: (Maybe Handle -> IO r) -> IO r
withLogging :: (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 Maybe Handle
forall a. Maybe a
Nothing
Just FilePath
logFile -> FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
logFile IOMode
AppendMode (Maybe Handle -> IO r
action (Maybe Handle -> IO r)
-> (Handle -> Maybe Handle) -> Handle -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Maybe Handle
forall a. a -> Maybe a
Just)
hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage{Bool
[FilePath]
[Maybe PackageDB]
[PackageDB]
[PathTemplate]
[ComponentTarget]
Maybe FilePath
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageId
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
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 -> [PackageDB]
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> [PackageDB]
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> [PackageDB]
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 -> PackageId
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
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 :: [PackageDB]
elabInplaceBuildPackageDBStack :: [PackageDB]
elabInplaceSetupPackageDBStack :: [PackageDB]
elabRegisterPackageDBStack :: [PackageDB]
elabBuildPackageDBStack :: [PackageDB]
elabSetupPackageDBStack :: [PackageDB]
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 :: PackageId
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 -> [PackageDB]
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> [PackageDB]
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> [PackageDB]
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 = (ComponentTarget -> Bool) -> [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ComponentTarget -> Bool
componentHasHaddocks [ComponentTarget]
components
where
components :: [ComponentTarget]
components :: [ComponentTarget]
components = [ComponentTarget]
elabBuildTargets [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabTestTargets [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabBenchTargets
[ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
forall a. [a] -> [a] -> [a]
++ Maybe ComponentTarget -> [ComponentTarget]
forall a. Maybe a -> [a]
maybeToList Maybe ComponentTarget
elabReplTarget [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget]
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 ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription
elabPkgDescription PackageDescription
-> Getting [ModuleName] PackageDescription [ModuleName]
-> [ModuleName]
forall s a. s -> Getting a s a -> a
^. ComponentName
-> Getting [ModuleName] PackageDescription [ModuleName]
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
-> GenericReadyPackage ElaboratedConfiguredPackage
-> 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 :: GenericReadyPackage ElaboratedConfiguredPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
BuildStatusRebuild
buildStatus
FilePath
srcdir FilePath
builddir = do
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)
IO () -> IO ()
whenReConfigure (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
ConfigureFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CommandUI ConfigFlags
-> (Version -> ConfigFlags) -> (Version -> [FilePath]) -> IO ()
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
let docsResult :: DocsResult
docsResult = DocsResult
DocsNotTried
testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried
buildResult :: BuildResultMisc
buildResult :: BuildResultMisc
buildResult = (DocsResult
docsResult, TestsResult
testsResult)
IO () -> IO ()
whenRebuild (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
MonitorTimestamp
timestamp <- IO MonitorTimestamp
beginUpdateFileMonitor
(SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
BuildFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CommandUI BuildFlags
-> (Version -> BuildFlags) -> (Version -> [FilePath]) -> IO ()
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI BuildFlags
buildCommand Version -> BuildFlags
buildFlags Version -> [FilePath]
buildArgs
let listSimple :: IO [MonitorFilePath]
listSimple =
FilePath -> Rebuild () -> IO [MonitorFilePath]
forall a. FilePath -> Rebuild a -> IO [MonitorFilePath]
execRebuild FilePath
srcdir (ElaboratedConfiguredPackage -> Rebuild ()
needElaboratedConfiguredPackage ElaboratedConfiguredPackage
pkg)
listSdist :: IO [MonitorFilePath]
listSdist =
([FilePath] -> [MonitorFilePath])
-> IO [FilePath] -> IO [MonitorFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> MonitorFilePath) -> [FilePath] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorFileHashed) (IO [FilePath] -> IO [MonitorFilePath])
-> IO [FilePath] -> IO [MonitorFilePath]
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 t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs then m (t a)
m' else t a -> m (t a)
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
BuildType
_ | ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion ElaboratedConfiguredPackage
pkg Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1,Int
17]
-> IO [MonitorFilePath]
listSdist IO [MonitorFilePath]
-> IO [MonitorFilePath] -> IO [MonitorFilePath]
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 = (FilePath -> MonitorFilePath) -> [FilePath] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorFileHashed
([FilePath] -> [MonitorFilePath])
-> [FilePath] -> [MonitorFilePath]
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 [MonitorFilePath] -> [MonitorFilePath] -> [MonitorFilePath]
forall a. [a] -> [a] -> [a]
++ [MonitorFilePath]
dep_monitors) BuildResultMisc
buildResult
IO () -> IO ()
whenReRegister (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
InstallFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Maybe InstalledPackageInfo
mipkg <- if ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg
then do
InstalledPackageInfo
ipkg0 <- IO InstalledPackageInfo
generateInstalledPackageInfo
let ipkg :: InstalledPackageInfo
ipkg = InstalledPackageInfo
ipkg0 { installedUnitId :: UnitId
Installed.installedUnitId = UnitId
ipkgid }
Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
criticalSection Lock
registerLock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity
-> Compiler
-> ProgramDb
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
Cabal.registerPackage Verbosity
verbosity Compiler
compiler ProgramDb
progdb
(ElaboratedConfiguredPackage -> [PackageDB]
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg)
InstalledPackageInfo
ipkg RegisterOptions
Cabal.defaultRegisterOptions
Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageInfo -> Maybe InstalledPackageInfo
forall a. a -> Maybe a
Just InstalledPackageInfo
ipkg)
else Maybe InstalledPackageInfo -> IO (Maybe InstalledPackageInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InstalledPackageInfo
forall a. Maybe a
Nothing
PackageFileMonitor
-> FilePath -> Maybe InstalledPackageInfo -> IO ()
updatePackageRegFileMonitor PackageFileMonitor
packageFileMonitor FilePath
srcdir Maybe InstalledPackageInfo
mipkg
IO () -> IO ()
whenTest (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
TestsFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CommandUI TestFlags
-> (Version -> TestFlags) -> (Version -> [FilePath]) -> IO ()
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI TestFlags
testCommand Version -> TestFlags
testFlags Version -> [FilePath]
testArgs
IO () -> IO ()
whenBench (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
BenchFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CommandUI BenchmarkFlags
-> (Version -> BenchmarkFlags) -> (Version -> [FilePath]) -> IO ()
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI BenchmarkFlags
benchCommand Version -> BenchmarkFlags
benchFlags Version -> [FilePath]
benchArgs
IO () -> IO ()
whenRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
ReplFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
CommandUI ReplFlags
-> (Version -> ReplFlags) -> (Version -> [FilePath]) -> IO ()
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setupInteractive CommandUI ReplFlags
replCommand Version -> ReplFlags
replFlags Version -> [FilePath]
replArgs
IO () -> IO ()
whenHaddock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(SomeException -> BuildFailureReason) -> IO () -> IO ()
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
HaddocksFailed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
CommandUI HaddockFlags
-> (Version -> HaddockFlags) -> (Version -> [FilePath]) -> IO ()
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HaddockTarget
haddockTarget HaddockTarget -> HaddockTarget -> Bool
forall a. Eq a => a -> a -> Bool
== HaddockTarget
Cabal.ForHackage) (IO () -> IO ()) -> IO () -> IO ()
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 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Documentation tarball created: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dest
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
buildSettingHaddockOpen Bool -> Bool -> Bool
&& HaddockTarget
haddockTarget HaddockTarget -> HaddockTarget -> Bool
forall a. Eq a => a -> a -> Bool
/= HaddockTarget
Cabal.ForHackage) (IO () -> IO ()) -> IO () -> IO ()
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 -> Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
err
BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return BuildResult :: DocsResult -> TestsResult -> Maybe FilePath -> BuildResult
BuildResult {
buildResultDocs :: DocsResult
buildResultDocs = DocsResult
docsResult,
buildResultTests :: TestsResult
buildResultTests = TestsResult
testsResult,
buildResultLogFile :: Maybe FilePath
buildResultLogFile = Maybe FilePath
forall a. Maybe a
Nothing
}
where
ipkgid :: UnitId
ipkgid = ElaboratedConfiguredPackage -> UnitId
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 Int -> Int -> Bool
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
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenRebuild :: IO () -> IO ()
whenRebuild IO ()
action
| [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
pkg)
, [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg)
, [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IO ()
action
whenTest :: IO () -> IO ()
whenTest IO ()
action
| [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IO ()
action
whenBench :: IO () -> IO ()
whenBench IO ()
action
| [ComponentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IO ()
action
whenRepl :: IO () -> IO ()
whenRepl IO ()
action
| Maybe ComponentTarget -> Bool
forall a. Maybe a -> Bool
isNothing (ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabReplTarget ElaboratedConfiguredPackage
pkg) = () -> IO ()
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 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenReRegister :: IO () -> IO ()
whenReRegister IO ()
action
= case BuildStatusRebuild
buildStatus of
BuildStatusBuild (Just Maybe InstalledPackageInfo
_) BuildReason
_ ->
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"whenReRegister: previously registered"
BuildStatusRebuild
_ | [ComponentTarget] -> Bool
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 = (ConfigFlags -> Version -> ConfigFlags)
-> Version -> ConfigFlags -> ConfigFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags Version
v (ConfigFlags -> ConfigFlags) -> ConfigFlags -> ConfigFlags
forall a b. (a -> b) -> a -> b
$
GenericReadyPackage ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> ConfigFlags
setupHsConfigureFlags GenericReadyPackage ElaboratedConfiguredPackage
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
testFlags :: Version -> TestFlags
testFlags Version
v = (TestFlags -> Version -> TestFlags)
-> Version -> TestFlags -> TestFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip TestFlags -> Version -> TestFlags
filterTestFlags Version
v (TestFlags -> TestFlags) -> TestFlags -> TestFlags
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 = (HaddockFlags -> Version -> HaddockFlags)
-> Version -> HaddockFlags -> HaddockFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip HaddockFlags -> Version -> HaddockFlags
filterHaddockFlags Version
v (HaddockFlags -> HaddockFlags) -> HaddockFlags -> HaddockFlags
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 = ([FilePath] -> Version -> [FilePath])
-> Version -> [FilePath] -> [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [FilePath] -> Version -> [FilePath]
filterHaddockArgs Version
v ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
ElaboratedConfiguredPackage -> [FilePath]
setupHsHaddockArgs ElaboratedConfiguredPackage
pkg
scriptOptions :: SetupScriptOptions
scriptOptions = GenericReadyPackage ElaboratedConfiguredPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> FilePath
-> FilePath
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions GenericReadyPackage ElaboratedConfiguredPackage
rpkg ElaboratedInstallPlan
plan ElaboratedSharedConfig
pkgshared
DistDirLayout
distDirLayout FilePath
srcdir FilePath
builddir
Bool
isParallelBuild Lock
cacheLock
setupInteractive :: CommandUI flags
-> (Version -> flags) -> (Version -> [String]) -> IO ()
setupInteractive :: CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setupInteractive CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper Verbosity
verbosity
SetupScriptOptions
scriptOptions { isInteractive :: Bool
isInteractive = Bool
True }
(PackageDescription -> Maybe PackageDescription
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 :: CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper Verbosity
verbosity
SetupScriptOptions
scriptOptions
(PackageDescription -> Maybe PackageDescription
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 ((FilePath -> IO ()) -> IO InstalledPackageInfo)
-> (FilePath -> IO ()) -> IO InstalledPackageInfo
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
CommandUI RegisterFlags
-> (Version -> RegisterFlags) -> (Version -> [FilePath]) -> IO ()
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI RegisterFlags
Cabal.registerCommand Version -> RegisterFlags
registerFlags ([FilePath] -> Version -> [FilePath]
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 =
Verbosity
-> FilePath
-> FilePath
-> (FilePath -> IO InstalledPackageInfo)
-> IO InstalledPackageInfo
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
tempdir FilePath
"package-registration-" ((FilePath -> IO InstalledPackageInfo) -> IO InstalledPackageInfo)
-> (FilePath -> IO InstalledPackageInfo) -> IO InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
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 :: FilePath -> IO a
pkgConfParseFailed FilePath
perror =
Verbosity -> FilePath -> IO a
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$
FilePath
"Couldn't parse the output of 'setup register --gen-pkg-config':"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
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 -> FilePath -> IO ([FilePath], InstalledPackageInfo)
forall a. FilePath -> IO a
pkgConfParseFailed (FilePath -> IO ([FilePath], InstalledPackageInfo))
-> FilePath -> IO ([FilePath], InstalledPackageInfo)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
perrors
Right ([FilePath]
warns, InstalledPackageInfo
ipkg) -> ([FilePath], InstalledPackageInfo)
-> IO ([FilePath], InstalledPackageInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
warns, InstalledPackageInfo
ipkg)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
warns) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
warns
InstalledPackageInfo -> IO InstalledPackageInfo
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
ipkg
annotateFailureNoLog :: (SomeException -> BuildFailureReason)
-> IO a -> IO a
annotateFailureNoLog :: (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
annotate IO a
action =
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
forall a. Maybe a
Nothing SomeException -> BuildFailureReason
annotate IO a
action
annotateFailure :: Maybe FilePath
-> (SomeException -> BuildFailureReason)
-> IO a -> IO a
annotateFailure :: Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
annotate IO a
action =
IO a
action IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
`catches`
[
#if MIN_VERSION_base(4,7,0)
(SomeAsyncException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeAsyncException -> IO a) -> Handler a)
-> (SomeAsyncException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \SomeAsyncException
async -> SomeAsyncException -> IO a
forall e a. Exception e => e -> IO a
throwIO (SomeAsyncException
async :: SomeAsyncException)
#else
Handler $ \async -> throwIO (async :: AsyncException)
#endif
, (SomeException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeException -> IO a) -> Handler a)
-> (SomeException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \SomeException
other -> SomeException -> IO a
forall e a. Exception e => e -> IO a
handler (SomeException
other :: SomeException)
]
where
handler :: Exception e => e -> IO a
handler :: e -> IO a
handler = BuildFailure -> IO a
forall e a. Exception e => e -> IO a
throwIO (BuildFailure -> IO a) -> (e -> BuildFailure) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> BuildFailureReason -> BuildFailure
BuildFailure Maybe FilePath
mlogFile (BuildFailureReason -> BuildFailure)
-> (e -> BuildFailureReason) -> e -> BuildFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> BuildFailureReason
annotate (SomeException -> BuildFailureReason)
-> (e -> SomeException) -> e -> BuildFailureReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toException