@@ -156,12 +156,12 @@ import Distribution.Types.ComponentName
156
156
)
157
157
import Distribution.Types.UnqualComponentName
158
158
( UnqualComponentName
159
- , packageNameToUnqualComponentName
159
+ , packageNameToUnqualComponentName , unUnqualComponentName
160
160
)
161
161
162
162
import Distribution.Solver.Types.OptionalStanza
163
163
164
- import Control.Exception (assert )
164
+ import Control.Exception (assert , handle )
165
165
import qualified Data.List.NonEmpty as NE
166
166
import qualified Data.Map as Map
167
167
import qualified Data.Set as Set
@@ -192,7 +192,8 @@ import Distribution.Simple.Utils
192
192
, notice
193
193
, noticeNoWrap
194
194
, ordNub
195
- , warn
195
+ , warn , die'
196
+ , installExecutableFile
196
197
)
197
198
import Distribution.Types.Flag
198
199
( FlagAssignment
@@ -202,10 +203,11 @@ import Distribution.Types.Flag
202
203
import Distribution.Utils.NubList
203
204
( fromNubList
204
205
)
205
- import Distribution.Utils.Path (makeSymbolicPath )
206
+ import Distribution.Utils.Path (makeSymbolicPath , (</>) )
206
207
import Distribution.Verbosity
207
208
#ifdef MIN_VERSION_unix
208
209
import System.Posix.Signals (sigKILL , sigSEGV )
210
+ import qualified Distribution.Client.ProjectPlanning.Stage as Stage
209
211
210
212
#endif
211
213
@@ -475,8 +477,8 @@ runProjectPostBuildPhase _ ProjectBaseContext{buildSettings} _ _
475
477
return ()
476
478
runProjectPostBuildPhase
477
479
verbosity
478
- ProjectBaseContext {.. }
479
- ProjectBuildContext {.. }
480
+ baseCtx @ ProjectBaseContext {.. }
481
+ buildCtx @ ProjectBuildContext {.. }
480
482
buildOutcomes = do
481
483
-- Update other build artefacts
482
484
-- TODO: currently none, but could include:
@@ -493,6 +495,8 @@ runProjectPostBuildPhase
493
495
pkgsBuildStatus
494
496
buildOutcomes
495
497
498
+ installExecutables verbosity baseCtx buildCtx postBuildStatus
499
+
496
500
-- Write the .ghc.environment file (if allowed by the env file write policy).
497
501
let writeGhcEnvFilesPolicy =
498
502
projectConfigWriteGhcEnvironmentFilesPolicy . projectConfigShared $
@@ -522,6 +526,29 @@ runProjectPostBuildPhase
522
526
-- an exception to terminate the program
523
527
dieOnBuildFailures verbosity currentCommand elaboratedPlanToExecute buildOutcomes
524
528
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
+
525
552
-- Note that it is a deliberate design choice that the 'buildTargets' is
526
553
-- not passed to phase 1, and the various bits of input config is not
527
554
-- passed to phase 2.
0 commit comments