ProjectPlanning.hs 150 KB
Newer Older
1
{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, RankNTypes #-}
2 3 4
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonoLocalBinds #-}
5
{-# LANGUAGE DeriveDataTypeable #-}
6
{-# LANGUAGE DeriveFunctor #-}
Duncan Coutts's avatar
Duncan Coutts committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20

-- | Planning how to build everything in a project.
--
module Distribution.Client.ProjectPlanning (
    -- * elaborated install plan types
    ElaboratedInstallPlan,
    ElaboratedConfiguredPackage(..),
    ElaboratedPlanPackage,
    ElaboratedSharedConfig(..),
    ElaboratedReadyPackage,
    BuildStyle(..),
    CabalFileText,

    -- * Producing the elaborated install plan
21
    rebuildProjectConfig,
Duncan Coutts's avatar
Duncan Coutts committed
22 23 24
    rebuildInstallPlan,

    -- * Build targets
25 26 27 28
    availableTargets,
    AvailableTarget(..),
    AvailableTargetStatus(..),
    TargetRequested(..),
Duncan Coutts's avatar
Duncan Coutts committed
29 30 31
    ComponentTarget(..),
    SubComponentTarget(..),
    showComponentTarget,
32
    nubComponentTargets,
Duncan Coutts's avatar
Duncan Coutts committed
33 34 35

    -- * Selecting a plan subset
    pruneInstallPlanToTargets,
36
    TargetAction(..),
37
    pruneInstallPlanToDependencies,
38
    CannotPruneDependencies(..),
Duncan Coutts's avatar
Duncan Coutts committed
39 40 41

    -- * Utils required for building
    pkgHasEphemeralBuildTargets,
42
    elabBuildTargetWholeComponents,
Duncan Coutts's avatar
Duncan Coutts committed
43 44 45 46

    -- * Setup.hs CLI flags for building
    setupHsScriptOptions,
    setupHsConfigureFlags,
47
    setupHsConfigureArgs,
Duncan Coutts's avatar
Duncan Coutts committed
48 49 50 51
    setupHsBuildFlags,
    setupHsBuildArgs,
    setupHsReplFlags,
    setupHsReplArgs,
Oleg Grenrus's avatar
Oleg Grenrus committed
52 53
    setupHsTestFlags,
    setupHsTestArgs,
Duncan Coutts's avatar
Duncan Coutts committed
54 55 56 57 58 59 60
    setupHsCopyFlags,
    setupHsRegisterFlags,
    setupHsHaddockFlags,

    packageHashInputs,
  ) where

61 62 63
import Prelude ()
import Distribution.Client.Compat.Prelude

64
import           Distribution.Client.ProjectPlanning.Types as Ty
Duncan Coutts's avatar
Duncan Coutts committed
65 66
import           Distribution.Client.PackageHash
import           Distribution.Client.RebuildMonad
67
import           Distribution.Client.Store
Duncan Coutts's avatar
Duncan Coutts committed
68
import           Distribution.Client.ProjectConfig
69
import           Distribution.Client.ProjectPlanOutput
Duncan Coutts's avatar
Duncan Coutts committed
70

71
import           Distribution.Client.Types
Duncan Coutts's avatar
Duncan Coutts committed
72
import qualified Distribution.Client.InstallPlan as InstallPlan
73
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
Duncan Coutts's avatar
Duncan Coutts committed
74 75 76 77 78 79 80 81
import           Distribution.Client.Dependency
import           Distribution.Client.Dependency.Types
import qualified Distribution.Client.IndexUtils as IndexUtils
import           Distribution.Client.Targets (userToPackageConstraint)
import           Distribution.Client.DistDirLayout
import           Distribution.Client.SetupWrapper
import           Distribution.Client.JobControl
import           Distribution.Client.FetchUtils
82
import qualified Hackage.Security.Client as Sec
Duncan Coutts's avatar
Duncan Coutts committed
83
import           Distribution.Client.Setup hiding (packageName, cabalVersion)
84
import           Distribution.Utils.NubList
85 86
import           Distribution.Utils.LogProgress
import           Distribution.Utils.MapAccum
Duncan Coutts's avatar
Duncan Coutts committed
87

88 89
import qualified Distribution.Solver.Types.ComponentDeps as CD
import           Distribution.Solver.Types.ComponentDeps (ComponentDeps)
90
import           Distribution.Solver.Types.ConstraintSource
91
import           Distribution.Solver.Types.LabeledPackageConstraint
92 93
import           Distribution.Solver.Types.OptionalStanza
import           Distribution.Solver.Types.PkgConfigDb
94
import           Distribution.Solver.Types.ResolverPackage
95 96
import           Distribution.Solver.Types.SolverId
import           Distribution.Solver.Types.SolverPackage
97
import           Distribution.Solver.Types.InstSolverPackage
98
import           Distribution.Solver.Types.SourcePackage
99
import           Distribution.Solver.Types.Settings
100

101
import           Distribution.ModuleName
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
102 103
import           Distribution.Package hiding
  (InstalledPackageId, installedPackageId)
104
import           Distribution.Types.AnnotatedId
105
import           Distribution.Types.ComponentName
106 107
import           Distribution.Types.PkgconfigDependency
import           Distribution.Types.UnqualComponentName
Duncan Coutts's avatar
Duncan Coutts committed
108 109 110 111 112 113 114 115 116 117 118 119
import           Distribution.System
import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Configuration as PD
import           Distribution.Simple.PackageIndex (InstalledPackageIndex)
import           Distribution.Simple.Compiler hiding (Flag)
import qualified Distribution.Simple.GHC   as GHC   --TODO: [code cleanup] eliminate
import qualified Distribution.Simple.GHCJS as GHCJS --TODO: [code cleanup] eliminate
import           Distribution.Simple.Program
import           Distribution.Simple.Program.Db
import           Distribution.Simple.Program.Find
import qualified Distribution.Simple.Setup as Cabal
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
120 121
import           Distribution.Simple.Setup
  (Flag, toFlag, flagToMaybe, flagToList, fromFlagOrDefault)
Duncan Coutts's avatar
Duncan Coutts committed
122 123
import qualified Distribution.Simple.Configure as Cabal
import qualified Distribution.Simple.LocalBuildInfo as Cabal
124 125 126
import           Distribution.Simple.LocalBuildInfo
                   ( Component(..), pkgComponents, componentBuildInfo
                   , componentName )
Duncan Coutts's avatar
Duncan Coutts committed
127
import qualified Distribution.Simple.InstallDirs as InstallDirs
128
import qualified Distribution.InstalledPackageInfo as IPI
Duncan Coutts's avatar
Duncan Coutts committed
129

130 131
import           Distribution.Backpack.ConfiguredComponent
import           Distribution.Backpack.LinkedComponent
132
import           Distribution.Backpack.ComponentsGraph
133 134 135
import           Distribution.Backpack.ModuleShape
import           Distribution.Backpack.FullUnitId
import           Distribution.Backpack
136
import           Distribution.Types.ComponentInclude
137

Duncan Coutts's avatar
Duncan Coutts committed
138 139 140 141 142
import           Distribution.Simple.Utils hiding (matchFileGlob)
import           Distribution.Version
import           Distribution.Verbosity
import           Distribution.Text

143
import qualified Distribution.Compat.Graph as Graph
144
import           Distribution.Compat.Graph(IsNode(..))
145

146
import           Text.PrettyPrint hiding ((<>))
147
import qualified Text.PrettyPrint as Disp
Duncan Coutts's avatar
Duncan Coutts committed
148 149 150 151
import qualified Data.Map as Map
import           Data.Set (Set)
import qualified Data.Set as Set
import           Control.Monad
152
import qualified Data.Traversable as T
Duncan Coutts's avatar
Duncan Coutts committed
153 154
import           Control.Monad.State as State
import           Control.Exception
155
import           Data.List (groupBy)
156
import           Data.Either
Duncan Coutts's avatar
Duncan Coutts committed
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
import           Data.Function
import           System.FilePath

------------------------------------------------------------------------------
-- * Elaborated install plan
------------------------------------------------------------------------------

-- "Elaborated" -- worked out with great care and nicety of detail;
--                 executed with great minuteness: elaborate preparations;
--                 elaborate care.
--
-- So here's the idea:
--
-- Rather than a miscellaneous collection of 'ConfigFlags', 'InstallFlags' etc
-- all passed in as separate args and which are then further selected,
-- transformed etc during the execution of the build. Instead we construct
-- an elaborated install plan that includes everything we will need, and then
-- during the execution of the plan we do as little transformation of this
-- info as possible.
--
-- So we're trying to split the work into two phases: construction of the
-- elaborated install plan (which as far as possible should be pure) and
-- then simple execution of that plan without any smarts, just doing what the
-- plan says to do.
--
-- So that means we need a representation of this fully elaborated install
-- plan. The representation consists of two parts:
--
-- * A 'ElaboratedInstallPlan'. This is a 'GenericInstallPlan' with a
--   representation of source packages that includes a lot more detail about
--   that package's individual configuration
--
-- * A 'ElaboratedSharedConfig'. Some package configuration is the same for
--   every package in a plan. Rather than duplicate that info every entry in
--   the 'GenericInstallPlan' we keep that separately.
--
-- The division between the shared and per-package config is /not set in stone
-- for all time/. For example if we wanted to generalise the install plan to
-- describe a situation where we want to build some packages with GHC and some
-- with GHCJS then the platform and compiler would no longer be shared between
-- all packages but would have to be per-package (probably with some sanity
-- condition on the graph structure).
--

201
-- Refer to ProjectPlanning.Types for details of these important types:
Duncan Coutts's avatar
Duncan Coutts committed
202

203 204 205 206 207
-- type ElaboratedInstallPlan = ...
-- type ElaboratedPlanPackage = ...
-- data ElaboratedSharedConfig = ...
-- data ElaboratedConfiguredPackage = ...
-- data BuildStyle =
Duncan Coutts's avatar
Duncan Coutts committed
208 209


210
-- | Check that an 'ElaboratedConfiguredPackage' actually makes
211
-- sense under some 'ElaboratedSharedConfig'.
212 213 214 215 216 217 218 219 220 221
sanityCheckElaboratedConfiguredPackage
    :: ElaboratedSharedConfig
    -> ElaboratedConfiguredPackage
    -> a
    -> a
sanityCheckElaboratedConfiguredPackage sharedConfig
                             elab@ElaboratedConfiguredPackage{..} =
    (case elabPkgOrComp of
        ElabPackage pkg -> sanityCheckElaboratedPackage elab pkg
        ElabComponent comp -> sanityCheckElaboratedComponent elab comp)
Duncan Coutts's avatar
Duncan Coutts committed
222

223 224 225 226
    -- either a package is being built inplace, or the
    -- 'installedPackageId' we assigned is consistent with
    -- the 'hashedInstalledPackageId' we would compute from
    -- the elaborated configured package
227
  . assert (elabBuildStyle == BuildInplaceOnly ||
228
     elabComponentId == hashedInstalledPackageId
229 230 231 232 233
                            (packageHashInputs sharedConfig elab))

    -- the stanzas explicitly disabled should not be available
  . assert (Set.null (Map.keysSet (Map.filter not elabStanzasRequested)
                `Set.intersection` elabStanzasAvailable))
Duncan Coutts's avatar
Duncan Coutts committed
234

235 236 237
    -- either a package is built inplace, or we are not attempting to
    -- build any test suites or benchmarks (we never build these
    -- for remote packages!)
238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
  . assert (elabBuildStyle == BuildInplaceOnly ||
     Set.null elabStanzasAvailable)

sanityCheckElaboratedComponent
    :: ElaboratedConfiguredPackage
    -> ElaboratedComponent
    -> a
    -> a
sanityCheckElaboratedComponent ElaboratedConfiguredPackage{..}
                               ElaboratedComponent{..} =

    -- Should not be building bench or test if not inplace.
    assert (elabBuildStyle == BuildInplaceOnly ||
     case compComponentName of
        Nothing              -> True
        Just CLibName        -> True
        Just (CSubLibName _) -> True
        Just (CExeName _)    -> True
256 257 258 259
        -- This is interesting: there's no way to declare a dependency
        -- on a foreign library at the moment, but you may still want
        -- to install these to the store
        Just (CFLibName _)   -> True
260 261 262 263 264 265 266 267 268 269 270 271 272 273
        Just (CBenchName _)  -> False
        Just (CTestName _)   -> False)


sanityCheckElaboratedPackage
    :: ElaboratedConfiguredPackage
    -> ElaboratedPackage
    -> a
    -> a
sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..}
                             ElaboratedPackage{..} =
    -- we should only have enabled stanzas that actually can be built
    -- (according to the solver)
    assert (pkgStanzasEnabled `Set.isSubsetOf` elabStanzasAvailable)
274

275 276 277 278
    -- the stanzas that the user explicitly requested should be
    -- enabled (by the previous test, they are also available)
  . assert (Map.keysSet (Map.filter id elabStanzasRequested)
                `Set.isSubsetOf` pkgStanzasEnabled)
Duncan Coutts's avatar
Duncan Coutts committed
279 280 281 282 283

------------------------------------------------------------------------------
-- * Deciding what to do: making an 'ElaboratedInstallPlan'
------------------------------------------------------------------------------

284 285 286 287 288 289 290 291
-- | Return the up-to-date project config and information about the local
-- packages within the project.
--
rebuildProjectConfig :: Verbosity
                     -> DistDirLayout
                     -> ProjectConfig
                     -> IO (ProjectConfig, [UnresolvedSourcePackage])
rebuildProjectConfig verbosity
292 293
                     distDirLayout@DistDirLayout {
                       distProjectRootDirectory,
294 295 296 297 298 299 300
                       distDirectory,
                       distProjectCacheFile,
                       distProjectCacheDirectory
                     }
                     cliConfig = do

    (projectConfig, localPackages) <-
301
      runRebuild distProjectRootDirectory $
302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322
      rerunIfChanged verbosity fileMonitorProjectConfig () $ do

        projectConfig <- phaseReadProjectConfig
        localPackages <- phaseReadLocalPackages projectConfig
        return (projectConfig, localPackages)

    return (projectConfig <> cliConfig, localPackages)

  where
    fileMonitorProjectConfig = newFileMonitor (distProjectCacheFile "config")

    -- Read the cabal.project (or implicit config) and combine it with
    -- arguments from the command line
    --
    phaseReadProjectConfig :: Rebuild ProjectConfig
    phaseReadProjectConfig = do
      liftIO $ do
        info verbosity "Project settings changed, reconfiguring..."
        createDirectoryIfMissingVerbose verbosity True distDirectory
        createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory

323
      readProjectConfig verbosity distDirLayout
324 325 326 327 328 329

    -- Look for all the cabal packages in the project
    -- some of which may be local src dirs, tarballs etc
    --
    phaseReadLocalPackages :: ProjectConfig -> Rebuild [UnresolvedSourcePackage]
    phaseReadLocalPackages projectConfig = do
330
      localCabalFiles <- findProjectPackages distDirLayout projectConfig
331 332 333 334
      mapM (readSourcePackage verbosity) localCabalFiles


-- | Return an up-to-date elaborated install plan.
335 336 337 338 339 340 341 342 343 344 345 346
--
-- Two variants of the install plan are returned: with and without packages
-- from the store. That is, the \"improved\" plan where source packages are
-- replaced by pre-existing installed packages from the store (when their ids
-- match), and also the original elaborated plan which uses primarily source
-- packages.

-- The improved plan is what we use for building, but the original elaborated
-- plan is useful for reporting and configuration. For example the @freeze@
-- command needs the source package info to know about flag choices and
-- dependencies of executables and setup scripts.
--
Duncan Coutts's avatar
Duncan Coutts committed
347
rebuildInstallPlan :: Verbosity
348
                   -> DistDirLayout -> CabalDirLayout
Duncan Coutts's avatar
Duncan Coutts committed
349
                   -> ProjectConfig
350
                   -> [UnresolvedSourcePackage]
351 352
                   -> IO ( ElaboratedInstallPlan  -- with store packages
                         , ElaboratedInstallPlan  -- with source packages
353
                         , ElaboratedSharedConfig )
354
                      -- ^ @(improvedPlan, elaboratedPlan, _, _)@
Duncan Coutts's avatar
Duncan Coutts committed
355 356
rebuildInstallPlan verbosity
                   distDirLayout@DistDirLayout {
357
                     distProjectRootDirectory,
358
                     distProjectCacheFile
Duncan Coutts's avatar
Duncan Coutts committed
359
                   }
360 361
                   CabalDirLayout {
                     cabalStoreDirLayout
362
                   } = \projectConfig localPackages ->
363
    runRebuild distProjectRootDirectory $ do
Duncan Coutts's avatar
Duncan Coutts committed
364
    progsearchpath <- liftIO $ getSystemSearchPath
365
    let projectConfigMonitored = projectConfig { projectConfigBuildOnly = mempty }
Duncan Coutts's avatar
Duncan Coutts committed
366 367

    -- The overall improved plan is cached
368
    rerunIfChanged verbosity fileMonitorImprovedPlan
369 370 371
                   -- react to changes in the project config,
                   -- the package .cabal files and the path
                   (projectConfigMonitored, localPackages, progsearchpath) $ do
Duncan Coutts's avatar
Duncan Coutts committed
372 373

      -- And so is the elaborated plan that the improved plan based on
374
      (elaboratedPlan, elaboratedShared) <-
375
        rerunIfChanged verbosity fileMonitorElaboratedPlan
376 377
                       (projectConfigMonitored, localPackages,
                        progsearchpath) $ do
Duncan Coutts's avatar
Duncan Coutts committed
378 379

          compilerEtc   <- phaseConfigureCompiler projectConfig
380
          _             <- phaseConfigurePrograms projectConfig compilerEtc
381
          (solverPlan, pkgConfigDB)
382
                        <- phaseRunSolver         projectConfig
383 384
                                                  compilerEtc
                                                  localPackages
Duncan Coutts's avatar
Duncan Coutts committed
385
          (elaboratedPlan,
386
           elaboratedShared) <- phaseElaboratePlan projectConfig
387 388 389
                                                   compilerEtc pkgConfigDB
                                                   solverPlan
                                                   localPackages
390

391
          phaseMaintainPlanOutputs elaboratedPlan elaboratedShared
392
          return (elaboratedPlan, elaboratedShared)
Duncan Coutts's avatar
Duncan Coutts committed
393 394 395 396 397

      -- The improved plan changes each time we install something, whereas
      -- the underlying elaborated plan only changes when input config
      -- changes, so it's worth caching them separately.
      improvedPlan <- phaseImprovePlan elaboratedPlan elaboratedShared
398

399
      return (improvedPlan, elaboratedPlan, elaboratedShared)
Duncan Coutts's avatar
Duncan Coutts committed
400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418

  where
    fileMonitorCompiler       = newFileMonitorInCacheDir "compiler"
    fileMonitorSolverPlan     = newFileMonitorInCacheDir "solver-plan"
    fileMonitorSourceHashes   = newFileMonitorInCacheDir "source-hashes"
    fileMonitorElaboratedPlan = newFileMonitorInCacheDir "elaborated-plan"
    fileMonitorImprovedPlan   = newFileMonitorInCacheDir "improved-plan"

    newFileMonitorInCacheDir :: Eq a => FilePath -> FileMonitor a b
    newFileMonitorInCacheDir  = newFileMonitor . distProjectCacheFile


    -- Configure the compiler we're using.
    --
    -- This is moderately expensive and doesn't change that often so we cache
    -- it independently.
    --
    phaseConfigureCompiler :: ProjectConfig
                           -> Rebuild (Compiler, Platform, ProgramDb)
419 420 421 422 423 424 425 426 427 428 429 430
    phaseConfigureCompiler ProjectConfig {
                             projectConfigShared = ProjectConfigShared {
                               projectConfigHcFlavor,
                               projectConfigHcPath,
                               projectConfigHcPkg
                             },
                             projectConfigLocalPackages = PackageConfig {
                               packageConfigProgramPaths,
                               packageConfigProgramArgs,
                               packageConfigProgramPathExtra
                             }
                           } = do
Duncan Coutts's avatar
Duncan Coutts committed
431
        progsearchpath <- liftIO $ getSystemSearchPath
432
        rerunIfChanged verbosity fileMonitorCompiler
433 434 435 436
                       (hcFlavor, hcPath, hcPkg, progsearchpath,
                        packageConfigProgramPaths,
                        packageConfigProgramArgs,
                        packageConfigProgramPathExtra) $ do
Duncan Coutts's avatar
Duncan Coutts committed
437 438

          liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
439
          result@(_, _, progdb') <- liftIO $
Duncan Coutts's avatar
Duncan Coutts committed
440 441
            Cabal.configCompilerEx
              hcFlavor hcPath hcPkg
442
              progdb verbosity
Duncan Coutts's avatar
Duncan Coutts committed
443

444 445 446 447 448 449 450
        -- Note that we added the user-supplied program locations and args
        -- for /all/ programs, not just those for the compiler prog and
        -- compiler-related utils. In principle we don't know which programs
        -- the compiler will configure (and it does vary between compilers).
        -- We do know however that the compiler will only configure the
        -- programs it cares about, and those are the ones we monitor here.
          monitorFiles (programsMonitorFiles progdb')
Duncan Coutts's avatar
Duncan Coutts committed
451 452 453 454 455 456

          return result
      where
        hcFlavor = flagToMaybe projectConfigHcFlavor
        hcPath   = flagToMaybe projectConfigHcPath
        hcPkg    = flagToMaybe projectConfigHcPkg
457 458 459 460 461 462 463
        progdb   =
            userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))
          . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs))
          . modifyProgramSearchPath
              (++ [ ProgramSearchPathDir dir
                  | dir <- fromNubList packageConfigProgramPathExtra ])
          $ defaultProgramDb
Duncan Coutts's avatar
Duncan Coutts committed
464 465


466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496
    -- Configuring other programs.
    --
    -- Having configred the compiler, now we configure all the remaining
    -- programs. This is to check we can find them, and to monitor them for
    -- changes.
    --
    -- TODO: [required eventually] we don't actually do this yet.
    --
    -- We rely on the fact that the previous phase added the program config for
    -- all local packages, but that all the programs configured so far are the
    -- compiler program or related util programs.
    --
    phaseConfigurePrograms :: ProjectConfig
                           -> (Compiler, Platform, ProgramDb)
                           -> Rebuild ()
    phaseConfigurePrograms projectConfig (_, _, compilerprogdb) = do
        -- Users are allowed to specify program locations independently for
        -- each package (e.g. to use a particular version of a pre-processor
        -- for some packages). However they cannot do this for the compiler
        -- itself as that's just not going to work. So we check for this.
        liftIO $ checkBadPerPackageCompilerPaths
          (configuredPrograms compilerprogdb)
          (getMapMappend (projectConfigSpecificPackage projectConfig))

        --TODO: [required eventually] find/configure other programs that the
        -- user specifies.

        --TODO: [required eventually] find/configure all build-tools
        -- but note that some of them may be built as part of the plan.


Duncan Coutts's avatar
Duncan Coutts committed
497 498 499 500 501 502
    -- Run the solver to get the initial install plan.
    -- This is expensive so we cache it independently.
    --
    phaseRunSolver :: ProjectConfig
                   -> (Compiler, Platform, ProgramDb)
                   -> [UnresolvedSourcePackage]
503
                   -> Rebuild (SolverInstallPlan, PkgConfigDb)
Duncan Coutts's avatar
Duncan Coutts committed
504 505 506 507 508 509
    phaseRunSolver projectConfig@ProjectConfig {
                     projectConfigShared,
                     projectConfigBuildOnly
                   }
                   (compiler, platform, progdb)
                   localPackages =
510
        rerunIfChanged verbosity fileMonitorSolverPlan
511
                       (solverSettings,
Duncan Coutts's avatar
Duncan Coutts committed
512
                        localPackages, localPackagesEnabledStanzas,
513
                        compiler, platform, programDbSignature progdb) $ do
Duncan Coutts's avatar
Duncan Coutts committed
514 515 516 517

          installedPkgIndex <- getInstalledPackages verbosity
                                                    compiler progdb platform
                                                    corePackageDbs
518 519 520
          sourcePkgDb       <- getSourcePackages verbosity withRepoCtx
                                 (solverSettingIndexState solverSettings)
          pkgConfigDB       <- getPkgConfigDb verbosity progdb
Duncan Coutts's avatar
Duncan Coutts committed
521

522 523 524 525 526
          --TODO: [code cleanup] it'd be better if the Compiler contained the
          -- ConfiguredPrograms that it needs, rather than relying on the progdb
          -- since we don't need to depend on all the programs here, just the
          -- ones relevant for the compiler.

Duncan Coutts's avatar
Duncan Coutts committed
527 528 529 530 531 532
          liftIO $ do
            solver <- chooseSolver verbosity
                                   (solverSettingSolver solverSettings)
                                   (compilerInfo compiler)

            notice verbosity "Resolving dependencies..."
533
            plan <- foldProgress logMsg (die' verbosity) return $
534
              planPackages verbosity compiler platform solver solverSettings
Duncan Coutts's avatar
Duncan Coutts committed
535 536
                           installedPkgIndex sourcePkgDb pkgConfigDB
                           localPackages localPackagesEnabledStanzas
537
            return (plan, pkgConfigDB)
Duncan Coutts's avatar
Duncan Coutts committed
538 539 540 541 542
      where
        corePackageDbs = [GlobalPackageDB]
        withRepoCtx    = projectConfigWithSolverRepoContext verbosity
                           projectConfigShared
                           projectConfigBuildOnly
543
        solverSettings = resolveSolverSettings projectConfig
Duncan Coutts's avatar
Duncan Coutts committed
544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569
        logMsg message rest = debugNoWrap verbosity message >> rest

        localPackagesEnabledStanzas =
          Map.fromList
            [ (pkgname, stanzas)
            | pkg <- localPackages
            , let pkgname            = packageName pkg
                  testsEnabled       = lookupLocalPackageConfig
                                         packageConfigTests
                                         projectConfig pkgname
                  benchmarksEnabled  = lookupLocalPackageConfig
                                         packageConfigBenchmarks
                                         projectConfig pkgname
                  stanzas =
                    Map.fromList $
                      [ (TestStanzas, enabled)
                      | enabled <- flagToList testsEnabled ]
                   ++ [ (BenchStanzas , enabled)
                      | enabled <- flagToList benchmarksEnabled ]
            ]

    -- Elaborate the solver's install plan to get a fully detailed plan. This
    -- version of the plan has the final nix-style hashed ids.
    --
    phaseElaboratePlan :: ProjectConfig
                       -> (Compiler, Platform, ProgramDb)
570
                       -> PkgConfigDb
571
                       -> SolverInstallPlan
Duncan Coutts's avatar
Duncan Coutts committed
572 573 574 575 576 577 578 579 580
                       -> [SourcePackage loc]
                       -> Rebuild ( ElaboratedInstallPlan
                                  , ElaboratedSharedConfig )
    phaseElaboratePlan ProjectConfig {
                         projectConfigShared,
                         projectConfigLocalPackages,
                         projectConfigSpecificPackage,
                         projectConfigBuildOnly
                       }
581
                       (compiler, platform, progdb) pkgConfigDB
582
                       solverPlan localPackages = do
Duncan Coutts's avatar
Duncan Coutts committed
583 584 585 586

        liftIO $ debug verbosity "Elaborating the install plan..."

        sourcePackageHashes <-
587
          rerunIfChanged verbosity fileMonitorSourceHashes
588
                         (packageLocationsSignature solverPlan) $
Duncan Coutts's avatar
Duncan Coutts committed
589 590 591
            getPackageSourceHashes verbosity withRepoCtx solverPlan

        defaultInstallDirs <- liftIO $ userInstallDirTemplates compiler
592 593
        (elaboratedPlan, elaboratedShared)
          <- liftIO . runLogProgress verbosity $
594
              elaborateInstallPlan
595
                verbosity
596
                platform compiler progdb pkgConfigDB
597
                distDirLayout
598
                cabalStoreDirLayout
599 600 601 602 603 604 605
                solverPlan
                localPackages
                sourcePackageHashes
                defaultInstallDirs
                projectConfigShared
                projectConfigLocalPackages
                (getMapMappend projectConfigSpecificPackage)
606 607 608
        let instantiatedPlan = instantiateInstallPlan elaboratedPlan
        liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan instantiatedPlan)
        return (instantiatedPlan, elaboratedShared)
Duncan Coutts's avatar
Duncan Coutts committed
609
      where
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
610
        withRepoCtx = projectConfigWithSolverRepoContext verbosity
Duncan Coutts's avatar
Duncan Coutts committed
611 612 613
                        projectConfigShared
                        projectConfigBuildOnly

614 615
    -- Update the files we maintain that reflect our current build environment.
    -- In particular we maintain a JSON representation of the elaborated
616 617
    -- install plan (but not the improved plan since that reflects the state
    -- of the build rather than just the input environment).
618 619 620 621
    --
    phaseMaintainPlanOutputs :: ElaboratedInstallPlan
                             -> ElaboratedSharedConfig
                             -> Rebuild ()
622 623 624 625 626 627
    phaseMaintainPlanOutputs elaboratedPlan elaboratedShared = liftIO $ do
        debug verbosity "Updating plan.json"
        writePlanExternalRepresentation
          distDirLayout
          elaboratedPlan
          elaboratedShared
628 629


Duncan Coutts's avatar
Duncan Coutts committed
630 631 632 633 634 635 636 637 638 639 640 641 642 643 644
    -- Improve the elaborated install plan. The elaborated plan consists
    -- mostly of source packages (with full nix-style hashed ids). Where
    -- corresponding installed packages already exist in the store, replace
    -- them in the plan.
    --
    -- Note that we do monitor the store's package db here, so we will redo
    -- this improvement phase when the db changes -- including as a result of
    -- executing a plan and installing things.
    --
    phaseImprovePlan :: ElaboratedInstallPlan
                     -> ElaboratedSharedConfig
                     -> Rebuild ElaboratedInstallPlan
    phaseImprovePlan elaboratedPlan elaboratedShared = do

        liftIO $ debug verbosity "Improving the install plan..."
645
        storePkgIdSet <- getStoreEntries cabalStoreDirLayout compid
646
        let improvedPlan = improveInstallPlanWithInstalledPackages
647
                             storePkgIdSet
Duncan Coutts's avatar
Duncan Coutts committed
648
                             elaboratedPlan
649
        liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan improvedPlan)
650 651 652 653
        -- TODO: [nice to have] having checked which packages from the store
        -- we're using, it may be sensible to sanity check those packages
        -- by loading up the compiler package db and checking everything
        -- matches up as expected, e.g. no dangling deps, files deleted.
Duncan Coutts's avatar
Duncan Coutts committed
654 655
        return improvedPlan
      where
656
        compid = compilerId (pkgConfigCompiler elaboratedShared)
Duncan Coutts's avatar
Duncan Coutts committed
657 658 659 660 661 662 663 664 665 666 667 668 669


programsMonitorFiles :: ProgramDb -> [MonitorFilePath]
programsMonitorFiles progdb =
    [ monitor
    | prog    <- configuredPrograms progdb
    , monitor <- monitorFileSearchPath (programMonitorFiles prog)
                                       (programPath prog)
    ]

-- | Select the bits of a 'ProgramDb' to monitor for value changes.
-- Use 'programsMonitorFiles' for the files to monitor.
--
670 671
programDbSignature :: ProgramDb -> [ConfiguredProgram]
programDbSignature progdb =
Duncan Coutts's avatar
Duncan Coutts committed
672 673 674 675 676 677 678
    [ prog { programMonitorFiles = []
           , programOverrideEnv  = filter ((/="PATH") . fst)
                                          (programOverrideEnv prog) }
    | prog <- configuredPrograms progdb ]

getInstalledPackages :: Verbosity
                     -> Compiler -> ProgramDb -> Platform
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
679
                     -> PackageDBStack
Duncan Coutts's avatar
Duncan Coutts committed
680 681
                     -> Rebuild InstalledPackageIndex
getInstalledPackages verbosity compiler progdb platform packagedbs = do
682
    monitorFiles . map monitorFileOrDirectory
Duncan Coutts's avatar
Duncan Coutts committed
683 684 685 686 687 688 689
      =<< liftIO (IndexUtils.getInstalledPackagesMonitorFiles
                    verbosity compiler
                    packagedbs progdb platform)
    liftIO $ IndexUtils.getInstalledPackages
               verbosity compiler
               packagedbs progdb

690 691
{-
--TODO: [nice to have] use this but for sanity / consistency checking
Duncan Coutts's avatar
Duncan Coutts committed
692 693 694 695 696
getPackageDBContents :: Verbosity
                     -> Compiler -> ProgramDb -> Platform
                     -> PackageDB
                     -> Rebuild InstalledPackageIndex
getPackageDBContents verbosity compiler progdb platform packagedb = do
697
    monitorFiles . map monitorFileOrDirectory
Duncan Coutts's avatar
Duncan Coutts committed
698 699 700 701
      =<< liftIO (IndexUtils.getInstalledPackagesMonitorFiles
                    verbosity compiler
                    [packagedb] progdb platform)
    liftIO $ do
702
      createPackageDBIfMissing verbosity compiler progdb packagedb
Duncan Coutts's avatar
Duncan Coutts committed
703 704
      Cabal.getPackageDBContents verbosity compiler
                                 packagedb progdb
705
-}
Duncan Coutts's avatar
Duncan Coutts committed
706 707

getSourcePackages :: Verbosity -> (forall a. (RepoContext -> IO a) -> IO a)
708
                  -> Maybe IndexUtils.IndexState -> Rebuild SourcePackageDb
709
getSourcePackages verbosity withRepoCtx idxState = do
Duncan Coutts's avatar
Duncan Coutts committed
710
    (sourcePkgDb, repos) <-
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
711
      liftIO $
Duncan Coutts's avatar
Duncan Coutts committed
712
        withRepoCtx $ \repoctx -> do
713 714
          sourcePkgDb <- IndexUtils.getSourcePackagesAtIndexState verbosity
                                                                  repoctx idxState
Duncan Coutts's avatar
Duncan Coutts committed
715 716
          return (sourcePkgDb, repoContextRepos repoctx)

717 718 719
    mapM_ needIfExists
        . IndexUtils.getSourcePackagesMonitorFiles
        $ repos
Duncan Coutts's avatar
Duncan Coutts committed
720 721
    return sourcePkgDb

722

723 724 725 726 727
getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild PkgConfigDb
getPkgConfigDb verbosity progdb = do
    dirs <- liftIO $ getPkgConfigDbDirs verbosity progdb
    -- Just monitor the dirs so we'll notice new .pc files.
    -- Alternatively we could monitor all the .pc files too.
728
    mapM_ monitorDirectoryStatus dirs
729 730 731
    liftIO $ readPkgConfigDb verbosity progdb


732 733 734 735 736
-- | Select the config values to monitor for changes package source hashes.
packageLocationsSignature :: SolverInstallPlan
                          -> [(PackageId, PackageLocation (Maybe FilePath))]
packageLocationsSignature solverPlan =
    [ (packageId pkg, packageSource pkg)
737 738
    | SolverInstallPlan.Configured (SolverPackage { solverPkgSource = pkg})
        <- SolverInstallPlan.toList solverPlan
739 740 741
    ]


Duncan Coutts's avatar
Duncan Coutts committed
742 743 744 745 746 747 748 749 750
-- | Get the 'HashValue' for all the source packages where we use hashes,
-- and download any packages required to do so.
--
-- Note that we don't get hashes for local unpacked packages.
--
getPackageSourceHashes :: Verbosity
                       -> (forall a. (RepoContext -> IO a) -> IO a)
                       -> SolverInstallPlan
                       -> Rebuild (Map PackageId PackageSourceHash)
751
getPackageSourceHashes verbosity withRepoCtx solverPlan = do
Duncan Coutts's avatar
Duncan Coutts committed
752

753
    -- Determine if and where to get the package's source hash from.
Duncan Coutts's avatar
Duncan Coutts committed
754
    --
755 756 757
    let allPkgLocations :: [(PackageId, PackageLocation (Maybe FilePath))]
        allPkgLocations =
          [ (packageId pkg, packageSource pkg)
758 759
          | SolverInstallPlan.Configured (SolverPackage { solverPkgSource = pkg})
              <- SolverInstallPlan.toList solverPlan ]
760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789

        -- Tarballs that were local in the first place.
        -- We'll hash these tarball files directly.
        localTarballPkgs :: [(PackageId, FilePath)]
        localTarballPkgs =
          [ (pkgid, tarball)
          | (pkgid, LocalTarballPackage tarball) <- allPkgLocations ]

        -- Tarballs from remote URLs. We must have downloaded these already
        -- (since we extracted the .cabal file earlier)
        --TODO: [required eventually] finish remote tarball functionality
--        allRemoteTarballPkgs =
--          [ (pkgid, )
--          | (pkgid, RemoteTarballPackage ) <- allPkgLocations ]

        -- Tarballs from repositories, either where the repository provides
        -- hashes as part of the repo metadata, or where we will have to
        -- download and hash the tarball.
        repoTarballPkgsWithMetadata    :: [(PackageId, Repo)]
        repoTarballPkgsWithoutMetadata :: [(PackageId, Repo)]
        (repoTarballPkgsWithMetadata,
         repoTarballPkgsWithoutMetadata) =
          partitionEithers
          [ case repo of
              RepoSecure{} -> Left  (pkgid, repo)
              _            -> Right (pkgid, repo)
          | (pkgid, RepoTarballPackage repo _ _) <- allPkgLocations ]

    -- For tarballs from repos that do not have hashes available we now have
    -- to check if the packages were downloaded already.
Duncan Coutts's avatar
Duncan Coutts committed
790
    --
791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819
    (repoTarballPkgsToDownload,
     repoTarballPkgsDownloaded)
      <- fmap partitionEithers $
         liftIO $ sequence
           [ do mtarball <- checkRepoTarballFetched repo pkgid
                case mtarball of
                  Nothing      -> return (Left  (pkgid, repo))
                  Just tarball -> return (Right (pkgid, tarball))
           | (pkgid, repo) <- repoTarballPkgsWithoutMetadata ]

    (hashesFromRepoMetadata,
     repoTarballPkgsNewlyDownloaded) <-
      -- Avoid having to initialise the repository (ie 'withRepoCtx') if we
      -- don't have to. (The main cost is configuring the http client.)
      if null repoTarballPkgsToDownload && null repoTarballPkgsWithMetadata
      then return (Map.empty, [])
      else liftIO $ withRepoCtx $ \repoctx -> do

      -- For tarballs from repos that do have hashes available as part of the
      -- repo metadata we now load up the index for each repo and retrieve
      -- the hashes for the packages
      --
      hashesFromRepoMetadata <-
        Sec.uncheckClientErrors $ --TODO: [code cleanup] wrap in our own exceptions
        fmap (Map.fromList . concat) $
        sequence
          -- Reading the repo index is expensive so we group the packages by repo
          [ repoContextWithSecureRepo repoctx repo $ \secureRepo ->
              Sec.withIndex secureRepo $ \repoIndex ->
Duncan Coutts's avatar
Duncan Coutts committed
820
                sequence
821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849
                  [ do hash <- Sec.trusted <$> -- strip off Trusted tag
                               Sec.indexLookupHash repoIndex pkgid
                       -- Note that hackage-security currently uses SHA256
                       -- but this API could in principle give us some other
                       -- choice in future.
                       return (pkgid, hashFromTUF hash)
                  | pkgid <- pkgids ]
          | (repo, pkgids) <-
                map (\grp@((_,repo):_) -> (repo, map fst grp))
              . groupBy ((==)    `on` (remoteRepoName . repoRemote . snd))
              . sortBy  (compare `on` (remoteRepoName . repoRemote . snd))
              $ repoTarballPkgsWithMetadata
          ]

      -- For tarballs from repos that do not have hashes available, download
      -- the ones we previously determined we need.
      --
      repoTarballPkgsNewlyDownloaded <-
        sequence
          [ do tarball <- fetchRepoTarball verbosity repoctx repo pkgid
               return (pkgid, tarball)
          | (pkgid, repo) <- repoTarballPkgsToDownload ]

      return (hashesFromRepoMetadata,
              repoTarballPkgsNewlyDownloaded)

    -- Hash tarball files for packages where we have to do that. This includes
    -- tarballs that were local in the first place, plus tarballs from repos,
    -- either previously cached or freshly downloaded.
Duncan Coutts's avatar
Duncan Coutts committed
850
    --
851 852 853 854 855 856
    let allTarballFilePkgs :: [(PackageId, FilePath)]
        allTarballFilePkgs = localTarballPkgs
                          ++ repoTarballPkgsDownloaded
                          ++ repoTarballPkgsNewlyDownloaded
    hashesFromTarballFiles <- liftIO $
      fmap Map.fromList $
Duncan Coutts's avatar
Duncan Coutts committed
857 858 859
      sequence
        [ do srchash <- readFileHashValue tarball
             return (pkgid, srchash)
860 861 862 863 864 865 866 867
        | (pkgid, tarball) <- allTarballFilePkgs
        ]
    monitorFiles [ monitorFile tarball
                 | (_pkgid, tarball) <- allTarballFilePkgs ]

    -- Return the combination
    return $! hashesFromRepoMetadata
           <> hashesFromTarballFiles
Duncan Coutts's avatar
Duncan Coutts committed
868 869 870 871 872 873


-- ------------------------------------------------------------
-- * Installation planning
-- ------------------------------------------------------------

874 875
planPackages :: Verbosity
             -> Compiler
Duncan Coutts's avatar
Duncan Coutts committed
876 877 878 879 880 881 882
             -> Platform
             -> Solver -> SolverSettings
             -> InstalledPackageIndex
             -> SourcePackageDb
             -> PkgConfigDb
             -> [UnresolvedSourcePackage]
             -> Map PackageName (Map OptionalStanza Bool)
883
             -> Progress String String SolverInstallPlan
884
planPackages verbosity comp platform solver SolverSettings{..}
Duncan Coutts's avatar
Duncan Coutts committed
885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900
             installedPkgIndex sourcePkgDb pkgConfigDB
             localPackages pkgStanzasEnable =

    resolveDependencies
      platform (compilerInfo comp)
      pkgConfigDB solver
      resolverParams

  where

    --TODO: [nice to have] disable multiple instances restriction in the solver, but then
    -- make sure we can cope with that in the output.
    resolverParams =

        setMaxBackjumps solverSettingMaxBackjumps

kristenk's avatar
kristenk committed
901
      . setIndependentGoals solverSettingIndependentGoals
Duncan Coutts's avatar
Duncan Coutts committed
902 903 904

      . setReorderGoals solverSettingReorderGoals

905 906
      . setCountConflicts solverSettingCountConflicts

Duncan Coutts's avatar
Duncan Coutts committed
907 908 909 910 911 912 913 914
        --TODO: [required eventually] should only be configurable for custom installs
   -- . setAvoidReinstalls solverSettingAvoidReinstalls

        --TODO: [required eventually] should only be configurable for custom installs
   -- . setShadowPkgs solverSettingShadowPkgs

      . setStrongFlags solverSettingStrongFlags

915
      . setAllowBootLibInstalls solverSettingAllowBootLibInstalls
916

917 918
      . setSolverVerbosity verbosity

Duncan Coutts's avatar
Duncan Coutts committed
919 920 921 922 923 924 925 926
        --TODO: [required eventually] decide if we need to prefer installed for
        -- global packages, or prefer latest even for global packages. Perhaps
        -- should be configurable but with a different name than "upgrade-dependencies".
      . setPreferenceDefault PreferLatestForSelected
                           {-(if solverSettingUpgradeDeps
                                then PreferAllLatest
                                else PreferLatestForSelected)-}

927 928
      . removeLowerBounds solverSettingAllowOlder
      . removeUpperBounds solverSettingAllowNewer
Duncan Coutts's avatar
Duncan Coutts committed
929

930
      . addDefaultSetupDependencies (defaultSetupDeps comp platform
Duncan Coutts's avatar
Duncan Coutts committed
931 932 933
                                   . PD.packageDescription
                                   . packageDescription)

934 935 936 937 938 939 940 941 942 943 944 945 946
      . addSetupCabalMinVersionConstraint (mkVersion [1,20])
          -- While we can talk to older Cabal versions (we need to be able to
          -- do so for custom Setup scripts that require older Cabal lib
          -- versions), we have problems talking to some older versions that
          -- don't support certain features.
          --
          -- For example, Cabal-1.16 and older do not know about build targets.
          -- Even worse, 1.18 and older only supported the --constraint flag
          -- with source package ids, not --dependency with installed package
          -- ids. That is bad because we cannot reliably select the right
          -- dependencies in the presence of multiple instances (i.e. the
          -- store). See issue #3932. So we require Cabal 1.20 as a minimum.

Duncan Coutts's avatar
Duncan Coutts committed
947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970
      . addPreferences
          -- preferences from the config file or command line
          [ PackageVersionPreference name ver
          | Dependency name ver <- solverSettingPreferences ]

      . addConstraints
          -- version constraints from the config file or command line
            [ LabeledPackageConstraint (userToPackageConstraint pc) src
            | (pc, src) <- solverSettingConstraints ]

      . addPreferences
          -- enable stanza preference where the user did not specify
          [ PackageStanzasPreference pkgname stanzas
          | pkg <- localPackages
          , let pkgname = packageName pkg
                stanzaM = Map.findWithDefault Map.empty pkgname pkgStanzasEnable
                stanzas = [ stanza | stanza <- [minBound..maxBound]
                          , Map.lookup stanza stanzaM == Nothing ]
          , not (null stanzas)
          ]

      . addConstraints
          -- enable stanza constraints where the user asked to enable
          [ LabeledPackageConstraint
971
              (PackageConstraint (scopeToplevel pkgname)
972
                                 (PackagePropertyStanzas stanzas))
Duncan Coutts's avatar
Duncan Coutts committed
973 974 975 976 977 978 979 980 981 982
              ConstraintSourceConfigFlagOrTarget
          | pkg <- localPackages
          , let pkgname = packageName pkg
                stanzaM = Map.findWithDefault Map.empty pkgname pkgStanzasEnable
                stanzas = [ stanza | stanza <- [minBound..maxBound]
                          , Map.lookup stanza stanzaM == Just True ]
          , not (null stanzas)
          ]

      . addConstraints
983 984 985
          --TODO: [nice to have] should have checked at some point that the
          -- package in question actually has these flags.
          [ LabeledPackageConstraint
986
              (PackageConstraint (scopeToplevel pkgname)
987
                                 (PackagePropertyFlags flags))
988 989 990 991 992 993 994 995
              ConstraintSourceConfigFlagOrTarget
          | (pkgname, flags) <- Map.toList solverSettingFlagAssignments ]

      . addConstraints
          --TODO: [nice to have] we have user-supplied flags for unspecified
          -- local packages (as well as specific per-package flags). For the
          -- former we just apply all these flags to all local targets which
          -- is silly. We should check if the flags are appropriate.
Duncan Coutts's avatar
Duncan Coutts committed
996
          [ LabeledPackageConstraint
997
              (PackageConstraint (scopeToplevel pkgname)
998
                                 (PackagePropertyFlags flags))
Duncan Coutts's avatar
Duncan Coutts committed
999 1000 1001 1002 1003 1004 1005 1006 1007
              ConstraintSourceConfigFlagOrTarget
          | let flags = solverSettingFlagAssignment
          , not (null flags)
          , pkg <- localPackages
          , let pkgname = packageName pkg ]

      $ stdResolverParams

    stdResolverParams =
1008 1009 1010
      -- Note: we don't use the standardInstallPolicy here, since that uses
      -- its own addDefaultSetupDependencies that is not appropriate for us.
      basicInstallPolicy
Duncan Coutts's avatar
Duncan Coutts committed
1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038
        installedPkgIndex sourcePkgDb
        (map SpecificSourcePackage localPackages)


------------------------------------------------------------------------------
-- * Install plan post-processing
------------------------------------------------------------------------------

-- This phase goes from the InstallPlan we get from the solver and has to
-- make an elaborated install plan.
--
-- We go in two steps:
--
--  1. elaborate all the source packages that the solver has chosen.
--  2. swap source packages for pre-existing installed packages wherever
--     possible.
--
-- We do it in this order, elaborating and then replacing, because the easiest
-- way to calculate the installed package ids used for the replacement step is
-- from the elaborated configuration for each package.




------------------------------------------------------------------------------
-- * Install plan elaboration
------------------------------------------------------------------------------

1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112
-- Note [SolverId to ConfiguredId]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Dependency solving is a per package affair, so after we're done, we
-- end up with 'SolverInstallPlan' that records in 'solverPkgLibDeps'
-- and 'solverPkgExeDeps' what packages provide the libraries and executables
-- needed by each component of the package (phew!)  For example, if I have
--
--      library
--          build-depends: lib
--          build-tool-depends: pkg:exe1
--          build-tools: alex
--
-- After dependency solving, I find out that this library component has
-- library dependencies on lib-0.2, and executable dependencies on pkg-0.1
-- and alex-0.3 (other components of the package may have different
-- dependencies).  Note that I've "lost" the knowledge that I depend
-- *specifically* on the exe1 executable from pkg.
--
-- So, we have a this graph of packages, and we need to transform it into
-- a graph of components which we are actually going to build.  In particular:
--
-- NODE changes from PACKAGE (SolverPackage) to COMPONENTS (ElaboratedConfiguredPackage)
-- EDGE changes from PACKAGE DEP (SolverId) to COMPONENT DEPS (ConfiguredId)
--
-- In both cases, what was previously a single node/edge may turn into multiple
-- nodes/edges.  Multiple components, because there may be multiple components
-- in a package; multiple component deps, because we may depend upon multiple
-- executables from the same package (and maybe, some day, multiple libraries
-- from the same package.)
--
-- Let's talk about how to do this transformation. Naively, we might consider
-- just processing each package, converting it into (zero or) one or more
-- components.  But we also have to update the edges; this leads to
-- two complications:
--
--      1. We don't know what the ConfiguredId of a component is until
--      we've configured it, but we cannot configure a component unless
--      we know the ConfiguredId of all its dependencies.  Thus, we must
--      process the 'SolverInstallPlan' in topological order.
--
--      2. When we process a package, we know the SolverIds of its
--      dependencies, but we have to do some work to turn these into
--      ConfiguredIds.  For example, in the case of build-tool-depends, the
--      SolverId isn't enough to uniquely determine the ConfiguredId we should
--      elaborate to: we have to look at the executable name attached to
--      the package name in the package description to figure it out.
--      At the same time, we NEED to use the SolverId, because there might
--      be multiple versions of the same package in the build plan
--      (due to setup dependencies); we can't just look up the package name
--      from the package description.
--
-- However, we do have the following INVARIANT: a component never directly
-- depends on multiple versions of the same package.  Thus, we can
-- adopt the following strategy:
--
--      * When a package is transformed into components, record
--        a mapping from SolverId to ALL of the components
--        which were elaborated.
--
--      * When we look up an edge, we use our knowledge of the
--        component name to *filter* the list of components into
--        the ones we actually wanted to refer to.
--
-- By the way, we can tell that SolverInstallPlan is not the "right" type
-- because a SolverId cannot adequately represent all possible dependency
-- solver states: we may need to record foo-0.1 multiple times in
-- the solver install plan with different dependencies.  The solver probably
-- doesn't handle this correctly... but it should.  The right way to solve
-- this is to come up with something very much like a 'ConfiguredId', in that
-- it incorporates the version choices of its dependencies, but less
-- fine grained.  Fortunately, this doesn't seem to have affected anyone,
-- but it is good to watch out about.


Duncan Coutts's avatar
Duncan Coutts committed
1113 1114 1115 1116 1117 1118 1119
-- | Produce an elaborated install plan using the policy for local builds with
-- a nix-style shared store.
--
-- In theory should be able to make an elaborated install plan with a policy
-- matching that of the classic @cabal install --user@ or @--global@
--
elaborateInstallPlan
1120
  :: Verbosity -> Platform -> Compiler -> ProgramDb -> PkgConfigDb
Duncan Coutts's avatar
Duncan Coutts committed
1121
  -> DistDirLayout
1122
  -> StoreDirLayout
Duncan Coutts's avatar
Duncan Coutts committed
1123 1124 1125 1126 1127 1128 1129
  -> SolverInstallPlan
  -> [SourcePackage loc]
  -> Map PackageId PackageSourceHash
  -> InstallDirs.InstallDirTemplates
  -> ProjectConfigShared
  -> PackageConfig
  -> Map PackageName PackageConfig
1130 1131
  -> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
Duncan Coutts's avatar
Duncan Coutts committed
1132
                     DistDirLayout{..}
1133
                     storeDirLayout@StoreDirLayout{storePackageDBStack}
1134
                     solverPlan localPackages
Duncan Coutts's avatar
Duncan Coutts committed
1135 1136
                     sourcePackageHashes
                     defaultInstallDirs
1137
                     sharedPackageConfig
Duncan Coutts's avatar
Duncan Coutts committed
1138
                     localPackagesConfig
1139 1140 1141
                     perPackageConfig = do
    x <- elaboratedInstallPlan
    return (x, elaboratedSharedConfig)
Duncan Coutts's avatar
Duncan Coutts committed
1142 1143 1144
  where
    elaboratedSharedConfig =
      ElaboratedSharedConfig {
1145 1146 1147
        pkgConfigPlatform      = platform,
        pkgConfigCompiler      = compiler,
        pkgConfigCompilerProgs = compilerprogdb
Duncan Coutts's avatar
Duncan Coutts committed
1148 1149
      }

1150 1151 1152 1153
    preexistingInstantiatedPkgs =
        Map.fromList (mapMaybe f (SolverInstallPlan.toList solverPlan))
      where
        f (SolverInstallPlan.PreExisting inst)
1154 1155
            | let ipkg = instSolverPkgIPI inst
            , not (IPI.indefinite ipkg)
1156 1157 1158 1159 1160
            = Just (IPI.installedUnitId ipkg,
                     (FullUnitId (IPI.installedComponentId ipkg)
                                 (Map.fromList (IPI.instantiatedWith ipkg))))
        f _ = Nothing

Duncan Coutts's avatar
Duncan Coutts committed
1161
    elaboratedInstallPlan =
1162
      flip InstallPlan.fromSolverInstallPlanWithProgress solverPlan $ \mapDep planpkg ->
Duncan Coutts's avatar
Duncan Coutts committed
1163
        case planpkg of
1164
          SolverInstallPlan.PreExisting pkg ->
1165
            return [InstallPlan.PreExisting (instSolverPkgIPI pkg)]
Duncan Coutts's avatar
Duncan Coutts committed
1166

1167
          SolverInstallPlan.Configured  pkg ->
1168 1169 1170 1171 1172
            let inplace_doc | shouldBuildInplaceOnly pkg = text "inplace"
                            | otherwise                  = Disp.empty
            in addProgressCtx (text "In the" <+> inplace_doc <+> text "package" <+>
                             quotes (disp (packageId pkg))) $
               map InstallPlan.Configured <$> elaborateSolverToComponents mapDep pkg
1173

1174 1175
    -- NB: We don't INSTANTIATE packages at this point.  That's
    -- a post-pass.  This makes it simpler to compute dependencies.
1176
    elaborateSolverToComponents
1177 1178
        :: (SolverId -> [ElaboratedPlanPackage])
        -> SolverPackage UnresolvedPkgLoc
1179
        -> LogProgress [ElaboratedConfiguredPackage]
1180
    elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0 exe_deps0)
1181
        = case mkComponentsGraph (elabEnabledSpec elab0) pd of
1182
           Right g -> do
1183
            let src_comps = componentsGraphToList g
1184
            infoProgress $ hang (text "Component graph for" <+> disp pkgid <<>> colon)
1185
                            4 (dispComponentsWithDeps src_comps)
1186
            (_, comps) <- mapAccumM buildComponent
Edward Z. Yang's avatar
Edward Z. Yang committed
1187
                            (Map.empty, Map.empty, Map.empty)