{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.CmdBuild (
buildCommand,
buildAction,
BuildFlags(..),
defaultBuildFlags,
selectPackageTargets,
selectComponentTarget
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Client.ProjectFlags
( removeIgnoreProjectOption )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.TargetProblem
( TargetProblem (..), TargetProblem' )
import Distribution.Client.CmdErrorMessages
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), yesNoOpt )
import Distribution.Simple.Flag ( Flag(..), toFlag, fromFlag, fromFlagOrDefault )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives, option )
import Distribution.Verbosity
( normal )
import Distribution.Simple.Utils
( wrapText, die' )
import Distribution.Client.ScriptUtils
( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) )
import qualified Data.Map as Map
buildCommand :: CommandUI (NixStyleFlags BuildFlags)
buildCommand :: CommandUI (NixStyleFlags BuildFlags)
buildCommand = CommandUI {
commandName :: String
commandName = String
"v2-build",
commandSynopsis :: String
commandSynopsis = String
"Compile targets within the project.",
commandUsage :: String -> String
commandUsage = String -> [String] -> String -> String
usageAlternatives String
"v2-build" [ String
"[TARGETS] [FLAGS]" ],
commandDescription :: Maybe (String -> String)
commandDescription = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \String
_ -> String -> String
wrapText forall a b. (a -> b) -> a -> b
$
String
"Build one or more targets from within the project. The available "
forall a. [a] -> [a] -> [a]
++ String
"targets are the packages in the project as well as individual "
forall a. [a] -> [a] -> [a]
++ String
"components within those packages, including libraries, executables, "
forall a. [a] -> [a] -> [a]
++ String
"test-suites or benchmarks. Targets can be specified by name or "
forall a. [a] -> [a] -> [a]
++ String
"location. If no target is specified then the default is to build "
forall a. [a] -> [a] -> [a]
++ String
"the package in the current directory.\n\n"
forall a. [a] -> [a] -> [a]
++ String
"Dependencies are built or rebuilt as necessary. Additional "
forall a. [a] -> [a] -> [a]
++ String
"configuration flags can be specified on the command line and these "
forall a. [a] -> [a] -> [a]
++ String
"extend the project configuration from the 'cabal.project', "
forall a. [a] -> [a] -> [a]
++ String
"'cabal.project.local' and other files.",
commandNotes :: Maybe (String -> String)
commandNotes = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \String
pname ->
String
"Examples:\n"
forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-build\n"
forall a. [a] -> [a] -> [a]
++ String
" Build the package in the current directory "
forall a. [a] -> [a] -> [a]
++ String
"or all packages in the project\n"
forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-build pkgname\n"
forall a. [a] -> [a] -> [a]
++ String
" Build the package named pkgname in the project\n"
forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-build ./pkgfoo\n"
forall a. [a] -> [a] -> [a]
++ String
" Build the package in the ./pkgfoo directory\n"
forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-build cname\n"
forall a. [a] -> [a] -> [a]
++ String
" Build the component named cname in the project\n"
forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-build cname --enable-profiling\n"
forall a. [a] -> [a] -> [a]
++ String
" Build the component in profiling mode "
forall a. [a] -> [a] -> [a]
++ String
"(including dependencies as needed)\n"
, commandDefaultFlags :: NixStyleFlags BuildFlags
commandDefaultFlags = forall a. a -> NixStyleFlags a
defaultNixStyleFlags BuildFlags
defaultBuildFlags
, commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags BuildFlags)]
commandOptions = forall a. [OptionField a] -> [OptionField a]
removeIgnoreProjectOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions (\ShowOrParseArgs
showOrParseArgs ->
[ forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [String
"only-configure"]
String
"Instead of performing a full build just run the configure step"
BuildFlags -> Flag Bool
buildOnlyConfigure (\Flag Bool
v BuildFlags
flags -> BuildFlags
flags { buildOnlyConfigure :: Flag Bool
buildOnlyConfigure = Flag Bool
v })
(forall b.
ShowOrParseArgs
-> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
yesNoOpt ShowOrParseArgs
showOrParseArgs)
])
}
data BuildFlags = BuildFlags
{ BuildFlags -> Flag Bool
buildOnlyConfigure :: Flag Bool
}
defaultBuildFlags :: BuildFlags
defaultBuildFlags :: BuildFlags
defaultBuildFlags = BuildFlags
{ buildOnlyConfigure :: Flag Bool
buildOnlyConfigure = forall a. a -> Flag a
toFlag Bool
False
}
buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO ()
buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO ()
buildAction flags :: NixStyleFlags BuildFlags
flags@NixStyleFlags { extraFlags :: forall a. NixStyleFlags a -> a
extraFlags = BuildFlags
buildFlags, ConfigFlags
HaddockFlags
TestFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
projectFlags :: ProjectFlags
benchmarkFlags :: BenchmarkFlags
testFlags :: TestFlags
haddockFlags :: HaddockFlags
installFlags :: InstallFlags
configExFlags :: ConfigExFlags
configFlags :: ConfigFlags
..} [String]
targetStrings GlobalFlags
globalFlags
= forall a b.
AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags a
-> [String]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
-> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors AcceptNoTargets
RejectNoTargets forall a. Maybe a
Nothing NixStyleFlags BuildFlags
flags [String]
targetStrings GlobalFlags
globalFlags CurrentCommand
BuildCommand forall a b. (a -> b) -> a -> b
$ \TargetContext
targetCtx ProjectBaseContext
ctx [TargetSelector]
targetSelectors -> do
let onlyConfigure :: Bool
onlyConfigure = forall a. WithCallStack (Flag a -> a)
fromFlag (BuildFlags -> Flag Bool
buildOnlyConfigure BuildFlags
defaultBuildFlags
forall a. Semigroup a => a -> a -> a
<> BuildFlags -> Flag Bool
buildOnlyConfigure BuildFlags
buildFlags)
targetAction :: TargetAction
targetAction
| Bool
onlyConfigure = TargetAction
TargetActionConfigure
| Bool
otherwise = TargetAction
TargetActionBuild
ProjectBaseContext
baseCtx <- case TargetContext
targetCtx of
TargetContext
ProjectContext -> forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
TargetContext
GlobalContext -> forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
ScriptContext String
path Executable
exemeta -> ProjectBaseContext -> String -> Executable -> IO ProjectBaseContext
updateContextAndWriteProjectFile ProjectBaseContext
ctx String
path Executable
exemeta
ProjectBuildContext
buildCtx <-
Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
-> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
runProjectPreBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx forall a b. (a -> b) -> a -> b
$ \ElaboratedInstallPlan
elaboratedPlan -> do
TargetsMap
targets <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems Verbosity
verbosity) forall (m :: * -> *) a. Monad m => a -> m a
return
forall a b. (a -> b) -> a -> b
$ forall err.
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets
forall k.
TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargets
forall k.
SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k
selectComponentTarget
ElaboratedInstallPlan
elaboratedPlan
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors
let elaboratedPlan' :: ElaboratedInstallPlan
elaboratedPlan' = TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets
TargetAction
targetAction
TargetsMap
targets
ElaboratedInstallPlan
elaboratedPlan
ElaboratedInstallPlan
elaboratedPlan'' <-
if BuildTimeSettings -> Bool
buildSettingOnlyDeps (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
then forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies Verbosity
verbosity) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Set UnitId
-> ElaboratedInstallPlan
-> Either CannotPruneDependencies ElaboratedInstallPlan
pruneInstallPlanToDependencies (forall k a. Map k a -> Set k
Map.keysSet TargetsMap
targets)
ElaboratedInstallPlan
elaboratedPlan'
else forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedInstallPlan
elaboratedPlan'
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
elaboratedPlan'', TargetsMap
targets)
Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO ()
printPlan Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx
BuildOutcomes
buildOutcomes <- Verbosity
-> ProjectBaseContext -> ProjectBuildContext -> IO BuildOutcomes
runProjectBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx
Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> BuildOutcomes
-> IO ()
runProjectPostBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx BuildOutcomes
buildOutcomes
where
verbosity :: Verbosity
verbosity = forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargets :: forall k.
TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsBuildable)
= forall a b. b -> Either a b
Right [k]
targetsBuildable
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets)
= forall a b. a -> Either a b
Left (forall a. TargetSelector -> [AvailableTarget ()] -> TargetProblem a
TargetProblemNoneEnabled TargetSelector
targetSelector [AvailableTarget ()]
targets')
| Bool
otherwise
= forall a b. a -> Either a b
Left (forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
where
targets' :: [AvailableTarget ()]
targets' = forall k. [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail [AvailableTarget k]
targets
targetsBuildable :: [k]
targetsBuildable = forall k. (TargetRequested -> Bool) -> [AvailableTarget k] -> [k]
selectBuildableTargetsWith
(TargetSelector -> TargetRequested -> Bool
buildable TargetSelector
targetSelector)
[AvailableTarget k]
targets
buildable :: TargetSelector -> TargetRequested -> Bool
buildable (TargetPackage TargetImplicitCwd
_ [PackageId]
_ Maybe ComponentKind
Nothing) TargetRequested
TargetNotRequestedByDefault = Bool
False
buildable (TargetAllPackages Maybe ComponentKind
Nothing) TargetRequested
TargetNotRequestedByDefault = Bool
False
buildable TargetSelector
_ TargetRequested
_ = Bool
True
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem' k
selectComponentTarget :: forall k.
SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k
selectComponentTarget = forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic
reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems :: forall a. Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems Verbosity
verbosity [TargetProblem']
problems =
forall a. Verbosity -> String -> [TargetProblem'] -> IO a
reportTargetProblems Verbosity
verbosity String
"build" [TargetProblem']
problems
reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies :: forall a. Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies Verbosity
verbosity =
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. CannotPruneDependencies -> String
renderCannotPruneDependencies