1{-# LANGUAGE RecordWildCards #-}
2-- | cabal-install CLI command: build
3--
4module Distribution.Client.CmdBuild (
5    -- * The @build@ CLI and action
6    buildCommand,
7    buildAction,
8
9    -- * Internals exposed for testing
10    selectPackageTargets,
11    selectComponentTarget
12  ) where
13
14import Prelude ()
15import Distribution.Client.Compat.Prelude
16
17import Distribution.Client.ProjectOrchestration
18import Distribution.Client.TargetProblem
19         ( TargetProblem (..), TargetProblem' )
20import Distribution.Client.CmdErrorMessages
21
22import Distribution.Client.NixStyleOptions
23         ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
24import Distribution.Client.Setup
25         ( GlobalFlags, ConfigFlags(..), yesNoOpt )
26import Distribution.Simple.Flag ( Flag(..), toFlag, fromFlag, fromFlagOrDefault )
27import Distribution.Simple.Command
28         ( CommandUI(..), usageAlternatives, option, optionName )
29import Distribution.Verbosity
30         ( normal )
31import Distribution.Simple.Utils
32         ( wrapText, die' )
33
34import qualified Data.Map as Map
35
36
37buildCommand :: CommandUI (NixStyleFlags BuildFlags)
38buildCommand = CommandUI {
39  commandName         = "v2-build",
40  commandSynopsis     = "Compile targets within the project.",
41  commandUsage        = usageAlternatives "v2-build" [ "[TARGETS] [FLAGS]" ],
42  commandDescription  = Just $ \_ -> wrapText $
43        "Build one or more targets from within the project. The available "
44     ++ "targets are the packages in the project as well as individual "
45     ++ "components within those packages, including libraries, executables, "
46     ++ "test-suites or benchmarks. Targets can be specified by name or "
47     ++ "location. If no target is specified then the default is to build "
48     ++ "the package in the current directory.\n\n"
49
50     ++ "Dependencies are built or rebuilt as necessary. Additional "
51     ++ "configuration flags can be specified on the command line and these "
52     ++ "extend the project configuration from the 'cabal.project', "
53     ++ "'cabal.project.local' and other files.",
54  commandNotes        = Just $ \pname ->
55        "Examples:\n"
56     ++ "  " ++ pname ++ " v2-build\n"
57     ++ "    Build the package in the current directory "
58     ++ "or all packages in the project\n"
59     ++ "  " ++ pname ++ " v2-build pkgname\n"
60     ++ "    Build the package named pkgname in the project\n"
61     ++ "  " ++ pname ++ " v2-build ./pkgfoo\n"
62     ++ "    Build the package in the ./pkgfoo directory\n"
63     ++ "  " ++ pname ++ " v2-build cname\n"
64     ++ "    Build the component named cname in the project\n"
65     ++ "  " ++ pname ++ " v2-build cname --enable-profiling\n"
66     ++ "    Build the component in profiling mode "
67     ++ "(including dependencies as needed)\n"
68
69  , commandDefaultFlags = defaultNixStyleFlags defaultBuildFlags
70  , commandOptions      = filter (\o -> optionName o /= "ignore-project")
71                        . nixStyleOptions (\showOrParseArgs ->
72    [ option [] ["only-configure"]
73        "Instead of performing a full build just run the configure step"
74        buildOnlyConfigure (\v flags -> flags { buildOnlyConfigure = v })
75        (yesNoOpt showOrParseArgs)
76    ])
77  }
78
79data BuildFlags = BuildFlags
80    { buildOnlyConfigure  :: Flag Bool
81    }
82
83defaultBuildFlags :: BuildFlags
84defaultBuildFlags = BuildFlags
85    { buildOnlyConfigure = toFlag False
86    }
87
88-- | The @build@ command does a lot. It brings the install plan up to date,
89-- selects that part of the plan needed by the given or implicit targets and
90-- then executes the plan.
91--
92-- For more details on how this works, see the module
93-- "Distribution.Client.ProjectOrchestration"
94--
95buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO ()
96buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings globalFlags = do
97    -- TODO: This flags defaults business is ugly
98    let onlyConfigure = fromFlag (buildOnlyConfigure defaultBuildFlags
99                                 <> buildOnlyConfigure buildFlags)
100        targetAction
101            | onlyConfigure = TargetActionConfigure
102            | otherwise = TargetActionBuild
103
104    baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
105
106    targetSelectors <-
107      either (reportTargetSelectorProblems verbosity) return
108      =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings
109
110    buildCtx <-
111      runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
112
113            -- Interpret the targets on the command line as build targets
114            -- (as opposed to say repl or haddock targets).
115            targets <- either (reportBuildTargetProblems verbosity) return
116                     $ resolveTargets
117                         selectPackageTargets
118                         selectComponentTarget
119                         elaboratedPlan
120                         Nothing
121                         targetSelectors
122
123            let elaboratedPlan' = pruneInstallPlanToTargets
124                                    targetAction
125                                    targets
126                                    elaboratedPlan
127            elaboratedPlan'' <-
128              if buildSettingOnlyDeps (buildSettings baseCtx)
129                then either (reportCannotPruneDependencies verbosity) return $
130                     pruneInstallPlanToDependencies (Map.keysSet targets)
131                                                    elaboratedPlan'
132                else return elaboratedPlan'
133
134            return (elaboratedPlan'', targets)
135
136    printPlan verbosity baseCtx buildCtx
137
138    buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
139    runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
140  where
141    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
142    cliConfig = commandLineFlagsToProjectConfig globalFlags flags
143                  mempty -- ClientInstallFlags, not needed here
144
145-- | This defines what a 'TargetSelector' means for the @bench@ command.
146-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
147-- or otherwise classifies the problem.
148--
149-- For the @build@ command select all components except non-buildable
150-- and disabled tests\/benchmarks, fail if there are no such
151-- components
152--
153selectPackageTargets :: TargetSelector
154                     -> [AvailableTarget k] -> Either TargetProblem' [k]
155selectPackageTargets targetSelector targets
156
157    -- If there are any buildable targets then we select those
158  | not (null targetsBuildable)
159  = Right targetsBuildable
160
161    -- If there are targets but none are buildable then we report those
162  | not (null targets)
163  = Left (TargetProblemNoneEnabled targetSelector targets')
164
165    -- If there are no targets at all then we report that
166  | otherwise
167  = Left (TargetProblemNoTargets targetSelector)
168  where
169    targets'         = forgetTargetsDetail targets
170    targetsBuildable = selectBuildableTargetsWith
171                         (buildable targetSelector)
172                         targets
173
174    -- When there's a target filter like "pkg:tests" then we do select tests,
175    -- but if it's just a target like "pkg" then we don't build tests unless
176    -- they are requested by default (i.e. by using --enable-tests)
177    buildable (TargetPackage _ _  Nothing) TargetNotRequestedByDefault = False
178    buildable (TargetAllPackages  Nothing) TargetNotRequestedByDefault = False
179    buildable _ _ = True
180
181-- | For a 'TargetComponent' 'TargetSelector', check if the component can be
182-- selected.
183--
184-- For the @build@ command we just need the basic checks on being buildable etc.
185--
186selectComponentTarget :: SubComponentTarget
187                      -> AvailableTarget k -> Either TargetProblem' k
188selectComponentTarget = selectComponentTargetBasic
189
190reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
191reportBuildTargetProblems verbosity problems =
192  reportTargetProblems verbosity "build" problems
193
194reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a
195reportCannotPruneDependencies verbosity =
196    die' verbosity . renderCannotPruneDependencies
197