{-# 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
PackageIdentifier -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: DistDirLayout -> CompilerId -> PackageDB
distBinDirectory :: DistDirLayout -> FilePath
distTempDirectory :: DistDirLayout -> FilePath
distSdistDirectory :: DistDirLayout -> FilePath
distSdistFile :: DistDirLayout -> PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageIdentifier -> FilePath
distDownloadSrcDirectory :: DistDirLayout -> FilePath
distBuildRootDirectory :: DistDirLayout -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distDirectory :: DistDirLayout -> FilePath
distProjectFile :: DistDirLayout -> FilePath -> FilePath
distProjectRootDirectory :: DistDirLayout -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageIdentifier -> FilePath
distDownloadSrcDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
..} ElaboratedSharedConfig
shared =
forall (m :: * -> *) ipkg srcpkg b.
(Monad m, IsUnit ipkg, IsUnit srcpkg) =>
(GenericPlanPackage ipkg srcpkg -> [b] -> m b)
-> GenericInstallPlan ipkg srcpkg -> m (Map UnitId b)
foldMInstallPlanDepOrder ElaboratedPlanPackage -> [BuildStatus] -> IO BuildStatus
dryRunPkg
where
dryRunPkg :: ElaboratedPlanPackage
-> [BuildStatus]
-> IO BuildStatus
dryRunPkg :: ElaboratedPlanPackage -> [BuildStatus] -> IO BuildStatus
dryRunPkg (InstallPlan.PreExisting InstalledPackageInfo
_pkg) [BuildStatus]
_depsBuildStatus =
forall (m :: * -> *) a. Monad m => a -> m a
return BuildStatus
BuildStatusPreExisting
dryRunPkg (InstallPlan.Installed ElaboratedConfiguredPackage
_pkg) [BuildStatus]
_depsBuildStatus =
forall (m :: * -> *) a. Monad m => a -> m a
return BuildStatus
BuildStatusInstalled
dryRunPkg (InstallPlan.Configured ElaboratedConfiguredPackage
pkg) [BuildStatus]
depsBuildStatus = do
Maybe ResolvedPkgLoc
mloc <- UnresolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
checkFetched (ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgSourceLocation ElaboratedConfiguredPackage
pkg)
case Maybe ResolvedPkgLoc
mloc of
Maybe ResolvedPkgLoc
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return BuildStatus
BuildStatusDownload
Just (LocalUnpackedPackage FilePath
srcdir) ->
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
_ PackageIdentifier
_ FilePath
tarball) ->
ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunTarballPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
tarball
Just (RemoteSourceRepoPackage SourceRepoMaybe
_repo FilePath
tarball) ->
ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunTarballPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
tarball
dryRunTarballPkg :: ElaboratedConfiguredPackage
-> [BuildStatus]
-> FilePath
-> IO BuildStatus
dryRunTarballPkg :: ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunTarballPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
tarball =
case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg of
BuildStyle
BuildAndInstall -> forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatus
BuildStatusUnpack FilePath
tarball)
BuildStyle
BuildInplaceOnly -> do
Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
srcdir
if Bool
exists
then ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunLocalPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
srcdir
else forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatus
BuildStatusUnpack FilePath
tarball)
where
srcdir :: FilePath
srcdir :: FilePath
srcdir = PackageIdentifier -> FilePath
distUnpackedSrcDirectory (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
pkg)
dryRunLocalPkg :: ElaboratedConfiguredPackage
-> [BuildStatus]
-> FilePath
-> IO BuildStatus
dryRunLocalPkg :: ElaboratedConfiguredPackage
-> [BuildStatus] -> FilePath -> IO BuildStatus
dryRunLocalPkg ElaboratedConfiguredPackage
pkg [BuildStatus]
depsBuildStatus FilePath
srcdir = do
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 ->
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BuildStatusRebuild -> BuildStatus
BuildStatusRebuild FilePath
srcdir BuildStatusRebuild
rebuild)
Right BuildResult
buildResult ->
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResult -> BuildStatus
BuildStatusUpToDate BuildResult
buildResult)
where
packageFileMonitor :: PackageFileMonitor
packageFileMonitor :: PackageFileMonitor
packageFileMonitor =
ElaboratedSharedConfig
-> DistDirLayout -> DistDirParams -> PackageFileMonitor
newPackageFileMonitor ElaboratedSharedConfig
shared DistDirLayout
distDirLayout
(ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
shared ElaboratedConfiguredPackage
pkg)
foldMInstallPlanDepOrder
:: forall m ipkg srcpkg b.
(Monad m, IsUnit ipkg, IsUnit srcpkg)
=> (GenericPlanPackage ipkg srcpkg ->
[b] -> m b)
-> GenericInstallPlan ipkg srcpkg
-> m (Map UnitId b)
foldMInstallPlanDepOrder :: forall (m :: * -> *) ipkg srcpkg b.
(Monad m, IsUnit ipkg, IsUnit srcpkg) =>
(GenericPlanPackage ipkg srcpkg -> [b] -> m b)
-> GenericInstallPlan ipkg srcpkg -> m (Map UnitId b)
foldMInstallPlanDepOrder GenericPlanPackage ipkg srcpkg -> [b] -> m b
visit =
Map UnitId b
-> [GenericPlanPackage ipkg srcpkg] -> m (Map UnitId b)
go forall k a. Map k a
Map.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.reverseTopologicalOrder
where
go :: Map UnitId b
-> [GenericPlanPackage ipkg srcpkg]
-> m (Map UnitId b)
go :: Map UnitId b
-> [GenericPlanPackage ipkg srcpkg] -> m (Map UnitId b)
go !Map UnitId b
results [] = forall (m :: * -> *) a. Monad m => a -> m a
return Map UnitId b
results
go !Map UnitId b
results (GenericPlanPackage ipkg srcpkg
pkg : [GenericPlanPackage ipkg srcpkg]
pkgs) = do
let depresults :: [b]
depresults :: [b]
depresults =
forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
ipkgid -> let result :: b
result = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"foldMInstallPlanDepOrder") UnitId
ipkgid Map UnitId b
results
in b
result)
(forall a. IsUnit a => a -> [UnitId]
InstallPlan.depends GenericPlanPackage ipkg srcpkg
pkg)
b
result <- GenericPlanPackage ipkg srcpkg -> [b] -> m b
visit GenericPlanPackage ipkg srcpkg
pkg [b]
depresults
let results' :: Map UnitId b
results' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall a. IsNode a => a -> Key a
nodeKey GenericPlanPackage ipkg srcpkg
pkg) b
result Map UnitId b
results
Map UnitId b
-> [GenericPlanPackage ipkg srcpkg] -> m (Map UnitId b)
go Map UnitId b
results' [GenericPlanPackage ipkg srcpkg]
pkgs
improveInstallPlanWithUpToDatePackages :: BuildStatusMap
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages :: BuildStatusMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages BuildStatusMap
pkgsBuildStatus =
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
(srcpkg -> Bool)
-> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg
InstallPlan.installed ElaboratedConfiguredPackage -> Bool
canPackageBeImproved
where
canPackageBeImproved :: ElaboratedConfiguredPackage -> Bool
canPackageBeImproved :: ElaboratedConfiguredPackage -> Bool
canPackageBeImproved ElaboratedConfiguredPackage
pkg =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg) BuildStatusMap
pkgsBuildStatus of
Just BuildStatusUpToDate {} -> Bool
True
Just BuildStatus
_ -> Bool
False
Maybe BuildStatus
Nothing -> forall a. (?callStack::CallStack) => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"improveInstallPlanWithUpToDatePackages: "
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
pkg) forall a. [a] -> [a] -> [a]
++ FilePath
" not in status map"
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 {
pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig =
FileMonitor {
fileMonitorCacheFile :: FilePath
fileMonitorCacheFile = DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
dparams FilePath
"config",
fileMonitorKeyValid :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage -> Bool
fileMonitorKeyValid = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
normaliseConfiguredPackage ElaboratedSharedConfig
shared,
fileMonitorCheckIfOnlyValueChanged :: Bool
fileMonitorCheckIfOnlyValueChanged = Bool
False
},
pkgFileMonitorBuild :: FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild =
FileMonitor {
fileMonitorCacheFile :: FilePath
fileMonitorCacheFile = DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
dparams FilePath
"build",
fileMonitorKeyValid :: Set ComponentName -> Set ComponentName -> Bool
fileMonitorKeyValid = \Set ComponentName
componentsToBuild Set ComponentName
componentsAlreadyBuilt ->
Set ComponentName
componentsToBuild forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set ComponentName
componentsAlreadyBuilt,
fileMonitorCheckIfOnlyValueChanged :: Bool
fileMonitorCheckIfOnlyValueChanged = Bool
True
},
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg =
forall a b. Eq a => FilePath -> FileMonitor a b
newFileMonitor (DistDirParams -> FilePath -> FilePath
distPackageCacheFile DistDirParams
dparams FilePath
"registration")
}
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 = forall a. Maybe a
Nothing,
elabHaddockTargets :: [ComponentTarget]
elabHaddockTargets = [],
elabBuildHaddocks :: Bool
elabBuildHaddocks = Bool
False,
elabTestMachineLog :: Maybe PathTemplate
elabTestMachineLog = forall a. Maybe a
Nothing,
elabTestHumanLog :: Maybe PathTemplate
elabTestHumanLog = forall a. Maybe a
Nothing,
elabTestShowDetails :: Maybe TestShowDetails
elabTestShowDetails = forall a. Maybe a
Nothing,
elabTestKeepTix :: Bool
elabTestKeepTix = Bool
False,
elabTestTestOptions :: [PathTemplate]
elabTestTestOptions = [],
elabBenchmarkOptions :: [PathTemplate]
elabBenchmarkOptions = []
}
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 <- forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged
FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig FilePath
srcdir ElaboratedConfiguredPackage
pkgconfig
case MonitorChanged ElaboratedConfiguredPackage ()
configChanged of
MonitorChanged MonitorChangedReason ElaboratedConfiguredPackage
monitorReason ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (MonitorChangedReason () -> BuildStatusRebuild
BuildStatusConfigure MonitorChangedReason ()
monitorReason'))
where
monitorReason' :: MonitorChangedReason ()
monitorReason' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) MonitorChangedReason ElaboratedConfiguredPackage
monitorReason
MonitorUnchanged () [MonitorFilePath]
_
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BuildStatus -> Bool
buildStatusRequiresBuild [BuildStatus]
depsBuildStatus -> do
MonitorChanged () (Maybe InstalledPackageInfo)
regChanged <- forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg FilePath
srcdir ()
let mreg :: Maybe (Maybe InstalledPackageInfo)
mreg = forall a b. MonitorChanged a b -> Maybe b
changedToMaybe MonitorChanged () (Maybe InstalledPackageInfo)
regChanged
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
mreg BuildReason
BuildReasonDepsRebuilt))
| Bool
otherwise -> do
MonitorChanged (Set ComponentName) BuildResultMisc
buildChanged <- forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged
FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild FilePath
srcdir Set ComponentName
buildComponents
MonitorChanged () (Maybe InstalledPackageInfo)
regChanged <- forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged
FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg FilePath
srcdir ()
let mreg :: Maybe (Maybe InstalledPackageInfo)
mreg = forall a b. MonitorChanged a b -> Maybe b
changedToMaybe MonitorChanged () (Maybe InstalledPackageInfo)
regChanged
case (MonitorChanged (Set ComponentName) BuildResultMisc
buildChanged, MonitorChanged () (Maybe InstalledPackageInfo)
regChanged) of
(MonitorChanged (MonitoredValueChanged Set ComponentName
prevBuildComponents), MonitorChanged () (Maybe InstalledPackageInfo)
_) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
mreg BuildReason
buildReason))
where
buildReason :: BuildReason
buildReason = Set ComponentName -> BuildReason
BuildReasonExtraTargets Set ComponentName
prevBuildComponents
(MonitorChanged MonitorChangedReason (Set ComponentName)
monitorReason, MonitorChanged () (Maybe InstalledPackageInfo)
_) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
mreg BuildReason
buildReason))
where
buildReason :: BuildReason
buildReason = MonitorChangedReason () -> BuildReason
BuildReasonFilesChanged MonitorChangedReason ()
monitorReason'
monitorReason' :: MonitorChangedReason ()
monitorReason' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) MonitorChangedReason (Set ComponentName)
monitorReason
(MonitorUnchanged BuildResultMisc
_ [MonitorFilePath]
_, MonitorChanged MonitorChangedReason ()
monitorReason) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild forall a. Maybe a
Nothing BuildReason
buildReason))
where
buildReason :: BuildReason
buildReason = MonitorChangedReason () -> BuildReason
BuildReasonFilesChanged MonitorChangedReason ()
monitorReason'
monitorReason' :: MonitorChangedReason ()
monitorReason' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) MonitorChangedReason ()
monitorReason
(MonitorUnchanged BuildResultMisc
_ [MonitorFilePath]
_, MonitorUnchanged Maybe InstalledPackageInfo
_ [MonitorFilePath]
_)
| ElaboratedConfiguredPackage -> Bool
pkgHasEphemeralBuildTargets ElaboratedConfiguredPackage
pkg ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Maybe (Maybe InstalledPackageInfo)
-> BuildReason -> BuildStatusRebuild
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
mreg BuildReason
buildReason))
where
buildReason :: BuildReason
buildReason = BuildReason
BuildReasonEphemeralTargets
(MonitorUnchanged BuildResultMisc
buildResult [MonitorFilePath]
_, MonitorUnchanged Maybe InstalledPackageInfo
_ [MonitorFilePath]
_) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right BuildResult {
buildResultDocs :: DocsResult
buildResultDocs = DocsResult
docsResult,
buildResultTests :: TestsResult
buildResultTests = TestsResult
testsResult,
buildResultLogFile :: Maybe FilePath
buildResultLogFile = forall a. Maybe a
Nothing
}
where
(DocsResult
docsResult, TestsResult
testsResult) = BuildResultMisc
buildResult
where
(ElaboratedConfiguredPackage
pkgconfig, Set ComponentName
buildComponents) = ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues ElaboratedConfiguredPackage
pkg
changedToMaybe :: MonitorChanged a b -> Maybe b
changedToMaybe :: forall a b. MonitorChanged a b -> Maybe b
changedToMaybe (MonitorChanged MonitorChangedReason a
_) = forall a. Maybe a
Nothing
changedToMaybe (MonitorUnchanged b
x [MonitorFilePath]
_) = forall a. a -> Maybe a
Just b
x
updatePackageConfigFileMonitor :: PackageFileMonitor
-> FilePath
-> ElaboratedConfiguredPackage
-> IO ()
updatePackageConfigFileMonitor :: PackageFileMonitor
-> FilePath -> ElaboratedConfiguredPackage -> IO ()
updatePackageConfigFileMonitor PackageFileMonitor{FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig :: PackageFileMonitor -> FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig}
FilePath
srcdir ElaboratedConfiguredPackage
pkg =
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor ElaboratedConfiguredPackage ()
pkgFileMonitorConfig FilePath
srcdir forall a. Maybe a
Nothing
[] ElaboratedConfiguredPackage
pkgconfig ()
where
(ElaboratedConfiguredPackage
pkgconfig, Set ComponentName
_buildComponents) = ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues ElaboratedConfiguredPackage
pkg
updatePackageBuildFileMonitor :: PackageFileMonitor
-> FilePath
-> MonitorTimestamp
-> ElaboratedConfiguredPackage
-> BuildStatusRebuild
-> [MonitorFilePath]
-> BuildResultMisc
-> IO ()
updatePackageBuildFileMonitor :: PackageFileMonitor
-> FilePath
-> MonitorTimestamp
-> ElaboratedConfiguredPackage
-> BuildStatusRebuild
-> [MonitorFilePath]
-> BuildResultMisc
-> IO ()
updatePackageBuildFileMonitor PackageFileMonitor{FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild :: FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild :: PackageFileMonitor
-> FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild}
FilePath
srcdir MonitorTimestamp
timestamp ElaboratedConfiguredPackage
pkg BuildStatusRebuild
pkgBuildStatus
[MonitorFilePath]
monitors BuildResultMisc
buildResult =
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor (Set ComponentName) BuildResultMisc
pkgFileMonitorBuild FilePath
srcdir (forall a. a -> Maybe a
Just MonitorTimestamp
timestamp)
[MonitorFilePath]
monitors Set ComponentName
buildComponents' BuildResultMisc
buildResult
where
(ElaboratedConfiguredPackage
_pkgconfig, Set ComponentName
buildComponents) = ElaboratedConfiguredPackage
-> (ElaboratedConfiguredPackage, Set ComponentName)
packageFileMonitorKeyValues ElaboratedConfiguredPackage
pkg
buildComponents' :: Set ComponentName
buildComponents' =
case BuildStatusRebuild
pkgBuildStatus of
BuildStatusBuild Maybe (Maybe InstalledPackageInfo)
_ (BuildReasonExtraTargets Set ComponentName
prevBuildComponents)
-> Set ComponentName
buildComponents forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set ComponentName
prevBuildComponents
BuildStatusRebuild
_ -> Set ComponentName
buildComponents
updatePackageRegFileMonitor :: PackageFileMonitor
-> FilePath
-> Maybe InstalledPackageInfo
-> IO ()
updatePackageRegFileMonitor :: PackageFileMonitor
-> FilePath -> Maybe InstalledPackageInfo -> IO ()
updatePackageRegFileMonitor PackageFileMonitor{FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: PackageFileMonitor -> FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg}
FilePath
srcdir Maybe InstalledPackageInfo
mipkg =
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg FilePath
srcdir forall a. Maybe a
Nothing
[] () Maybe InstalledPackageInfo
mipkg
invalidatePackageRegFileMonitor :: PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor :: PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor PackageFileMonitor{FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: PackageFileMonitor -> FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg} =
FilePath -> IO ()
removeExistingFile (forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg)
rebuildTargets :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> BuildStatusMap
-> BuildTimeSettings
-> IO BuildOutcomes
rebuildTargets :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> BuildStatusMap
-> BuildTimeSettings
-> IO BuildOutcomes
rebuildTargets Verbosity
verbosity
distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
FilePath -> FilePath
PackageIdentifier -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageIdentifier -> FilePath
distDownloadSrcDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
distPackageDB :: DistDirLayout -> CompilerId -> PackageDB
distBinDirectory :: DistDirLayout -> FilePath
distTempDirectory :: DistDirLayout -> FilePath
distSdistDirectory :: DistDirLayout -> FilePath
distSdistFile :: DistDirLayout -> PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageIdentifier -> FilePath
distDownloadSrcDirectory :: DistDirLayout -> FilePath
distBuildRootDirectory :: DistDirLayout -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distDirectory :: DistDirLayout -> FilePath
distProjectFile :: DistDirLayout -> FilePath -> FilePath
distProjectRootDirectory :: DistDirLayout -> FilePath
..}
StoreDirLayout
storeDirLayout
ElaboratedInstallPlan
installPlan
sharedPackageConfig :: ElaboratedSharedConfig
sharedPackageConfig@ElaboratedSharedConfig {
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler = Compiler
compiler,
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs = ProgramDb
progdb
}
BuildStatusMap
pkgsBuildStatus
buildSettings :: BuildTimeSettings
buildSettings@BuildTimeSettings{
Int
buildSettingNumJobs :: BuildTimeSettings -> Int
buildSettingNumJobs :: Int
buildSettingNumJobs,
Bool
buildSettingKeepGoing :: BuildTimeSettings -> Bool
buildSettingKeepGoing :: Bool
buildSettingKeepGoing
} = do
JobControl IO (UnitId, Either BuildFailure BuildResult)
jobControl <- if Bool
isParallelBuild
then forall a. WithCallStack (Int -> IO (JobControl IO a))
newParallelJobControl Int
buildSettingNumJobs
else forall a. IO (JobControl IO a)
newSerialJobControl
Lock
registerLock <- IO Lock
newLock
Lock
cacheLock <- IO Lock
newLock
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
FilePath
"Executing install plan "
forall a. [a] -> [a] -> [a]
++ if Bool
isParallelBuild
then FilePath
" in parallel using " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
buildSettingNumJobs forall a. [a] -> [a] -> [a]
++ FilePath
" threads."
else FilePath
" serially."
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
distBuildRootDirectory
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
distTempDirectory
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> Compiler -> ProgramDb -> PackageDB -> IO ()
createPackageDBIfMissing Verbosity
verbosity Compiler
compiler ProgramDb
progdb) PackageDBStack
packageDBsToUse
forall a.
Verbosity
-> ((RepoContext -> IO a) -> IO a)
-> ElaboratedInstallPlan
-> BuildStatusMap
-> (AsyncFetchMap -> IO a)
-> IO a
asyncDownloadPackages Verbosity
verbosity (RepoContext -> IO BuildOutcomes) -> IO BuildOutcomes
withRepoCtx
ElaboratedInstallPlan
installPlan BuildStatusMap
pkgsBuildStatus forall a b. (a -> b) -> a -> b
$ \AsyncFetchMap
downloadMap ->
forall (m :: * -> *) ipkg srcpkg result failure.
(IsUnit ipkg, IsUnit srcpkg, Monad m) =>
JobControl m (UnitId, Either failure result)
-> Bool
-> (srcpkg -> failure)
-> GenericInstallPlan ipkg srcpkg
-> (GenericReadyPackage srcpkg -> m (Either failure result))
-> m (BuildOutcomes failure result)
InstallPlan.execute JobControl IO (UnitId, Either BuildFailure BuildResult)
jobControl Bool
keepGoing
(Maybe FilePath -> BuildFailureReason -> BuildFailure
BuildFailure forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> BuildFailureReason
DependentFailed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageIdentifier
packageId)
ElaboratedInstallPlan
installPlan forall a b. (a -> b) -> a -> b
$ \ElaboratedReadyPackage
pkg ->
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(BuildFailure
e :: BuildFailure) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left BuildFailure
e)) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
let uid :: UnitId
uid = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedReadyPackage
pkg
pkgBuildStatus :: BuildStatus
pkgBuildStatus = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"rebuildTargets") UnitId
uid BuildStatusMap
pkgsBuildStatus in
Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> AsyncFetchMap
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatus
-> IO BuildResult
rebuildTarget
Verbosity
verbosity
DistDirLayout
distDirLayout
StoreDirLayout
storeDirLayout
BuildTimeSettings
buildSettings AsyncFetchMap
downloadMap
Lock
registerLock Lock
cacheLock
ElaboratedSharedConfig
sharedPackageConfig
ElaboratedInstallPlan
installPlan ElaboratedReadyPackage
pkg
BuildStatus
pkgBuildStatus
where
isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs forall a. Ord a => a -> a -> Bool
>= Int
2
keepGoing :: Bool
keepGoing = Bool
buildSettingKeepGoing
withRepoCtx :: (RepoContext -> IO BuildOutcomes) -> IO BuildOutcomes
withRepoCtx = forall a.
Verbosity -> BuildTimeSettings -> (RepoContext -> IO a) -> IO a
projectConfigWithBuilderRepoContext Verbosity
verbosity
BuildTimeSettings
buildSettings
packageDBsToUse :: PackageDBStack
packageDBsToUse =
(forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList)
[ PackageDB
pkgdb
| InstallPlan.Configured ElaboratedConfiguredPackage
elab <- forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
installPlan
, PackageDB
pkgdb <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack ElaboratedConfiguredPackage
elab
, ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack ElaboratedConfiguredPackage
elab
, ElaboratedConfiguredPackage -> PackageDBStack
elabSetupPackageDBStack ElaboratedConfiguredPackage
elab ]
]
createPackageDBIfMissing :: Verbosity -> Compiler -> ProgramDb
-> PackageDB -> IO ()
createPackageDBIfMissing :: Verbosity -> Compiler -> ProgramDb -> PackageDB -> IO ()
createPackageDBIfMissing Verbosity
verbosity Compiler
compiler ProgramDb
progdb
(SpecificPackageDB FilePath
dbPath) = do
Bool
exists <- FilePath -> IO Bool
Cabal.doesPackageDBExist FilePath
dbPath
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ do
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (FilePath -> FilePath
takeDirectory FilePath
dbPath)
Verbosity -> Compiler -> ProgramDb -> Bool -> FilePath -> IO ()
Cabal.createPackageDB Verbosity
verbosity Compiler
compiler ProgramDb
progdb Bool
False FilePath
dbPath
createPackageDBIfMissing Verbosity
_ Compiler
_ ProgramDb
_ PackageDB
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
rebuildTarget :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> AsyncFetchMap
-> Lock -> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatus
-> IO BuildResult
rebuildTarget :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> AsyncFetchMap
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatus
-> IO BuildResult
rebuildTarget Verbosity
verbosity
distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{DistDirParams -> FilePath
distBuildDirectory :: DistDirParams -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory}
StoreDirLayout
storeDirLayout
BuildTimeSettings
buildSettings AsyncFetchMap
downloadMap
Lock
registerLock Lock
cacheLock
ElaboratedSharedConfig
sharedPackageConfig
ElaboratedInstallPlan
plan rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
BuildStatus
pkgBuildStatus
| BuildTimeSettings -> Bool
buildSettingOnlyDownload BuildTimeSettings
buildSettings = do
case BuildStatus
pkgBuildStatus of
BuildStatus
BuildStatusDownload ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Verbosity
-> AsyncFetchMap
-> ElaboratedConfiguredPackage
-> IO DownloadedSourceLocation
waitAsyncPackageDownload Verbosity
verbosity AsyncFetchMap
downloadMap ElaboratedConfiguredPackage
pkg
BuildStatus
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DocsResult -> TestsResult -> Maybe FilePath -> BuildResult
BuildResult DocsResult
DocsNotTried TestsResult
TestsNotTried forall a. Maybe a
Nothing
| Bool
otherwise =
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 {} -> forall {a}. a
unexpectedState
BuildStatusInstalled {} -> forall {a}. a
unexpectedState
BuildStatusUpToDate {} -> forall {a}. a
unexpectedState
where
unexpectedState :: a
unexpectedState = forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"rebuildTarget: unexpected package status"
downloadPhase :: IO BuildResult
downloadPhase :: IO BuildResult
downloadPhase = do
DownloadedSourceLocation
downsrcloc <- forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
DownloadFailed forall a b. (a -> b) -> a -> b
$
Verbosity
-> AsyncFetchMap
-> ElaboratedConfiguredPackage
-> IO DownloadedSourceLocation
waitAsyncPackageDownload Verbosity
verbosity AsyncFetchMap
downloadMap ElaboratedConfiguredPackage
pkg
case DownloadedSourceLocation
downsrcloc of
DownloadedTarball FilePath
tarball -> FilePath -> IO BuildResult
unpackTarballPhase FilePath
tarball
unpackTarballPhase :: FilePath -> IO BuildResult
unpackTarballPhase :: FilePath -> IO BuildResult
unpackTarballPhase FilePath
tarball =
forall a.
Verbosity
-> DistDirLayout
-> FilePath
-> PackageIdentifier
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath -> FilePath -> IO a)
-> IO a
withTarballLocalDirectory
Verbosity
verbosity DistDirLayout
distDirLayout FilePath
tarball
(forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedConfiguredPackage
pkg) (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
sharedPackageConfig ElaboratedConfiguredPackage
pkg)
(ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg)
(ElaboratedConfiguredPackage -> Maybe CabalFileText
elabPkgDescriptionOverride ElaboratedConfiguredPackage
pkg) forall a b. (a -> b) -> a -> b
$
case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg of
BuildStyle
BuildAndInstall -> FilePath -> FilePath -> IO BuildResult
buildAndInstall
BuildStyle
BuildInplaceOnly -> BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
buildInplace BuildStatusRebuild
buildStatus
where
buildStatus :: BuildStatusRebuild
buildStatus = MonitorChangedReason () -> BuildStatusRebuild
BuildStatusConfigure forall a. MonitorChangedReason a
MonitorFirstRun
rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult
rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult
rebuildPhase BuildStatusRebuild
buildStatus FilePath
srcdir =
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
pkg forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly) forall a b. (a -> b) -> a -> b
$
BuildStatusRebuild -> FilePath -> FilePath -> IO BuildResult
buildInplace BuildStatusRebuild
buildStatus FilePath
srcdir FilePath
builddir
where
builddir :: FilePath
builddir = DistDirParams -> FilePath
distBuildDirectory
(ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
sharedPackageConfig ElaboratedConfiguredPackage
pkg)
buildAndInstall :: FilePath -> FilePath -> IO BuildResult
buildAndInstall :: FilePath -> FilePath -> IO BuildResult
buildAndInstall FilePath
srcdir FilePath
builddir =
Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> FilePath
-> FilePath
-> IO BuildResult
buildAndInstallUnpackedPackage
Verbosity
verbosity DistDirLayout
distDirLayout StoreDirLayout
storeDirLayout
BuildTimeSettings
buildSettings Lock
registerLock Lock
cacheLock
ElaboratedSharedConfig
sharedPackageConfig
ElaboratedInstallPlan
plan ElaboratedReadyPackage
rpkg
FilePath
srcdir FilePath
builddir'
where
builddir' :: FilePath
builddir' = FilePath -> FilePath -> FilePath
makeRelative FilePath
srcdir FilePath
builddir
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
-> ElaboratedReadyPackage
-> BuildStatusRebuild
-> FilePath
-> FilePath
-> IO BuildResult
buildInplaceUnpackedPackage
Verbosity
verbosity DistDirLayout
distDirLayout
BuildTimeSettings
buildSettings Lock
registerLock Lock
cacheLock
ElaboratedSharedConfig
sharedPackageConfig
ElaboratedInstallPlan
plan ElaboratedReadyPackage
rpkg
BuildStatusRebuild
buildStatus
FilePath
srcdir FilePath
builddir
asyncDownloadPackages :: Verbosity
-> ((RepoContext -> IO a) -> IO a)
-> ElaboratedInstallPlan
-> BuildStatusMap
-> (AsyncFetchMap -> IO a)
-> IO a
asyncDownloadPackages :: forall a.
Verbosity
-> ((RepoContext -> IO a) -> IO a)
-> ElaboratedInstallPlan
-> BuildStatusMap
-> (AsyncFetchMap -> IO a)
-> IO a
asyncDownloadPackages Verbosity
verbosity (RepoContext -> IO a) -> IO a
withRepoCtx ElaboratedInstallPlan
installPlan BuildStatusMap
pkgsBuildStatus AsyncFetchMap -> IO a
body
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnresolvedPkgLoc]
pkgsToDownload = AsyncFetchMap -> IO a
body forall k a. Map k a
Map.empty
| Bool
otherwise = (RepoContext -> IO a) -> IO a
withRepoCtx forall a b. (a -> b) -> a -> b
$ \RepoContext
repoctx ->
forall a.
Verbosity
-> RepoContext
-> [UnresolvedPkgLoc]
-> (AsyncFetchMap -> IO a)
-> IO a
asyncFetchPackages Verbosity
verbosity RepoContext
repoctx
[UnresolvedPkgLoc]
pkgsToDownload AsyncFetchMap -> IO a
body
where
pkgsToDownload :: [PackageLocation (Maybe FilePath)]
pkgsToDownload :: [UnresolvedPkgLoc]
pkgsToDownload =
forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$
[ ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgSourceLocation ElaboratedConfiguredPackage
elab
| InstallPlan.Configured ElaboratedConfiguredPackage
elab
<- forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.reverseTopologicalOrder ElaboratedInstallPlan
installPlan
, let uid :: UnitId
uid = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
elab
pkgBuildStatus :: BuildStatus
pkgBuildStatus = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"asyncDownloadPackages") UnitId
uid BuildStatusMap
pkgsBuildStatus
, BuildStatus
BuildStatusDownload <- [BuildStatus
pkgBuildStatus]
]
waitAsyncPackageDownload :: Verbosity
-> AsyncFetchMap
-> ElaboratedConfiguredPackage
-> IO DownloadedSourceLocation
waitAsyncPackageDownload :: Verbosity
-> AsyncFetchMap
-> ElaboratedConfiguredPackage
-> IO DownloadedSourceLocation
waitAsyncPackageDownload Verbosity
verbosity AsyncFetchMap
downloadMap ElaboratedConfiguredPackage
elab = do
ResolvedPkgLoc
pkgloc <- Verbosity -> AsyncFetchMap -> UnresolvedPkgLoc -> IO ResolvedPkgLoc
waitAsyncFetchPackage Verbosity
verbosity AsyncFetchMap
downloadMap
(ElaboratedConfiguredPackage -> UnresolvedPkgLoc
elabPkgSourceLocation ElaboratedConfiguredPackage
elab)
case ResolvedPkgLoc -> Maybe DownloadedSourceLocation
downloadedSourceLocation ResolvedPkgLoc
pkgloc of
Just DownloadedSourceLocation
loc -> forall (m :: * -> *) a. Monad m => a -> m a
return DownloadedSourceLocation
loc
Maybe DownloadedSourceLocation
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"waitAsyncPackageDownload: unexpected source location"
data DownloadedSourceLocation = DownloadedTarball FilePath
downloadedSourceLocation :: PackageLocation FilePath
-> Maybe DownloadedSourceLocation
downloadedSourceLocation :: ResolvedPkgLoc -> Maybe DownloadedSourceLocation
downloadedSourceLocation ResolvedPkgLoc
pkgloc =
case ResolvedPkgLoc
pkgloc of
RemoteTarballPackage URI
_ FilePath
tarball -> forall a. a -> Maybe a
Just (FilePath -> DownloadedSourceLocation
DownloadedTarball FilePath
tarball)
RepoTarballPackage Repo
_ PackageIdentifier
_ FilePath
tarball -> forall a. a -> Maybe a
Just (FilePath -> DownloadedSourceLocation
DownloadedTarball FilePath
tarball)
ResolvedPkgLoc
_ -> forall a. Maybe a
Nothing
withTarballLocalDirectory
:: Verbosity
-> DistDirLayout
-> FilePath
-> PackageId
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath ->
FilePath ->
IO a)
-> IO a
withTarballLocalDirectory :: forall a.
Verbosity
-> DistDirLayout
-> FilePath
-> PackageIdentifier
-> DistDirParams
-> BuildStyle
-> Maybe CabalFileText
-> (FilePath -> FilePath -> IO a)
-> IO a
withTarballLocalDirectory Verbosity
verbosity distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
FilePath -> FilePath
PackageIdentifier -> FilePath
CompilerId -> PackageDB
DistDirParams -> FilePath
DistDirParams -> FilePath -> FilePath
distPackageDB :: CompilerId -> PackageDB
distBinDirectory :: FilePath
distTempDirectory :: FilePath
distSdistDirectory :: FilePath
distSdistFile :: PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheFile :: DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: FilePath
distProjectCacheFile :: FilePath -> FilePath
distUnpackedSrcRootDirectory :: FilePath
distUnpackedSrcDirectory :: PackageIdentifier -> FilePath
distDownloadSrcDirectory :: FilePath
distBuildRootDirectory :: FilePath
distBuildDirectory :: DistDirParams -> FilePath
distDirectory :: FilePath
distProjectFile :: FilePath -> FilePath
distProjectRootDirectory :: FilePath
distPackageDB :: DistDirLayout -> CompilerId -> PackageDB
distBinDirectory :: DistDirLayout -> FilePath
distTempDirectory :: DistDirLayout -> FilePath
distSdistDirectory :: DistDirLayout -> FilePath
distSdistFile :: DistDirLayout -> PackageIdentifier -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheFile :: DistDirLayout -> DistDirParams -> FilePath -> FilePath
distProjectCacheDirectory :: DistDirLayout -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distUnpackedSrcRootDirectory :: DistDirLayout -> FilePath
distUnpackedSrcDirectory :: DistDirLayout -> PackageIdentifier -> FilePath
distDownloadSrcDirectory :: DistDirLayout -> FilePath
distBuildRootDirectory :: DistDirLayout -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distDirectory :: DistDirLayout -> FilePath
distProjectFile :: DistDirLayout -> FilePath -> FilePath
distProjectRootDirectory :: DistDirLayout -> FilePath
..}
FilePath
tarball PackageIdentifier
pkgid DistDirParams
dparams BuildStyle
buildstyle Maybe CabalFileText
pkgTextOverride
FilePath -> FilePath -> IO a
buildPkg =
case BuildStyle
buildstyle of
BuildStyle
BuildAndInstall ->
let tmpdir :: FilePath
tmpdir = FilePath
distTempDirectory in
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
tmpdir FilePath
"src" forall a b. (a -> b) -> a -> b
$ \FilePath
unpackdir -> do
Verbosity
-> FilePath
-> FilePath
-> PackageIdentifier
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
unpackdir
PackageIdentifier
pkgid Maybe CabalFileText
pkgTextOverride
let srcdir :: FilePath
srcdir = FilePath
unpackdir FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
builddir :: FilePath
builddir = FilePath
srcdir FilePath -> FilePath -> FilePath
</> FilePath
"dist"
FilePath -> FilePath -> IO a
buildPkg FilePath
srcdir FilePath
builddir
BuildStyle
BuildInplaceOnly -> do
let srcrootdir :: FilePath
srcrootdir = FilePath
distUnpackedSrcRootDirectory
srcdir :: FilePath
srcdir = PackageIdentifier -> FilePath
distUnpackedSrcDirectory PackageIdentifier
pkgid
builddir :: FilePath
builddir = DistDirParams -> FilePath
distBuildDirectory DistDirParams
dparams
Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
srcdir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ do
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
srcrootdir
Verbosity
-> FilePath
-> FilePath
-> PackageIdentifier
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
srcrootdir
PackageIdentifier
pkgid Maybe CabalFileText
pkgTextOverride
Verbosity
-> DistDirLayout
-> FilePath
-> PackageIdentifier
-> DistDirParams
-> IO ()
moveTarballShippedDistDirectory Verbosity
verbosity DistDirLayout
distDirLayout
FilePath
srcrootdir PackageIdentifier
pkgid DistDirParams
dparams
FilePath -> FilePath -> IO a
buildPkg FilePath
srcdir FilePath
builddir
unpackPackageTarball :: Verbosity -> FilePath -> FilePath
-> PackageId -> Maybe CabalFileText
-> IO ()
unpackPackageTarball :: Verbosity
-> FilePath
-> FilePath
-> PackageIdentifier
-> Maybe CabalFileText
-> IO ()
unpackPackageTarball Verbosity
verbosity FilePath
tarball FilePath
parentdir PackageIdentifier
pkgid Maybe CabalFileText
pkgTextOverride =
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
UnpackFailed forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Extracting " forall a. [a] -> [a] -> [a]
++ FilePath
tarball forall a. [a] -> [a] -> [a]
++ FilePath
" to " forall a. [a] -> [a] -> [a]
++ FilePath
parentdir forall a. [a] -> [a] -> [a]
++ FilePath
"..."
FilePath -> FilePath -> FilePath -> IO ()
Tar.extractTarGzFile FilePath
parentdir FilePath
pkgsubdir FilePath
tarball
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
cabalFile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
FilePath
"Package .cabal file not found in the tarball: " forall a. [a] -> [a] -> [a]
++ FilePath
cabalFile
case Maybe CabalFileText
pkgTextOverride of
Maybe CabalFileText
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just CabalFileText
pkgtxt -> do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Updating " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkgname FilePath -> FilePath -> FilePath
<.> FilePath
"cabal"
forall a. [a] -> [a] -> [a]
++ FilePath
" with the latest revision from the index."
FilePath -> CabalFileText -> IO ()
writeFileAtomic FilePath
cabalFile CabalFileText
pkgtxt
where
cabalFile :: FilePath
cabalFile :: FilePath
cabalFile = FilePath
parentdir FilePath -> FilePath -> FilePath
</> FilePath
pkgsubdir
FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkgname FilePath -> FilePath -> FilePath
<.> FilePath
"cabal"
pkgsubdir :: FilePath
pkgsubdir = forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
pkgname :: PackageName
pkgname = forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgid
moveTarballShippedDistDirectory :: Verbosity -> DistDirLayout
-> FilePath -> PackageId -> DistDirParams
-> IO ()
moveTarballShippedDistDirectory :: Verbosity
-> DistDirLayout
-> FilePath
-> PackageIdentifier
-> DistDirParams
-> IO ()
moveTarballShippedDistDirectory Verbosity
verbosity DistDirLayout{DistDirParams -> FilePath
distBuildDirectory :: DistDirParams -> FilePath
distBuildDirectory :: DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory}
FilePath
parentdir PackageIdentifier
pkgid DistDirParams
dparams = do
Bool
distDirExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
tarballDistDir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
distDirExists forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Moving '" forall a. [a] -> [a] -> [a]
++ FilePath
tarballDistDir forall a. [a] -> [a] -> [a]
++ FilePath
"' to '"
forall a. [a] -> [a] -> [a]
++ FilePath
targetDistDir forall a. [a] -> [a] -> [a]
++ FilePath
"'"
FilePath -> FilePath -> IO ()
renameDirectory FilePath
tarballDistDir FilePath
targetDistDir
where
tarballDistDir :: FilePath
tarballDistDir = FilePath
parentdir FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid FilePath -> FilePath -> FilePath
</> FilePath
"dist"
targetDistDir :: FilePath
targetDistDir = DistDirParams -> FilePath
distBuildDirectory DistDirParams
dparams
buildAndInstallUnpackedPackage :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings -> Lock -> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> FilePath -> FilePath
-> IO BuildResult
buildAndInstallUnpackedPackage :: Verbosity
-> DistDirLayout
-> StoreDirLayout
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> FilePath
-> FilePath
-> IO BuildResult
buildAndInstallUnpackedPackage Verbosity
verbosity
distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout{FilePath
distTempDirectory :: FilePath
distTempDirectory :: DistDirLayout -> FilePath
distTempDirectory}
storeDirLayout :: StoreDirLayout
storeDirLayout@StoreDirLayout {
CompilerId -> PackageDBStack
storePackageDBStack :: StoreDirLayout -> CompilerId -> PackageDBStack
storePackageDBStack :: CompilerId -> PackageDBStack
storePackageDBStack
}
BuildTimeSettings {
Int
buildSettingNumJobs :: Int
buildSettingNumJobs :: BuildTimeSettings -> Int
buildSettingNumJobs,
Maybe
(Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile :: BuildTimeSettings
-> Maybe
(Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile :: Maybe
(Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile
}
Lock
registerLock Lock
cacheLock
pkgshared :: ElaboratedSharedConfig
pkgshared@ElaboratedSharedConfig {
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigPlatform = Platform
platform,
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler = Compiler
compiler,
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs = ProgramDb
progdb
}
ElaboratedInstallPlan
plan rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
FilePath
srcdir FilePath
builddir = do
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (FilePath
srcdir FilePath -> FilePath -> FilePath
</> FilePath
builddir)
IO ()
initLogFile
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressStarting
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
ConfigureFailed forall a b. (a -> b) -> a -> b
$
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI ConfigFlags
configureCommand Version -> ConfigFlags
configureFlags Version -> [FilePath]
configureArgs
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressBuilding
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
BuildFailed forall a b. (a -> b) -> a -> b
$
forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI BuildFlags
buildCommand Version -> BuildFlags
buildFlags
IO () -> IO ()
whenHaddock forall a b. (a -> b) -> a -> b
$ do
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressHaddock
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
HaddocksFailed forall a b. (a -> b) -> a -> b
$
forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI HaddockFlags
haddockCommand Version -> HaddockFlags
haddockFlags
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressInstalling
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
InstallFailed forall a b. (a -> b) -> a -> b
$ do
let copyPkgFiles :: FilePath -> IO (FilePath, [FilePath])
copyPkgFiles FilePath
tmpDir = do
let tmpDirNormalised :: FilePath
tmpDirNormalised = FilePath -> FilePath
normalise FilePath
tmpDir
forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI CopyFlags
Cabal.copyCommand (FilePath -> Version -> CopyFlags
copyFlags FilePath
tmpDirNormalised)
let prefix :: FilePath
prefix = FilePath -> FilePath
normalise forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath
dropDrive (forall dir. InstallDirs dir -> dir
InstallDirs.prefix (ElaboratedConfiguredPackage -> InstallDirs FilePath
elabInstallDirs ElaboratedConfiguredPackage
pkg))
entryDir :: FilePath
entryDir = FilePath
tmpDirNormalised FilePath -> FilePath -> FilePath
</> FilePath
prefix
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
entryDir
let hashFileName :: FilePath
hashFileName = FilePath
entryDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal-hash.txt"
outPkgHashInputs :: CabalFileText
outPkgHashInputs = PackageHashInputs -> CabalFileText
renderPackageHashInputs (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> PackageHashInputs
packageHashInputs ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg)
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
FilePath
"creating file with the inputs used to compute the package hash: " forall a. [a] -> [a] -> [a]
++ FilePath
hashFileName
FilePath -> CabalFileText -> IO ()
LBS.writeFile FilePath
hashFileName CabalFileText
outPkgHashInputs
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity FilePath
"Package hash inputs:"
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
(Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"> " forall a. [a] -> [a] -> [a]
++))
(FilePath -> [FilePath]
lines forall a b. (a -> b) -> a -> b
$ CabalFileText -> FilePath
LBS.Char8.unpack CabalFileText
outPkgHashInputs)
[FilePath]
otherFiles <- forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
entryDir) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
FilePath -> IO [FilePath]
listFilesRecursive FilePath
tmpDirNormalised
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
entryDir, [FilePath]
otherFiles)
where
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive FilePath
path = do
[FilePath]
files <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
path FilePath -> FilePath -> FilePath
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]
listDirectory FilePath
path)
[[FilePath]]
allFiles <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FilePath]
files forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
file
if Bool
isDir
then FilePath -> IO [FilePath]
listFilesRecursive FilePath
file
else forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
file]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
allFiles)
registerPkg :: IO ()
registerPkg
| Bool -> Bool
not (ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg) =
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
FilePath
"registerPkg: elab does NOT require registration for "
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow UnitId
uid
| Bool
otherwise = do
InstalledPackageInfo
ipkg0 <- IO InstalledPackageInfo
generateInstalledPackageInfo
let ipkg :: InstalledPackageInfo
ipkg = InstalledPackageInfo
ipkg0 { installedUnitId :: UnitId
Installed.installedUnitId = UnitId
uid }
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ( ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg
forall a. Eq a => a -> a -> Bool
== CompilerId -> PackageDBStack
storePackageDBStack CompilerId
compid) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall a. Lock -> IO a -> IO a
criticalSection Lock
registerLock forall a b. (a -> b) -> a -> b
$
Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
Cabal.registerPackage
Verbosity
verbosity Compiler
compiler ProgramDb
progdb
(CompilerId -> PackageDBStack
storePackageDBStack CompilerId
compid) InstalledPackageInfo
ipkg
RegisterOptions
Cabal.defaultRegisterOptions {
registerMultiInstance :: Bool
Cabal.registerMultiInstance = Bool
True,
registerSuppressFilesCheck :: Bool
Cabal.registerSuppressFilesCheck = Bool
True
}
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Verbosity
-> StoreDirLayout
-> CompilerId
-> UnitId
-> (FilePath -> IO (FilePath, [FilePath]))
-> IO ()
-> IO NewStoreEntryOutcome
newStoreEntry Verbosity
verbosity StoreDirLayout
storeDirLayout
CompilerId
compid UnitId
uid
FilePath -> IO (FilePath, [FilePath])
copyPkgFiles IO ()
registerPkg
let docsResult :: DocsResult
docsResult = DocsResult
DocsNotTried
testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried
ProgressPhase -> IO ()
noticeProgress ProgressPhase
ProgressCompleted
forall (m :: * -> *) a. Monad m => a -> m a
return BuildResult {
buildResultDocs :: DocsResult
buildResultDocs = DocsResult
docsResult,
buildResultTests :: TestsResult
buildResultTests = TestsResult
testsResult,
buildResultLogFile :: Maybe FilePath
buildResultLogFile = Maybe FilePath
mlogFile
}
where
pkgid :: PackageIdentifier
pkgid = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ElaboratedReadyPackage
rpkg
uid :: UnitId
uid = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedReadyPackage
rpkg
compid :: CompilerId
compid = Compiler -> CompilerId
compilerId Compiler
compiler
dispname :: String
dispname :: FilePath
dispname = case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
pkg of
ElabPackage ElaboratedPackage
_ -> forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
forall a. [a] -> [a] -> [a]
++ FilePath
" (all, legacy fallback)"
ElabComponent ElaboratedComponent
comp -> forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid
forall a. [a] -> [a] -> [a]
++ FilePath
" (" forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"custom" forall a. Pretty a => a -> FilePath
prettyShow (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
comp) forall a. [a] -> [a] -> [a]
++ FilePath
")"
noticeProgress :: ProgressPhase -> IO ()
noticeProgress :: ProgressPhase -> IO ()
noticeProgress ProgressPhase
phase = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isParallelBuild forall a b. (a -> b) -> a -> b
$
Verbosity -> ProgressPhase -> FilePath -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
phase FilePath
dispname
isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs forall a. Ord a => a -> a -> Bool
>= Int
2
whenHaddock :: IO () -> IO ()
whenHaddock IO ()
action
| ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage
pkg = IO ()
action
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
configureCommand :: CommandUI ConfigFlags
configureCommand = ProgramDb -> CommandUI ConfigFlags
Cabal.configureCommand ProgramDb
defaultProgramDb
configureFlags :: Version -> ConfigFlags
configureFlags Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags Version
v forall a b. (a -> b) -> a -> b
$
ElaboratedReadyPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> ConfigFlags
setupHsConfigureFlags ElaboratedReadyPackage
rpkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
configureArgs :: Version -> [FilePath]
configureArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsConfigureArgs ElaboratedConfiguredPackage
pkg
buildCommand :: CommandUI BuildFlags
buildCommand = ProgramDb -> CommandUI BuildFlags
Cabal.buildCommand ProgramDb
defaultProgramDb
buildFlags :: Version -> BuildFlags
buildFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> BuildFlags
setupHsBuildFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared Verbosity
verbosity FilePath
builddir
haddockCommand :: CommandUI HaddockFlags
haddockCommand = CommandUI HaddockFlags
Cabal.haddockCommand
haddockFlags :: Version -> HaddockFlags
haddockFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> HaddockFlags
setupHsHaddockFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
Verbosity
-> FilePath -> (FilePath -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile
Verbosity
verbosity FilePath
distTempDirectory forall a b. (a -> b) -> a -> b
$ \FilePath
pkgConfDest -> do
let registerFlags :: Version -> RegisterFlags
registerFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> FilePath
-> FilePath
-> RegisterFlags
setupHsRegisterFlags
ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
FilePath
pkgConfDest
forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI RegisterFlags
Cabal.registerCommand Version -> RegisterFlags
registerFlags
copyFlags :: FilePath -> Version -> CopyFlags
copyFlags FilePath
destdir Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> FilePath
-> FilePath
-> CopyFlags
setupHsCopyFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared Verbosity
verbosity
FilePath
builddir FilePath
destdir
scriptOptions :: SetupScriptOptions
scriptOptions = ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> FilePath
-> FilePath
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions ElaboratedReadyPackage
rpkg ElaboratedInstallPlan
plan ElaboratedSharedConfig
pkgshared
DistDirLayout
distDirLayout FilePath
srcdir FilePath
builddir
Bool
isParallelBuild Lock
cacheLock
setup :: CommandUI flags -> (Version -> flags) -> IO ()
setup :: forall flags. CommandUI flags -> (Version -> flags) -> IO ()
setup CommandUI flags
cmd Version -> flags
flags = forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI flags
cmd Version -> flags
flags (forall a b. a -> b -> a
const [])
setup' :: CommandUI flags -> (Version -> flags) -> (Version -> [String])
-> IO ()
setup' :: forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup' CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
forall r. (Maybe Handle -> IO r) -> IO r
withLogging forall a b. (a -> b) -> a -> b
$ \Maybe Handle
mLogFileHandle ->
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper
Verbosity
verbosity
SetupScriptOptions
scriptOptions
{ useLoggingHandle :: Maybe Handle
useLoggingHandle = Maybe Handle
mLogFileHandle
, useExtraEnvOverrides :: [(FilePath, Maybe FilePath)]
useExtraEnvOverrides = DistDirLayout
-> ElaboratedInstallPlan -> [(FilePath, Maybe FilePath)]
dataDirsEnvironmentForPlan
DistDirLayout
distDirLayout ElaboratedInstallPlan
plan }
(forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args
mlogFile :: Maybe FilePath
mlogFile :: Maybe FilePath
mlogFile =
case Maybe
(Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
buildSettingLogFile of
Maybe
(Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath)
Nothing -> forall a. Maybe a
Nothing
Just Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath
mkLogFile -> forall a. a -> Maybe a
Just (Compiler -> Platform -> PackageIdentifier -> UnitId -> FilePath
mkLogFile Compiler
compiler Platform
platform PackageIdentifier
pkgid UnitId
uid)
initLogFile :: IO ()
initLogFile :: IO ()
initLogFile =
case Maybe FilePath
mlogFile of
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FilePath
logFile -> do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
logFile)
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
logFile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
logFile
withLogging :: (Maybe Handle -> IO r) -> IO r
withLogging :: forall r. (Maybe Handle -> IO r) -> IO r
withLogging Maybe Handle -> IO r
action =
case Maybe FilePath
mlogFile of
Maybe FilePath
Nothing -> Maybe Handle -> IO r
action forall a. Maybe a
Nothing
Just FilePath
logFile -> forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
logFile IOMode
AppendMode (Maybe Handle -> IO r
action forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage{Bool
[FilePath]
[Maybe PackageDB]
PackageDBStack
[PathTemplate]
[ComponentTarget]
Maybe FilePath
Maybe TestShowDetails
Maybe PathTemplate
Maybe CabalFileText
Maybe PackageSourceHash
Maybe ComponentTarget
PackageDescription
PackageIdentifier
UnitId
ComponentId
Map FilePath FilePath
Map FilePath [FilePath]
Map ModuleName Module
Map ModuleName OpenModule
HaddockTarget
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
DumpBuildInfo
InstallDirs FilePath
ModuleShape
Version
ComponentRequestedSpec
FlagAssignment
OptionalStanzaSet
OptionalStanzaMap (Maybe Bool)
UnresolvedPkgLoc
SetupScriptStyle
BuildStyle
ElaboratedPackageOrComponent
elabConfigureTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabSetupScriptCliVersion :: ElaboratedConfiguredPackage -> Version
elabSetupScriptStyle :: ElaboratedConfiguredPackage -> SetupScriptStyle
elabTestFailWhenNoTestSuites :: ElaboratedConfiguredPackage -> Bool
elabTestWrapper :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockLib :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockBaseUrl :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockIndex :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockContents :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabHaddockHscolourCss :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockQuickJump :: ElaboratedConfiguredPackage -> Bool
elabHaddockLinkedSource :: ElaboratedConfiguredPackage -> Bool
elabHaddockCss :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockInternal :: ElaboratedConfiguredPackage -> Bool
elabHaddockBenchmarks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTestSuites :: ElaboratedConfiguredPackage -> Bool
elabHaddockExecutables :: ElaboratedConfiguredPackage -> Bool
elabHaddockForHackage :: ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForeignLibs :: ElaboratedConfiguredPackage -> Bool
elabHaddockHtmlLocation :: ElaboratedConfiguredPackage -> Maybe FilePath
elabHaddockHtml :: ElaboratedConfiguredPackage -> Bool
elabHaddockHoogle :: ElaboratedConfiguredPackage -> Bool
elabProgSuffix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabProgPrefix :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabExtraIncludeDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraFrameworkDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraLibDirsStatic :: ElaboratedConfiguredPackage -> [FilePath]
elabExtraLibDirs :: ElaboratedConfiguredPackage -> [FilePath]
elabConfigureScriptArgs :: ElaboratedConfiguredPackage -> [FilePath]
elabProgramPathExtra :: ElaboratedConfiguredPackage -> [FilePath]
elabProgramArgs :: ElaboratedConfiguredPackage -> Map FilePath [FilePath]
elabProgramPaths :: ElaboratedConfiguredPackage -> Map FilePath FilePath
elabDumpBuildInfo :: ElaboratedConfiguredPackage -> DumpBuildInfo
elabDebugInfo :: ElaboratedConfiguredPackage -> DebugInfoLevel
elabStripExes :: ElaboratedConfiguredPackage -> Bool
elabStripLibs :: ElaboratedConfiguredPackage -> Bool
elabSplitSections :: ElaboratedConfiguredPackage -> Bool
elabSplitObjs :: ElaboratedConfiguredPackage -> Bool
elabOptimization :: ElaboratedConfiguredPackage -> OptimisationLevel
elabCoverage :: ElaboratedConfiguredPackage -> Bool
elabProfExeDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfLibDetail :: ElaboratedConfiguredPackage -> ProfDetailLevel
elabProfExe :: ElaboratedConfiguredPackage -> Bool
elabProfLib :: ElaboratedConfiguredPackage -> Bool
elabGHCiLib :: ElaboratedConfiguredPackage -> Bool
elabFullyStaticExe :: ElaboratedConfiguredPackage -> Bool
elabDynExe :: ElaboratedConfiguredPackage -> Bool
elabStaticLib :: ElaboratedConfiguredPackage -> Bool
elabSharedLib :: ElaboratedConfiguredPackage -> Bool
elabVanillaLib :: ElaboratedConfiguredPackage -> Bool
elabInplaceRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabInplaceSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabPackageDbs :: ElaboratedConfiguredPackage -> [Maybe PackageDB]
elabStanzasRequested :: ElaboratedConfiguredPackage -> OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: ElaboratedConfiguredPackage -> OptionalStanzaSet
elabEnabledSpec :: ElaboratedConfiguredPackage -> ComponentRequestedSpec
elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabPkgSourceHash :: ElaboratedConfiguredPackage -> Maybe PackageSourceHash
elabFlagDefaults :: ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment :: ElaboratedConfiguredPackage -> FlagAssignment
elabModuleShape :: ElaboratedConfiguredPackage -> ModuleShape
elabPkgSourceId :: ElaboratedConfiguredPackage -> PackageIdentifier
elabIsCanonical :: ElaboratedConfiguredPackage -> Bool
elabLinkedInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName OpenModule
elabInstantiatedWith :: ElaboratedConfiguredPackage -> Map ModuleName Module
elabComponentId :: ElaboratedConfiguredPackage -> ComponentId
elabUnitId :: ElaboratedConfiguredPackage -> UnitId
elabPkgOrComp :: ElaboratedPackageOrComponent
elabBuildHaddocks :: Bool
elabHaddockTargets :: [ComponentTarget]
elabReplTarget :: Maybe ComponentTarget
elabBenchTargets :: [ComponentTarget]
elabTestTargets :: [ComponentTarget]
elabBuildTargets :: [ComponentTarget]
elabConfigureTargets :: [ComponentTarget]
elabSetupScriptCliVersion :: Version
elabSetupScriptStyle :: SetupScriptStyle
elabBenchmarkOptions :: [PathTemplate]
elabTestTestOptions :: [PathTemplate]
elabTestFailWhenNoTestSuites :: Bool
elabTestWrapper :: Maybe FilePath
elabTestKeepTix :: Bool
elabTestShowDetails :: Maybe TestShowDetails
elabTestHumanLog :: Maybe PathTemplate
elabTestMachineLog :: Maybe PathTemplate
elabHaddockLib :: Maybe FilePath
elabHaddockBaseUrl :: Maybe FilePath
elabHaddockIndex :: Maybe PathTemplate
elabHaddockContents :: Maybe PathTemplate
elabHaddockHscolourCss :: Maybe FilePath
elabHaddockQuickJump :: Bool
elabHaddockLinkedSource :: Bool
elabHaddockCss :: Maybe FilePath
elabHaddockInternal :: Bool
elabHaddockBenchmarks :: Bool
elabHaddockTestSuites :: Bool
elabHaddockExecutables :: Bool
elabHaddockForHackage :: HaddockTarget
elabHaddockForeignLibs :: Bool
elabHaddockHtmlLocation :: Maybe FilePath
elabHaddockHtml :: Bool
elabHaddockHoogle :: Bool
elabInstallDirs :: InstallDirs FilePath
elabProgSuffix :: Maybe PathTemplate
elabProgPrefix :: Maybe PathTemplate
elabExtraIncludeDirs :: [FilePath]
elabExtraFrameworkDirs :: [FilePath]
elabExtraLibDirsStatic :: [FilePath]
elabExtraLibDirs :: [FilePath]
elabConfigureScriptArgs :: [FilePath]
elabProgramPathExtra :: [FilePath]
elabProgramArgs :: Map FilePath [FilePath]
elabProgramPaths :: Map FilePath FilePath
elabDumpBuildInfo :: DumpBuildInfo
elabDebugInfo :: DebugInfoLevel
elabStripExes :: Bool
elabStripLibs :: Bool
elabSplitSections :: Bool
elabSplitObjs :: Bool
elabOptimization :: OptimisationLevel
elabCoverage :: Bool
elabProfExeDetail :: ProfDetailLevel
elabProfLibDetail :: ProfDetailLevel
elabProfExe :: Bool
elabProfLib :: Bool
elabGHCiLib :: Bool
elabFullyStaticExe :: Bool
elabDynExe :: Bool
elabStaticLib :: Bool
elabSharedLib :: Bool
elabVanillaLib :: Bool
elabPkgDescriptionOverride :: Maybe CabalFileText
elabInplaceRegisterPackageDBStack :: PackageDBStack
elabInplaceBuildPackageDBStack :: PackageDBStack
elabInplaceSetupPackageDBStack :: PackageDBStack
elabRegisterPackageDBStack :: PackageDBStack
elabBuildPackageDBStack :: PackageDBStack
elabSetupPackageDBStack :: PackageDBStack
elabPackageDbs :: [Maybe PackageDB]
elabStanzasRequested :: OptionalStanzaMap (Maybe Bool)
elabStanzasAvailable :: OptionalStanzaSet
elabEnabledSpec :: ComponentRequestedSpec
elabBuildStyle :: BuildStyle
elabLocalToProject :: Bool
elabPkgSourceHash :: Maybe PackageSourceHash
elabPkgSourceLocation :: UnresolvedPkgLoc
elabPkgDescription :: PackageDescription
elabFlagDefaults :: FlagAssignment
elabFlagAssignment :: FlagAssignment
elabModuleShape :: ModuleShape
elabPkgSourceId :: PackageIdentifier
elabIsCanonical :: Bool
elabLinkedInstantiatedWith :: Map ModuleName OpenModule
elabInstantiatedWith :: Map ModuleName Module
elabComponentId :: ComponentId
elabUnitId :: UnitId
elabPkgDescription :: ElaboratedConfiguredPackage -> PackageDescription
elabPkgOrComp :: ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs FilePath
elabPkgDescriptionOverride :: ElaboratedConfiguredPackage -> Maybe CabalFileText
elabSetupPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack :: ElaboratedConfiguredPackage -> PackageDBStack
elabBenchmarkOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestTestOptions :: ElaboratedConfiguredPackage -> [PathTemplate]
elabTestKeepTix :: ElaboratedConfiguredPackage -> Bool
elabTestShowDetails :: ElaboratedConfiguredPackage -> Maybe TestShowDetails
elabTestHumanLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabTestMachineLog :: ElaboratedConfiguredPackage -> Maybe PathTemplate
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabHaddockTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabBenchTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildStyle :: ElaboratedConfiguredPackage -> BuildStyle
elabPkgSourceLocation :: ElaboratedConfiguredPackage -> UnresolvedPkgLoc
..}
| Bool -> Bool
not Bool
elabBuildHaddocks = Bool
False
| Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ComponentTarget -> Bool
componentHasHaddocks [ComponentTarget]
components
where
components :: [ComponentTarget]
components :: [ComponentTarget]
components = [ComponentTarget]
elabBuildTargets forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabTestTargets forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabBenchTargets
forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe ComponentTarget
elabReplTarget forall a. [a] -> [a] -> [a]
++ [ComponentTarget]
elabHaddockTargets
componentHasHaddocks :: ComponentTarget -> Bool
componentHasHaddocks :: ComponentTarget -> Bool
componentHasHaddocks (ComponentTarget ComponentName
name SubComponentTarget
_) =
case ComponentName
name of
CLibName LibraryName
LMainLibName -> Bool
hasHaddocks
CLibName (LSubLibName UnqualComponentName
_) -> Bool
elabHaddockInternal Bool -> Bool -> Bool
&& Bool
hasHaddocks
CFLibName UnqualComponentName
_ -> Bool
elabHaddockForeignLibs Bool -> Bool -> Bool
&& Bool
hasHaddocks
CExeName UnqualComponentName
_ -> Bool
elabHaddockExecutables Bool -> Bool -> Bool
&& Bool
hasHaddocks
CTestName UnqualComponentName
_ -> Bool
elabHaddockTestSuites Bool -> Bool -> Bool
&& Bool
hasHaddocks
CBenchName UnqualComponentName
_ -> Bool
elabHaddockBenchmarks Bool -> Bool -> Bool
&& Bool
hasHaddocks
where
hasHaddocks :: Bool
hasHaddocks = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription
elabPkgDescription forall s a. s -> Getting a s a -> a
^. forall r.
Monoid r =>
ComponentName -> Getting r PackageDescription [ModuleName]
componentModules ComponentName
name))
buildInplaceUnpackedPackage :: Verbosity
-> DistDirLayout
-> BuildTimeSettings -> Lock -> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatusRebuild
-> FilePath -> FilePath
-> IO BuildResult
buildInplaceUnpackedPackage :: Verbosity
-> DistDirLayout
-> BuildTimeSettings
-> Lock
-> Lock
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedReadyPackage
-> BuildStatusRebuild
-> FilePath
-> FilePath
-> IO BuildResult
buildInplaceUnpackedPackage Verbosity
verbosity
distDirLayout :: DistDirLayout
distDirLayout@DistDirLayout {
FilePath
distTempDirectory :: FilePath
distTempDirectory :: DistDirLayout -> FilePath
distTempDirectory,
DistDirParams -> FilePath
distPackageCacheDirectory :: DistDirParams -> FilePath
distPackageCacheDirectory :: DistDirLayout -> DistDirParams -> FilePath
distPackageCacheDirectory,
FilePath
distDirectory :: FilePath
distDirectory :: DistDirLayout -> FilePath
distDirectory
}
BuildTimeSettings{Int
buildSettingNumJobs :: Int
buildSettingNumJobs :: BuildTimeSettings -> Int
buildSettingNumJobs, Bool
buildSettingHaddockOpen :: BuildTimeSettings -> Bool
buildSettingHaddockOpen :: Bool
buildSettingHaddockOpen}
Lock
registerLock Lock
cacheLock
pkgshared :: ElaboratedSharedConfig
pkgshared@ElaboratedSharedConfig {
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler = Compiler
compiler,
pkgConfigCompilerProgs :: ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs = ProgramDb
progdb,
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigPlatform = Platform
platform
}
ElaboratedInstallPlan
plan
rpkg :: ElaboratedReadyPackage
rpkg@(ReadyPackage ElaboratedConfiguredPackage
pkg)
BuildStatusRebuild
buildStatus
FilePath
srcdir FilePath
builddir = do
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 forall a b. (a -> b) -> a -> b
$ do
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
ConfigureFailed forall a b. (a -> b) -> a -> b
$
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI ConfigFlags
configureCommand Version -> ConfigFlags
configureFlags Version -> [FilePath]
configureArgs
PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor PackageFileMonitor
packageFileMonitor
PackageFileMonitor
-> FilePath -> ElaboratedConfiguredPackage -> IO ()
updatePackageConfigFileMonitor PackageFileMonitor
packageFileMonitor FilePath
srcdir ElaboratedConfiguredPackage
pkg
let docsResult :: DocsResult
docsResult = DocsResult
DocsNotTried
testsResult :: TestsResult
testsResult = TestsResult
TestsNotTried
buildResult :: BuildResultMisc
buildResult :: BuildResultMisc
buildResult = (DocsResult
docsResult, TestsResult
testsResult)
IO () -> IO ()
whenRebuild forall a b. (a -> b) -> a -> b
$ do
MonitorTimestamp
timestamp <- IO MonitorTimestamp
beginUpdateFileMonitor
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
BuildFailed forall a b. (a -> b) -> a -> b
$
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI BuildFlags
buildCommand Version -> BuildFlags
buildFlags Version -> [FilePath]
buildArgs
let listSimple :: IO [MonitorFilePath]
listSimple =
forall a. FilePath -> Rebuild a -> IO [MonitorFilePath]
execRebuild FilePath
srcdir (ElaboratedConfiguredPackage -> Rebuild ()
needElaboratedConfiguredPackage ElaboratedConfiguredPackage
pkg)
listSdist :: IO [MonitorFilePath]
listSdist =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorFileHashed) forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO [FilePath]
allPackageSourceFiles Verbosity
verbosity FilePath
srcdir
ifNullThen :: m (t a) -> m (t a) -> m (t a)
ifNullThen m (t a)
m m (t a)
m' = do t a
xs <- m (t a)
m
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs then m (t a)
m' else forall (m :: * -> *) a. Monad m => a -> m a
return t a
xs
[MonitorFilePath]
monitors <- case PackageDescription -> BuildType
PD.buildType (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg) of
BuildType
Simple -> IO [MonitorFilePath]
listSimple
BuildType
_ | ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion ElaboratedConfiguredPackage
pkg forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1,Int
17]
-> IO [MonitorFilePath]
listSdist forall {m :: * -> *} {t :: * -> *} {a}.
(Monad m, Foldable t) =>
m (t a) -> m (t a) -> m (t a)
`ifNullThen` IO [MonitorFilePath]
listSimple
| Bool
otherwise
-> IO [MonitorFilePath]
listSimple
let dep_monitors :: [MonitorFilePath]
dep_monitors = forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorFileHashed
forall a b. (a -> b) -> a -> b
$ DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> ElaboratedConfiguredPackage
-> [FilePath]
elabInplaceDependencyBuildCacheFiles
DistDirLayout
distDirLayout ElaboratedSharedConfig
pkgshared ElaboratedInstallPlan
plan ElaboratedConfiguredPackage
pkg
PackageFileMonitor
-> FilePath
-> MonitorTimestamp
-> ElaboratedConfiguredPackage
-> BuildStatusRebuild
-> [MonitorFilePath]
-> BuildResultMisc
-> IO ()
updatePackageBuildFileMonitor PackageFileMonitor
packageFileMonitor FilePath
srcdir MonitorTimestamp
timestamp
ElaboratedConfiguredPackage
pkg BuildStatusRebuild
buildStatus
([MonitorFilePath]
monitors forall a. [a] -> [a] -> [a]
++ [MonitorFilePath]
dep_monitors) BuildResultMisc
buildResult
IO () -> IO ()
whenReRegister forall a b. (a -> b) -> a -> b
$ forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
InstallFailed forall a b. (a -> b) -> a -> b
$ do
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 }
forall a. Lock -> IO a -> IO a
criticalSection Lock
registerLock forall a b. (a -> b) -> a -> b
$
Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
Cabal.registerPackage Verbosity
verbosity Compiler
compiler ProgramDb
progdb
(ElaboratedConfiguredPackage -> PackageDBStack
elabRegisterPackageDBStack ElaboratedConfiguredPackage
pkg)
InstalledPackageInfo
ipkg RegisterOptions
Cabal.defaultRegisterOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just InstalledPackageInfo
ipkg)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
PackageFileMonitor
-> FilePath -> Maybe InstalledPackageInfo -> IO ()
updatePackageRegFileMonitor PackageFileMonitor
packageFileMonitor FilePath
srcdir Maybe InstalledPackageInfo
mipkg
IO () -> IO ()
whenTest forall a b. (a -> b) -> a -> b
$ do
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
TestsFailed forall a b. (a -> b) -> a -> b
$
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI TestFlags
testCommand Version -> TestFlags
testFlags Version -> [FilePath]
testArgs
IO () -> IO ()
whenBench forall a b. (a -> b) -> a -> b
$
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
BenchFailed forall a b. (a -> b) -> a -> b
$
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI BenchmarkFlags
benchCommand Version -> BenchmarkFlags
benchFlags Version -> [FilePath]
benchArgs
IO () -> IO ()
whenRepl forall a b. (a -> b) -> a -> b
$
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
ReplFailed forall a b. (a -> b) -> a -> b
$
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setupInteractive CommandUI ReplFlags
replCommand Version -> ReplFlags
replFlags Version -> [FilePath]
replArgs
IO () -> IO ()
whenHaddock forall a b. (a -> b) -> a -> b
$
forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
HaddocksFailed forall a b. (a -> b) -> a -> b
$ do
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI HaddockFlags
haddockCommand Version -> HaddockFlags
haddockFlags Version -> [FilePath]
haddockArgs
let haddockTarget :: HaddockTarget
haddockTarget = ElaboratedConfiguredPackage -> HaddockTarget
elabHaddockForHackage ElaboratedConfiguredPackage
pkg
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HaddockTarget
haddockTarget forall a. Eq a => a -> a -> Bool
== HaddockTarget
Cabal.ForHackage) forall a b. (a -> b) -> a -> b
$ do
let dest :: FilePath
dest = FilePath
distDirectory FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"
name :: FilePath
name = HaddockTarget -> PackageDescription -> FilePath
haddockDirName HaddockTarget
haddockTarget (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
docDir :: FilePath
docDir = DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory DistDirLayout
distDirLayout DistDirParams
dparams
FilePath -> FilePath -> FilePath
</> FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath
"html"
FilePath -> FilePath -> FilePath -> IO ()
Tar.createTarGzFile FilePath
dest FilePath
docDir FilePath
name
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Documentation tarball created: " forall a. [a] -> [a] -> [a]
++ FilePath
dest
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
buildSettingHaddockOpen Bool -> Bool -> Bool
&& HaddockTarget
haddockTarget forall a. Eq a => a -> a -> Bool
/= HaddockTarget
Cabal.ForHackage) forall a b. (a -> b) -> a -> b
$ do
let dest :: FilePath
dest = FilePath
docDir FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
</> FilePath
"index.html"
name :: FilePath
name = HaddockTarget -> PackageDescription -> FilePath
haddockDirName HaddockTarget
haddockTarget (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg)
docDir :: FilePath
docDir = DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory DistDirLayout
distDirLayout DistDirParams
dparams
FilePath -> FilePath -> FilePath
</> FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath
"html"
Either FilePath FilePath
exe <- Platform -> IO (Either FilePath FilePath)
findOpenProgramLocation Platform
platform
case Either FilePath FilePath
exe of
Right FilePath
open -> Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (FilePath -> [FilePath] -> ProgramInvocation
simpleProgramInvocation FilePath
open [FilePath
dest])
Left FilePath
err -> forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
err
forall (m :: * -> *) a. Monad m => a -> m a
return BuildResult {
buildResultDocs :: DocsResult
buildResultDocs = DocsResult
docsResult,
buildResultTests :: TestsResult
buildResultTests = TestsResult
testsResult,
buildResultLogFile :: Maybe FilePath
buildResultLogFile = forall a. Maybe a
Nothing
}
where
ipkgid :: UnitId
ipkgid = forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg
dparams :: DistDirParams
dparams = ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
pkgshared ElaboratedConfiguredPackage
pkg
isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs forall a. Ord a => a -> a -> Bool
>= Int
2
packageFileMonitor :: PackageFileMonitor
packageFileMonitor = ElaboratedSharedConfig
-> DistDirLayout -> DistDirParams -> PackageFileMonitor
newPackageFileMonitor ElaboratedSharedConfig
pkgshared DistDirLayout
distDirLayout DistDirParams
dparams
whenReConfigure :: IO () -> IO ()
whenReConfigure IO ()
action = case BuildStatusRebuild
buildStatus of
BuildStatusConfigure MonitorChangedReason ()
_ -> IO ()
action
BuildStatusRebuild
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenRebuild :: IO () -> IO ()
whenRebuild IO ()
action
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
pkg)
, forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg)
, forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IO ()
action
whenTest :: IO () -> IO ()
whenTest IO ()
action
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabTestTargets ElaboratedConfiguredPackage
pkg) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IO ()
action
whenBench :: IO () -> IO ()
whenBench IO ()
action
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBenchTargets ElaboratedConfiguredPackage
pkg) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IO ()
action
whenRepl :: IO () -> IO ()
whenRepl IO ()
action
| forall a. Maybe a -> Bool
isNothing (ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabReplTarget ElaboratedConfiguredPackage
pkg) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IO ()
action
whenHaddock :: IO () -> IO ()
whenHaddock IO ()
action
| ElaboratedConfiguredPackage -> Bool
hasValidHaddockTargets ElaboratedConfiguredPackage
pkg = IO ()
action
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenReRegister :: IO () -> IO ()
whenReRegister IO ()
action
= case BuildStatusRebuild
buildStatus of
BuildStatusBuild (Just Maybe InstalledPackageInfo
_) BuildReason
_ ->
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"whenReRegister: previously registered"
BuildStatusRebuild
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets ElaboratedConfiguredPackage
pkg) ->
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"whenReRegister: nothing to register"
| Bool
otherwise -> IO ()
action
configureCommand :: CommandUI ConfigFlags
configureCommand = ProgramDb -> CommandUI ConfigFlags
Cabal.configureCommand ProgramDb
defaultProgramDb
configureFlags :: Version -> ConfigFlags
configureFlags Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags Version
v forall a b. (a -> b) -> a -> b
$
ElaboratedReadyPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> ConfigFlags
setupHsConfigureFlags ElaboratedReadyPackage
rpkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
configureArgs :: Version -> [FilePath]
configureArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsConfigureArgs ElaboratedConfiguredPackage
pkg
buildCommand :: CommandUI BuildFlags
buildCommand = ProgramDb -> CommandUI BuildFlags
Cabal.buildCommand ProgramDb
defaultProgramDb
buildFlags :: Version -> BuildFlags
buildFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> BuildFlags
setupHsBuildFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
buildArgs :: Version -> [FilePath]
buildArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsBuildArgs ElaboratedConfiguredPackage
pkg
testCommand :: CommandUI TestFlags
testCommand = CommandUI TestFlags
Cabal.testCommand
testFlags :: Version -> TestFlags
testFlags Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip TestFlags -> Version -> TestFlags
filterTestFlags Version
v forall a b. (a -> b) -> a -> b
$
ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> TestFlags
setupHsTestFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
testArgs :: Version -> [FilePath]
testArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsTestArgs ElaboratedConfiguredPackage
pkg
benchCommand :: CommandUI BenchmarkFlags
benchCommand = CommandUI BenchmarkFlags
Cabal.benchmarkCommand
benchFlags :: Version -> BenchmarkFlags
benchFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> FilePath
-> BenchmarkFlags
setupHsBenchFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
benchArgs :: Version -> [FilePath]
benchArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsBenchArgs ElaboratedConfiguredPackage
pkg
replCommand :: CommandUI ReplFlags
replCommand = ProgramDb -> CommandUI ReplFlags
Cabal.replCommand ProgramDb
defaultProgramDb
replFlags :: Version -> ReplFlags
replFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> ReplFlags
setupHsReplFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
replArgs :: Version -> [FilePath]
replArgs Version
_ = ElaboratedConfiguredPackage -> [FilePath]
setupHsReplArgs ElaboratedConfiguredPackage
pkg
haddockCommand :: CommandUI HaddockFlags
haddockCommand = CommandUI HaddockFlags
Cabal.haddockCommand
haddockFlags :: Version -> HaddockFlags
haddockFlags Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip HaddockFlags -> Version -> HaddockFlags
filterHaddockFlags Version
v forall a b. (a -> b) -> a -> b
$
ElaboratedConfiguredPackage
-> ElaboratedSharedConfig -> Verbosity -> FilePath -> HaddockFlags
setupHsHaddockFlags ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
haddockArgs :: Version -> [FilePath]
haddockArgs Version
v = forall a b c. (a -> b -> c) -> b -> a -> c
flip [FilePath] -> Version -> [FilePath]
filterHaddockArgs Version
v forall a b. (a -> b) -> a -> b
$
ElaboratedConfiguredPackage -> [FilePath]
setupHsHaddockArgs ElaboratedConfiguredPackage
pkg
scriptOptions :: SetupScriptOptions
scriptOptions = ElaboratedReadyPackage
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> DistDirLayout
-> FilePath
-> FilePath
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions ElaboratedReadyPackage
rpkg ElaboratedInstallPlan
plan ElaboratedSharedConfig
pkgshared
DistDirLayout
distDirLayout FilePath
srcdir FilePath
builddir
Bool
isParallelBuild Lock
cacheLock
setupInteractive :: CommandUI flags
-> (Version -> flags) -> (Version -> [String]) -> IO ()
setupInteractive :: forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setupInteractive CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper Verbosity
verbosity
SetupScriptOptions
scriptOptions { isInteractive :: Bool
isInteractive = Bool
True }
(forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args
setup :: CommandUI flags -> (Version -> flags) -> (Version -> [String])
-> IO ()
setup :: forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args =
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper Verbosity
verbosity
SetupScriptOptions
scriptOptions
(forall a. a -> Maybe a
Just (ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg))
CommandUI flags
cmd Version -> flags
flags Version -> [FilePath]
args
generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
Verbosity
-> FilePath -> (FilePath -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile
Verbosity
verbosity FilePath
distTempDirectory forall a b. (a -> b) -> a -> b
$ \FilePath
pkgConfDest -> do
let registerFlags :: Version -> RegisterFlags
registerFlags Version
_ = ElaboratedConfiguredPackage
-> ElaboratedSharedConfig
-> Verbosity
-> FilePath
-> FilePath
-> RegisterFlags
setupHsRegisterFlags
ElaboratedConfiguredPackage
pkg ElaboratedSharedConfig
pkgshared
Verbosity
verbosity FilePath
builddir
FilePath
pkgConfDest
forall flags.
CommandUI flags
-> (Version -> flags) -> (Version -> [FilePath]) -> IO ()
setup CommandUI RegisterFlags
Cabal.registerCommand Version -> RegisterFlags
registerFlags (forall a b. a -> b -> a
const [])
withTempInstalledPackageInfoFile :: Verbosity -> FilePath
-> (FilePath -> IO ())
-> IO InstalledPackageInfo
withTempInstalledPackageInfoFile :: Verbosity
-> FilePath -> (FilePath -> IO ()) -> IO InstalledPackageInfo
withTempInstalledPackageInfoFile Verbosity
verbosity FilePath
tempdir FilePath -> IO ()
action =
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
tempdir FilePath
"package-registration-" forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
FilePath
abs_dir <- FilePath -> IO FilePath
canonicalizePath FilePath
dir
let pkgConfDest :: FilePath
pkgConfDest = FilePath
abs_dir FilePath -> FilePath -> FilePath
</> FilePath
"pkgConf"
FilePath -> IO ()
action FilePath
pkgConfDest
FilePath -> FilePath -> IO InstalledPackageInfo
readPkgConf FilePath
"." FilePath
pkgConfDest
where
pkgConfParseFailed :: String -> IO a
pkgConfParseFailed :: forall a. FilePath -> IO a
pkgConfParseFailed FilePath
perror =
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
FilePath
"Couldn't parse the output of 'setup register --gen-pkg-config':"
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
perror
readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
readPkgConf FilePath
pkgConfDir FilePath
pkgConfFile = do
ByteString
pkgConfStr <- FilePath -> IO ByteString
BS.readFile (FilePath
pkgConfDir FilePath -> FilePath -> FilePath
</> FilePath
pkgConfFile)
([FilePath]
warns, InstalledPackageInfo
ipkg) <- case ByteString
-> Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)
Installed.parseInstalledPackageInfo ByteString
pkgConfStr of
Left NonEmpty FilePath
perrors -> forall a. FilePath -> IO a
pkgConfParseFailed forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
perrors
Right ([FilePath]
warns, InstalledPackageInfo
ipkg) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
warns, InstalledPackageInfo
ipkg)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
warns) forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
warns
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
ipkg
annotateFailureNoLog :: (SomeException -> BuildFailureReason)
-> IO a -> IO a
annotateFailureNoLog :: forall a. (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailureNoLog SomeException -> BuildFailureReason
annotate IO a
action =
forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure forall a. Maybe a
Nothing SomeException -> BuildFailureReason
annotate IO a
action
annotateFailure :: Maybe FilePath
-> (SomeException -> BuildFailureReason)
-> IO a -> IO a
annotateFailure :: forall a.
Maybe FilePath
-> (SomeException -> BuildFailureReason) -> IO a -> IO a
annotateFailure Maybe FilePath
mlogFile SomeException -> BuildFailureReason
annotate IO a
action =
IO a
action forall a. IO a -> [Handler a] -> IO a
`catches`
[
#if MIN_VERSION_base(4,7,0)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \SomeAsyncException
async -> forall e a. Exception e => e -> IO a
throwIO (SomeAsyncException
async :: SomeAsyncException)
#else
Handler $ \async -> throwIO (async :: AsyncException)
#endif
, forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \SomeException
other -> forall e a. Exception e => e -> IO a
handler (SomeException
other :: SomeException)
]
where
handler :: Exception e => e -> IO a
handler :: forall e a. Exception e => e -> IO a
handler = forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> BuildFailureReason -> BuildFailure
BuildFailure Maybe FilePath
mlogFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> BuildFailureReason
annotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toException