Skip to content

Commit 8956904

Browse files
committed
Add installExecutables function to handle executable installation post-build
1 parent eeb1cf2 commit 8956904

File tree

1 file changed

+33
-6
lines changed

1 file changed

+33
-6
lines changed

cabal-install/src/Distribution/Client/ProjectOrchestration.hs

Lines changed: 33 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -156,12 +156,12 @@ import Distribution.Types.ComponentName
156156
)
157157
import Distribution.Types.UnqualComponentName
158158
( UnqualComponentName
159-
, packageNameToUnqualComponentName
159+
, packageNameToUnqualComponentName, unUnqualComponentName
160160
)
161161

162162
import Distribution.Solver.Types.OptionalStanza
163163

164-
import Control.Exception (assert)
164+
import Control.Exception (assert, handle)
165165
import qualified Data.List.NonEmpty as NE
166166
import qualified Data.Map as Map
167167
import qualified Data.Set as Set
@@ -192,7 +192,8 @@ import Distribution.Simple.Utils
192192
, notice
193193
, noticeNoWrap
194194
, ordNub
195-
, warn
195+
, warn, die'
196+
, installExecutableFile
196197
)
197198
import Distribution.Types.Flag
198199
( FlagAssignment
@@ -202,10 +203,11 @@ import Distribution.Types.Flag
202203
import Distribution.Utils.NubList
203204
( fromNubList
204205
)
205-
import Distribution.Utils.Path (makeSymbolicPath)
206+
import Distribution.Utils.Path (makeSymbolicPath, (</>))
206207
import Distribution.Verbosity
207208
#ifdef MIN_VERSION_unix
208209
import System.Posix.Signals (sigKILL, sigSEGV)
210+
import qualified Distribution.Client.ProjectPlanning.Stage as Stage
209211

210212
#endif
211213

@@ -475,8 +477,8 @@ runProjectPostBuildPhase _ ProjectBaseContext{buildSettings} _ _
475477
return ()
476478
runProjectPostBuildPhase
477479
verbosity
478-
ProjectBaseContext{..}
479-
ProjectBuildContext{..}
480+
baseCtx@ProjectBaseContext{..}
481+
buildCtx@ProjectBuildContext{..}
480482
buildOutcomes = do
481483
-- Update other build artefacts
482484
-- TODO: currently none, but could include:
@@ -493,6 +495,8 @@ runProjectPostBuildPhase
493495
pkgsBuildStatus
494496
buildOutcomes
495497

498+
installExecutables verbosity baseCtx buildCtx postBuildStatus
499+
496500
-- Write the .ghc.environment file (if allowed by the env file write policy).
497501
let writeGhcEnvFilesPolicy =
498502
projectConfigWriteGhcEnvironmentFilesPolicy . projectConfigShared $
@@ -522,6 +526,29 @@ runProjectPostBuildPhase
522526
-- an exception to terminate the program
523527
dieOnBuildFailures verbosity currentCommand elaboratedPlanToExecute buildOutcomes
524528

529+
installExecutables :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> PostBuildProjectStatus -> IO ()
530+
installExecutables
531+
verbosity
532+
ProjectBaseContext {distDirLayout}
533+
ProjectBuildContext {elaboratedPlanOriginal, elaboratedShared, targetsMap}
534+
postBuildStatus =
535+
for_ (Map.toList targetsMap) $ \(key@(WithStage stage _unitId), targets) -> do
536+
guard $ stage == Stage.Host
537+
guard $ key `Set.member` packagesDefinitelyUpToDate postBuildStatus
538+
case InstallPlan.lookup elaboratedPlanOriginal key of
539+
Nothing -> die' verbosity "target missing from the plan"
540+
Just (InstallPlan.PreExisting _) -> return ()
541+
Just (InstallPlan.Installed _) -> return ()
542+
Just (InstallPlan.Configured elab) -> do
543+
for_ targets $ \case
544+
(ComponentTarget (CExeName cname) _subtarget, _targetSelectors) -> do
545+
let exe = unUnqualComponentName cname
546+
dir = binDirectoryFor distDirLayout elaboratedShared elab exe
547+
handle (\(e :: IOException) -> do putStrLn "Error copying executable files:"; print e) $ do
548+
-- Copy the executable to the dist/bin directory
549+
installExecutableFile verbosity (dir </> exe) (distBinDirectory distDirLayout </> exe)
550+
_ -> return () -- nothing to do for non-executables
551+
525552
-- Note that it is a deliberate design choice that the 'buildTargets' is
526553
-- not passed to phase 1, and the various bits of input config is not
527554
-- passed to phase 2.

0 commit comments

Comments
 (0)