1{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, RankNTypes #-}
2{-# LANGUAGE ViewPatterns #-}
3{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE NoMonoLocalBinds #-}
5{-# LANGUAGE DeriveDataTypeable #-}
6{-# LANGUAGE DeriveFunctor #-}
7
8-- | Planning how to build everything in a project.
9--
10module Distribution.Client.ProjectPlanning (
11    -- * elaborated install plan types
12    ElaboratedInstallPlan,
13    ElaboratedConfiguredPackage(..),
14    ElaboratedPlanPackage,
15    ElaboratedSharedConfig(..),
16    ElaboratedReadyPackage,
17    BuildStyle(..),
18    CabalFileText,
19
20    -- * Producing the elaborated install plan
21    rebuildProjectConfig,
22    rebuildInstallPlan,
23
24    -- * Build targets
25    availableTargets,
26    AvailableTarget(..),
27    AvailableTargetStatus(..),
28    TargetRequested(..),
29    ComponentTarget(..),
30    SubComponentTarget(..),
31    showComponentTarget,
32    nubComponentTargets,
33
34    -- * Selecting a plan subset
35    pruneInstallPlanToTargets,
36    TargetAction(..),
37    pruneInstallPlanToDependencies,
38    CannotPruneDependencies(..),
39
40    -- * Utils required for building
41    pkgHasEphemeralBuildTargets,
42    elabBuildTargetWholeComponents,
43
44    -- * Setup.hs CLI flags for building
45    setupHsScriptOptions,
46    setupHsConfigureFlags,
47    setupHsConfigureArgs,
48    setupHsBuildFlags,
49    setupHsBuildArgs,
50    setupHsReplFlags,
51    setupHsReplArgs,
52    setupHsTestFlags,
53    setupHsTestArgs,
54    setupHsBenchFlags,
55    setupHsBenchArgs,
56    setupHsCopyFlags,
57    setupHsRegisterFlags,
58    setupHsHaddockFlags,
59    setupHsHaddockArgs,
60
61    packageHashInputs,
62
63    -- * Path construction
64    binDirectoryFor,
65    binDirectories,
66    storePackageInstallDirs,
67    storePackageInstallDirs'
68  ) where
69
70import Prelude ()
71import Distribution.Client.Compat.Prelude
72
73import           Distribution.Client.HashValue
74import           Distribution.Client.ProjectPlanning.Types as Ty
75import           Distribution.Client.PackageHash
76import           Distribution.Client.RebuildMonad
77import           Distribution.Client.Store
78import           Distribution.Client.ProjectConfig
79import           Distribution.Client.ProjectPlanOutput
80
81import           Distribution.Client.Types
82import qualified Distribution.Client.InstallPlan as InstallPlan
83import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
84import           Distribution.Client.Dependency
85import           Distribution.Client.Dependency.Types
86import qualified Distribution.Client.IndexUtils as IndexUtils
87import           Distribution.Client.Init (incVersion)
88import           Distribution.Client.Targets (userToPackageConstraint)
89import           Distribution.Client.DistDirLayout
90import           Distribution.Client.SetupWrapper
91import           Distribution.Client.JobControl
92import           Distribution.Client.FetchUtils
93import           Distribution.Client.Config
94import qualified Hackage.Security.Client as Sec
95import           Distribution.Client.Setup hiding (packageName, cabalVersion)
96import           Distribution.Utils.NubList
97import           Distribution.Utils.LogProgress
98import           Distribution.Utils.MapAccum
99
100import qualified Distribution.Solver.Types.ComponentDeps as CD
101import           Distribution.Solver.Types.ComponentDeps (ComponentDeps)
102import           Distribution.Solver.Types.ConstraintSource
103import           Distribution.Solver.Types.LabeledPackageConstraint
104import           Distribution.Solver.Types.OptionalStanza
105import           Distribution.Solver.Types.PkgConfigDb
106import           Distribution.Solver.Types.ResolverPackage
107import           Distribution.Solver.Types.SolverId
108import           Distribution.Solver.Types.SolverPackage
109import           Distribution.Solver.Types.InstSolverPackage
110import           Distribution.Solver.Types.SourcePackage
111import           Distribution.Solver.Types.Settings
112
113import           Distribution.ModuleName
114import           Distribution.Package
115import           Distribution.Types.AnnotatedId
116import           Distribution.Types.ComponentName
117import           Distribution.Types.LibraryName
118import           Distribution.Types.GivenComponent
119  (GivenComponent(..))
120import           Distribution.Types.PackageVersionConstraint
121import           Distribution.Types.PkgconfigDependency
122import           Distribution.Types.UnqualComponentName
123import           Distribution.System
124import qualified Distribution.PackageDescription as Cabal
125import qualified Distribution.PackageDescription as PD
126import qualified Distribution.PackageDescription.Configuration as PD
127import           Distribution.Simple.PackageIndex (InstalledPackageIndex)
128import           Distribution.Simple.Compiler hiding (Flag)
129import qualified Distribution.Simple.GHC   as GHC   --TODO: [code cleanup] eliminate
130import qualified Distribution.Simple.GHCJS as GHCJS --TODO: [code cleanup] eliminate
131import           Distribution.Simple.Program
132import           Distribution.Simple.Program.Db
133import           Distribution.Simple.Program.Find
134import qualified Distribution.Simple.Setup as Cabal
135import           Distribution.Simple.Setup
136  (Flag(..), toFlag, flagToMaybe, flagToList, fromFlagOrDefault)
137import qualified Distribution.Simple.Configure as Cabal
138import qualified Distribution.Simple.LocalBuildInfo as Cabal
139import           Distribution.Simple.LocalBuildInfo
140                   ( Component(..), pkgComponents, componentBuildInfo
141                   , componentName )
142import qualified Distribution.Simple.InstallDirs as InstallDirs
143import qualified Distribution.InstalledPackageInfo as IPI
144
145import           Distribution.Backpack.ConfiguredComponent
146import           Distribution.Backpack.LinkedComponent
147import           Distribution.Backpack.ComponentsGraph
148import           Distribution.Backpack.ModuleShape
149import           Distribution.Backpack.FullUnitId
150import           Distribution.Backpack
151import           Distribution.Types.ComponentInclude
152
153import           Distribution.Simple.Utils
154import           Distribution.Version
155import           Distribution.Verbosity
156import           Distribution.Deprecated.Text
157
158import qualified Distribution.Compat.Graph as Graph
159import           Distribution.Compat.Graph(IsNode(..))
160
161import           Text.PrettyPrint hiding ((<>))
162import qualified Text.PrettyPrint as Disp
163import qualified Data.Map as Map
164import qualified Data.Set as Set
165import           Control.Monad
166import qualified Data.Traversable as T
167import           Control.Monad.State as State
168import           Control.Exception
169import           Data.List (groupBy)
170import qualified Data.List.NonEmpty as NE
171import           Data.Either
172import           Data.Function
173import           System.FilePath
174
175------------------------------------------------------------------------------
176-- * Elaborated install plan
177------------------------------------------------------------------------------
178
179-- "Elaborated" -- worked out with great care and nicety of detail;
180--                 executed with great minuteness: elaborate preparations;
181--                 elaborate care.
182--
183-- So here's the idea:
184--
185-- Rather than a miscellaneous collection of 'ConfigFlags', 'InstallFlags' etc
186-- all passed in as separate args and which are then further selected,
187-- transformed etc during the execution of the build. Instead we construct
188-- an elaborated install plan that includes everything we will need, and then
189-- during the execution of the plan we do as little transformation of this
190-- info as possible.
191--
192-- So we're trying to split the work into two phases: construction of the
193-- elaborated install plan (which as far as possible should be pure) and
194-- then simple execution of that plan without any smarts, just doing what the
195-- plan says to do.
196--
197-- So that means we need a representation of this fully elaborated install
198-- plan. The representation consists of two parts:
199--
200-- * A 'ElaboratedInstallPlan'. This is a 'GenericInstallPlan' with a
201--   representation of source packages that includes a lot more detail about
202--   that package's individual configuration
203--
204-- * A 'ElaboratedSharedConfig'. Some package configuration is the same for
205--   every package in a plan. Rather than duplicate that info every entry in
206--   the 'GenericInstallPlan' we keep that separately.
207--
208-- The division between the shared and per-package config is /not set in stone
209-- for all time/. For example if we wanted to generalise the install plan to
210-- describe a situation where we want to build some packages with GHC and some
211-- with GHCJS then the platform and compiler would no longer be shared between
212-- all packages but would have to be per-package (probably with some sanity
213-- condition on the graph structure).
214--
215
216-- Refer to ProjectPlanning.Types for details of these important types:
217
218-- type ElaboratedInstallPlan = ...
219-- type ElaboratedPlanPackage = ...
220-- data ElaboratedSharedConfig = ...
221-- data ElaboratedConfiguredPackage = ...
222-- data BuildStyle =
223
224
225-- | Check that an 'ElaboratedConfiguredPackage' actually makes
226-- sense under some 'ElaboratedSharedConfig'.
227sanityCheckElaboratedConfiguredPackage
228    :: ElaboratedSharedConfig
229    -> ElaboratedConfiguredPackage
230    -> a
231    -> a
232sanityCheckElaboratedConfiguredPackage sharedConfig
233                             elab@ElaboratedConfiguredPackage{..} =
234    (case elabPkgOrComp of
235        ElabPackage pkg -> sanityCheckElaboratedPackage elab pkg
236        ElabComponent comp -> sanityCheckElaboratedComponent elab comp)
237
238    -- either a package is being built inplace, or the
239    -- 'installedPackageId' we assigned is consistent with
240    -- the 'hashedInstalledPackageId' we would compute from
241    -- the elaborated configured package
242  . assert (elabBuildStyle == BuildInplaceOnly ||
243     elabComponentId == hashedInstalledPackageId
244                            (packageHashInputs sharedConfig elab))
245
246    -- the stanzas explicitly disabled should not be available
247  . assert (Set.null (Map.keysSet (Map.filter not elabStanzasRequested)
248                `Set.intersection` elabStanzasAvailable))
249
250    -- either a package is built inplace, or we are not attempting to
251    -- build any test suites or benchmarks (we never build these
252    -- for remote packages!)
253  . assert (elabBuildStyle == BuildInplaceOnly ||
254     Set.null elabStanzasAvailable)
255
256sanityCheckElaboratedComponent
257    :: ElaboratedConfiguredPackage
258    -> ElaboratedComponent
259    -> a
260    -> a
261sanityCheckElaboratedComponent ElaboratedConfiguredPackage{..}
262                               ElaboratedComponent{..} =
263
264    -- Should not be building bench or test if not inplace.
265    assert (elabBuildStyle == BuildInplaceOnly ||
266     case compComponentName of
267        Nothing              -> True
268        Just (CLibName _)    -> True
269        Just (CExeName _)    -> True
270        -- This is interesting: there's no way to declare a dependency
271        -- on a foreign library at the moment, but you may still want
272        -- to install these to the store
273        Just (CFLibName _)   -> True
274        Just (CBenchName _)  -> False
275        Just (CTestName _)   -> False)
276
277
278sanityCheckElaboratedPackage
279    :: ElaboratedConfiguredPackage
280    -> ElaboratedPackage
281    -> a
282    -> a
283sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..}
284                             ElaboratedPackage{..} =
285    -- we should only have enabled stanzas that actually can be built
286    -- (according to the solver)
287    assert (pkgStanzasEnabled `Set.isSubsetOf` elabStanzasAvailable)
288
289    -- the stanzas that the user explicitly requested should be
290    -- enabled (by the previous test, they are also available)
291  . assert (Map.keysSet (Map.filter id elabStanzasRequested)
292                `Set.isSubsetOf` pkgStanzasEnabled)
293
294------------------------------------------------------------------------------
295-- * Deciding what to do: making an 'ElaboratedInstallPlan'
296------------------------------------------------------------------------------
297
298-- | Return the up-to-date project config and information about the local
299-- packages within the project.
300--
301rebuildProjectConfig :: Verbosity
302                     -> DistDirLayout
303                     -> ProjectConfig
304                     -> IO ( ProjectConfig
305                           , [PackageSpecifier UnresolvedSourcePackage] )
306rebuildProjectConfig verbosity
307                     distDirLayout@DistDirLayout {
308                       distProjectRootDirectory,
309                       distDirectory,
310                       distProjectCacheFile,
311                       distProjectCacheDirectory,
312                       distProjectFile
313                     }
314                     cliConfig = do
315
316    fileMonitorProjectConfigKey <- do
317      configPath <- getConfigFilePath projectConfigConfigFile
318      return (configPath, distProjectFile "")
319
320    (projectConfig, localPackages) <-
321      runRebuild distProjectRootDirectory
322      $ rerunIfChanged verbosity
323                       fileMonitorProjectConfig
324                       fileMonitorProjectConfigKey
325      $ do
326          liftIO $ info verbosity "Project settings changed, reconfiguring..."
327          projectConfig <- phaseReadProjectConfig
328          localPackages <- phaseReadLocalPackages projectConfig
329          return (projectConfig, localPackages)
330
331    info verbosity
332      $ unlines
333      $ ("this build was affected by the following (project) config files:" :)
334      $ [ "- " ++ path
335        | Explicit path <- Set.toList $ projectConfigProvenance projectConfig
336        ]
337
338    return (projectConfig <> cliConfig, localPackages)
339
340  where
341
342    ProjectConfigShared { projectConfigConfigFile } =
343      projectConfigShared cliConfig
344
345    fileMonitorProjectConfig =
346      newFileMonitor (distProjectCacheFile "config") :: FileMonitor
347          (FilePath, FilePath)
348          (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
349
350    -- Read the cabal.project (or implicit config) and combine it with
351    -- arguments from the command line
352    --
353    phaseReadProjectConfig :: Rebuild ProjectConfig
354    phaseReadProjectConfig = do
355      readProjectConfig verbosity projectConfigConfigFile distDirLayout
356
357    -- Look for all the cabal packages in the project
358    -- some of which may be local src dirs, tarballs etc
359    --
360    phaseReadLocalPackages :: ProjectConfig
361                           -> Rebuild [PackageSpecifier UnresolvedSourcePackage]
362    phaseReadLocalPackages projectConfig@ProjectConfig {
363                               projectConfigShared,
364                               projectConfigBuildOnly
365                             } = do
366      pkgLocations <- findProjectPackages distDirLayout projectConfig
367
368      -- Create folder only if findProjectPackages did not throw a
369      -- BadPackageLocations exception.
370      liftIO $ do
371        createDirectoryIfMissingVerbose verbosity True distDirectory
372        createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory
373
374      fetchAndReadSourcePackages verbosity distDirLayout
375                                 projectConfigShared
376                                 projectConfigBuildOnly
377                                 pkgLocations
378
379
380-- | Return an up-to-date elaborated install plan.
381--
382-- Two variants of the install plan are returned: with and without packages
383-- from the store. That is, the \"improved\" plan where source packages are
384-- replaced by pre-existing installed packages from the store (when their ids
385-- match), and also the original elaborated plan which uses primarily source
386-- packages.
387
388-- The improved plan is what we use for building, but the original elaborated
389-- plan is useful for reporting and configuration. For example the @freeze@
390-- command needs the source package info to know about flag choices and
391-- dependencies of executables and setup scripts.
392--
393rebuildInstallPlan :: Verbosity
394                   -> DistDirLayout -> CabalDirLayout
395                   -> ProjectConfig
396                   -> [PackageSpecifier UnresolvedSourcePackage]
397                   -> IO ( ElaboratedInstallPlan  -- with store packages
398                         , ElaboratedInstallPlan  -- with source packages
399                         , ElaboratedSharedConfig )
400                      -- ^ @(improvedPlan, elaboratedPlan, _, _)@
401rebuildInstallPlan verbosity
402                   distDirLayout@DistDirLayout {
403                     distProjectRootDirectory,
404                     distProjectCacheFile
405                   }
406                   CabalDirLayout {
407                     cabalStoreDirLayout
408                   } = \projectConfig localPackages ->
409    runRebuild distProjectRootDirectory $ do
410    progsearchpath <- liftIO $ getSystemSearchPath
411    let projectConfigMonitored = projectConfig { projectConfigBuildOnly = mempty }
412
413    -- The overall improved plan is cached
414    rerunIfChanged verbosity fileMonitorImprovedPlan
415                   -- react to changes in the project config,
416                   -- the package .cabal files and the path
417                   (projectConfigMonitored, localPackages, progsearchpath) $ do
418
419      -- And so is the elaborated plan that the improved plan based on
420      (elaboratedPlan, elaboratedShared) <-
421        rerunIfChanged verbosity fileMonitorElaboratedPlan
422                       (projectConfigMonitored, localPackages,
423                        progsearchpath) $ do
424
425          compilerEtc   <- phaseConfigureCompiler projectConfig
426          _             <- phaseConfigurePrograms projectConfig compilerEtc
427          (solverPlan, pkgConfigDB)
428                        <- phaseRunSolver         projectConfig
429                                                  compilerEtc
430                                                  localPackages
431          (elaboratedPlan,
432           elaboratedShared) <- phaseElaboratePlan projectConfig
433                                                   compilerEtc pkgConfigDB
434                                                   solverPlan
435                                                   localPackages
436
437          phaseMaintainPlanOutputs elaboratedPlan elaboratedShared
438          return (elaboratedPlan, elaboratedShared)
439
440      -- The improved plan changes each time we install something, whereas
441      -- the underlying elaborated plan only changes when input config
442      -- changes, so it's worth caching them separately.
443      improvedPlan <- phaseImprovePlan elaboratedPlan elaboratedShared
444
445      return (improvedPlan, elaboratedPlan, elaboratedShared)
446
447  where
448    fileMonitorCompiler       = newFileMonitorInCacheDir "compiler"
449    fileMonitorSolverPlan     = newFileMonitorInCacheDir "solver-plan"
450    fileMonitorSourceHashes   = newFileMonitorInCacheDir "source-hashes"
451    fileMonitorElaboratedPlan = newFileMonitorInCacheDir "elaborated-plan"
452    fileMonitorImprovedPlan   = newFileMonitorInCacheDir "improved-plan"
453
454    newFileMonitorInCacheDir :: Eq a => FilePath -> FileMonitor a b
455    newFileMonitorInCacheDir  = newFileMonitor . distProjectCacheFile
456
457
458    -- Configure the compiler we're using.
459    --
460    -- This is moderately expensive and doesn't change that often so we cache
461    -- it independently.
462    --
463    phaseConfigureCompiler :: ProjectConfig
464                           -> Rebuild (Compiler, Platform, ProgramDb)
465    phaseConfigureCompiler ProjectConfig {
466                             projectConfigShared = ProjectConfigShared {
467                               projectConfigHcFlavor,
468                               projectConfigHcPath,
469                               projectConfigHcPkg
470                             },
471                             projectConfigLocalPackages = PackageConfig {
472                               packageConfigProgramPaths,
473                               packageConfigProgramArgs,
474                               packageConfigProgramPathExtra
475                             }
476                           } = do
477        progsearchpath <- liftIO $ getSystemSearchPath
478        rerunIfChanged verbosity fileMonitorCompiler
479                       (hcFlavor, hcPath, hcPkg, progsearchpath,
480                        packageConfigProgramPaths,
481                        packageConfigProgramArgs,
482                        packageConfigProgramPathExtra) $ do
483
484          liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
485          result@(_, _, progdb') <- liftIO $
486            Cabal.configCompilerEx
487              hcFlavor hcPath hcPkg
488              progdb verbosity
489
490        -- Note that we added the user-supplied program locations and args
491        -- for /all/ programs, not just those for the compiler prog and
492        -- compiler-related utils. In principle we don't know which programs
493        -- the compiler will configure (and it does vary between compilers).
494        -- We do know however that the compiler will only configure the
495        -- programs it cares about, and those are the ones we monitor here.
496          monitorFiles (programsMonitorFiles progdb')
497
498          return result
499      where
500        hcFlavor = flagToMaybe projectConfigHcFlavor
501        hcPath   = flagToMaybe projectConfigHcPath
502        hcPkg    = flagToMaybe projectConfigHcPkg
503        progdb   =
504            userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))
505          . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs))
506          . modifyProgramSearchPath
507              (++ [ ProgramSearchPathDir dir
508                  | dir <- fromNubList packageConfigProgramPathExtra ])
509          $ defaultProgramDb
510
511
512    -- Configuring other programs.
513    --
514    -- Having configred the compiler, now we configure all the remaining
515    -- programs. This is to check we can find them, and to monitor them for
516    -- changes.
517    --
518    -- TODO: [required eventually] we don't actually do this yet.
519    --
520    -- We rely on the fact that the previous phase added the program config for
521    -- all local packages, but that all the programs configured so far are the
522    -- compiler program or related util programs.
523    --
524    phaseConfigurePrograms :: ProjectConfig
525                           -> (Compiler, Platform, ProgramDb)
526                           -> Rebuild ()
527    phaseConfigurePrograms projectConfig (_, _, compilerprogdb) = do
528        -- Users are allowed to specify program locations independently for
529        -- each package (e.g. to use a particular version of a pre-processor
530        -- for some packages). However they cannot do this for the compiler
531        -- itself as that's just not going to work. So we check for this.
532        liftIO $ checkBadPerPackageCompilerPaths
533          (configuredPrograms compilerprogdb)
534          (getMapMappend (projectConfigSpecificPackage projectConfig))
535
536        --TODO: [required eventually] find/configure other programs that the
537        -- user specifies.
538
539        --TODO: [required eventually] find/configure all build-tools
540        -- but note that some of them may be built as part of the plan.
541
542
543    -- Run the solver to get the initial install plan.
544    -- This is expensive so we cache it independently.
545    --
546    phaseRunSolver :: ProjectConfig
547                   -> (Compiler, Platform, ProgramDb)
548                   -> [PackageSpecifier UnresolvedSourcePackage]
549                   -> Rebuild (SolverInstallPlan, PkgConfigDb)
550    phaseRunSolver projectConfig@ProjectConfig {
551                     projectConfigShared,
552                     projectConfigBuildOnly
553                   }
554                   (compiler, platform, progdb)
555                   localPackages =
556        rerunIfChanged verbosity fileMonitorSolverPlan
557                       (solverSettings,
558                        localPackages, localPackagesEnabledStanzas,
559                        compiler, platform, programDbSignature progdb) $ do
560
561          installedPkgIndex <- getInstalledPackages verbosity
562                                                    compiler progdb platform
563                                                    corePackageDbs
564          sourcePkgDb       <- getSourcePackages verbosity withRepoCtx
565                                 (solverSettingIndexState solverSettings)
566          pkgConfigDB       <- getPkgConfigDb verbosity progdb
567
568          --TODO: [code cleanup] it'd be better if the Compiler contained the
569          -- ConfiguredPrograms that it needs, rather than relying on the progdb
570          -- since we don't need to depend on all the programs here, just the
571          -- ones relevant for the compiler.
572
573          liftIO $ do
574            solver <- chooseSolver verbosity
575                                   (solverSettingSolver solverSettings)
576                                   (compilerInfo compiler)
577
578            notice verbosity "Resolving dependencies..."
579            plan <- foldProgress logMsg (die' verbosity) return $
580              planPackages verbosity compiler platform solver solverSettings
581                           installedPkgIndex sourcePkgDb pkgConfigDB
582                           localPackages localPackagesEnabledStanzas
583            return (plan, pkgConfigDB)
584      where
585        corePackageDbs = [GlobalPackageDB]
586        withRepoCtx    = projectConfigWithSolverRepoContext verbosity
587                           projectConfigShared
588                           projectConfigBuildOnly
589        solverSettings = resolveSolverSettings projectConfig
590        logMsg message rest = debugNoWrap verbosity message >> rest
591
592        localPackagesEnabledStanzas =
593          Map.fromList
594            [ (pkgname, stanzas)
595            | pkg <- localPackages
596            , let pkgname            = pkgSpecifierTarget pkg
597                  testsEnabled       = lookupLocalPackageConfig
598                                         packageConfigTests
599                                         projectConfig pkgname
600                  benchmarksEnabled  = lookupLocalPackageConfig
601                                         packageConfigBenchmarks
602                                         projectConfig pkgname
603                  stanzas =
604                    Map.fromList $
605                      [ (TestStanzas, enabled)
606                      | enabled <- flagToList testsEnabled ]
607                   ++ [ (BenchStanzas , enabled)
608                      | enabled <- flagToList benchmarksEnabled ]
609            ]
610
611    -- Elaborate the solver's install plan to get a fully detailed plan. This
612    -- version of the plan has the final nix-style hashed ids.
613    --
614    phaseElaboratePlan :: ProjectConfig
615                       -> (Compiler, Platform, ProgramDb)
616                       -> PkgConfigDb
617                       -> SolverInstallPlan
618                       -> [PackageSpecifier (SourcePackage (PackageLocation loc))]
619                       -> Rebuild ( ElaboratedInstallPlan
620                                  , ElaboratedSharedConfig )
621    phaseElaboratePlan ProjectConfig {
622                         projectConfigShared,
623                         projectConfigAllPackages,
624                         projectConfigLocalPackages,
625                         projectConfigSpecificPackage,
626                         projectConfigBuildOnly
627                       }
628                       (compiler, platform, progdb) pkgConfigDB
629                       solverPlan localPackages = do
630
631        liftIO $ debug verbosity "Elaborating the install plan..."
632
633        sourcePackageHashes <-
634          rerunIfChanged verbosity fileMonitorSourceHashes
635                         (packageLocationsSignature solverPlan) $
636            getPackageSourceHashes verbosity withRepoCtx solverPlan
637
638        defaultInstallDirs <- liftIO $ userInstallDirTemplates compiler
639        (elaboratedPlan, elaboratedShared)
640          <- liftIO . runLogProgress verbosity $
641              elaborateInstallPlan
642                verbosity
643                platform compiler progdb pkgConfigDB
644                distDirLayout
645                cabalStoreDirLayout
646                solverPlan
647                localPackages
648                sourcePackageHashes
649                defaultInstallDirs
650                projectConfigShared
651                projectConfigAllPackages
652                projectConfigLocalPackages
653                (getMapMappend projectConfigSpecificPackage)
654        let instantiatedPlan
655              = instantiateInstallPlan
656                  cabalStoreDirLayout
657                  defaultInstallDirs
658                  elaboratedShared
659                  elaboratedPlan
660        liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan instantiatedPlan)
661        return (instantiatedPlan, elaboratedShared)
662      where
663        withRepoCtx = projectConfigWithSolverRepoContext verbosity
664                        projectConfigShared
665                        projectConfigBuildOnly
666
667    -- Update the files we maintain that reflect our current build environment.
668    -- In particular we maintain a JSON representation of the elaborated
669    -- install plan (but not the improved plan since that reflects the state
670    -- of the build rather than just the input environment).
671    --
672    phaseMaintainPlanOutputs :: ElaboratedInstallPlan
673                             -> ElaboratedSharedConfig
674                             -> Rebuild ()
675    phaseMaintainPlanOutputs elaboratedPlan elaboratedShared = liftIO $ do
676        debug verbosity "Updating plan.json"
677        writePlanExternalRepresentation
678          distDirLayout
679          elaboratedPlan
680          elaboratedShared
681
682
683    -- Improve the elaborated install plan. The elaborated plan consists
684    -- mostly of source packages (with full nix-style hashed ids). Where
685    -- corresponding installed packages already exist in the store, replace
686    -- them in the plan.
687    --
688    -- Note that we do monitor the store's package db here, so we will redo
689    -- this improvement phase when the db changes -- including as a result of
690    -- executing a plan and installing things.
691    --
692    phaseImprovePlan :: ElaboratedInstallPlan
693                     -> ElaboratedSharedConfig
694                     -> Rebuild ElaboratedInstallPlan
695    phaseImprovePlan elaboratedPlan elaboratedShared = do
696
697        liftIO $ debug verbosity "Improving the install plan..."
698        storePkgIdSet <- getStoreEntries cabalStoreDirLayout compid
699        let improvedPlan = improveInstallPlanWithInstalledPackages
700                             storePkgIdSet
701                             elaboratedPlan
702        liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan improvedPlan)
703        -- TODO: [nice to have] having checked which packages from the store
704        -- we're using, it may be sensible to sanity check those packages
705        -- by loading up the compiler package db and checking everything
706        -- matches up as expected, e.g. no dangling deps, files deleted.
707        return improvedPlan
708      where
709        compid = compilerId (pkgConfigCompiler elaboratedShared)
710
711
712programsMonitorFiles :: ProgramDb -> [MonitorFilePath]
713programsMonitorFiles progdb =
714    [ monitor
715    | prog    <- configuredPrograms progdb
716    , monitor <- monitorFileSearchPath (programMonitorFiles prog)
717                                       (programPath prog)
718    ]
719
720-- | Select the bits of a 'ProgramDb' to monitor for value changes.
721-- Use 'programsMonitorFiles' for the files to monitor.
722--
723programDbSignature :: ProgramDb -> [ConfiguredProgram]
724programDbSignature progdb =
725    [ prog { programMonitorFiles = []
726           , programOverrideEnv  = filter ((/="PATH") . fst)
727                                          (programOverrideEnv prog) }
728    | prog <- configuredPrograms progdb ]
729
730getInstalledPackages :: Verbosity
731                     -> Compiler -> ProgramDb -> Platform
732                     -> PackageDBStack
733                     -> Rebuild InstalledPackageIndex
734getInstalledPackages verbosity compiler progdb platform packagedbs = do
735    monitorFiles . map monitorFileOrDirectory
736      =<< liftIO (IndexUtils.getInstalledPackagesMonitorFiles
737                    verbosity compiler
738                    packagedbs progdb platform)
739    liftIO $ IndexUtils.getInstalledPackages
740               verbosity compiler
741               packagedbs progdb
742
743{-
744--TODO: [nice to have] use this but for sanity / consistency checking
745getPackageDBContents :: Verbosity
746                     -> Compiler -> ProgramDb -> Platform
747                     -> PackageDB
748                     -> Rebuild InstalledPackageIndex
749getPackageDBContents verbosity compiler progdb platform packagedb = do
750    monitorFiles . map monitorFileOrDirectory
751      =<< liftIO (IndexUtils.getInstalledPackagesMonitorFiles
752                    verbosity compiler
753                    [packagedb] progdb platform)
754    liftIO $ do
755      createPackageDBIfMissing verbosity compiler progdb packagedb
756      Cabal.getPackageDBContents verbosity compiler
757                                 packagedb progdb
758-}
759
760getSourcePackages :: Verbosity -> (forall a. (RepoContext -> IO a) -> IO a)
761                  -> Maybe IndexUtils.IndexState -> Rebuild SourcePackageDb
762getSourcePackages verbosity withRepoCtx idxState = do
763    (sourcePkgDb, repos) <-
764      liftIO $
765        withRepoCtx $ \repoctx -> do
766          sourcePkgDb <- IndexUtils.getSourcePackagesAtIndexState verbosity
767                                                                  repoctx idxState
768          return (sourcePkgDb, repoContextRepos repoctx)
769
770    mapM_ needIfExists
771        . IndexUtils.getSourcePackagesMonitorFiles
772        $ repos
773    return sourcePkgDb
774
775
776getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild PkgConfigDb
777getPkgConfigDb verbosity progdb = do
778    dirs <- liftIO $ getPkgConfigDbDirs verbosity progdb
779    -- Just monitor the dirs so we'll notice new .pc files.
780    -- Alternatively we could monitor all the .pc files too.
781    mapM_ monitorDirectoryStatus dirs
782    liftIO $ readPkgConfigDb verbosity progdb
783
784
785-- | Select the config values to monitor for changes package source hashes.
786packageLocationsSignature :: SolverInstallPlan
787                          -> [(PackageId, PackageLocation (Maybe FilePath))]
788packageLocationsSignature solverPlan =
789    [ (packageId pkg, packageSource pkg)
790    | SolverInstallPlan.Configured (SolverPackage { solverPkgSource = pkg})
791        <- SolverInstallPlan.toList solverPlan
792    ]
793
794
795-- | Get the 'HashValue' for all the source packages where we use hashes,
796-- and download any packages required to do so.
797--
798-- Note that we don't get hashes for local unpacked packages.
799--
800getPackageSourceHashes :: Verbosity
801                       -> (forall a. (RepoContext -> IO a) -> IO a)
802                       -> SolverInstallPlan
803                       -> Rebuild (Map PackageId PackageSourceHash)
804getPackageSourceHashes verbosity withRepoCtx solverPlan = do
805
806    -- Determine if and where to get the package's source hash from.
807    --
808    let allPkgLocations :: [(PackageId, PackageLocation (Maybe FilePath))]
809        allPkgLocations =
810          [ (packageId pkg, packageSource pkg)
811          | SolverInstallPlan.Configured (SolverPackage { solverPkgSource = pkg})
812              <- SolverInstallPlan.toList solverPlan ]
813
814        -- Tarballs that were local in the first place.
815        -- We'll hash these tarball files directly.
816        localTarballPkgs :: [(PackageId, FilePath)]
817        localTarballPkgs =
818          [ (pkgid, tarball)
819          | (pkgid, LocalTarballPackage tarball) <- allPkgLocations ]
820
821        -- Tarballs from remote URLs. We must have downloaded these already
822        -- (since we extracted the .cabal file earlier)
823        --TODO: [required eventually] finish remote tarball functionality
824--        allRemoteTarballPkgs =
825--          [ (pkgid, )
826--          | (pkgid, RemoteTarballPackage ) <- allPkgLocations ]
827
828        -- Tarballs from repositories, either where the repository provides
829        -- hashes as part of the repo metadata, or where we will have to
830        -- download and hash the tarball.
831        repoTarballPkgsWithMetadata    :: [(PackageId, Repo)]
832        repoTarballPkgsWithoutMetadata :: [(PackageId, Repo)]
833        (repoTarballPkgsWithMetadata,
834         repoTarballPkgsWithoutMetadata) =
835          partitionEithers
836          [ case repo of
837              RepoSecure{} -> Left  (pkgid, repo)
838              _            -> Right (pkgid, repo)
839          | (pkgid, RepoTarballPackage repo _ _) <- allPkgLocations ]
840
841    -- For tarballs from repos that do not have hashes available we now have
842    -- to check if the packages were downloaded already.
843    --
844    (repoTarballPkgsToDownload,
845     repoTarballPkgsDownloaded)
846      <- fmap partitionEithers $
847         liftIO $ sequence
848           [ do mtarball <- checkRepoTarballFetched repo pkgid
849                case mtarball of
850                  Nothing      -> return (Left  (pkgid, repo))
851                  Just tarball -> return (Right (pkgid, tarball))
852           | (pkgid, repo) <- repoTarballPkgsWithoutMetadata ]
853
854    (hashesFromRepoMetadata,
855     repoTarballPkgsNewlyDownloaded) <-
856      -- Avoid having to initialise the repository (ie 'withRepoCtx') if we
857      -- don't have to. (The main cost is configuring the http client.)
858      if null repoTarballPkgsToDownload && null repoTarballPkgsWithMetadata
859      then return (Map.empty, [])
860      else liftIO $ withRepoCtx $ \repoctx -> do
861
862      -- For tarballs from repos that do have hashes available as part of the
863      -- repo metadata we now load up the index for each repo and retrieve
864      -- the hashes for the packages
865      --
866      hashesFromRepoMetadata <-
867        Sec.uncheckClientErrors $ --TODO: [code cleanup] wrap in our own exceptions
868        fmap (Map.fromList . concat) $
869        sequence
870          -- Reading the repo index is expensive so we group the packages by repo
871          [ repoContextWithSecureRepo repoctx repo $ \secureRepo ->
872              Sec.withIndex secureRepo $ \repoIndex ->
873                sequence
874                  [ do hash <- Sec.trusted <$> -- strip off Trusted tag
875                               Sec.indexLookupHash repoIndex pkgid
876                       -- Note that hackage-security currently uses SHA256
877                       -- but this API could in principle give us some other
878                       -- choice in future.
879                       return (pkgid, hashFromTUF hash)
880                  | pkgid <- pkgids ]
881          | (repo, pkgids) <-
882                map (\grp@((_,repo):|_) -> (repo, map fst (NE.toList grp)))
883              . NE.groupBy ((==)    `on` (remoteRepoName . repoRemote . snd))
884              . sortBy  (compare `on` (remoteRepoName . repoRemote . snd))
885              $ repoTarballPkgsWithMetadata
886          ]
887
888      -- For tarballs from repos that do not have hashes available, download
889      -- the ones we previously determined we need.
890      --
891      repoTarballPkgsNewlyDownloaded <-
892        sequence
893          [ do tarball <- fetchRepoTarball verbosity repoctx repo pkgid
894               return (pkgid, tarball)
895          | (pkgid, repo) <- repoTarballPkgsToDownload ]
896
897      return (hashesFromRepoMetadata,
898              repoTarballPkgsNewlyDownloaded)
899
900    -- Hash tarball files for packages where we have to do that. This includes
901    -- tarballs that were local in the first place, plus tarballs from repos,
902    -- either previously cached or freshly downloaded.
903    --
904    let allTarballFilePkgs :: [(PackageId, FilePath)]
905        allTarballFilePkgs = localTarballPkgs
906                          ++ repoTarballPkgsDownloaded
907                          ++ repoTarballPkgsNewlyDownloaded
908    hashesFromTarballFiles <- liftIO $
909      fmap Map.fromList $
910      sequence
911        [ do srchash <- readFileHashValue tarball
912             return (pkgid, srchash)
913        | (pkgid, tarball) <- allTarballFilePkgs
914        ]
915    monitorFiles [ monitorFile tarball
916                 | (_pkgid, tarball) <- allTarballFilePkgs ]
917
918    -- Return the combination
919    return $! hashesFromRepoMetadata
920           <> hashesFromTarballFiles
921
922
923-- ------------------------------------------------------------
924-- * Installation planning
925-- ------------------------------------------------------------
926
927planPackages :: Verbosity
928             -> Compiler
929             -> Platform
930             -> Solver -> SolverSettings
931             -> InstalledPackageIndex
932             -> SourcePackageDb
933             -> PkgConfigDb
934             -> [PackageSpecifier UnresolvedSourcePackage]
935             -> Map PackageName (Map OptionalStanza Bool)
936             -> Progress String String SolverInstallPlan
937planPackages verbosity comp platform solver SolverSettings{..}
938             installedPkgIndex sourcePkgDb pkgConfigDB
939             localPackages pkgStanzasEnable =
940
941    resolveDependencies
942      platform (compilerInfo comp)
943      pkgConfigDB solver
944      resolverParams
945
946  where
947
948    --TODO: [nice to have] disable multiple instances restriction in
949    -- the solver, but then make sure we can cope with that in the
950    -- output.
951    resolverParams =
952
953        setMaxBackjumps solverSettingMaxBackjumps
954
955      . setIndependentGoals solverSettingIndependentGoals
956
957      . setReorderGoals solverSettingReorderGoals
958
959      . setCountConflicts solverSettingCountConflicts
960
961      . setFineGrainedConflicts solverSettingFineGrainedConflicts
962
963      . setMinimizeConflictSet solverSettingMinimizeConflictSet
964
965        --TODO: [required eventually] should only be configurable for
966        --custom installs
967   -- . setAvoidReinstalls solverSettingAvoidReinstalls
968
969        --TODO: [required eventually] should only be configurable for
970        --custom installs
971   -- . setShadowPkgs solverSettingShadowPkgs
972
973      . setStrongFlags solverSettingStrongFlags
974
975      . setAllowBootLibInstalls solverSettingAllowBootLibInstalls
976
977      . setOnlyConstrained solverSettingOnlyConstrained
978
979      . setSolverVerbosity verbosity
980
981        --TODO: [required eventually] decide if we need to prefer
982        -- installed for global packages, or prefer latest even for
983        -- global packages. Perhaps should be configurable but with a
984        -- different name than "upgrade-dependencies".
985      . setPreferenceDefault PreferLatestForSelected
986                           {-(if solverSettingUpgradeDeps
987                                then PreferAllLatest
988                                else PreferLatestForSelected)-}
989
990      . removeLowerBounds solverSettingAllowOlder
991      . removeUpperBounds solverSettingAllowNewer
992
993      . addDefaultSetupDependencies (defaultSetupDeps comp platform
994                                   . PD.packageDescription
995                                   . packageDescription)
996
997      . addSetupCabalMinVersionConstraint setupMinCabalVersionConstraint
998      . addSetupCabalMaxVersionConstraint setupMaxCabalVersionConstraint
999
1000      . addPreferences
1001          -- preferences from the config file or command line
1002          [ PackageVersionPreference name ver
1003          | PackageVersionConstraint name ver <- solverSettingPreferences ]
1004
1005      . addConstraints
1006          -- version constraints from the config file or command line
1007            [ LabeledPackageConstraint (userToPackageConstraint pc) src
1008            | (pc, src) <- solverSettingConstraints ]
1009
1010      . addPreferences
1011          -- enable stanza preference where the user did not specify
1012          [ PackageStanzasPreference pkgname stanzas
1013          | pkg <- localPackages
1014          , let pkgname = pkgSpecifierTarget pkg
1015                stanzaM = Map.findWithDefault Map.empty pkgname pkgStanzasEnable
1016                stanzas = [ stanza | stanza <- [minBound..maxBound]
1017                          , Map.lookup stanza stanzaM == Nothing ]
1018          , not (null stanzas)
1019          ]
1020
1021      . addConstraints
1022          -- enable stanza constraints where the user asked to enable
1023          [ LabeledPackageConstraint
1024              (PackageConstraint (scopeToplevel pkgname)
1025                                 (PackagePropertyStanzas stanzas))
1026              ConstraintSourceConfigFlagOrTarget
1027          | pkg <- localPackages
1028          , let pkgname = pkgSpecifierTarget pkg
1029                stanzaM = Map.findWithDefault Map.empty pkgname pkgStanzasEnable
1030                stanzas = [ stanza | stanza <- [minBound..maxBound]
1031                          , Map.lookup stanza stanzaM == Just True ]
1032          , not (null stanzas)
1033          ]
1034
1035      . addConstraints
1036          --TODO: [nice to have] should have checked at some point that the
1037          -- package in question actually has these flags.
1038          [ LabeledPackageConstraint
1039              (PackageConstraint (scopeToplevel pkgname)
1040                                 (PackagePropertyFlags flags))
1041              ConstraintSourceConfigFlagOrTarget
1042          | (pkgname, flags) <- Map.toList solverSettingFlagAssignments ]
1043
1044      . addConstraints
1045          --TODO: [nice to have] we have user-supplied flags for unspecified
1046          -- local packages (as well as specific per-package flags). For the
1047          -- former we just apply all these flags to all local targets which
1048          -- is silly. We should check if the flags are appropriate.
1049          [ LabeledPackageConstraint
1050              (PackageConstraint (scopeToplevel pkgname)
1051                                 (PackagePropertyFlags flags))
1052              ConstraintSourceConfigFlagOrTarget
1053          | let flags = solverSettingFlagAssignment
1054          , not (PD.nullFlagAssignment flags)
1055          , pkg <- localPackages
1056          , let pkgname = pkgSpecifierTarget pkg ]
1057
1058      $ stdResolverParams
1059
1060    stdResolverParams =
1061      -- Note: we don't use the standardInstallPolicy here, since that uses
1062      -- its own addDefaultSetupDependencies that is not appropriate for us.
1063      basicInstallPolicy
1064        installedPkgIndex sourcePkgDb
1065        localPackages
1066
1067    -- While we can talk to older Cabal versions (we need to be able to
1068    -- do so for custom Setup scripts that require older Cabal lib
1069    -- versions), we have problems talking to some older versions that
1070    -- don't support certain features.
1071    --
1072    -- For example, Cabal-1.16 and older do not know about build targets.
1073    -- Even worse, 1.18 and older only supported the --constraint flag
1074    -- with source package ids, not --dependency with installed package
1075    -- ids. That is bad because we cannot reliably select the right
1076    -- dependencies in the presence of multiple instances (i.e. the
1077    -- store). See issue #3932. So we require Cabal 1.20 as a minimum.
1078    --
1079    -- Moreover, lib:Cabal generally only supports the interface of
1080    -- current and past compilers; in fact recent lib:Cabal versions
1081    -- will warn when they encounter a too new or unknown GHC compiler
1082    -- version (c.f. #415). To avoid running into unsupported
1083    -- configurations we encode the compatibility matrix as lower
1084    -- bounds on lib:Cabal here (effectively corresponding to the
1085    -- respective major Cabal version bundled with the respective GHC
1086    -- release).
1087    --
1088    -- GHC 8.8   needs  Cabal >= 3.0
1089    -- GHC 8.6   needs  Cabal >= 2.4
1090    -- GHC 8.4   needs  Cabal >= 2.2
1091    -- GHC 8.2   needs  Cabal >= 2.0
1092    -- GHC 8.0   needs  Cabal >= 1.24
1093    -- GHC 7.10  needs  Cabal >= 1.22
1094    --
1095    -- (NB: we don't need to consider older GHCs as Cabal >= 1.20 is
1096    -- the absolute lower bound)
1097    --
1098    -- TODO: long-term, this compatibility matrix should be
1099    --       stored as a field inside 'Distribution.Compiler.Compiler'
1100    setupMinCabalVersionConstraint
1101      | isGHC, compVer >= mkVersion [8,10] = mkVersion [3,2]
1102      | isGHC, compVer >= mkVersion [8,8]  = mkVersion [3,0]
1103      | isGHC, compVer >= mkVersion [8,6]  = mkVersion [2,4]
1104      | isGHC, compVer >= mkVersion [8,4]  = mkVersion [2,2]
1105      | isGHC, compVer >= mkVersion [8,2]  = mkVersion [2,0]
1106      | isGHC, compVer >= mkVersion [8,0]  = mkVersion [1,24]
1107      | isGHC, compVer >= mkVersion [7,10] = mkVersion [1,22]
1108      | otherwise                          = mkVersion [1,20]
1109      where
1110        isGHC    = compFlav `elem` [GHC,GHCJS]
1111        compFlav = compilerFlavor comp
1112        compVer  = compilerVersion comp
1113
1114    -- As we can't predict the future, we also place a global upper
1115    -- bound on the lib:Cabal version we know how to interact with:
1116    --
1117    -- The upper bound is computed by incrementing the current major
1118    -- version twice in order to allow for the current version, as
1119    -- well as the next adjacent major version (one of which will not
1120    -- be released, as only "even major" versions of Cabal are
1121    -- released to Hackage or bundled with proper GHC releases).
1122    --
1123    -- For instance, if the current version of cabal-install is an odd
1124    -- development version, e.g.  Cabal-2.1.0.0, then we impose an
1125    -- upper bound `setup.Cabal < 2.3`; if `cabal-install` is on a
1126    -- stable/release even version, e.g. Cabal-2.2.1.0, the upper
1127    -- bound is `setup.Cabal < 2.4`. This gives us enough flexibility
1128    -- when dealing with development snapshots of Cabal and cabal-install.
1129    --
1130    setupMaxCabalVersionConstraint =
1131      alterVersion (take 2) $ incVersion 1 $ incVersion 1 cabalVersion
1132
1133------------------------------------------------------------------------------
1134-- * Install plan post-processing
1135------------------------------------------------------------------------------
1136
1137-- This phase goes from the InstallPlan we get from the solver and has to
1138-- make an elaborated install plan.
1139--
1140-- We go in two steps:
1141--
1142--  1. elaborate all the source packages that the solver has chosen.
1143--  2. swap source packages for pre-existing installed packages wherever
1144--     possible.
1145--
1146-- We do it in this order, elaborating and then replacing, because the easiest
1147-- way to calculate the installed package ids used for the replacement step is
1148-- from the elaborated configuration for each package.
1149
1150
1151
1152
1153------------------------------------------------------------------------------
1154-- * Install plan elaboration
1155------------------------------------------------------------------------------
1156
1157-- Note [SolverId to ConfiguredId]
1158-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1159-- Dependency solving is a per package affair, so after we're done, we
1160-- end up with 'SolverInstallPlan' that records in 'solverPkgLibDeps'
1161-- and 'solverPkgExeDeps' what packages provide the libraries and executables
1162-- needed by each component of the package (phew!)  For example, if I have
1163--
1164--      library
1165--          build-depends: lib
1166--          build-tool-depends: pkg:exe1
1167--          build-tools: alex
1168--
1169-- After dependency solving, I find out that this library component has
1170-- library dependencies on lib-0.2, and executable dependencies on pkg-0.1
1171-- and alex-0.3 (other components of the package may have different
1172-- dependencies).  Note that I've "lost" the knowledge that I depend
1173-- *specifically* on the exe1 executable from pkg.
1174--
1175-- So, we have a this graph of packages, and we need to transform it into
1176-- a graph of components which we are actually going to build.  In particular:
1177--
1178-- NODE changes from PACKAGE (SolverPackage) to COMPONENTS (ElaboratedConfiguredPackage)
1179-- EDGE changes from PACKAGE DEP (SolverId) to COMPONENT DEPS (ConfiguredId)
1180--
1181-- In both cases, what was previously a single node/edge may turn into multiple
1182-- nodes/edges.  Multiple components, because there may be multiple components
1183-- in a package; multiple component deps, because we may depend upon multiple
1184-- executables from the same package (and maybe, some day, multiple libraries
1185-- from the same package.)
1186--
1187-- Let's talk about how to do this transformation. Naively, we might consider
1188-- just processing each package, converting it into (zero or) one or more
1189-- components.  But we also have to update the edges; this leads to
1190-- two complications:
1191--
1192--      1. We don't know what the ConfiguredId of a component is until
1193--      we've configured it, but we cannot configure a component unless
1194--      we know the ConfiguredId of all its dependencies.  Thus, we must
1195--      process the 'SolverInstallPlan' in topological order.
1196--
1197--      2. When we process a package, we know the SolverIds of its
1198--      dependencies, but we have to do some work to turn these into
1199--      ConfiguredIds.  For example, in the case of build-tool-depends, the
1200--      SolverId isn't enough to uniquely determine the ConfiguredId we should
1201--      elaborate to: we have to look at the executable name attached to
1202--      the package name in the package description to figure it out.
1203--      At the same time, we NEED to use the SolverId, because there might
1204--      be multiple versions of the same package in the build plan
1205--      (due to setup dependencies); we can't just look up the package name
1206--      from the package description.
1207--
1208-- We can adopt the following strategy:
1209--
1210--      * When a package is transformed into components, record
1211--        a mapping from SolverId to ALL of the components
1212--        which were elaborated.
1213--
1214--      * When we look up an edge, we use our knowledge of the
1215--        component name to *filter* the list of components into
1216--        the ones we actually wanted to refer to.
1217--
1218-- By the way, we can tell that SolverInstallPlan is not the "right" type
1219-- because a SolverId cannot adequately represent all possible dependency
1220-- solver states: we may need to record foo-0.1 multiple times in
1221-- the solver install plan with different dependencies.  This imprecision in the
1222-- type currently doesn't cause any problems because the dependency solver
1223-- continues to enforce the single instance restriction regardless of compiler
1224-- version.  The right way to solve this is to come up with something very much
1225-- like a 'ConfiguredId', in that it incorporates the version choices of its
1226-- dependencies, but less fine grained.
1227
1228
1229-- | Produce an elaborated install plan using the policy for local builds with
1230-- a nix-style shared store.
1231--
1232-- In theory should be able to make an elaborated install plan with a policy
1233-- matching that of the classic @cabal install --user@ or @--global@
1234--
1235elaborateInstallPlan
1236  :: Verbosity -> Platform -> Compiler -> ProgramDb -> PkgConfigDb
1237  -> DistDirLayout
1238  -> StoreDirLayout
1239  -> SolverInstallPlan
1240  -> [PackageSpecifier (SourcePackage (PackageLocation loc))]
1241  -> Map PackageId PackageSourceHash
1242  -> InstallDirs.InstallDirTemplates
1243  -> ProjectConfigShared
1244  -> PackageConfig
1245  -> PackageConfig
1246  -> Map PackageName PackageConfig
1247  -> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
1248elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
1249                     distDirLayout@DistDirLayout{..}
1250                     storeDirLayout@StoreDirLayout{storePackageDBStack}
1251                     solverPlan localPackages
1252                     sourcePackageHashes
1253                     defaultInstallDirs
1254                     sharedPackageConfig
1255                     allPackagesConfig
1256                     localPackagesConfig
1257                     perPackageConfig = do
1258    x <- elaboratedInstallPlan
1259    return (x, elaboratedSharedConfig)
1260  where
1261    elaboratedSharedConfig =
1262      ElaboratedSharedConfig {
1263        pkgConfigPlatform      = platform,
1264        pkgConfigCompiler      = compiler,
1265        pkgConfigCompilerProgs = compilerprogdb,
1266        pkgConfigReplOptions   = []
1267      }
1268
1269    preexistingInstantiatedPkgs =
1270        Map.fromList (mapMaybe f (SolverInstallPlan.toList solverPlan))
1271      where
1272        f (SolverInstallPlan.PreExisting inst)
1273            | let ipkg = instSolverPkgIPI inst
1274            , not (IPI.indefinite ipkg)
1275            = Just (IPI.installedUnitId ipkg,
1276                     (FullUnitId (IPI.installedComponentId ipkg)
1277                                 (Map.fromList (IPI.instantiatedWith ipkg))))
1278        f _ = Nothing
1279
1280    elaboratedInstallPlan =
1281      flip InstallPlan.fromSolverInstallPlanWithProgress solverPlan $ \mapDep planpkg ->
1282        case planpkg of
1283          SolverInstallPlan.PreExisting pkg ->
1284            return [InstallPlan.PreExisting (instSolverPkgIPI pkg)]
1285
1286          SolverInstallPlan.Configured  pkg ->
1287            let inplace_doc | shouldBuildInplaceOnly pkg = text "inplace"
1288                            | otherwise                  = Disp.empty
1289            in addProgressCtx (text "In the" <+> inplace_doc <+> text "package" <+>
1290                             quotes (disp (packageId pkg))) $
1291               map InstallPlan.Configured <$> elaborateSolverToComponents mapDep pkg
1292
1293    -- NB: We don't INSTANTIATE packages at this point.  That's
1294    -- a post-pass.  This makes it simpler to compute dependencies.
1295    elaborateSolverToComponents
1296        :: (SolverId -> [ElaboratedPlanPackage])
1297        -> SolverPackage UnresolvedPkgLoc
1298        -> LogProgress [ElaboratedConfiguredPackage]
1299    elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0 exe_deps0)
1300        = case mkComponentsGraph (elabEnabledSpec elab0) pd of
1301           Right g -> do
1302            let src_comps = componentsGraphToList g
1303            infoProgress $ hang (text "Component graph for" <+> disp pkgid <<>> colon)
1304                            4 (dispComponentsWithDeps src_comps)
1305            (_, comps) <- mapAccumM buildComponent
1306                            (Map.empty, Map.empty, Map.empty)
1307                            (map fst src_comps)
1308            let not_per_component_reasons = why_not_per_component src_comps
1309            if null not_per_component_reasons
1310                then return comps
1311                else do checkPerPackageOk comps not_per_component_reasons
1312                        return [elaborateSolverToPackage spkg g $
1313                                comps ++ maybeToList setupComponent]
1314           Left cns ->
1315            dieProgress $
1316                hang (text "Dependency cycle between the following components:") 4
1317                     (vcat (map (text . componentNameStanza) cns))
1318      where
1319        -- You are eligible to per-component build if this list is empty
1320        why_not_per_component g
1321            = cuz_buildtype ++ cuz_spec ++ cuz_length ++ cuz_flag ++ cuz_coverage
1322          where
1323            cuz reason = [text reason]
1324            -- We have to disable per-component for now with
1325            -- Configure-type scripts in order to prevent parallel
1326            -- invocation of the same `./configure` script.
1327            -- See https://github.com/haskell/cabal/issues/4548
1328            --
1329            -- Moreoever, at this point in time, only non-Custom setup scripts
1330            -- are supported.  Implementing per-component builds with
1331            -- Custom would require us to create a new 'ElabSetup'
1332            -- type, and teach all of the code paths how to handle it.
1333            -- Once you've implemented this, swap it for the code below.
1334            cuz_buildtype =
1335                case PD.buildType (elabPkgDescription elab0) of
1336                    PD.Configure -> cuz "build-type is Configure"
1337                    PD.Custom -> cuz "build-type is Custom"
1338                    _         -> []
1339            -- cabal-format versions prior to 1.8 have different build-depends semantics
1340            -- for now it's easier to just fallback to legacy-mode when specVersion < 1.8
1341            -- see, https://github.com/haskell/cabal/issues/4121
1342            cuz_spec
1343                | PD.specVersion pd >= mkVersion [1,8] = []
1344                | otherwise = cuz "cabal-version is less than 1.8"
1345            -- In the odd corner case that a package has no components at all
1346            -- then keep it as a whole package, since otherwise it turns into
1347            -- 0 component graph nodes and effectively vanishes. We want to
1348            -- keep it around at least for error reporting purposes.
1349            cuz_length
1350                | length g > 0 = []
1351                | otherwise    = cuz "there are no buildable components"
1352            -- For ease of testing, we let per-component builds be toggled
1353            -- at the top level
1354            cuz_flag
1355                | fromFlagOrDefault True (projectConfigPerComponent sharedPackageConfig)
1356                = []
1357                | otherwise = cuz "you passed --disable-per-component"
1358            -- Enabling program coverage introduces odd runtime dependencies
1359            -- between components.
1360            cuz_coverage
1361                | fromFlagOrDefault False (packageConfigCoverage localPackagesConfig)
1362                = cuz "program coverage is enabled"
1363                | otherwise = []
1364
1365        -- | Sometimes a package may make use of features which are only
1366        -- supported in per-package mode.  If this is the case, we should
1367        -- give an error when this occurs.
1368        checkPerPackageOk comps reasons = do
1369            let is_sublib (CLibName (LSubLibName _)) = True
1370                is_sublib _ = False
1371            when (any (matchElabPkg is_sublib) comps) $
1372                dieProgress $
1373                    text "Internal libraries only supported with per-component builds." $$
1374                    text "Per-component builds were disabled because" <+>
1375                        fsep (punctuate comma reasons)
1376            -- TODO: Maybe exclude Backpack too
1377
1378        elab0 = elaborateSolverToCommon spkg
1379        pkgid = elabPkgSourceId    elab0
1380        pd    = elabPkgDescription elab0
1381
1382        -- TODO: This is just a skeleton to get elaborateSolverToPackage
1383        -- working correctly
1384        -- TODO: When we actually support building these components, we
1385        -- have to add dependencies on this from all other components
1386        setupComponent :: Maybe ElaboratedConfiguredPackage
1387        setupComponent
1388            | PD.buildType (elabPkgDescription elab0) == PD.Custom
1389            = Just elab0 {
1390                elabModuleShape = emptyModuleShape,
1391                elabUnitId = notImpl "elabUnitId",
1392                elabComponentId = notImpl "elabComponentId",
1393                elabLinkedInstantiatedWith = Map.empty,
1394                elabInstallDirs = notImpl "elabInstallDirs",
1395                elabPkgOrComp = ElabComponent (ElaboratedComponent {..})
1396              }
1397            | otherwise
1398            = Nothing
1399          where
1400            compSolverName      = CD.ComponentSetup
1401            compComponentName   = Nothing
1402            dep_pkgs = elaborateLibSolverId mapDep =<< CD.setupDeps deps0
1403            compLibDependencies
1404                = map configuredId dep_pkgs
1405            compLinkedLibDependencies = notImpl "compLinkedLibDependencies"
1406            compOrderLibDependencies = notImpl "compOrderLibDependencies"
1407            -- Not supported:
1408            compExeDependencies         = []
1409            compExeDependencyPaths      = []
1410            compPkgConfigDependencies   = []
1411
1412            notImpl f =
1413                error $ "Distribution.Client.ProjectPlanning.setupComponent: " ++
1414                        f ++ " not implemented yet"
1415
1416
1417        buildComponent
1418            :: (ConfiguredComponentMap,
1419                LinkedComponentMap,
1420                Map ComponentId FilePath)
1421            -> Cabal.Component
1422            -> LogProgress
1423                ((ConfiguredComponentMap,
1424                  LinkedComponentMap,
1425                  Map ComponentId FilePath),
1426                ElaboratedConfiguredPackage)
1427        buildComponent (cc_map, lc_map, exe_map) comp =
1428          addProgressCtx (text "In the stanza" <+>
1429                          quotes (text (componentNameStanza cname))) $ do
1430
1431            -- 1. Configure the component, but with a place holder ComponentId.
1432            cc0 <- toConfiguredComponent
1433                    pd
1434                    (error "Distribution.Client.ProjectPlanning.cc_cid: filled in later")
1435                    (Map.unionWith Map.union external_lib_cc_map cc_map)
1436                    (Map.unionWith Map.union external_exe_cc_map cc_map)
1437                    comp
1438
1439
1440            -- 2. Read out the dependencies from the ConfiguredComponent cc0
1441            let compLibDependencies =
1442                    -- Nub because includes can show up multiple times
1443                    ordNub (map (annotatedIdToConfiguredId . ci_ann_id)
1444                                (cc_includes cc0))
1445                compExeDependencies =
1446                    map annotatedIdToConfiguredId
1447                        (cc_exe_deps cc0)
1448                compExeDependencyPaths =
1449                    [ (annotatedIdToConfiguredId aid', path)
1450                    | aid' <- cc_exe_deps cc0
1451                    , Just paths <- [Map.lookup (ann_id aid') exe_map1]
1452                    , path <- paths ]
1453                elab_comp = ElaboratedComponent {..}
1454
1455            -- 3. Construct a preliminary ElaboratedConfiguredPackage,
1456            -- and use this to compute the component ID.  Fix up cc_id
1457            -- correctly.
1458            let elab1 = elab0 {
1459                        elabPkgOrComp = ElabComponent $ elab_comp
1460                     }
1461                cid = case elabBuildStyle elab0 of
1462                        BuildInplaceOnly ->
1463                          mkComponentId $
1464                            display pkgid ++ "-inplace" ++
1465                              (case Cabal.componentNameString cname of
1466                                  Nothing -> ""
1467                                  Just s -> "-" ++ display s)
1468                        BuildAndInstall ->
1469                          hashedInstalledPackageId
1470                            (packageHashInputs
1471                                elaboratedSharedConfig
1472                                elab1) -- knot tied
1473                cc = cc0 { cc_ann_id = fmap (const cid) (cc_ann_id cc0) }
1474            infoProgress $ dispConfiguredComponent cc
1475
1476            -- 4. Perform mix-in linking
1477            let lookup_uid def_uid =
1478                    case Map.lookup (unDefUnitId def_uid) preexistingInstantiatedPkgs of
1479                        Just full -> full
1480                        Nothing -> error ("lookup_uid: " ++ display def_uid)
1481            lc <- toLinkedComponent verbosity lookup_uid (elabPkgSourceId elab0)
1482                        (Map.union external_lc_map lc_map) cc
1483            infoProgress $ dispLinkedComponent lc
1484            -- NB: elab is setup to be the correct form for an
1485            -- indefinite library, or a definite library with no holes.
1486            -- We will modify it in 'instantiateInstallPlan' to handle
1487            -- instantiated packages.
1488
1489            -- 5. Construct the final ElaboratedConfiguredPackage
1490            let
1491                elab2 = elab1 {
1492                    elabModuleShape = lc_shape lc,
1493                    elabUnitId      = abstractUnitId (lc_uid lc),
1494                    elabComponentId = lc_cid lc,
1495                    elabLinkedInstantiatedWith = Map.fromList (lc_insts lc),
1496                    elabPkgOrComp = ElabComponent $ elab_comp {
1497                        compLinkedLibDependencies = ordNub (map ci_id (lc_includes lc)),
1498                        compOrderLibDependencies =
1499                          ordNub (map (abstractUnitId . ci_id)
1500                                      (lc_includes lc ++ lc_sig_includes lc))
1501                      }
1502                   }
1503                elab = elab2 {
1504                    elabInstallDirs = computeInstallDirs
1505                      storeDirLayout
1506                      defaultInstallDirs
1507                      elaboratedSharedConfig
1508                      elab2
1509                   }
1510
1511            -- 6. Construct the updated local maps
1512            let cc_map'  = extendConfiguredComponentMap cc cc_map
1513                lc_map'  = extendLinkedComponentMap lc lc_map
1514                exe_map' = Map.insert cid (inplace_bin_dir elab) exe_map
1515
1516            return ((cc_map', lc_map', exe_map'), elab)
1517          where
1518            compLinkedLibDependencies = error "buildComponent: compLinkedLibDependencies"
1519            compOrderLibDependencies = error "buildComponent: compOrderLibDependencies"
1520
1521            cname = Cabal.componentName comp
1522            compComponentName = Just cname
1523            compSolverName = CD.componentNameToComponent cname
1524
1525            -- NB: compLinkedLibDependencies and
1526            -- compOrderLibDependencies are defined when we define
1527            -- 'elab'.
1528            external_lib_dep_sids = CD.select (== compSolverName) deps0
1529            external_exe_dep_sids = CD.select (== compSolverName) exe_deps0
1530
1531            external_lib_dep_pkgs = concatMap mapDep external_lib_dep_sids
1532
1533            -- Combine library and build-tool dependencies, for backwards
1534            -- compatibility (See issue #5412 and the documentation for
1535            -- InstallPlan.fromSolverInstallPlan), but prefer the versions
1536            -- specified as build-tools.
1537            external_exe_dep_pkgs =
1538                concatMap mapDep $
1539                ordNubBy (pkgName . packageId) $
1540                external_exe_dep_sids ++ external_lib_dep_sids
1541
1542            external_exe_map = Map.fromList $
1543                [ (getComponentId pkg, paths)
1544                | pkg <- external_exe_dep_pkgs
1545                , let paths = planPackageExePaths pkg ]
1546            exe_map1 = Map.union external_exe_map $ fmap (\x -> [x]) exe_map
1547
1548            external_lib_cc_map = Map.fromListWith Map.union
1549                                $ map mkCCMapping external_lib_dep_pkgs
1550            external_exe_cc_map = Map.fromListWith Map.union
1551                                $ map mkCCMapping external_exe_dep_pkgs
1552            external_lc_map =
1553                Map.fromList $ map mkShapeMapping $
1554                external_lib_dep_pkgs ++ concatMap mapDep external_exe_dep_sids
1555
1556            compPkgConfigDependencies =
1557                [ (pn, fromMaybe (error $ "compPkgConfigDependencies: impossible! "
1558                                            ++ display pn ++ " from "
1559                                            ++ display (elabPkgSourceId elab0))
1560                                 (pkgConfigDbPkgVersion pkgConfigDB pn))
1561                | PkgconfigDependency pn _ <- PD.pkgconfigDepends
1562                                                (Cabal.componentBuildInfo comp) ]
1563
1564            inplace_bin_dir elab =
1565                binDirectoryFor
1566                    distDirLayout
1567                    elaboratedSharedConfig
1568                    elab $
1569                    case Cabal.componentNameString cname of
1570                             Just n -> display n
1571                             Nothing -> ""
1572
1573
1574    -- | Given a 'SolverId' referencing a dependency on a library, return
1575    -- the 'ElaboratedPlanPackage' corresponding to the library.  This
1576    -- returns at most one result.
1577    elaborateLibSolverId :: (SolverId -> [ElaboratedPlanPackage])
1578                         -> SolverId -> [ElaboratedPlanPackage]
1579    elaborateLibSolverId mapDep = filter (matchPlanPkg (== (CLibName LMainLibName))) . mapDep
1580
1581    -- | Given an 'ElaboratedPlanPackage', return the paths to where the
1582    -- executables that this package represents would be installed.
1583    -- The only case where multiple paths can be returned is the inplace
1584    -- monolithic package one, since there can be multiple exes and each one
1585    -- has its own directory.
1586    planPackageExePaths :: ElaboratedPlanPackage -> [FilePath]
1587    planPackageExePaths =
1588        -- Pre-existing executables are assumed to be in PATH
1589        -- already.  In fact, this should be impossible.
1590        InstallPlan.foldPlanPackage (const []) $ \elab ->
1591            let
1592              executables :: [FilePath]
1593              executables =
1594                case elabPkgOrComp elab of
1595                    -- Monolithic mode: all exes of the package
1596                    ElabPackage _ -> unUnqualComponentName . PD.exeName
1597                                 <$> PD.executables (elabPkgDescription elab)
1598                    -- Per-component mode: just the selected exe
1599                    ElabComponent comp ->
1600                        case fmap Cabal.componentNameString
1601                                  (compComponentName comp) of
1602                            Just (Just n) -> [display n]
1603                            _ -> [""]
1604            in
1605              binDirectoryFor
1606                 distDirLayout
1607                 elaboratedSharedConfig
1608                 elab
1609                 <$> executables
1610
1611    elaborateSolverToPackage :: SolverPackage UnresolvedPkgLoc
1612                             -> ComponentsGraph
1613                             -> [ElaboratedConfiguredPackage]
1614                             -> ElaboratedConfiguredPackage
1615    elaborateSolverToPackage
1616        pkg@(SolverPackage (SourcePackage pkgid _gdesc _srcloc _descOverride)
1617                           _flags _stanzas _deps0 _exe_deps0)
1618        compGraph comps =
1619        -- Knot tying: the final elab includes the
1620        -- pkgInstalledId, which is calculated by hashing many
1621        -- of the other fields of the elaboratedPackage.
1622        elab
1623      where
1624        elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon pkg
1625        elab1 = elab0 {
1626                elabUnitId = newSimpleUnitId pkgInstalledId,
1627                elabComponentId = pkgInstalledId,
1628                elabLinkedInstantiatedWith = Map.empty,
1629                elabPkgOrComp = ElabPackage $ ElaboratedPackage {..},
1630                elabModuleShape = modShape
1631            }
1632        elab = elab1 {
1633                elabInstallDirs =
1634                  computeInstallDirs storeDirLayout
1635                                     defaultInstallDirs
1636                                     elaboratedSharedConfig
1637                                     elab1
1638            }
1639
1640        modShape = case find (matchElabPkg (== (CLibName LMainLibName))) comps of
1641                        Nothing -> emptyModuleShape
1642                        Just e -> Ty.elabModuleShape e
1643
1644        pkgInstalledId
1645          | shouldBuildInplaceOnly pkg
1646          = mkComponentId (display pkgid ++ "-inplace")
1647
1648          | otherwise
1649          = assert (isJust elabPkgSourceHash) $
1650            hashedInstalledPackageId
1651              (packageHashInputs
1652                elaboratedSharedConfig
1653                elab)  -- recursive use of elab
1654
1655          | otherwise
1656          = error $ "elaborateInstallPlan: non-inplace package "
1657                 ++ " is missing a source hash: " ++ display pkgid
1658
1659        -- Need to filter out internal dependencies, because they don't
1660        -- correspond to anything real anymore.
1661        isExt confid = confSrcId confid /= pkgid
1662        filterExt  = filter isExt
1663        filterExt' = filter (isExt . fst)
1664
1665        pkgLibDependencies
1666            = buildComponentDeps (filterExt  . compLibDependencies)
1667        pkgExeDependencies
1668            = buildComponentDeps (filterExt  . compExeDependencies)
1669        pkgExeDependencyPaths
1670            = buildComponentDeps (filterExt' . compExeDependencyPaths)
1671        -- TODO: Why is this flat?
1672        pkgPkgConfigDependencies
1673            = CD.flatDeps $ buildComponentDeps compPkgConfigDependencies
1674
1675        pkgDependsOnSelfLib
1676            = CD.fromList [ (CD.componentNameToComponent cn, [()])
1677                          | Graph.N _ cn _ <- fromMaybe [] mb_closure ]
1678          where
1679            mb_closure = Graph.revClosure compGraph [ k | k <- Graph.keys compGraph, is_lib k ]
1680            -- NB: the sublib case should not occur, because sub-libraries
1681            -- are not supported without per-component builds
1682            is_lib (CLibName _) = True
1683            is_lib _ = False
1684
1685        buildComponentDeps f
1686            = CD.fromList [ (compSolverName comp, f comp)
1687                          | ElaboratedConfiguredPackage{
1688                                elabPkgOrComp = ElabComponent comp
1689                            } <- comps
1690                          ]
1691
1692        -- NB: This is not the final setting of 'pkgStanzasEnabled'.
1693        -- See [Sticky enabled testsuites]; we may enable some extra
1694        -- stanzas opportunistically when it is cheap to do so.
1695        --
1696        -- However, we start off by enabling everything that was
1697        -- requested, so that we can maintain an invariant that
1698        -- pkgStanzasEnabled is a superset of elabStanzasRequested
1699        pkgStanzasEnabled  = Map.keysSet (Map.filter (id :: Bool -> Bool) elabStanzasRequested)
1700
1701    elaborateSolverToCommon :: SolverPackage UnresolvedPkgLoc
1702                            -> ElaboratedConfiguredPackage
1703    elaborateSolverToCommon
1704        pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride)
1705                           flags stanzas deps0 _exe_deps0) =
1706        elaboratedPackage
1707      where
1708        elaboratedPackage = ElaboratedConfiguredPackage {..}
1709
1710        -- These get filled in later
1711        elabUnitId          = error "elaborateSolverToCommon: elabUnitId"
1712        elabComponentId     = error "elaborateSolverToCommon: elabComponentId"
1713        elabInstantiatedWith = Map.empty
1714        elabLinkedInstantiatedWith = error "elaborateSolverToCommon: elabLinkedInstantiatedWith"
1715        elabPkgOrComp       = error "elaborateSolverToCommon: elabPkgOrComp"
1716        elabInstallDirs     = error "elaborateSolverToCommon: elabInstallDirs"
1717        elabModuleShape     = error "elaborateSolverToCommon: elabModuleShape"
1718
1719        elabIsCanonical     = True
1720        elabPkgSourceId     = pkgid
1721        elabPkgDescription  = case PD.finalizePD
1722                                    flags elabEnabledSpec (const True)
1723                                    platform (compilerInfo compiler)
1724                                    [] gdesc of
1725                               Right (desc, _) -> desc
1726                               Left _          -> error "Failed to finalizePD in elaborateSolverToCommon"
1727        elabFlagAssignment  = flags
1728        elabFlagDefaults    = PD.mkFlagAssignment
1729                              [ (Cabal.flagName flag, Cabal.flagDefault flag)
1730                              | flag <- PD.genPackageFlags gdesc ]
1731
1732        elabEnabledSpec      = enableStanzas stanzas
1733        elabStanzasAvailable = Set.fromList stanzas
1734        elabStanzasRequested =
1735            -- NB: even if a package stanza is requested, if the package
1736            -- doesn't actually have any of that stanza we omit it from
1737            -- the request, to ensure that we don't decide that this
1738            -- package needs to be rebuilt.  (It needs to be done here,
1739            -- because the ElaboratedConfiguredPackage is where we test
1740            -- whether or not there have been changes.)
1741            Map.fromList $ [ (TestStanzas,  v) | v <- maybeToList tests
1742                                               , _ <- PD.testSuites elabPkgDescription ]
1743                        ++ [ (BenchStanzas, v) | v <- maybeToList benchmarks
1744                                               , _ <- PD.benchmarks elabPkgDescription ]
1745          where
1746            tests, benchmarks :: Maybe Bool
1747            tests      = perPkgOptionMaybe pkgid packageConfigTests
1748            benchmarks = perPkgOptionMaybe pkgid packageConfigBenchmarks
1749
1750        -- This is a placeholder which will get updated by 'pruneInstallPlanPass1'
1751        -- and 'pruneInstallPlanPass2'.  We can't populate it here
1752        -- because whether or not tests/benchmarks should be enabled
1753        -- is heuristically calculated based on whether or not the
1754        -- dependencies of the test suite have already been installed,
1755        -- but this function doesn't know what is installed (since
1756        -- we haven't improved the plan yet), so we do it in another pass.
1757        -- Check the comments of those functions for more details.
1758        elabConfigureTargets = []
1759        elabBuildTargets    = []
1760        elabTestTargets     = []
1761        elabBenchTargets    = []
1762        elabReplTarget      = Nothing
1763        elabHaddockTargets  = []
1764
1765        elabBuildHaddocks   =
1766          perPkgOptionFlag pkgid False packageConfigDocumentation
1767
1768        elabPkgSourceLocation = srcloc
1769        elabPkgSourceHash   = Map.lookup pkgid sourcePackageHashes
1770        elabLocalToProject  = isLocalToProject pkg
1771        elabBuildStyle      = if shouldBuildInplaceOnly pkg
1772                                then BuildInplaceOnly else BuildAndInstall
1773        elabBuildPackageDBStack    = buildAndRegisterDbs
1774        elabRegisterPackageDBStack = buildAndRegisterDbs
1775
1776        elabSetupScriptStyle       = packageSetupScriptStyle elabPkgDescription
1777        elabSetupScriptCliVersion  =
1778          packageSetupScriptSpecVersion
1779          elabSetupScriptStyle elabPkgDescription libDepGraph deps0
1780        elabSetupPackageDBStack    = buildAndRegisterDbs
1781
1782        buildAndRegisterDbs
1783          | shouldBuildInplaceOnly pkg = inplacePackageDbs
1784          | otherwise                  = storePackageDbs
1785
1786        elabPkgDescriptionOverride = descOverride
1787
1788        elabVanillaLib    = perPkgOptionFlag pkgid True packageConfigVanillaLib --TODO: [required feature]: also needs to be handled recursively
1789        elabSharedLib     = pkgid `Set.member` pkgsUseSharedLibrary
1790        elabStaticLib     = perPkgOptionFlag pkgid False packageConfigStaticLib
1791        elabDynExe        = perPkgOptionFlag pkgid False packageConfigDynExe
1792        elabFullyStaticExe = perPkgOptionFlag pkgid False packageConfigFullyStaticExe
1793        elabGHCiLib       = perPkgOptionFlag pkgid False packageConfigGHCiLib --TODO: [required feature] needs to default to enabled on windows still
1794
1795        elabProfExe       = perPkgOptionFlag pkgid False packageConfigProf
1796        elabProfLib       = pkgid `Set.member` pkgsUseProfilingLibrary
1797
1798        (elabProfExeDetail,
1799         elabProfLibDetail) = perPkgOptionLibExeFlag pkgid ProfDetailDefault
1800                               packageConfigProfDetail
1801                               packageConfigProfLibDetail
1802        elabCoverage      = perPkgOptionFlag pkgid False packageConfigCoverage
1803
1804        elabOptimization  = perPkgOptionFlag pkgid NormalOptimisation packageConfigOptimization
1805        elabSplitObjs     = perPkgOptionFlag pkgid False packageConfigSplitObjs
1806        elabSplitSections = perPkgOptionFlag pkgid False packageConfigSplitSections
1807        elabStripLibs     = perPkgOptionFlag pkgid False packageConfigStripLibs
1808        elabStripExes     = perPkgOptionFlag pkgid False packageConfigStripExes
1809        elabDebugInfo     = perPkgOptionFlag pkgid NoDebugInfo packageConfigDebugInfo
1810
1811        -- Combine the configured compiler prog settings with the user-supplied
1812        -- config. For the compiler progs any user-supplied config was taken
1813        -- into account earlier when configuring the compiler so its ok that
1814        -- our configured settings for the compiler override the user-supplied
1815        -- config here.
1816        elabProgramPaths  = Map.fromList
1817                             [ (programId prog, programPath prog)
1818                             | prog <- configuredPrograms compilerprogdb ]
1819                        <> perPkgOptionMapLast pkgid packageConfigProgramPaths
1820        elabProgramArgs   = Map.fromList
1821                             [ (programId prog, args)
1822                             | prog <- configuredPrograms compilerprogdb
1823                             , let args = programOverrideArgs prog
1824                             , not (null args)
1825                             ]
1826                        <> perPkgOptionMapMappend pkgid packageConfigProgramArgs
1827        elabProgramPathExtra    = perPkgOptionNubList pkgid packageConfigProgramPathExtra
1828        elabConfigureScriptArgs = perPkgOptionList pkgid packageConfigConfigureArgs
1829        elabExtraLibDirs        = perPkgOptionList pkgid packageConfigExtraLibDirs
1830        elabExtraFrameworkDirs  = perPkgOptionList pkgid packageConfigExtraFrameworkDirs
1831        elabExtraIncludeDirs    = perPkgOptionList pkgid packageConfigExtraIncludeDirs
1832        elabProgPrefix          = perPkgOptionMaybe pkgid packageConfigProgPrefix
1833        elabProgSuffix          = perPkgOptionMaybe pkgid packageConfigProgSuffix
1834
1835
1836        elabHaddockHoogle       = perPkgOptionFlag pkgid False packageConfigHaddockHoogle
1837        elabHaddockHtml         = perPkgOptionFlag pkgid False packageConfigHaddockHtml
1838        elabHaddockHtmlLocation = perPkgOptionMaybe pkgid packageConfigHaddockHtmlLocation
1839        elabHaddockForeignLibs  = perPkgOptionFlag pkgid False packageConfigHaddockForeignLibs
1840        elabHaddockForHackage   = perPkgOptionFlag pkgid Cabal.ForDevelopment packageConfigHaddockForHackage
1841        elabHaddockExecutables  = perPkgOptionFlag pkgid False packageConfigHaddockExecutables
1842        elabHaddockTestSuites   = perPkgOptionFlag pkgid False packageConfigHaddockTestSuites
1843        elabHaddockBenchmarks   = perPkgOptionFlag pkgid False packageConfigHaddockBenchmarks
1844        elabHaddockInternal     = perPkgOptionFlag pkgid False packageConfigHaddockInternal
1845        elabHaddockCss          = perPkgOptionMaybe pkgid packageConfigHaddockCss
1846        elabHaddockLinkedSource = perPkgOptionFlag pkgid False packageConfigHaddockLinkedSource
1847        elabHaddockQuickJump    = perPkgOptionFlag pkgid False packageConfigHaddockQuickJump
1848        elabHaddockHscolourCss  = perPkgOptionMaybe pkgid packageConfigHaddockHscolourCss
1849        elabHaddockContents     = perPkgOptionMaybe pkgid packageConfigHaddockContents
1850
1851        elabTestMachineLog      = perPkgOptionMaybe pkgid packageConfigTestMachineLog
1852        elabTestHumanLog        = perPkgOptionMaybe pkgid packageConfigTestHumanLog
1853        elabTestShowDetails     = perPkgOptionMaybe pkgid packageConfigTestShowDetails
1854        elabTestKeepTix         = perPkgOptionFlag pkgid False packageConfigTestKeepTix
1855        elabTestWrapper         = perPkgOptionMaybe pkgid packageConfigTestWrapper
1856        elabTestFailWhenNoTestSuites = perPkgOptionFlag pkgid False packageConfigTestFailWhenNoTestSuites
1857        elabTestTestOptions     = perPkgOptionList pkgid packageConfigTestTestOptions
1858
1859        elabBenchmarkOptions    = perPkgOptionList pkgid packageConfigBenchmarkOptions
1860
1861    perPkgOptionFlag  :: PackageId -> a ->  (PackageConfig -> Flag a) -> a
1862    perPkgOptionMaybe :: PackageId ->       (PackageConfig -> Flag a) -> Maybe a
1863    perPkgOptionList  :: PackageId ->       (PackageConfig -> [a])    -> [a]
1864
1865    perPkgOptionFlag  pkgid def f = fromFlagOrDefault def (lookupPerPkgOption pkgid f)
1866    perPkgOptionMaybe pkgid     f = flagToMaybe (lookupPerPkgOption pkgid f)
1867    perPkgOptionList  pkgid     f = lookupPerPkgOption pkgid f
1868    perPkgOptionNubList    pkgid f = fromNubList   (lookupPerPkgOption pkgid f)
1869    perPkgOptionMapLast    pkgid f = getMapLast    (lookupPerPkgOption pkgid f)
1870    perPkgOptionMapMappend pkgid f = getMapMappend (lookupPerPkgOption pkgid f)
1871
1872    perPkgOptionLibExeFlag pkgid def fboth flib = (exe, lib)
1873      where
1874        exe = fromFlagOrDefault def bothflag
1875        lib = fromFlagOrDefault def (bothflag <> libflag)
1876
1877        bothflag = lookupPerPkgOption pkgid fboth
1878        libflag  = lookupPerPkgOption pkgid flib
1879
1880    lookupPerPkgOption :: (Package pkg, Monoid m)
1881                       => pkg -> (PackageConfig -> m) -> m
1882    lookupPerPkgOption pkg f =
1883        -- This is where we merge the options from the project config that
1884        -- apply to all packages, all project local packages, and to specific
1885        -- named packages
1886        global `mappend` local `mappend` perpkg
1887      where
1888        global = f allPackagesConfig
1889        local  | isLocalToProject pkg
1890               = f localPackagesConfig
1891               | otherwise
1892               = mempty
1893        perpkg = maybe mempty f (Map.lookup (packageName pkg) perPackageConfig)
1894
1895    inplacePackageDbs = storePackageDbs
1896                     ++ [ distPackageDB (compilerId compiler) ]
1897
1898    storePackageDbs   = storePackageDBStack (compilerId compiler)
1899
1900    -- For this local build policy, every package that lives in a local source
1901    -- dir (as opposed to a tarball), or depends on such a package, will be
1902    -- built inplace into a shared dist dir. Tarball packages that depend on
1903    -- source dir packages will also get unpacked locally.
1904    shouldBuildInplaceOnly :: SolverPackage loc -> Bool
1905    shouldBuildInplaceOnly pkg = Set.member (packageId pkg)
1906                                            pkgsToBuildInplaceOnly
1907
1908    pkgsToBuildInplaceOnly :: Set PackageId
1909    pkgsToBuildInplaceOnly =
1910        Set.fromList
1911      $ map packageId
1912      $ SolverInstallPlan.reverseDependencyClosure
1913          solverPlan
1914          (map PlannedId (Set.toList pkgsLocalToProject))
1915
1916    isLocalToProject :: Package pkg => pkg -> Bool
1917    isLocalToProject pkg = Set.member (packageId pkg)
1918                                      pkgsLocalToProject
1919
1920    pkgsLocalToProject :: Set PackageId
1921    pkgsLocalToProject =
1922        Set.fromList (catMaybes (map shouldBeLocal localPackages))
1923        --TODO: localPackages is a misnomer, it's all project packages
1924        -- here is where we decide which ones will be local!
1925      where
1926        shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId
1927        shouldBeLocal NamedPackage{}              = Nothing
1928        shouldBeLocal (SpecificSourcePackage pkg)
1929          | LocalTarballPackage _ <- packageSource pkg = Nothing
1930          | otherwise = Just (packageId pkg)
1931        -- TODO: Is it only LocalTarballPackages we can know about without
1932        -- them being "local" in the sense meant here?
1933        --
1934        -- Also, review use of SourcePackage's loc vs ProjectPackageLocation
1935
1936    pkgsUseSharedLibrary :: Set PackageId
1937    pkgsUseSharedLibrary =
1938        packagesWithLibDepsDownwardClosedProperty needsSharedLib
1939      where
1940        needsSharedLib pkg =
1941            fromMaybe compilerShouldUseSharedLibByDefault
1942                      (liftM2 (||) pkgSharedLib pkgDynExe)
1943          where
1944            pkgid        = packageId pkg
1945            pkgSharedLib = perPkgOptionMaybe pkgid packageConfigSharedLib
1946            pkgDynExe    = perPkgOptionMaybe pkgid packageConfigDynExe
1947
1948    --TODO: [code cleanup] move this into the Cabal lib. It's currently open
1949    -- coded in Distribution.Simple.Configure, but should be made a proper
1950    -- function of the Compiler or CompilerInfo.
1951    compilerShouldUseSharedLibByDefault =
1952      case compilerFlavor compiler of
1953        GHC   -> GHC.isDynamic compiler
1954        GHCJS -> GHCJS.isDynamic compiler
1955        _     -> False
1956
1957    pkgsUseProfilingLibrary :: Set PackageId
1958    pkgsUseProfilingLibrary =
1959        packagesWithLibDepsDownwardClosedProperty needsProfilingLib
1960      where
1961        needsProfilingLib pkg =
1962            fromFlagOrDefault False (profBothFlag <> profLibFlag)
1963          where
1964            pkgid        = packageId pkg
1965            profBothFlag = lookupPerPkgOption pkgid packageConfigProf
1966            profLibFlag  = lookupPerPkgOption pkgid packageConfigProfLib
1967            --TODO: [code cleanup] unused: the old deprecated packageConfigProfExe
1968
1969    libDepGraph = Graph.fromDistinctList $
1970                    map NonSetupLibDepSolverPlanPackage
1971                        (SolverInstallPlan.toList solverPlan)
1972
1973    packagesWithLibDepsDownwardClosedProperty property =
1974        Set.fromList
1975      . map packageId
1976      . fromMaybe []
1977      $ Graph.closure
1978          libDepGraph
1979          [ Graph.nodeKey pkg
1980          | pkg <- SolverInstallPlan.toList solverPlan
1981          , property pkg ] -- just the packages that satisfy the property
1982      --TODO: [nice to have] this does not check the config consistency,
1983      -- e.g. a package explicitly turning off profiling, but something
1984      -- depending on it that needs profiling. This really needs a separate
1985      -- package config validation/resolution pass.
1986
1987      --TODO: [nice to have] config consistency checking:
1988      -- + profiling libs & exes, exe needs lib, recursive
1989      -- + shared libs & exes, exe needs lib, recursive
1990      -- + vanilla libs & exes, exe needs lib, recursive
1991      -- + ghci or shared lib needed by TH, recursive, ghc version dependent
1992
1993-- TODO: Drop matchPlanPkg/matchElabPkg in favor of mkCCMapping
1994
1995-- | Given a 'ElaboratedPlanPackage', report if it matches a 'ComponentName'.
1996matchPlanPkg :: (ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool
1997matchPlanPkg p = InstallPlan.foldPlanPackage (p . ipiComponentName) (matchElabPkg p)
1998
1999-- | Get the appropriate 'ComponentName' which identifies an installed
2000-- component.
2001ipiComponentName :: IPI.InstalledPackageInfo -> ComponentName
2002ipiComponentName = CLibName . IPI.sourceLibName
2003
2004-- | Given a 'ElaboratedConfiguredPackage', report if it matches a
2005-- 'ComponentName'.
2006matchElabPkg :: (ComponentName -> Bool) -> ElaboratedConfiguredPackage -> Bool
2007matchElabPkg p elab =
2008    case elabPkgOrComp elab of
2009        ElabComponent comp -> maybe False p (compComponentName comp)
2010        ElabPackage _ ->
2011            -- So, what should we do here?  One possibility is to
2012            -- unconditionally return 'True', because whatever it is
2013            -- that we're looking for, it better be in this package.
2014            -- But this is a bit dodgy if the package doesn't actually
2015            -- have, e.g., a library.  Fortunately, it's not possible
2016            -- for the build of the library/executables to be toggled
2017            -- by 'pkgStanzasEnabled', so the only thing we have to
2018            -- test is if the component in question is *buildable.*
2019            any (p . componentName)
2020                (Cabal.pkgBuildableComponents (elabPkgDescription elab))
2021
2022-- | Given an 'ElaboratedPlanPackage', generate the mapping from 'PackageName'
2023-- and 'ComponentName' to the 'ComponentId' that that should be used
2024-- in this case.
2025mkCCMapping :: ElaboratedPlanPackage
2026            -> (PackageName, Map ComponentName (AnnotatedId ComponentId))
2027mkCCMapping =
2028    InstallPlan.foldPlanPackage
2029       (\ipkg -> (packageName ipkg,
2030                    Map.singleton (ipiComponentName ipkg)
2031                                  -- TODO: libify
2032                                  (AnnotatedId {
2033                                    ann_id = IPI.installedComponentId ipkg,
2034                                    ann_pid = packageId ipkg,
2035                                    ann_cname = IPI.sourceComponentName ipkg
2036                                  })))
2037      $ \elab ->
2038        let mk_aid cn = AnnotatedId {
2039                            ann_id = elabComponentId elab,
2040                            ann_pid = packageId elab,
2041                            ann_cname = cn
2042                        }
2043        in (packageName elab,
2044            case elabPkgOrComp elab of
2045                ElabComponent comp ->
2046                    case compComponentName comp of
2047                        Nothing -> Map.empty
2048                        Just n  -> Map.singleton n (mk_aid n)
2049                ElabPackage _ ->
2050                    Map.fromList $
2051                        map (\comp -> let cn = Cabal.componentName comp in (cn, mk_aid cn))
2052                            (Cabal.pkgBuildableComponents (elabPkgDescription elab)))
2053
2054-- | Given an 'ElaboratedPlanPackage', generate the mapping from 'ComponentId'
2055-- to the shape of this package, as per mix-in linking.
2056mkShapeMapping :: ElaboratedPlanPackage
2057               -> (ComponentId, (OpenUnitId, ModuleShape))
2058mkShapeMapping dpkg =
2059    (getComponentId dpkg, (indef_uid, shape))
2060  where
2061    (dcid, shape) =
2062        InstallPlan.foldPlanPackage
2063            -- Uses Monad (->)
2064            (liftM2 (,) IPI.installedComponentId shapeInstalledPackage)
2065            (liftM2 (,) elabComponentId elabModuleShape)
2066            dpkg
2067    indef_uid =
2068        IndefFullUnitId dcid
2069            (Map.fromList [ (req, OpenModuleVar req)
2070                          | req <- Set.toList (modShapeRequires shape)])
2071
2072-- | Get the bin\/ directories that a package's executables should reside in.
2073--
2074-- The result may be empty if the package does not build any executables.
2075--
2076-- The result may have several entries if this is an inplace build of a package
2077-- with multiple executables.
2078binDirectories
2079  :: DistDirLayout
2080  -> ElaboratedSharedConfig
2081  -> ElaboratedConfiguredPackage
2082  -> [FilePath]
2083binDirectories layout config package = case elabBuildStyle package of
2084  -- quick sanity check: no sense returning a bin directory if we're not going
2085  -- to put any executables in it, that will just clog up the PATH
2086  _ | noExecutables -> []
2087  BuildAndInstall -> [installedBinDirectory package]
2088  BuildInplaceOnly -> map (root</>) $ case elabPkgOrComp package of
2089    ElabComponent comp -> case compSolverName comp of
2090      CD.ComponentExe n -> [display n]
2091      _ -> []
2092    ElabPackage _ -> map (display . PD.exeName)
2093                   . PD.executables
2094                   . elabPkgDescription
2095                   $ package
2096  where
2097  noExecutables = null . PD.executables . elabPkgDescription $ package
2098  root  =  distBuildDirectory layout (elabDistDirParams config package)
2099       </> "build"
2100
2101-- | A newtype for 'SolverInstallPlan.SolverPlanPackage' for which the
2102-- dependency graph considers only dependencies on libraries which are
2103-- NOT from setup dependencies.  Used to compute the set
2104-- of packages needed for profiling and dynamic libraries.
2105newtype NonSetupLibDepSolverPlanPackage
2106    = NonSetupLibDepSolverPlanPackage
2107    { unNonSetupLibDepSolverPlanPackage :: SolverInstallPlan.SolverPlanPackage }
2108
2109instance Package NonSetupLibDepSolverPlanPackage where
2110    packageId = packageId . unNonSetupLibDepSolverPlanPackage
2111
2112instance IsNode NonSetupLibDepSolverPlanPackage where
2113    type Key NonSetupLibDepSolverPlanPackage = SolverId
2114    nodeKey = nodeKey . unNonSetupLibDepSolverPlanPackage
2115    nodeNeighbors (NonSetupLibDepSolverPlanPackage spkg)
2116        = ordNub $ CD.nonSetupDeps (resolverPackageLibDeps spkg)
2117
2118type InstS = Map UnitId ElaboratedPlanPackage
2119type InstM a = State InstS a
2120
2121getComponentId :: ElaboratedPlanPackage
2122               -> ComponentId
2123getComponentId (InstallPlan.PreExisting dipkg) = IPI.installedComponentId dipkg
2124getComponentId (InstallPlan.Configured elab) = elabComponentId elab
2125getComponentId (InstallPlan.Installed elab) = elabComponentId elab
2126
2127instantiateInstallPlan :: StoreDirLayout -> InstallDirs.InstallDirTemplates -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedInstallPlan
2128instantiateInstallPlan storeDirLayout defaultInstallDirs elaboratedShared plan =
2129    InstallPlan.new (IndependentGoals False)
2130                    (Graph.fromDistinctList (Map.elems ready_map))
2131  where
2132    pkgs = InstallPlan.toList plan
2133
2134    cmap = Map.fromList [ (getComponentId pkg, pkg) | pkg <- pkgs ]
2135
2136    instantiateUnitId :: ComponentId -> Map ModuleName Module
2137                      -> InstM DefUnitId
2138    instantiateUnitId cid insts = state $ \s ->
2139        case Map.lookup uid s of
2140            Nothing ->
2141                -- Knot tied
2142                let (r, s') = runState (instantiateComponent uid cid insts)
2143                                       (Map.insert uid r s)
2144                in (def_uid, Map.insert uid r s')
2145            Just _ -> (def_uid, s)
2146      where
2147        def_uid = mkDefUnitId cid insts
2148        uid = unDefUnitId def_uid
2149
2150    instantiateComponent
2151        :: UnitId -> ComponentId -> Map ModuleName Module
2152        -> InstM ElaboratedPlanPackage
2153    instantiateComponent uid cid insts
2154      | Just planpkg <- Map.lookup cid cmap
2155      = case planpkg of
2156          InstallPlan.Configured (elab0@ElaboratedConfiguredPackage
2157                                    { elabPkgOrComp = ElabComponent comp }) -> do
2158            deps <- mapM (substUnitId insts)
2159                         (compLinkedLibDependencies comp)
2160            let getDep (Module dep_uid _) = [dep_uid]
2161                elab1 = elab0 {
2162                    elabUnitId = uid,
2163                    elabComponentId = cid,
2164                    elabInstantiatedWith = insts,
2165                    elabIsCanonical = Map.null insts,
2166                    elabPkgOrComp = ElabComponent comp {
2167                        compOrderLibDependencies =
2168                            (if Map.null insts then [] else [newSimpleUnitId cid]) ++
2169                            ordNub (map unDefUnitId
2170                                (deps ++ concatMap getDep (Map.elems insts)))
2171                    }
2172                  }
2173                elab = elab1 {
2174                    elabInstallDirs = computeInstallDirs storeDirLayout
2175                                                         defaultInstallDirs
2176                                                         elaboratedShared
2177                                                         elab1
2178                  }
2179            return $ InstallPlan.Configured elab
2180          _ -> return planpkg
2181      | otherwise = error ("instantiateComponent: " ++ display cid)
2182
2183    substUnitId :: Map ModuleName Module -> OpenUnitId -> InstM DefUnitId
2184    substUnitId _ (DefiniteUnitId uid) =
2185        return uid
2186    substUnitId subst (IndefFullUnitId cid insts) = do
2187        insts' <- substSubst subst insts
2188        instantiateUnitId cid insts'
2189
2190    -- NB: NOT composition
2191    substSubst :: Map ModuleName Module
2192               -> Map ModuleName OpenModule
2193               -> InstM (Map ModuleName Module)
2194    substSubst subst insts = T.mapM (substModule subst) insts
2195
2196    substModule :: Map ModuleName Module -> OpenModule -> InstM Module
2197    substModule subst (OpenModuleVar mod_name)
2198        | Just m <- Map.lookup mod_name subst = return m
2199        | otherwise = error "substModule: non-closing substitution"
2200    substModule subst (OpenModule uid mod_name) = do
2201        uid' <- substUnitId subst uid
2202        return (Module uid' mod_name)
2203
2204    indefiniteUnitId :: ComponentId -> InstM UnitId
2205    indefiniteUnitId cid = do
2206        let uid = newSimpleUnitId cid
2207        r <- indefiniteComponent uid cid
2208        state $ \s -> (uid, Map.insert uid r s)
2209
2210    indefiniteComponent :: UnitId -> ComponentId -> InstM ElaboratedPlanPackage
2211    indefiniteComponent _uid cid
2212      -- Only need Configured; this phase happens before improvement, so
2213      -- there shouldn't be any Installed packages here.
2214      | Just (InstallPlan.Configured epkg) <- Map.lookup cid cmap
2215      , ElabComponent elab_comp <- elabPkgOrComp epkg
2216      = do -- We need to do a little more processing of the includes: some
2217           -- of them are fully definite even without substitution.  We
2218           -- want to build those too; see #5634.
2219           --
2220           -- This code mimics similar code in Distribution.Backpack.ReadyComponent;
2221           -- however, unlike the conversion from LinkedComponent to
2222           -- ReadyComponent, this transformation is done *without*
2223           -- changing the type in question; and what we are simply
2224           -- doing is enforcing tighter invariants on the data
2225           -- structure in question.  The new invariant is that there
2226           -- is no IndefFullUnitId in compLinkedLibDependencies that actually
2227           -- has no holes.  We couldn't specify this invariant when
2228           -- we initially created the ElaboratedPlanPackage because
2229           -- we have no way of actually refiying the UnitId into a
2230           -- DefiniteUnitId (that's what substUnitId does!)
2231           new_deps <- forM (compLinkedLibDependencies elab_comp) $ \uid ->
2232             if Set.null (openUnitIdFreeHoles uid)
2233                then fmap DefiniteUnitId (substUnitId Map.empty uid)
2234                else return uid
2235           return $ InstallPlan.Configured epkg {
2236            elabPkgOrComp = ElabComponent elab_comp {
2237                compLinkedLibDependencies = new_deps,
2238                -- I think this is right: any new definite unit ids we
2239                -- minted in the phase above need to be built before us.
2240                -- Add 'em in.  This doesn't remove any old dependencies
2241                -- on the indefinite package; they're harmless.
2242                compOrderLibDependencies =
2243                    ordNub $ compOrderLibDependencies elab_comp ++
2244                             [unDefUnitId d | DefiniteUnitId d <- new_deps]
2245            }
2246           }
2247      | Just planpkg <- Map.lookup cid cmap
2248      = return planpkg
2249      | otherwise = error ("indefiniteComponent: " ++ display cid)
2250
2251    ready_map = execState work Map.empty
2252
2253    work = forM_ pkgs $ \pkg ->
2254            case pkg of
2255                InstallPlan.Configured elab
2256                    | not (Map.null (elabLinkedInstantiatedWith elab))
2257                    -> indefiniteUnitId (elabComponentId elab)
2258                        >> return ()
2259                _ -> instantiateUnitId (getComponentId pkg) Map.empty
2260                        >> return ()
2261
2262---------------------------
2263-- Build targets
2264--
2265
2266-- Refer to ProjectPlanning.Types for details of these important types:
2267
2268-- data ComponentTarget = ...
2269-- data SubComponentTarget = ...
2270
2271-- One step in the build system is to translate higher level intentions like
2272-- "build this package", "test that package", or "repl that component" into
2273-- a more detailed specification of exactly which components to build (or other
2274-- actions like repl or build docs). This translation is somewhat different for
2275-- different commands. For example "test" for a package will build a different
2276-- set of components than "build". In addition, the translation of these
2277-- intentions can fail. For example "run" for a package is only unambiguous
2278-- when the package has a single executable.
2279--
2280-- So we need a little bit of infrastructure to make it easy for the command
2281-- implementations to select what component targets are meant when a user asks
2282-- to do something with a package or component. To do this (and to be able to
2283-- produce good error messages for mistakes and when targets are not available)
2284-- we need to gather and summarise accurate information about all the possible
2285-- targets, both available and unavailable. Then a command implementation can
2286-- decide which of the available component targets should be selected.
2287
2288-- | An available target represents a component within a package that a user
2289-- command could plausibly refer to. In this sense, all the components defined
2290-- within the package are things the user could refer to, whether or not it
2291-- would actually be possible to build that component.
2292--
2293-- In particular the available target contains an 'AvailableTargetStatus' which
2294-- informs us about whether it's actually possible to select this component to
2295-- be built, and if not why not. This detail makes it possible for command
2296-- implementations (like @build@, @test@ etc) to accurately report why a target
2297-- cannot be used.
2298--
2299-- Note that the type parameter is used to help enforce that command
2300-- implementations can only select targets that can actually be built (by
2301-- forcing them to return the @k@ value for the selected targets).
2302-- In particular 'resolveTargets' makes use of this (with @k@ as
2303-- @('UnitId', ComponentName')@) to identify the targets thus selected.
2304--
2305data AvailableTarget k = AvailableTarget {
2306       availableTargetPackageId      :: PackageId,
2307       availableTargetComponentName  :: ComponentName,
2308       availableTargetStatus         :: AvailableTargetStatus k,
2309       availableTargetLocalToProject :: Bool
2310     }
2311  deriving (Eq, Show, Functor)
2312
2313-- | The status of a an 'AvailableTarget' component. This tells us whether
2314-- it's actually possible to select this component to be built, and if not
2315-- why not.
2316--
2317data AvailableTargetStatus k =
2318       TargetDisabledByUser   -- ^ When the user does @tests: False@
2319     | TargetDisabledBySolver -- ^ When the solver could not enable tests
2320     | TargetNotBuildable     -- ^ When the component has @buildable: False@
2321     | TargetNotLocal         -- ^ When the component is non-core in a non-local package
2322     | TargetBuildable k TargetRequested -- ^ The target can or should be built
2323  deriving (Eq, Ord, Show, Functor)
2324
2325-- | This tells us whether a target ought to be built by default, or only if
2326-- specifically requested. The policy is that components like libraries and
2327-- executables are built by default by @build@, but test suites and benchmarks
2328-- are not, unless this is overridden in the project configuration.
2329--
2330data TargetRequested =
2331       TargetRequestedByDefault    -- ^ To be built by default
2332     | TargetNotRequestedByDefault -- ^ Not to be built by default
2333  deriving (Eq, Ord, Show)
2334
2335-- | Given the install plan, produce the set of 'AvailableTarget's for each
2336-- package-component pair.
2337--
2338-- Typically there will only be one such target for each component, but for
2339-- example if we have a plan with both normal and profiling variants of a
2340-- component then we would get both as available targets, or similarly if we
2341-- had a plan that contained two instances of the same version of a package.
2342-- This approach makes it relatively easy to select all instances\/variants
2343-- of a component.
2344--
2345availableTargets :: ElaboratedInstallPlan
2346                 -> Map (PackageId, ComponentName)
2347                        [AvailableTarget (UnitId, ComponentName)]
2348availableTargets installPlan =
2349    let rs = [ (pkgid, cname, fake, target)
2350             | pkg <- InstallPlan.toList installPlan
2351             , (pkgid, cname, fake, target) <- case pkg of
2352                 InstallPlan.PreExisting ipkg -> availableInstalledTargets ipkg
2353                 InstallPlan.Installed   elab -> availableSourceTargets elab
2354                 InstallPlan.Configured  elab -> availableSourceTargets elab
2355             ]
2356     in Map.union
2357         (Map.fromListWith (++)
2358            [ ((pkgid, cname), [target])
2359            | (pkgid, cname, fake, target) <- rs, not fake])
2360         (Map.fromList
2361            [ ((pkgid, cname), [target])
2362            | (pkgid, cname, fake, target) <- rs, fake])
2363    -- The normal targets mask the fake ones. We get all instances of the
2364    -- normal ones and only one copy of the fake ones (as there are many
2365    -- duplicates of the fake ones). See 'availableSourceTargets' below for
2366    -- more details on this fake stuff is about.
2367
2368availableInstalledTargets :: IPI.InstalledPackageInfo
2369                          -> [(PackageId, ComponentName, Bool,
2370                               AvailableTarget (UnitId, ComponentName))]
2371availableInstalledTargets ipkg =
2372    let unitid = installedUnitId ipkg
2373        cname  = CLibName LMainLibName
2374        status = TargetBuildable (unitid, cname) TargetRequestedByDefault
2375        target = AvailableTarget (packageId ipkg) cname status False
2376        fake   = False
2377     in [(packageId ipkg, cname, fake, target)]
2378
2379availableSourceTargets :: ElaboratedConfiguredPackage
2380                       -> [(PackageId, ComponentName, Bool,
2381                            AvailableTarget (UnitId, ComponentName))]
2382availableSourceTargets elab =
2383    -- We have a somewhat awkward problem here. We need to know /all/ the
2384    -- components from /all/ the packages because these are the things that
2385    -- users could refer to. Unfortunately, at this stage the elaborated install
2386    -- plan does /not/ contain all components: some components have already
2387    -- been deleted because they cannot possibly be built. This is the case
2388    -- for components that are marked @buildable: False@ in their .cabal files.
2389    -- (It's not unreasonable that the unbuildable components have been pruned
2390    -- as the plan invariant is considerably simpler if all nodes can be built)
2391    --
2392    -- We can recover the missing components but it's not exactly elegant. For
2393    -- a graph node corresponding to a component we still have the information
2394    -- about the package that it came from, and this includes the names of
2395    -- /all/ the other components in the package. So in principle this lets us
2396    -- find the names of all components, plus full details of the buildable
2397    -- components.
2398    --
2399    -- Consider for example a package with 3 exe components: foo, bar and baz
2400    -- where foo and bar are buildable, but baz is not. So the plan contains
2401    -- nodes for the components foo and bar. Now we look at each of these two
2402    -- nodes and look at the package they come from and the names of the
2403    -- components in this package. This will give us the names foo, bar and
2404    -- baz, twice (once for each of the two buildable components foo and bar).
2405    --
2406    -- We refer to these reconstructed missing components as fake targets.
2407    -- It is an invariant that they are not available to be built.
2408    --
2409    -- To produce the final set of targets we put the fake targets in a finite
2410    -- map (thus eliminating the duplicates) and then we overlay that map with
2411    -- the normal buildable targets. (This is done above in 'availableTargets'.)
2412    --
2413    [ (packageId elab, cname, fake, target)
2414    | component <- pkgComponents (elabPkgDescription elab)
2415    , let cname  = componentName component
2416          status = componentAvailableTargetStatus component
2417          target = AvailableTarget {
2418                     availableTargetPackageId      = packageId elab,
2419                     availableTargetComponentName  = cname,
2420                     availableTargetStatus         = status,
2421                     availableTargetLocalToProject = elabLocalToProject elab
2422                   }
2423          fake   = isFakeTarget cname
2424
2425    -- TODO: The goal of this test is to exclude "instantiated"
2426    -- packages as available targets. This means that you can't
2427    -- ask for a particular instantiated component to be built;
2428    -- it will only get built by a dependency.  Perhaps the
2429    -- correct way to implement this is to run selection
2430    -- prior to instantiating packages.  If you refactor
2431    -- this, then you can delete this test.
2432    , elabIsCanonical elab
2433
2434      -- Filter out some bogus parts of the cross product that are never needed
2435    , case status of
2436        TargetBuildable{} | fake -> False
2437        _                        -> True
2438    ]
2439  where
2440    isFakeTarget cname =
2441      case elabPkgOrComp elab of
2442        ElabPackage _               -> False
2443        ElabComponent elabComponent -> compComponentName elabComponent
2444                                       /= Just cname
2445
2446    componentAvailableTargetStatus
2447      :: Component -> AvailableTargetStatus (UnitId, ComponentName)
2448    componentAvailableTargetStatus component =
2449        case componentOptionalStanza $ CD.componentNameToComponent cname of
2450          -- it is not an optional stanza, so a library, exe or foreign lib
2451          Nothing
2452            | not buildable  -> TargetNotBuildable
2453            | otherwise      -> TargetBuildable (elabUnitId elab, cname)
2454                                                TargetRequestedByDefault
2455
2456          -- it is not an optional stanza, so a testsuite or benchmark
2457          Just stanza ->
2458            case (Map.lookup stanza (elabStanzasRequested elab),
2459                  Set.member stanza (elabStanzasAvailable elab)) of
2460              _ | not withinPlan -> TargetNotLocal
2461              (Just False,   _)  -> TargetDisabledByUser
2462              (Nothing,  False)  -> TargetDisabledBySolver
2463              _ | not buildable  -> TargetNotBuildable
2464              (Just True, True)  -> TargetBuildable (elabUnitId elab, cname)
2465                                                    TargetRequestedByDefault
2466              (Nothing,   True)  -> TargetBuildable (elabUnitId elab, cname)
2467                                                    TargetNotRequestedByDefault
2468              (Just True, False) ->
2469                error "componentAvailableTargetStatus: impossible"
2470      where
2471        cname      = componentName component
2472        buildable  = PD.buildable (componentBuildInfo component)
2473        withinPlan = elabLocalToProject elab
2474                  || case elabPkgOrComp elab of
2475                       ElabComponent elabComponent ->
2476                         compComponentName elabComponent == Just cname
2477                       ElabPackage _ ->
2478                         case componentName component of
2479                           CLibName (LMainLibName) -> True
2480                           CExeName _ -> True
2481                           --TODO: what about sub-libs and foreign libs?
2482                           _          -> False
2483
2484-- | Merge component targets that overlap each other. Specially when we have
2485-- multiple targets for the same component and one of them refers to the whole
2486-- component (rather than a module or file within) then all the other targets
2487-- for that component are subsumed.
2488--
2489-- We also allow for information associated with each component target, and
2490-- whenever we targets subsume each other we aggregate their associated info.
2491--
2492nubComponentTargets :: [(ComponentTarget, a)] -> [(ComponentTarget, [a])]
2493nubComponentTargets =
2494    concatMap (wholeComponentOverrides . map snd)
2495  . groupBy ((==)    `on` fst)
2496  . sortBy  (compare `on` fst)
2497  . map (\t@((ComponentTarget cname _, _)) -> (cname, t))
2498  . map compatSubComponentTargets
2499  where
2500    -- If we're building the whole component then that the only target all we
2501    -- need, otherwise we can have several targets within the component.
2502    wholeComponentOverrides :: [(ComponentTarget,  a )]
2503                            -> [(ComponentTarget, [a])]
2504    wholeComponentOverrides ts =
2505      case [ t | (t@(ComponentTarget _ WholeComponent), _) <- ts ] of
2506        (t:_) -> [ (t, map snd ts) ]
2507        []    -> [ (t,[x]) | (t,x) <- ts ]
2508
2509    -- Not all Cabal Setup.hs versions support sub-component targets, so switch
2510    -- them over to the whole component
2511    compatSubComponentTargets :: (ComponentTarget, a) -> (ComponentTarget, a)
2512    compatSubComponentTargets target@(ComponentTarget cname _subtarget, x)
2513      | not setupHsSupportsSubComponentTargets
2514                  = (ComponentTarget cname WholeComponent, x)
2515      | otherwise = target
2516
2517    -- Actually the reality is that no current version of Cabal's Setup.hs
2518    -- build command actually support building specific files or modules.
2519    setupHsSupportsSubComponentTargets = False
2520    -- TODO: when that changes, adjust this test, e.g.
2521    -- | pkgSetupScriptCliVersion >= Version [x,y] []
2522
2523pkgHasEphemeralBuildTargets :: ElaboratedConfiguredPackage -> Bool
2524pkgHasEphemeralBuildTargets elab =
2525    isJust (elabReplTarget elab)
2526 || (not . null) (elabTestTargets elab)
2527 || (not . null) (elabBenchTargets elab)
2528 || (not . null) (elabHaddockTargets elab)
2529 || (not . null) [ () | ComponentTarget _ subtarget <- elabBuildTargets elab
2530                      , subtarget /= WholeComponent ]
2531
2532-- | The components that we'll build all of, meaning that after they're built
2533-- we can skip building them again (unlike with building just some modules or
2534-- other files within a component).
2535--
2536elabBuildTargetWholeComponents :: ElaboratedConfiguredPackage
2537                              -> Set ComponentName
2538elabBuildTargetWholeComponents elab =
2539    Set.fromList
2540      [ cname | ComponentTarget cname WholeComponent <- elabBuildTargets elab ]
2541
2542
2543
2544------------------------------------------------------------------------------
2545-- * Install plan pruning
2546------------------------------------------------------------------------------
2547
2548-- | How 'pruneInstallPlanToTargets' should interpret the per-package
2549-- 'ComponentTarget's: as build, repl or haddock targets.
2550--
2551data TargetAction = TargetActionConfigure
2552                  | TargetActionBuild
2553                  | TargetActionRepl
2554                  | TargetActionTest
2555                  | TargetActionBench
2556                  | TargetActionHaddock
2557
2558-- | Given a set of per-package\/per-component targets, take the subset of the
2559-- install plan needed to build those targets. Also, update the package config
2560-- to specify which optional stanzas to enable, and which targets within each
2561-- package to build.
2562--
2563-- NB: Pruning happens after improvement, which is important because we
2564-- will prune differently depending on what is already installed (to
2565-- implement "sticky" test suite enabling behavior).
2566--
2567pruneInstallPlanToTargets :: TargetAction
2568                          -> Map UnitId [ComponentTarget]
2569                          -> ElaboratedInstallPlan -> ElaboratedInstallPlan
2570pruneInstallPlanToTargets targetActionType perPkgTargetsMap elaboratedPlan =
2571    InstallPlan.new (InstallPlan.planIndepGoals elaboratedPlan)
2572  . Graph.fromDistinctList
2573    -- We have to do the pruning in two passes
2574  . pruneInstallPlanPass2
2575  . pruneInstallPlanPass1
2576    -- Set the targets that will be the roots for pruning
2577  . setRootTargets targetActionType perPkgTargetsMap
2578  . InstallPlan.toList
2579  $ elaboratedPlan
2580
2581-- | This is a temporary data type, where we temporarily
2582-- override the graph dependencies of an 'ElaboratedPackage',
2583-- so we can take a closure over them.  We'll throw out the
2584-- overriden dependencies when we're done so it's strictly temporary.
2585--
2586-- For 'ElaboratedComponent', this the cached unit IDs always
2587-- coincide with the real thing.
2588data PrunedPackage = PrunedPackage ElaboratedConfiguredPackage [UnitId]
2589
2590instance Package PrunedPackage where
2591    packageId (PrunedPackage elab _) = packageId elab
2592
2593instance HasUnitId PrunedPackage where
2594    installedUnitId = nodeKey
2595
2596instance IsNode PrunedPackage where
2597    type Key PrunedPackage = UnitId
2598    nodeKey (PrunedPackage elab _)  = nodeKey elab
2599    nodeNeighbors (PrunedPackage _ deps) = deps
2600
2601fromPrunedPackage :: PrunedPackage -> ElaboratedConfiguredPackage
2602fromPrunedPackage (PrunedPackage elab _) = elab
2603
2604-- | Set the build targets based on the user targets (but not rev deps yet).
2605-- This is required before we can prune anything.
2606--
2607setRootTargets :: TargetAction
2608               -> Map UnitId [ComponentTarget]
2609               -> [ElaboratedPlanPackage]
2610               -> [ElaboratedPlanPackage]
2611setRootTargets targetAction perPkgTargetsMap =
2612    assert (not (Map.null perPkgTargetsMap)) $
2613    assert (all (not . null) (Map.elems perPkgTargetsMap)) $
2614
2615    map (mapConfiguredPackage setElabBuildTargets)
2616  where
2617    -- Set the targets we'll build for this package/component. This is just
2618    -- based on the root targets from the user, not targets implied by reverse
2619    -- dependencies. Those comes in the second pass once we know the rev deps.
2620    --
2621    setElabBuildTargets elab =
2622      case (Map.lookup (installedUnitId elab) perPkgTargetsMap,
2623            targetAction) of
2624        (Nothing, _)                      -> elab
2625        (Just tgts,  TargetActionConfigure) -> elab { elabConfigureTargets = tgts }
2626        (Just tgts,  TargetActionBuild)   -> elab { elabBuildTargets = tgts }
2627        (Just tgts,  TargetActionTest)    -> elab { elabTestTargets  = tgts }
2628        (Just tgts,  TargetActionBench)   -> elab { elabBenchTargets  = tgts }
2629        (Just [tgt], TargetActionRepl)    -> elab { elabReplTarget = Just tgt
2630                                                  , elabBuildHaddocks = False }
2631        (Just tgts,  TargetActionHaddock) ->
2632          foldr setElabHaddockTargets (elab { elabHaddockTargets = tgts
2633                                            , elabBuildHaddocks = True }) tgts
2634        (Just _,     TargetActionRepl)    ->
2635          error "pruneInstallPlanToTargets: multiple repl targets"
2636
2637    setElabHaddockTargets tgt elab
2638      | isTestComponentTarget tgt       = elab { elabHaddockTestSuites  = True }
2639      | isBenchComponentTarget tgt      = elab { elabHaddockBenchmarks  = True }
2640      | isForeignLibComponentTarget tgt = elab { elabHaddockForeignLibs = True }
2641      | isExeComponentTarget tgt        = elab { elabHaddockExecutables = True }
2642      | isSubLibComponentTarget tgt     = elab { elabHaddockInternal    = True }
2643      | otherwise                       = elab
2644
2645-- | Assuming we have previously set the root build targets (i.e. the user
2646-- targets but not rev deps yet), the first pruning pass does two things:
2647--
2648-- * A first go at determining which optional stanzas (testsuites, benchmarks)
2649--   are needed. We have a second go in the next pass.
2650-- * Take the dependency closure using pruned dependencies. We prune deps that
2651--   are used only by unneeded optional stanzas. These pruned deps are only
2652--   used for the dependency closure and are not persisted in this pass.
2653--
2654pruneInstallPlanPass1 :: [ElaboratedPlanPackage]
2655                      -> [ElaboratedPlanPackage]
2656pruneInstallPlanPass1 pkgs =
2657    map (mapConfiguredPackage fromPrunedPackage)
2658        (fromMaybe [] $ Graph.closure graph roots)
2659  where
2660    pkgs' = map (mapConfiguredPackage prune) pkgs
2661    graph = Graph.fromDistinctList pkgs'
2662    roots = mapMaybe find_root pkgs'
2663
2664    prune elab = PrunedPackage elab' (pruneOptionalDependencies elab')
2665      where elab' =
2666                setDocumentation
2667              $ addOptionalStanzas elab
2668
2669    find_root (InstallPlan.Configured (PrunedPackage elab _)) =
2670        if not $ and [ null (elabConfigureTargets elab)
2671                     , null (elabBuildTargets elab)
2672                     , null (elabTestTargets elab)
2673                     , null (elabBenchTargets elab)
2674                     , isNothing (elabReplTarget elab)
2675                     , null (elabHaddockTargets elab)
2676                     ]
2677            then Just (installedUnitId elab)
2678            else Nothing
2679    find_root _ = Nothing
2680
2681    -- Note [Sticky enabled testsuites]
2682    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2683    -- The testsuite and benchmark targets are somewhat special in that we need
2684    -- to configure the packages with them enabled, and we need to do that even
2685    -- if we only want to build one of several testsuites.
2686    --
2687    -- There are two cases in which we will enable the testsuites (or
2688    -- benchmarks): if one of the targets is a testsuite, or if all of the
2689    -- testsuite dependencies are already cached in the store. The rationale
2690    -- for the latter is to minimise how often we have to reconfigure due to
2691    -- the particular targets we choose to build. Otherwise choosing to build
2692    -- a testsuite target, and then later choosing to build an exe target
2693    -- would involve unnecessarily reconfiguring the package with testsuites
2694    -- disabled. Technically this introduces a little bit of stateful
2695    -- behaviour to make this "sticky", but it should be benign.
2696
2697    -- Decide whether or not to enable testsuites and benchmarks.
2698    -- See [Sticky enabled testsuites]
2699    addOptionalStanzas :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
2700    addOptionalStanzas elab@ElaboratedConfiguredPackage{ elabPkgOrComp = ElabPackage pkg } =
2701        elab {
2702            elabPkgOrComp = ElabPackage (pkg { pkgStanzasEnabled = stanzas })
2703        }
2704      where
2705        stanzas :: Set OptionalStanza
2706               -- By default, we enabled all stanzas requested by the user,
2707               -- as per elabStanzasRequested, done in
2708               -- 'elaborateSolverToPackage'
2709        stanzas = pkgStanzasEnabled pkg
2710               -- optionalStanzasRequiredByTargets has to be done at
2711               -- prune-time because it depends on 'elabTestTargets'
2712               -- et al, which is done by 'setRootTargets' at the
2713               -- beginning of pruning.
2714               <> optionalStanzasRequiredByTargets elab
2715               -- optionalStanzasWithDepsAvailable has to be done at
2716               -- prune-time because it depends on what packages are
2717               -- installed, which is not known until after improvement
2718               -- (pruning is done after improvement)
2719               <> optionalStanzasWithDepsAvailable availablePkgs elab pkg
2720    addOptionalStanzas elab = elab
2721
2722    setDocumentation :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
2723    setDocumentation elab@ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } =
2724      elab {
2725        elabBuildHaddocks =
2726            elabBuildHaddocks elab && documentationEnabled (compSolverName comp) elab
2727      }
2728
2729      where
2730        documentationEnabled c =
2731          case c of
2732            CD.ComponentLib      -> const True
2733            CD.ComponentSubLib _ -> elabHaddockInternal
2734            CD.ComponentFLib _   -> elabHaddockForeignLibs
2735            CD.ComponentExe _    -> elabHaddockExecutables
2736            CD.ComponentTest _   -> elabHaddockTestSuites
2737            CD.ComponentBench _  -> elabHaddockBenchmarks
2738            CD.ComponentSetup    -> const False
2739
2740    setDocumentation elab = elab
2741
2742    -- Calculate package dependencies but cut out those needed only by
2743    -- optional stanzas that we've determined we will not enable.
2744    -- These pruned deps are not persisted in this pass since they're based on
2745    -- the optional stanzas and we'll make further tweaks to the optional
2746    -- stanzas in the next pass.
2747    --
2748    pruneOptionalDependencies :: ElaboratedConfiguredPackage -> [UnitId]
2749    pruneOptionalDependencies elab@ElaboratedConfiguredPackage{ elabPkgOrComp = ElabComponent _ }
2750        = InstallPlan.depends elab -- no pruning
2751    pruneOptionalDependencies ElaboratedConfiguredPackage{ elabPkgOrComp = ElabPackage pkg }
2752        = (CD.flatDeps . CD.filterDeps keepNeeded) (pkgOrderDependencies pkg)
2753      where
2754        keepNeeded (CD.ComponentTest  _) _ = TestStanzas  `Set.member` stanzas
2755        keepNeeded (CD.ComponentBench _) _ = BenchStanzas `Set.member` stanzas
2756        keepNeeded _                     _ = True
2757        stanzas = pkgStanzasEnabled pkg
2758
2759    optionalStanzasRequiredByTargets :: ElaboratedConfiguredPackage
2760                                     -> Set OptionalStanza
2761    optionalStanzasRequiredByTargets pkg =
2762      Set.fromList
2763        [ stanza
2764        | ComponentTarget cname _ <- elabBuildTargets pkg
2765                                  ++ elabTestTargets pkg
2766                                  ++ elabBenchTargets pkg
2767                                  ++ maybeToList (elabReplTarget pkg)
2768                                  ++ elabHaddockTargets pkg
2769        , stanza <- maybeToList $
2770                    componentOptionalStanza $
2771                    CD.componentNameToComponent cname
2772        ]
2773
2774    availablePkgs =
2775      Set.fromList
2776        [ installedUnitId pkg
2777        | InstallPlan.PreExisting pkg <- pkgs ]
2778
2779-- | Given a set of already installed packages @availablePkgs@,
2780-- determine the set of available optional stanzas from @pkg@
2781-- which have all of their dependencies already installed.  This is used
2782-- to implement "sticky" testsuites, where once we have installed
2783-- all of the deps needed for the test suite, we go ahead and
2784-- enable it always.
2785optionalStanzasWithDepsAvailable :: Set UnitId
2786                                 -> ElaboratedConfiguredPackage
2787                                 -> ElaboratedPackage
2788                                 -> Set OptionalStanza
2789optionalStanzasWithDepsAvailable availablePkgs elab pkg =
2790    Set.fromList
2791      [ stanza
2792      | stanza <- Set.toList (elabStanzasAvailable elab)
2793      , let deps :: [UnitId]
2794            deps = CD.select (optionalStanzaDeps stanza)
2795                             -- TODO: probably need to select other
2796                             -- dep types too eventually
2797                             (pkgOrderDependencies pkg)
2798      , all (`Set.member` availablePkgs) deps
2799      ]
2800  where
2801    optionalStanzaDeps TestStanzas  (CD.ComponentTest  _) = True
2802    optionalStanzaDeps BenchStanzas (CD.ComponentBench _) = True
2803    optionalStanzaDeps _            _                     = False
2804
2805
2806-- The second pass does three things:
2807--
2808-- * A second go at deciding which optional stanzas to enable.
2809-- * Prune the dependencies based on the final choice of optional stanzas.
2810-- * Extend the targets within each package to build, now we know the reverse
2811--   dependencies, ie we know which libs are needed as deps by other packages.
2812--
2813-- Achieving sticky behaviour with enabling\/disabling optional stanzas is
2814-- tricky. The first approximation was handled by the first pass above, but
2815-- it's not quite enough. That pass will enable stanzas if all of the deps
2816-- of the optional stanza are already installed /in the store/. That's important
2817-- but it does not account for dependencies that get built inplace as part of
2818-- the project. We cannot take those inplace build deps into account in the
2819-- pruning pass however because we don't yet know which ones we're going to
2820-- build. Once we do know, we can have another go and enable stanzas that have
2821-- all their deps available. Now we can consider all packages in the pruned
2822-- plan to be available, including ones we already decided to build from
2823-- source.
2824--
2825-- Deciding which targets to build depends on knowing which packages have
2826-- reverse dependencies (ie are needed). This requires the result of first
2827-- pass, which is another reason we have to split it into two passes.
2828--
2829-- Note that just because we might enable testsuites or benchmarks (in the
2830-- first or second pass) doesn't mean that we build all (or even any) of them.
2831-- That depends on which targets we picked in the first pass.
2832--
2833pruneInstallPlanPass2 :: [ElaboratedPlanPackage]
2834                      -> [ElaboratedPlanPackage]
2835pruneInstallPlanPass2 pkgs =
2836    map (mapConfiguredPackage setStanzasDepsAndTargets) pkgs
2837  where
2838    setStanzasDepsAndTargets elab =
2839        elab {
2840          elabBuildTargets = ordNub
2841                           $ elabBuildTargets elab
2842                          ++ libTargetsRequiredForRevDeps
2843                          ++ exeTargetsRequiredForRevDeps,
2844          elabPkgOrComp =
2845            case elabPkgOrComp elab of
2846              ElabPackage pkg ->
2847                let stanzas = pkgStanzasEnabled pkg
2848                           <> optionalStanzasWithDepsAvailable availablePkgs elab pkg
2849                    keepNeeded (CD.ComponentTest  _) _ = TestStanzas  `Set.member` stanzas
2850                    keepNeeded (CD.ComponentBench _) _ = BenchStanzas `Set.member` stanzas
2851                    keepNeeded _                     _ = True
2852                in ElabPackage $ pkg {
2853                  pkgStanzasEnabled = stanzas,
2854                  pkgLibDependencies   = CD.filterDeps keepNeeded (pkgLibDependencies pkg),
2855                  pkgExeDependencies   = CD.filterDeps keepNeeded (pkgExeDependencies pkg),
2856                  pkgExeDependencyPaths = CD.filterDeps keepNeeded (pkgExeDependencyPaths pkg)
2857                }
2858              r@(ElabComponent _) -> r
2859        }
2860      where
2861        libTargetsRequiredForRevDeps =
2862          [ ComponentTarget (CLibName Cabal.defaultLibName) WholeComponent
2863          | installedUnitId elab `Set.member` hasReverseLibDeps
2864          ]
2865        exeTargetsRequiredForRevDeps =
2866          -- TODO: allow requesting executable with different name
2867          -- than package name
2868          [ ComponentTarget (Cabal.CExeName
2869                             $ packageNameToUnqualComponentName
2870                             $ packageName $ elabPkgSourceId elab)
2871                            WholeComponent
2872          | installedUnitId elab `Set.member` hasReverseExeDeps
2873          ]
2874
2875
2876    availablePkgs :: Set UnitId
2877    availablePkgs = Set.fromList (map installedUnitId pkgs)
2878
2879    hasReverseLibDeps :: Set UnitId
2880    hasReverseLibDeps =
2881      Set.fromList [ depid
2882                   | InstallPlan.Configured pkg <- pkgs
2883                   , depid <- elabOrderLibDependencies pkg ]
2884
2885    hasReverseExeDeps :: Set UnitId
2886    hasReverseExeDeps =
2887      Set.fromList [ depid
2888                   | InstallPlan.Configured pkg <- pkgs
2889                   , depid <- elabOrderExeDependencies pkg ]
2890
2891mapConfiguredPackage :: (srcpkg -> srcpkg')
2892                     -> InstallPlan.GenericPlanPackage ipkg srcpkg
2893                     -> InstallPlan.GenericPlanPackage ipkg srcpkg'
2894mapConfiguredPackage f (InstallPlan.Configured pkg) =
2895  InstallPlan.Configured (f pkg)
2896mapConfiguredPackage f (InstallPlan.Installed pkg) =
2897  InstallPlan.Installed (f pkg)
2898mapConfiguredPackage _ (InstallPlan.PreExisting pkg) =
2899  InstallPlan.PreExisting pkg
2900
2901------------------------------------
2902-- Support for --only-dependencies
2903--
2904
2905-- | Try to remove the given targets from the install plan.
2906--
2907-- This is not always possible.
2908--
2909pruneInstallPlanToDependencies :: Set UnitId
2910                               -> ElaboratedInstallPlan
2911                               -> Either CannotPruneDependencies
2912                                         ElaboratedInstallPlan
2913pruneInstallPlanToDependencies pkgTargets installPlan =
2914    assert (all (isJust . InstallPlan.lookup installPlan)
2915                (Set.toList pkgTargets)) $
2916
2917    fmap (InstallPlan.new (InstallPlan.planIndepGoals installPlan))
2918  . checkBrokenDeps
2919  . Graph.fromDistinctList
2920  . filter (\pkg -> installedUnitId pkg `Set.notMember` pkgTargets)
2921  . InstallPlan.toList
2922  $ installPlan
2923    where
2924      -- Our strategy is to remove the packages we don't want and then check
2925      -- if the remaining graph is broken or not, ie any packages with dangling
2926      -- dependencies. If there are then we cannot prune the given targets.
2927      checkBrokenDeps :: Graph.Graph ElaboratedPlanPackage
2928                      -> Either CannotPruneDependencies
2929                                (Graph.Graph ElaboratedPlanPackage)
2930      checkBrokenDeps graph =
2931        case Graph.broken graph of
2932          []             -> Right graph
2933          brokenPackages ->
2934            Left $ CannotPruneDependencies
2935             [ (pkg, missingDeps)
2936             | (pkg, missingDepIds) <- brokenPackages
2937             , let missingDeps = mapMaybe lookupDep missingDepIds
2938             ]
2939            where
2940              -- lookup in the original unpruned graph
2941              lookupDep = InstallPlan.lookup installPlan
2942
2943-- | It is not always possible to prune to only the dependencies of a set of
2944-- targets. It may be the case that removing a package leaves something else
2945-- that still needed the pruned package.
2946--
2947-- This lists all the packages that would be broken, and their dependencies
2948-- that would be missing if we did prune.
2949--
2950newtype CannotPruneDependencies =
2951        CannotPruneDependencies [(ElaboratedPlanPackage,
2952                                  [ElaboratedPlanPackage])]
2953  deriving (Show)
2954
2955
2956---------------------------
2957-- Setup.hs script policy
2958--
2959
2960-- Handling for Setup.hs scripts is a bit tricky, part of it lives in the
2961-- solver phase, and part in the elaboration phase. We keep the helper
2962-- functions for both phases together here so at least you can see all of it
2963-- in one place.
2964--
2965-- There are four major cases for Setup.hs handling:
2966--
2967--  1. @build-type@ Custom with a @custom-setup@ section
2968--  2. @build-type@ Custom without a @custom-setup@ section
2969--  3. @build-type@ not Custom with @cabal-version >  $our-cabal-version@
2970--  4. @build-type@ not Custom with @cabal-version <= $our-cabal-version@
2971--
2972-- It's also worth noting that packages specifying @cabal-version: >= 1.23@
2973-- or later that have @build-type@ Custom will always have a @custom-setup@
2974-- section. Therefore in case 2, the specified @cabal-version@ will always be
2975-- less than 1.23.
2976--
2977-- In cases 1 and 2 we obviously have to build an external Setup.hs script,
2978-- while in case 4 we can use the internal library API. In case 3 we also have
2979-- to build an external Setup.hs script because the package needs a later
2980-- Cabal lib version than we can support internally.
2981--
2982-- data SetupScriptStyle = ...  -- see ProjectPlanning.Types
2983
2984-- | Work out the 'SetupScriptStyle' given the package description.
2985--
2986packageSetupScriptStyle :: PD.PackageDescription -> SetupScriptStyle
2987packageSetupScriptStyle pkg
2988  | buildType == PD.Custom
2989  , Just setupbi <- PD.setupBuildInfo pkg -- does have a custom-setup stanza
2990  , not (PD.defaultSetupDepends setupbi)  -- but not one we added internally
2991  = SetupCustomExplicitDeps
2992
2993  | buildType == PD.Custom
2994  , Just setupbi <- PD.setupBuildInfo pkg -- we get this case post-solver as
2995  , PD.defaultSetupDepends setupbi        -- the solver fills in the deps
2996  = SetupCustomImplicitDeps
2997
2998  | buildType == PD.Custom
2999  , Nothing <- PD.setupBuildInfo pkg      -- we get this case pre-solver
3000  = SetupCustomImplicitDeps
3001
3002  | PD.specVersion pkg > cabalVersion -- one cabal-install is built against
3003  = SetupNonCustomExternalLib
3004
3005  | otherwise
3006  = SetupNonCustomInternalLib
3007  where
3008    buildType = PD.buildType pkg
3009
3010
3011-- | Part of our Setup.hs handling policy is implemented by getting the solver
3012-- to work out setup dependencies for packages. The solver already handles
3013-- packages that explicitly specify setup dependencies, but we can also tell
3014-- the solver to treat other packages as if they had setup dependencies.
3015-- That's what this function does, it gets called by the solver for all
3016-- packages that don't already have setup dependencies.
3017--
3018-- The dependencies we want to add is different for each 'SetupScriptStyle'.
3019--
3020-- Note that adding default deps means these deps are actually /added/ to the
3021-- packages that we get out of the solver in the 'SolverInstallPlan'. Making
3022-- implicit setup deps explicit is a problem in the post-solver stages because
3023-- we still need to distinguish the case of explicit and implict setup deps.
3024-- See 'rememberImplicitSetupDeps'.
3025--
3026-- Note in addition to adding default setup deps, we also use
3027-- 'addSetupCabalMinVersionConstraint' (in 'planPackages') to require
3028-- @Cabal >= 1.20@ for Setup scripts.
3029--
3030defaultSetupDeps :: Compiler -> Platform
3031                 -> PD.PackageDescription
3032                 -> Maybe [Dependency]
3033defaultSetupDeps compiler platform pkg =
3034    case packageSetupScriptStyle pkg of
3035
3036      -- For packages with build type custom that do not specify explicit
3037      -- setup dependencies, we add a dependency on Cabal and a number
3038      -- of other packages.
3039      SetupCustomImplicitDeps ->
3040        Just $
3041        [ Dependency depPkgname anyVersion (Set.singleton LMainLibName)
3042        | depPkgname <- legacyCustomSetupPkgs compiler platform ] ++
3043        [ Dependency cabalPkgname cabalConstraint (Set.singleton LMainLibName)
3044        | packageName pkg /= cabalPkgname ]
3045        where
3046          -- The Cabal dep is slightly special:
3047          -- * We omit the dep for the Cabal lib itself, since it bootstraps.
3048          -- * We constrain it to be < 1.25
3049          --
3050          -- Note: we also add a global constraint to require Cabal >= 1.20
3051          -- for Setup scripts (see use addSetupCabalMinVersionConstraint).
3052          --
3053          cabalConstraint   = orLaterVersion (PD.specVersion pkg)
3054                                `intersectVersionRanges`
3055                              earlierVersion cabalCompatMaxVer
3056          -- The idea here is that at some point we will make significant
3057          -- breaking changes to the Cabal API that Setup.hs scripts use.
3058          -- So for old custom Setup scripts that do not specify explicit
3059          -- constraints, we constrain them to use a compatible Cabal version.
3060          cabalCompatMaxVer = mkVersion [1,25]
3061
3062      -- For other build types (like Simple) if we still need to compile an
3063      -- external Setup.hs, it'll be one of the simple ones that only depends
3064      -- on Cabal and base.
3065      SetupNonCustomExternalLib ->
3066        Just [ Dependency cabalPkgname cabalConstraint (Set.singleton LMainLibName)
3067             , Dependency basePkgname  anyVersion (Set.singleton LMainLibName)]
3068        where
3069          cabalConstraint = orLaterVersion (PD.specVersion pkg)
3070
3071      -- The internal setup wrapper method has no deps at all.
3072      SetupNonCustomInternalLib -> Just []
3073
3074      -- This case gets ruled out by the caller, planPackages, see the note
3075      -- above in the SetupCustomImplicitDeps case.
3076      SetupCustomExplicitDeps ->
3077        error $ "defaultSetupDeps: called for a package with explicit "
3078             ++ "setup deps: " ++ display (packageId pkg)
3079
3080
3081-- | Work out which version of the Cabal spec we will be using to talk to the
3082-- Setup.hs interface for this package.
3083--
3084-- This depends somewhat on the 'SetupScriptStyle' but most cases are a result
3085-- of what the solver picked for us, based on the explicit setup deps or the
3086-- ones added implicitly by 'defaultSetupDeps'.
3087--
3088packageSetupScriptSpecVersion :: SetupScriptStyle
3089                              -> PD.PackageDescription
3090                              -> Graph.Graph NonSetupLibDepSolverPlanPackage
3091                              -> ComponentDeps [SolverId]
3092                              -> Version
3093
3094-- We're going to be using the internal Cabal library, so the spec version of
3095-- that is simply the version of the Cabal library that cabal-install has been
3096-- built with.
3097packageSetupScriptSpecVersion SetupNonCustomInternalLib _ _ _ =
3098    cabalVersion
3099
3100-- If we happen to be building the Cabal lib itself then because that
3101-- bootstraps itself then we use the version of the lib we're building.
3102packageSetupScriptSpecVersion SetupCustomImplicitDeps pkg _ _
3103  | packageName pkg == cabalPkgname
3104  = packageVersion pkg
3105
3106-- In all other cases we have a look at what version of the Cabal lib the
3107-- solver picked. Or if it didn't depend on Cabal at all (which is very rare)
3108-- then we look at the .cabal file to see what spec version it declares.
3109packageSetupScriptSpecVersion _ pkg libDepGraph deps =
3110    case find ((cabalPkgname ==) . packageName) setupLibDeps of
3111      Just dep -> packageVersion dep
3112      Nothing  -> PD.specVersion pkg
3113  where
3114    setupLibDeps = map packageId $ fromMaybe [] $
3115                   Graph.closure libDepGraph (CD.setupDeps deps)
3116
3117
3118cabalPkgname, basePkgname :: PackageName
3119cabalPkgname = mkPackageName "Cabal"
3120basePkgname  = mkPackageName "base"
3121
3122
3123legacyCustomSetupPkgs :: Compiler -> Platform -> [PackageName]
3124legacyCustomSetupPkgs compiler (Platform _ os) =
3125    map mkPackageName $
3126        [ "array", "base", "binary", "bytestring", "containers"
3127        , "deepseq", "directory", "filepath", "old-time", "pretty"
3128        , "process", "time", "transformers" ]
3129     ++ [ "Win32" | os == Windows ]
3130     ++ [ "unix"  | os /= Windows ]
3131     ++ [ "ghc-prim"         | isGHC ]
3132     ++ [ "template-haskell" | isGHC ]
3133  where
3134    isGHC = compilerCompatFlavor GHC compiler
3135
3136-- The other aspects of our Setup.hs policy lives here where we decide on
3137-- the 'SetupScriptOptions'.
3138--
3139-- Our current policy for the 'SetupCustomImplicitDeps' case is that we
3140-- try to make the implicit deps cover everything, and we don't allow the
3141-- compiler to pick up other deps. This may or may not be sustainable, and
3142-- we might have to allow the deps to be non-exclusive, but that itself would
3143-- be tricky since we would have to allow the Setup access to all the packages
3144-- in the store and local dbs.
3145
3146setupHsScriptOptions :: ElaboratedReadyPackage
3147                     -> ElaboratedInstallPlan
3148                     -> ElaboratedSharedConfig
3149                     -> DistDirLayout
3150                     -> FilePath
3151                     -> FilePath
3152                     -> Bool
3153                     -> Lock
3154                     -> SetupScriptOptions
3155-- TODO: Fix this so custom is a separate component.  Custom can ALWAYS
3156-- be a separate component!!!
3157setupHsScriptOptions (ReadyPackage elab@ElaboratedConfiguredPackage{..})
3158                     plan ElaboratedSharedConfig{..} distdir srcdir builddir
3159                     isParallelBuild cacheLock =
3160    SetupScriptOptions {
3161      useCabalVersion          = thisVersion elabSetupScriptCliVersion,
3162      useCabalSpecVersion      = Just elabSetupScriptCliVersion,
3163      useCompiler              = Just pkgConfigCompiler,
3164      usePlatform              = Just pkgConfigPlatform,
3165      usePackageDB             = elabSetupPackageDBStack,
3166      usePackageIndex          = Nothing,
3167      useDependencies          = [ (uid, srcid)
3168                                 | ConfiguredId srcid (Just (CLibName LMainLibName)) uid
3169                                 <- elabSetupDependencies elab ],
3170      useDependenciesExclusive = True,
3171      useVersionMacros         = elabSetupScriptStyle == SetupCustomExplicitDeps,
3172      useProgramDb             = pkgConfigCompilerProgs,
3173      useDistPref              = builddir,
3174      useLoggingHandle         = Nothing, -- this gets set later
3175      useWorkingDir            = Just srcdir,
3176      useExtraPathEnv          = elabExeDependencyPaths elab,
3177      useExtraEnvOverrides     = dataDirsEnvironmentForPlan distdir plan,
3178      useWin32CleanHack        = False,   --TODO: [required eventually]
3179      forceExternalSetupMethod = isParallelBuild,
3180      setupCacheLock           = Just cacheLock,
3181      isInteractive            = False
3182    }
3183
3184
3185-- | To be used for the input for elaborateInstallPlan.
3186--
3187-- TODO: [code cleanup] make InstallDirs.defaultInstallDirs pure.
3188--
3189userInstallDirTemplates :: Compiler
3190                        -> IO InstallDirs.InstallDirTemplates
3191userInstallDirTemplates compiler = do
3192    InstallDirs.defaultInstallDirs
3193                  (compilerFlavor compiler)
3194                  True  -- user install
3195                  False -- unused
3196
3197storePackageInstallDirs :: StoreDirLayout
3198                        -> CompilerId
3199                        -> InstalledPackageId
3200                        -> InstallDirs.InstallDirs FilePath
3201storePackageInstallDirs storeDirLayout compid ipkgid =
3202  storePackageInstallDirs' storeDirLayout compid $ newSimpleUnitId ipkgid
3203
3204storePackageInstallDirs' :: StoreDirLayout
3205                         -> CompilerId
3206                         -> UnitId
3207                         -> InstallDirs.InstallDirs FilePath
3208storePackageInstallDirs' StoreDirLayout{ storePackageDirectory
3209                                       , storeDirectory }
3210                         compid unitid =
3211    InstallDirs.InstallDirs {..}
3212  where
3213    store        = storeDirectory compid
3214    prefix       = storePackageDirectory compid unitid
3215    bindir       = prefix </> "bin"
3216    libdir       = prefix </> "lib"
3217    libsubdir    = ""
3218    -- Note: on macOS, we place libraries into
3219    --       @store/lib@ to work around the load
3220    --       command size limit of macOSs mach-o linker.
3221    --       See also @PackageHash.hashedInstalledPackageIdVeryShort@
3222    dynlibdir    | buildOS == OSX = store </> "lib"
3223                 | otherwise      = libdir
3224    flibdir      = libdir
3225    libexecdir   = prefix </> "libexec"
3226    libexecsubdir= ""
3227    includedir   = libdir </> "include"
3228    datadir      = prefix </> "share"
3229    datasubdir   = ""
3230    docdir       = datadir </> "doc"
3231    mandir       = datadir </> "man"
3232    htmldir      = docdir  </> "html"
3233    haddockdir   = htmldir
3234    sysconfdir   = prefix </> "etc"
3235
3236
3237
3238computeInstallDirs :: StoreDirLayout
3239                   -> InstallDirs.InstallDirTemplates
3240                   -> ElaboratedSharedConfig
3241                   -> ElaboratedConfiguredPackage
3242                   -> InstallDirs.InstallDirs FilePath
3243computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
3244  | elabBuildStyle elab == BuildInplaceOnly
3245  -- use the ordinary default install dirs
3246  = (InstallDirs.absoluteInstallDirs
3247       (elabPkgSourceId elab)
3248       (elabUnitId elab)
3249       (compilerInfo (pkgConfigCompiler elaboratedShared))
3250       InstallDirs.NoCopyDest
3251       (pkgConfigPlatform elaboratedShared)
3252       defaultInstallDirs) {
3253
3254      -- absoluteInstallDirs sets these as 'undefined' but we have
3255      -- to use them as "Setup.hs configure" args
3256      InstallDirs.libsubdir  = "",
3257      InstallDirs.libexecsubdir  = "",
3258      InstallDirs.datasubdir = ""
3259    }
3260
3261  | otherwise
3262  -- use special simplified install dirs
3263  = storePackageInstallDirs'
3264      storeDirLayout
3265      (compilerId (pkgConfigCompiler elaboratedShared))
3266      (elabUnitId elab)
3267
3268
3269--TODO: [code cleanup] perhaps reorder this code
3270-- based on the ElaboratedInstallPlan + ElaboratedSharedConfig,
3271-- make the various Setup.hs {configure,build,copy} flags
3272
3273
3274setupHsConfigureFlags :: ElaboratedReadyPackage
3275                      -> ElaboratedSharedConfig
3276                      -> Verbosity
3277                      -> FilePath
3278                      -> Cabal.ConfigFlags
3279setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..})
3280                      sharedConfig@ElaboratedSharedConfig{..}
3281                      verbosity builddir =
3282    sanityCheckElaboratedConfiguredPackage sharedConfig elab
3283        (Cabal.ConfigFlags {..})
3284  where
3285    configArgs                = mempty -- unused, passed via args
3286    configDistPref            = toFlag builddir
3287    configCabalFilePath       = mempty
3288    configVerbosity           = toFlag verbosity
3289
3290    configInstantiateWith     = Map.toList elabInstantiatedWith
3291
3292    configDeterministic       = mempty -- doesn't matter, configIPID/configCID overridese
3293    configIPID                = case elabPkgOrComp of
3294                                  ElabPackage pkg -> toFlag (display (pkgInstalledId pkg))
3295                                  ElabComponent _ -> mempty
3296    configCID                 = case elabPkgOrComp of
3297                                  ElabPackage _ -> mempty
3298                                  ElabComponent _ -> toFlag elabComponentId
3299
3300    configProgramPaths        = Map.toList elabProgramPaths
3301    configProgramArgs
3302        | {- elabSetupScriptCliVersion < mkVersion [1,24,3] -} True
3303          -- workaround for <https://github.com/haskell/cabal/issues/4010>
3304          --
3305          -- It turns out, that even with Cabal 2.0, there's still cases such as e.g.
3306          -- custom Setup.hs scripts calling out to GHC even when going via
3307          -- @runProgram ghcProgram@, as e.g. happy does in its
3308          -- <http://hackage.haskell.org/package/happy-1.19.5/src/Setup.lhs>
3309          -- (see also <https://github.com/haskell/cabal/pull/4433#issuecomment-299396099>)
3310          --
3311          -- So for now, let's pass the rather harmless and idempotent
3312          -- `-hide-all-packages` flag to all invocations (which has
3313          -- the benefit that every GHC invocation starts with a
3314          -- conistently well-defined clean slate) until we find a
3315          -- better way.
3316                              = Map.toList $
3317                                Map.insertWith (++) "ghc" ["-hide-all-packages"]
3318                                               elabProgramArgs
3319        | otherwise           = Map.toList elabProgramArgs
3320    configProgramPathExtra    = toNubList elabProgramPathExtra
3321    configHcFlavor            = toFlag (compilerFlavor pkgConfigCompiler)
3322    configHcPath              = mempty -- we use configProgramPaths instead
3323    configHcPkg               = mempty -- we use configProgramPaths instead
3324
3325    configVanillaLib          = toFlag elabVanillaLib
3326    configSharedLib           = toFlag elabSharedLib
3327    configStaticLib           = toFlag elabStaticLib
3328
3329    configDynExe              = toFlag elabDynExe
3330    configFullyStaticExe      = toFlag elabFullyStaticExe
3331    configGHCiLib             = toFlag elabGHCiLib
3332    configProfExe             = mempty
3333    configProfLib             = toFlag elabProfLib
3334    configProf                = toFlag elabProfExe
3335
3336    -- configProfDetail is for exe+lib, but overridden by configProfLibDetail
3337    -- so we specify both so we can specify independently
3338    configProfDetail          = toFlag elabProfExeDetail
3339    configProfLibDetail       = toFlag elabProfLibDetail
3340
3341    configCoverage            = toFlag elabCoverage
3342    configLibCoverage         = mempty
3343
3344    configOptimization        = toFlag elabOptimization
3345    configSplitSections       = toFlag elabSplitSections
3346    configSplitObjs           = toFlag elabSplitObjs
3347    configStripExes           = toFlag elabStripExes
3348    configStripLibs           = toFlag elabStripLibs
3349    configDebugInfo           = toFlag elabDebugInfo
3350
3351    configConfigurationsFlags = elabFlagAssignment
3352    configConfigureArgs       = elabConfigureScriptArgs
3353    configExtraLibDirs        = elabExtraLibDirs
3354    configExtraFrameworkDirs  = elabExtraFrameworkDirs
3355    configExtraIncludeDirs    = elabExtraIncludeDirs
3356    configProgPrefix          = maybe mempty toFlag elabProgPrefix
3357    configProgSuffix          = maybe mempty toFlag elabProgSuffix
3358
3359    configInstallDirs         = fmap (toFlag . InstallDirs.toPathTemplate)
3360                                     elabInstallDirs
3361
3362    -- we only use configDependencies, unless we're talking to an old Cabal
3363    -- in which case we use configConstraints
3364    -- NB: This does NOT use InstallPlan.depends, which includes executable
3365    -- dependencies which should NOT be fed in here (also you don't have
3366    -- enough info anyway)
3367    configDependencies        = [ GivenComponent
3368                                    (packageName srcid)
3369                                    ln
3370                                    cid
3371                                | ConfiguredId srcid mb_cn cid <- elabLibDependencies elab
3372                                , let ln = case mb_cn
3373                                           of Just (CLibName lname) -> lname
3374                                              Just _ -> error "non-library dependency"
3375                                              Nothing -> LMainLibName
3376                                ]
3377    configConstraints         =
3378        case elabPkgOrComp of
3379            ElabPackage _ ->
3380                [ thisPackageVersion srcid
3381                | ConfiguredId srcid _ _uid <- elabLibDependencies elab ]
3382            ElabComponent _ -> []
3383
3384
3385    -- explicitly clear, then our package db stack
3386    -- TODO: [required eventually] have to do this differently for older Cabal versions
3387    configPackageDBs          = Nothing : map Just elabBuildPackageDBStack
3388
3389    configTests               = case elabPkgOrComp of
3390                                    ElabPackage pkg -> toFlag (TestStanzas  `Set.member` pkgStanzasEnabled pkg)
3391                                    ElabComponent _ -> mempty
3392    configBenchmarks          = case elabPkgOrComp of
3393                                    ElabPackage pkg -> toFlag (BenchStanzas `Set.member` pkgStanzasEnabled pkg)
3394                                    ElabComponent _ -> mempty
3395
3396    configExactConfiguration  = toFlag True
3397    configFlagError           = mempty --TODO: [research required] appears not to be implemented
3398    configRelocatable         = mempty --TODO: [research required] ???
3399    configScratchDir          = mempty -- never use
3400    configUserInstall         = mempty -- don't rely on defaults
3401    configPrograms_           = mempty -- never use, shouldn't exist
3402    configUseResponseFiles    = mempty
3403    -- TODO set to true when the solver can prevent private-library-deps by itself
3404    -- (issue #6039)
3405    configAllowDependingOnPrivateLibs = mempty
3406
3407setupHsConfigureArgs :: ElaboratedConfiguredPackage
3408                     -> [String]
3409setupHsConfigureArgs (ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ }) = []
3410setupHsConfigureArgs elab@(ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp }) =
3411    [showComponentTarget (packageId elab) (ComponentTarget cname WholeComponent)]
3412  where
3413    cname = fromMaybe (error "setupHsConfigureArgs: trying to configure setup")
3414                      (compComponentName comp)
3415
3416setupHsBuildFlags :: ElaboratedConfiguredPackage
3417                  -> ElaboratedSharedConfig
3418                  -> Verbosity
3419                  -> FilePath
3420                  -> Cabal.BuildFlags
3421setupHsBuildFlags _ _ verbosity builddir =
3422    Cabal.BuildFlags {
3423      buildProgramPaths = mempty, --unused, set at configure time
3424      buildProgramArgs  = mempty, --unused, set at configure time
3425      buildVerbosity    = toFlag verbosity,
3426      buildDistPref     = toFlag builddir,
3427      buildNumJobs      = mempty, --TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs),
3428      buildArgs         = mempty, -- unused, passed via args not flags
3429      buildCabalFilePath= mempty
3430    }
3431
3432
3433setupHsBuildArgs :: ElaboratedConfiguredPackage -> [String]
3434setupHsBuildArgs elab@(ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ })
3435    -- Fix for #3335, don't pass build arguments if it's not supported
3436    | elabSetupScriptCliVersion elab >= mkVersion [1,17]
3437    = map (showComponentTarget (packageId elab)) (elabBuildTargets elab)
3438    | otherwise
3439    = []
3440setupHsBuildArgs (ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent _ })
3441    = []
3442
3443
3444setupHsTestFlags :: ElaboratedConfiguredPackage
3445                 -> ElaboratedSharedConfig
3446                 -> Verbosity
3447                 -> FilePath
3448                 -> Cabal.TestFlags
3449setupHsTestFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = Cabal.TestFlags
3450    { testDistPref    = toFlag builddir
3451    , testVerbosity   = toFlag verbosity
3452    , testMachineLog  = maybe mempty toFlag elabTestMachineLog
3453    , testHumanLog    = maybe mempty toFlag elabTestHumanLog
3454    , testShowDetails = maybe (Flag Cabal.Always) toFlag elabTestShowDetails
3455    , testKeepTix     = toFlag elabTestKeepTix
3456    , testWrapper     = maybe mempty toFlag elabTestWrapper
3457    , testFailWhenNoTestSuites = toFlag elabTestFailWhenNoTestSuites
3458    , testOptions     = elabTestTestOptions
3459    }
3460
3461setupHsTestArgs :: ElaboratedConfiguredPackage -> [String]
3462-- TODO: Does the issue #3335 affects test as well
3463setupHsTestArgs elab =
3464    mapMaybe (showTestComponentTarget (packageId elab)) (elabTestTargets elab)
3465
3466
3467setupHsBenchFlags :: ElaboratedConfiguredPackage
3468                  -> ElaboratedSharedConfig
3469                  -> Verbosity
3470                  -> FilePath
3471                  -> Cabal.BenchmarkFlags
3472setupHsBenchFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = Cabal.BenchmarkFlags
3473    { benchmarkDistPref  = toFlag builddir
3474    , benchmarkVerbosity = toFlag verbosity
3475    , benchmarkOptions   = elabBenchmarkOptions
3476    }
3477
3478setupHsBenchArgs :: ElaboratedConfiguredPackage -> [String]
3479setupHsBenchArgs elab =
3480    mapMaybe (showBenchComponentTarget (packageId elab)) (elabBenchTargets elab)
3481
3482
3483setupHsReplFlags :: ElaboratedConfiguredPackage
3484                 -> ElaboratedSharedConfig
3485                 -> Verbosity
3486                 -> FilePath
3487                 -> Cabal.ReplFlags
3488setupHsReplFlags _ sharedConfig verbosity builddir =
3489    Cabal.ReplFlags {
3490      replProgramPaths = mempty, --unused, set at configure time
3491      replProgramArgs  = mempty, --unused, set at configure time
3492      replVerbosity    = toFlag verbosity,
3493      replDistPref     = toFlag builddir,
3494      replReload       = mempty, --only used as callback from repl
3495      replReplOptions  = pkgConfigReplOptions sharedConfig       --runtime override for repl flags
3496    }
3497
3498
3499setupHsReplArgs :: ElaboratedConfiguredPackage -> [String]
3500setupHsReplArgs elab =
3501    maybe [] (\t -> [showComponentTarget (packageId elab) t]) (elabReplTarget elab)
3502    --TODO: should be able to give multiple modules in one component
3503
3504
3505setupHsCopyFlags :: ElaboratedConfiguredPackage
3506                 -> ElaboratedSharedConfig
3507                 -> Verbosity
3508                 -> FilePath
3509                 -> FilePath
3510                 -> Cabal.CopyFlags
3511setupHsCopyFlags _ _ verbosity builddir destdir =
3512    Cabal.CopyFlags {
3513      copyArgs      = [], -- TODO: could use this to only copy what we enabled
3514      copyDest      = toFlag (InstallDirs.CopyTo destdir),
3515      copyDistPref  = toFlag builddir,
3516      copyVerbosity = toFlag verbosity,
3517      copyCabalFilePath = mempty
3518    }
3519
3520setupHsRegisterFlags :: ElaboratedConfiguredPackage
3521                     -> ElaboratedSharedConfig
3522                     -> Verbosity
3523                     -> FilePath
3524                     -> FilePath
3525                     -> Cabal.RegisterFlags
3526setupHsRegisterFlags ElaboratedConfiguredPackage{..} _
3527                     verbosity builddir pkgConfFile =
3528    Cabal.RegisterFlags {
3529      regPackageDB   = mempty,  -- misfeature
3530      regGenScript   = mempty,  -- never use
3531      regGenPkgConf  = toFlag (Just pkgConfFile),
3532      regInPlace     = case elabBuildStyle of
3533                         BuildInplaceOnly -> toFlag True
3534                         _                -> toFlag False,
3535      regPrintId     = mempty,  -- never use
3536      regDistPref    = toFlag builddir,
3537      regArgs        = [],
3538      regVerbosity   = toFlag verbosity,
3539      regCabalFilePath = mempty
3540    }
3541
3542setupHsHaddockFlags :: ElaboratedConfiguredPackage
3543                    -> ElaboratedSharedConfig
3544                    -> Verbosity
3545                    -> FilePath
3546                    -> Cabal.HaddockFlags
3547setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir =
3548    Cabal.HaddockFlags {
3549      haddockProgramPaths  = mempty, --unused, set at configure time
3550      haddockProgramArgs   = mempty, --unused, set at configure time
3551      haddockHoogle        = toFlag elabHaddockHoogle,
3552      haddockHtml          = toFlag elabHaddockHtml,
3553      haddockHtmlLocation  = maybe mempty toFlag elabHaddockHtmlLocation,
3554      haddockForHackage    = toFlag elabHaddockForHackage,
3555      haddockForeignLibs   = toFlag elabHaddockForeignLibs,
3556      haddockExecutables   = toFlag elabHaddockExecutables,
3557      haddockTestSuites    = toFlag elabHaddockTestSuites,
3558      haddockBenchmarks    = toFlag elabHaddockBenchmarks,
3559      haddockInternal      = toFlag elabHaddockInternal,
3560      haddockCss           = maybe mempty toFlag elabHaddockCss,
3561      haddockLinkedSource  = toFlag elabHaddockLinkedSource,
3562      haddockQuickJump     = toFlag elabHaddockQuickJump,
3563      haddockHscolourCss   = maybe mempty toFlag elabHaddockHscolourCss,
3564      haddockContents      = maybe mempty toFlag elabHaddockContents,
3565      haddockDistPref      = toFlag builddir,
3566      haddockKeepTempFiles = mempty, --TODO: from build settings
3567      haddockVerbosity     = toFlag verbosity,
3568      haddockCabalFilePath = mempty,
3569      haddockArgs          = mempty
3570    }
3571
3572setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String]
3573-- TODO: Does the issue #3335 affects test as well
3574setupHsHaddockArgs elab =
3575  map (showComponentTarget (packageId elab)) (elabHaddockTargets elab)
3576
3577{-
3578setupHsTestFlags :: ElaboratedConfiguredPackage
3579                 -> ElaboratedSharedConfig
3580                 -> Verbosity
3581                 -> FilePath
3582                 -> Cabal.TestFlags
3583setupHsTestFlags _ _ verbosity builddir =
3584    Cabal.TestFlags {
3585    }
3586-}
3587
3588------------------------------------------------------------------------------
3589-- * Sharing installed packages
3590------------------------------------------------------------------------------
3591
3592--
3593-- Nix style store management for tarball packages
3594--
3595-- So here's our strategy:
3596--
3597-- We use a per-user nix-style hashed store, but /only/ for tarball packages.
3598-- So that includes packages from hackage repos (and other http and local
3599-- tarballs). For packages in local directories we do not register them into
3600-- the shared store by default, we just build them locally inplace.
3601--
3602-- The reason we do it like this is that it's easy to make stable hashes for
3603-- tarball packages, and these packages benefit most from sharing. By contrast
3604-- unpacked dir packages are harder to hash and they tend to change more
3605-- frequently so there's less benefit to sharing them.
3606--
3607-- When using the nix store approach we have to run the solver *without*
3608-- looking at the packages installed in the store, just at the source packages
3609-- (plus core\/global installed packages). Then we do a post-processing pass
3610-- to replace configured packages in the plan with pre-existing ones, where
3611-- possible. Where possible of course means where the nix-style package hash
3612-- equals one that's already in the store.
3613--
3614-- One extra wrinkle is that unless we know package tarball hashes upfront, we
3615-- will have to download the tarballs to find their hashes. So we have two
3616-- options: delay replacing source with pre-existing installed packages until
3617-- the point during the execution of the install plan where we have the
3618-- tarball, or try to do as much up-front as possible and then check again
3619-- during plan execution. The former isn't great because we would end up
3620-- telling users we're going to re-install loads of packages when in fact we
3621-- would just share them. It'd be better to give as accurate a prediction as
3622-- we can. The latter is better for users, but we do still have to check
3623-- during plan execution because it's important that we don't replace existing
3624-- installed packages even if they have the same package hash, because we
3625-- don't guarantee ABI stability.
3626
3627-- TODO: [required eventually] for safety of concurrent installs, we must make sure we register but
3628-- not replace installed packages with ghc-pkg.
3629
3630packageHashInputs :: ElaboratedSharedConfig
3631                  -> ElaboratedConfiguredPackage
3632                  -> PackageHashInputs
3633packageHashInputs
3634    pkgshared
3635    elab@(ElaboratedConfiguredPackage {
3636      elabPkgSourceHash = Just srchash
3637    }) =
3638    PackageHashInputs {
3639      pkgHashPkgId       = packageId elab,
3640      pkgHashComponent   =
3641        case elabPkgOrComp elab of
3642          ElabPackage _ -> Nothing
3643          ElabComponent comp -> Just (compSolverName comp),
3644      pkgHashSourceHash  = srchash,
3645      pkgHashPkgConfigDeps = Set.fromList (elabPkgConfigDependencies elab),
3646      pkgHashDirectDeps  =
3647        case elabPkgOrComp elab of
3648          ElabPackage (ElaboratedPackage{..}) ->
3649            Set.fromList $
3650             [ confInstId dep
3651             | dep <- CD.select relevantDeps pkgLibDependencies ] ++
3652             [ confInstId dep
3653             | dep <- CD.select relevantDeps pkgExeDependencies ]
3654          ElabComponent comp ->
3655            Set.fromList (map confInstId (compLibDependencies comp
3656                                       ++ compExeDependencies comp)),
3657      pkgHashOtherConfig = packageHashConfigInputs pkgshared elab
3658    }
3659  where
3660    -- Obviously the main deps are relevant
3661    relevantDeps CD.ComponentLib       = True
3662    relevantDeps (CD.ComponentSubLib _) = True
3663    relevantDeps (CD.ComponentFLib _)   = True
3664    relevantDeps (CD.ComponentExe _)   = True
3665    -- Setup deps can affect the Setup.hs behaviour and thus what is built
3666    relevantDeps  CD.ComponentSetup    = True
3667    -- However testsuites and benchmarks do not get installed and should not
3668    -- affect the result, so we do not include them.
3669    relevantDeps (CD.ComponentTest  _) = False
3670    relevantDeps (CD.ComponentBench _) = False
3671
3672packageHashInputs _ pkg =
3673    error $ "packageHashInputs: only for packages with source hashes. "
3674         ++ display (packageId pkg)
3675
3676packageHashConfigInputs :: ElaboratedSharedConfig
3677                        -> ElaboratedConfiguredPackage
3678                        -> PackageHashConfigInputs
3679packageHashConfigInputs shared@ElaboratedSharedConfig{..} pkg =
3680    PackageHashConfigInputs {
3681      pkgHashCompilerId          = compilerId pkgConfigCompiler,
3682      pkgHashPlatform            = pkgConfigPlatform,
3683      pkgHashFlagAssignment      = elabFlagAssignment,
3684      pkgHashConfigureScriptArgs = elabConfigureScriptArgs,
3685      pkgHashVanillaLib          = elabVanillaLib,
3686      pkgHashSharedLib           = elabSharedLib,
3687      pkgHashDynExe              = elabDynExe,
3688      pkgHashFullyStaticExe      = elabFullyStaticExe,
3689      pkgHashGHCiLib             = elabGHCiLib,
3690      pkgHashProfLib             = elabProfLib,
3691      pkgHashProfExe             = elabProfExe,
3692      pkgHashProfLibDetail       = elabProfLibDetail,
3693      pkgHashProfExeDetail       = elabProfExeDetail,
3694      pkgHashCoverage            = elabCoverage,
3695      pkgHashOptimization        = elabOptimization,
3696      pkgHashSplitSections       = elabSplitSections,
3697      pkgHashSplitObjs           = elabSplitObjs,
3698      pkgHashStripLibs           = elabStripLibs,
3699      pkgHashStripExes           = elabStripExes,
3700      pkgHashDebugInfo           = elabDebugInfo,
3701      pkgHashProgramArgs         = elabProgramArgs,
3702      pkgHashExtraLibDirs        = elabExtraLibDirs,
3703      pkgHashExtraFrameworkDirs  = elabExtraFrameworkDirs,
3704      pkgHashExtraIncludeDirs    = elabExtraIncludeDirs,
3705      pkgHashProgPrefix          = elabProgPrefix,
3706      pkgHashProgSuffix          = elabProgSuffix,
3707
3708      pkgHashDocumentation       = elabBuildHaddocks,
3709      pkgHashHaddockHoogle       = elabHaddockHoogle,
3710      pkgHashHaddockHtml         = elabHaddockHtml,
3711      pkgHashHaddockHtmlLocation = elabHaddockHtmlLocation,
3712      pkgHashHaddockForeignLibs  = elabHaddockForeignLibs,
3713      pkgHashHaddockExecutables  = elabHaddockExecutables,
3714      pkgHashHaddockTestSuites   = elabHaddockTestSuites,
3715      pkgHashHaddockBenchmarks   = elabHaddockBenchmarks,
3716      pkgHashHaddockInternal     = elabHaddockInternal,
3717      pkgHashHaddockCss          = elabHaddockCss,
3718      pkgHashHaddockLinkedSource = elabHaddockLinkedSource,
3719      pkgHashHaddockQuickJump    = elabHaddockQuickJump,
3720      pkgHashHaddockContents     = elabHaddockContents
3721    }
3722  where
3723    ElaboratedConfiguredPackage{..} = normaliseConfiguredPackage shared pkg
3724
3725-- | Given the 'InstalledPackageIndex' for a nix-style package store, and an
3726-- 'ElaboratedInstallPlan', replace configured source packages by installed
3727-- packages from the store whenever they exist.
3728--
3729improveInstallPlanWithInstalledPackages :: Set UnitId
3730                                        -> ElaboratedInstallPlan
3731                                        -> ElaboratedInstallPlan
3732improveInstallPlanWithInstalledPackages installedPkgIdSet =
3733    InstallPlan.installed canPackageBeImproved
3734  where
3735    canPackageBeImproved pkg =
3736      installedUnitId pkg `Set.member` installedPkgIdSet
3737    --TODO: sanity checks:
3738    -- * the installed package must have the expected deps etc
3739    -- * the installed package must not be broken, valid dep closure
3740
3741    --TODO: decide what to do if we encounter broken installed packages,
3742    -- since overwriting is never safe.
3743
3744
3745-- Path construction
3746------
3747
3748-- | The path to the directory that contains a specific executable.
3749-- NB: For inplace NOT InstallPaths.bindir installDirs; for an
3750-- inplace build those values are utter nonsense.  So we
3751-- have to guess where the directory is going to be.
3752-- Fortunately this is "stable" part of Cabal API.
3753-- But the way we get the build directory is A HORRIBLE
3754-- HACK.
3755binDirectoryFor
3756  :: DistDirLayout
3757  -> ElaboratedSharedConfig
3758  -> ElaboratedConfiguredPackage
3759  -> FilePath
3760  -> FilePath
3761binDirectoryFor layout config package exe = case elabBuildStyle package of
3762  BuildAndInstall -> installedBinDirectory package
3763  BuildInplaceOnly -> inplaceBinRoot layout config package </> exe
3764
3765-- package has been built and installed.
3766installedBinDirectory :: ElaboratedConfiguredPackage -> FilePath
3767installedBinDirectory = InstallDirs.bindir . elabInstallDirs
3768
3769-- | The path to the @build@ directory for an inplace build.
3770inplaceBinRoot
3771  :: DistDirLayout
3772  -> ElaboratedSharedConfig
3773  -> ElaboratedConfiguredPackage
3774  -> FilePath
3775inplaceBinRoot layout config package
3776  =  distBuildDirectory layout (elabDistDirParams config package)
3777 </> "build"
3778