Commit 66cd8579 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add runProjectPostBuildPhase in project orchestration

Previously the post-build phase was just reportBuildFailures and was
called directly from Cmd{Build,Repl}. So initially this just rearranges
things without changing behaviour, but it gives us a place to add other
post-build actions.

This also simplifies the code in Cmd{Configure,Build,Repl}.

A few examples are mentioned in a comment, including updating:
  .ghc.environment
  bin symlinks/wrappers
  haddock/hoogle/ctags indexes
  delete stale lib registrations
  delete stale package dirs
parent 602a5434
......@@ -8,9 +8,6 @@ module Distribution.Client.CmdBuild (
) where
import Distribution.Client.ProjectOrchestration
( PreBuildHooks(..), runProjectPreBuildPhase, selectTargets
, ProjectBuildContext(..), runProjectBuildPhase
, printPlan, reportBuildFailures )
import Distribution.Client.ProjectConfig
( BuildTimeSettings(..) )
import Distribution.Client.ProjectPlanning
......@@ -25,8 +22,6 @@ import Distribution.Simple.Setup
import Distribution.Verbosity
( normal )
import Control.Monad (unless)
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Simple.Utils
......@@ -69,7 +64,7 @@ buildAction (configFlags, configExFlags, installFlags, haddockFlags)
userTargets <- readUserBuildTargets targetStrings
buildCtx@ProjectBuildContext{buildSettings, elaboratedPlan} <-
buildCtx <-
runProjectPreBuildPhase
verbosity
( globalFlags, configFlags, configExFlags
......@@ -91,9 +86,8 @@ buildAction (configFlags, configExFlags, installFlags, haddockFlags)
printPlan verbosity buildCtx
unless (buildSettingDryRun buildSettings) $ do
buildResults <- runProjectBuildPhase verbosity buildCtx
reportBuildFailures verbosity elaboratedPlan buildResults
buildOutcomes <- runProjectBuildPhase verbosity buildCtx
runProjectPostBuildPhase verbosity buildCtx buildOutcomes
where
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
......@@ -66,16 +66,16 @@ configureAction (configFlags, configExFlags, installFlags, haddockFlags)
hookSelectPlanSubset = \_ -> return
}
let buildCtx' = buildCtx {
buildSettings = (buildSettings buildCtx) {
buildSettingDryRun = True
}
}
--TODO: Hmm, but we don't have any targets. Currently this prints what we
-- would build if we were to build everything. Could pick implicit target like "."
--TODO: should we say what's in the project (+deps) as a whole?
printPlan
verbosity
buildCtx {
buildSettings = (buildSettings buildCtx) {
buildSettingDryRun = True
}
}
printPlan verbosity buildCtx'
where
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
......@@ -8,9 +8,6 @@ module Distribution.Client.CmdRepl (
) where
import Distribution.Client.ProjectOrchestration
( PreBuildHooks(..), runProjectPreBuildPhase, selectTargets
, ProjectBuildContext(..), runProjectBuildPhase
, printPlan, reportBuildFailures )
import Distribution.Client.ProjectConfig
( BuildTimeSettings(..) )
import Distribution.Client.ProjectPlanning
......@@ -25,7 +22,7 @@ import Distribution.Simple.Setup
import Distribution.Verbosity
( normal )
import Control.Monad (when, unless)
import Control.Monad (when)
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
......@@ -66,7 +63,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags)
userTargets <- readUserBuildTargets targetStrings
buildCtx@ProjectBuildContext{buildSettings, elaboratedPlan} <-
buildCtx <-
runProjectPreBuildPhase
verbosity
( globalFlags, configFlags, configExFlags
......@@ -96,9 +93,8 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags)
printPlan verbosity buildCtx
unless (buildSettingDryRun buildSettings) $ do
buildResults <- runProjectBuildPhase verbosity buildCtx
reportBuildFailures verbosity elaboratedPlan buildResults
buildOutcomes <- runProjectBuildPhase verbosity buildCtx
runProjectPostBuildPhase verbosity buildCtx buildOutcomes
where
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
......@@ -53,6 +53,7 @@ module Distribution.Client.ProjectOrchestration (
runProjectBuildPhase,
-- * Post build actions
runProjectPostBuildPhase,
reportBuildFailures,
) where
......@@ -124,7 +125,7 @@ data PreBuildHooks = PreBuildHooks {
-> IO ElaboratedInstallPlan
}
-- | This holds the context between the pre-build and build phases.
-- | This holds the context between the pre-build, build and post-build phases.
--
data ProjectBuildContext = ProjectBuildContext {
distDirLayout :: DistDirLayout,
......@@ -210,6 +211,10 @@ runProjectPreBuildPhase
runProjectBuildPhase :: Verbosity
-> ProjectBuildContext
-> IO BuildOutcomes
runProjectBuildPhase _ ProjectBuildContext {buildSettings}
| buildSettingDryRun buildSettings
= return Map.empty
runProjectBuildPhase verbosity ProjectBuildContext {..} =
fmap (Map.union (previousBuildOutcomes pkgsBuildStatus)) $
rebuildTargets verbosity
......@@ -226,6 +231,30 @@ runProjectBuildPhase verbosity ProjectBuildContext {..} =
--TODO: [nice to have] record build failures persistently
_ -> Nothing
-- | Post-build phase: various administrative tasks
--
-- Update bits of state based on the build outcomes and report any failures.
--
runProjectPostBuildPhase :: Verbosity
-> ProjectBuildContext
-> BuildOutcomes
-> IO ()
runProjectPostBuildPhase _ ProjectBuildContext {buildSettings} _
| buildSettingDryRun buildSettings
= return ()
runProjectPostBuildPhase verbosity ProjectBuildContext {..} buildOutcomes = do
-- Update other build artefacts
-- TODO: currently none, but could include:
-- - .ghc.environment
-- - bin symlinks/wrappers
-- - haddock/hoogle/ctags indexes
-- - delete stale lib registrations
-- - delete stale package dirs
-- Report any build failures
reportBuildFailures verbosity elaboratedPlan buildOutcomes
-- Note that it is a deliberate design choice that the 'buildTargets' is
-- not passed to phase 1, and the various bits of input config is not
-- passed to phase 2.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment