ProjectPlanOutput.hs 36.4 KB
Newer Older
1 2 3
{-# LANGUAGE BangPatterns, RecordWildCards, NamedFieldPuns,
             DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving,
             ScopedTypeVariables #-}
4 5
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
6 7

module Distribution.Client.ProjectPlanOutput (
8
    -- * Plan output
9
    writePlanExternalRepresentation,
10 11 12 13 14

    -- * Project status
    -- | Several outputs rely on having a general overview of
    PostBuildProjectStatus(..),
    updatePostBuildProjectStatus,
15
    writePlanGhcEnvironment,
16 17 18
  ) where

import           Distribution.Client.ProjectPlanning.Types
19
import           Distribution.Client.ProjectBuilding.Types
20
import           Distribution.Client.DistDirLayout
21
import           Distribution.Client.Types (confInstId)
22
import           Distribution.Client.PackageHash (showHashValue)
23 24 25

import qualified Distribution.Client.InstallPlan as InstallPlan
import qualified Distribution.Client.Utils.Json as J
26
import qualified Distribution.Simple.InstallDirs as InstallDirs
27 28

import qualified Distribution.Solver.Types.ComponentDeps as ComponentDeps
29 30

import           Distribution.Package
31
import           Distribution.System
32
import           Distribution.InstalledPackageInfo (InstalledPackageInfo)
33
import qualified Distribution.PackageDescription as PD
34 35 36
import           Distribution.Compiler (CompilerFlavor(GHC))
import           Distribution.Simple.Compiler
                   ( PackageDBStack, PackageDB(..)
37
                   , compilerVersion, compilerFlavor, showCompilerId )
38 39 40 41
import           Distribution.Simple.GHC
                   ( getImplInfo, GhcImplInfo(supportsPkgEnvFiles)
                   , GhcEnvironmentFileEntry(..), simpleGhcEnvironmentFile
                   , writeGhcEnvironmentFile )
42
import           Distribution.Text
43 44 45
import qualified Distribution.Compat.Graph as Graph
import           Distribution.Compat.Graph (Graph, Node)
import qualified Distribution.Compat.Binary as Binary
46
import qualified Distribution.Utils.BinaryWithFingerprint as Binary
47
import           Distribution.Simple.Utils
48
import           Distribution.Verbosity
49 50
import qualified Paths_cabal_install as Our (version)

51
import           Data.Maybe (maybeToList, fromMaybe)
52
import           Data.Monoid
53 54 55 56
import qualified Data.Map as Map
import           Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.ByteString.Lazy as BS
57
import qualified Data.ByteString.Builder as BB
58

59
import           GHC.Generics
60
import           System.FilePath
61
import           System.IO
62 63


64 65 66 67
-----------------------------------------------------------------------------
-- Writing plan.json files
--

68 69 70 71 72 73 74 75 76 77 78 79 80
-- | Write out a representation of the elaborated install plan.
--
-- This is for the benefit of debugging and external tools like editors.
--
writePlanExternalRepresentation :: DistDirLayout
                                -> ElaboratedInstallPlan
                                -> ElaboratedSharedConfig
                                -> IO ()
writePlanExternalRepresentation distDirLayout elaboratedInstallPlan
                                elaboratedSharedConfig =
    writeFileAtomic (distProjectCacheFile distDirLayout "plan.json") $
        BB.toLazyByteString
      . J.encodeToBuilder
81
      $ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig
82 83 84 85

-- | Renders a subset of the elaborated install plan in a semi-stable JSON
-- format.
--
86 87
encodePlanAsJson :: DistDirLayout -> ElaboratedInstallPlan -> ElaboratedSharedConfig -> J.Value
encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
88 89 90 91
    --TODO: [nice to have] include all of the sharedPackageConfig and all of
    --      the parts of the elaboratedInstallPlan
    J.object [ "cabal-version"     J..= jdisplay Our.version
             , "cabal-lib-version" J..= jdisplay cabalVersion
92 93 94 95
             , "compiler-id"       J..= (J.String . showCompilerId . pkgConfigCompiler)
                                        elaboratedSharedConfig
             , "os"                J..= jdisplay os
             , "arch"              J..= jdisplay arch
96
             , "install-plan"      J..= installPlanToJ elaboratedInstallPlan
97 98
             ]
  where
99 100
    Platform arch os = pkgConfigPlatform elaboratedSharedConfig

101 102 103 104 105 106 107 108 109
    installPlanToJ :: ElaboratedInstallPlan -> [J.Value]
    installPlanToJ = map planPackageToJ . InstallPlan.toList

    planPackageToJ :: ElaboratedPlanPackage -> J.Value
    planPackageToJ pkg =
      case pkg of
        InstallPlan.PreExisting ipi -> installedPackageInfoToJ ipi
        InstallPlan.Configured elab -> elaboratedPackageToJ False elab
        InstallPlan.Installed  elab -> elaboratedPackageToJ True  elab
110 111 112 113
        -- Note that the plan.json currently only uses the elaborated plan,
        -- not the improved plan. So we will not get the Installed state for
        -- that case, but the code supports it in case we want to use this
        -- later in some use case where we want the status of the build.
114

115 116 117 118 119 120
    installedPackageInfoToJ :: InstalledPackageInfo -> J.Value
    installedPackageInfoToJ ipi =
      -- Pre-existing packages lack configuration information such as their flag
      -- settings or non-lib components. We only get pre-existing packages for
      -- the global/core packages however, so this isn't generally a problem.
      -- So these packages are never local to the project.
121 122 123
      --
      J.object
        [ "type"       J..= J.String "pre-existing"
124 125 126 127
        , "id"         J..= (jdisplay . installedUnitId) ipi
        , "pkg-name"   J..= (jdisplay . pkgName . packageId) ipi
        , "pkg-version" J..= (jdisplay . pkgVersion . packageId) ipi
        , "depends"    J..= map jdisplay (installedDepends ipi)
128 129
        ]

130 131
    elaboratedPackageToJ :: Bool -> ElaboratedConfiguredPackage -> J.Value
    elaboratedPackageToJ isInstalled elab =
132
      J.object $
133 134
        [ "type"       J..= J.String (if isInstalled then "installed"
                                                     else "configured")
135
        , "id"         J..= (jdisplay . installedUnitId) elab
136 137
        , "pkg-name"   J..= (jdisplay . pkgName . packageId) elab
        , "pkg-version" J..= (jdisplay . pkgVersion . packageId) elab
138 139
        , "flags"      J..= J.object [ PD.unFlagName fn J..= v
                                     | (fn,v) <- elabFlagAssignment elab ]
140
        , "style"      J..= J.String (style2str (elabLocalToProject elab) (elabBuildStyle elab))
141
        ] ++
142 143
        [ "pkg-src-sha256" J..= J.String (showHashValue hash)
        | Just hash <- [elabPkgSourceHash elab] ] ++
144 145 146 147 148 149 150
        (case elabBuildStyle elab of
            BuildInplaceOnly ->
                ["dist-dir"   J..= J.String dist_dir]
            BuildAndInstall ->
                -- TODO: install dirs?
                []
            ) ++
151
        case elabPkgOrComp elab of
Edward Z. Yang's avatar
Edward Z. Yang committed
152 153
          ElabPackage pkg ->
            let components = J.object $
154
                  [ comp2str c J..= (J.object $
155
                    [ "depends"     J..= map (jdisplay . confInstId) ldeps
156 157
                    , "exe-depends" J..= map (jdisplay . confInstId) edeps ] ++
                    bin_file c)
158 159 160 161
                  | (c,(ldeps,edeps))
                      <- ComponentDeps.toList $
                         ComponentDeps.zip (pkgLibDependencies pkg)
                                           (pkgExeDependencies pkg) ]
Edward Z. Yang's avatar
Edward Z. Yang committed
162
            in ["components" J..= components]
163
          ElabComponent comp ->
Edward Z. Yang's avatar
Edward Z. Yang committed
164
            ["depends"     J..= map (jdisplay . confInstId) (elabLibDependencies elab)
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181
            ,"exe-depends" J..= map jdisplay (elabExeDependencies elab)
            ,"component-name" J..= J.String (comp2str (compSolverName comp))
            ] ++
            bin_file (compSolverName comp)
     where
      dist_dir = distBuildDirectory distDirLayout
                    (elabDistDirParams elaboratedSharedConfig elab)

      bin_file c = case c of
        ComponentDeps.ComponentExe s   -> bin_file' s
        ComponentDeps.ComponentTest s  -> bin_file' s
        ComponentDeps.ComponentBench s -> bin_file' s
        _ -> []
      bin_file' s =
        ["bin-file" J..= J.String bin]
       where
        bin = if elabBuildStyle elab == BuildInplaceOnly
182 183
               then dist_dir </> "build" </> display s </> display s
               else InstallDirs.bindir (elabInstallDirs elab) </> display s
184 185 186

    -- TODO: maybe move this helper to "ComponentDeps" module?
    --       Or maybe define a 'Text' instance?
187
    comp2str :: ComponentDeps.Component -> String
188
    comp2str c = case c of
189
        ComponentDeps.ComponentLib     -> "lib"
190 191 192 193 194
        ComponentDeps.ComponentSubLib s -> "lib:"   <> display s
        ComponentDeps.ComponentFLib s  -> "flib:"  <> display s
        ComponentDeps.ComponentExe s   -> "exe:"   <> display s
        ComponentDeps.ComponentTest s  -> "test:"  <> display s
        ComponentDeps.ComponentBench s -> "bench:" <> display s
195 196
        ComponentDeps.ComponentSetup   -> "setup"

197 198 199 200 201
    style2str :: Bool -> BuildStyle -> String
    style2str True  _                = "local"
    style2str False BuildInplaceOnly = "inplace"
    style2str False BuildAndInstall  = "global"

202 203 204
    jdisplay :: Text a => a -> J.Value
    jdisplay = J.String . display

205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330

-----------------------------------------------------------------------------
-- Project status
--

-- So, what is the status of a project after a build? That is, how do the
-- inputs (package source files etc) compare to the output artefacts (build
-- libs, exes etc)? Do the outputs reflect the current values of the inputs
-- or are outputs out of date or invalid?
--
-- First of all, what do we mean by out-of-date and what do we mean by
-- invalid? We think of the build system as a morally pure function that
-- computes the output artefacts given input values. We say an output artefact
-- is out of date when its value is not the value that would be computed by a
-- build given the current values of the inputs. An output artefact can be
-- out-of-date but still be perfectly usable; it simply correspond to a
-- previous state of the inputs.
--
-- On the other hand there are cases where output artefacts cannot safely be
-- used. For example libraries and dynamically linked executables cannot be
-- used when the libs they depend on change without them being recompiled
-- themselves. Whether an artefact is still usable depends on what it is, e.g.
-- dynamically linked vs statically linked and on how it gets updated (e.g.
-- only atomically on success or if failure can leave invalid states). We need
-- a definition (or two) that is independent of the kind of artefact and can
-- be computed just in terms of changes in package graphs, but are still
-- useful for determining when particular kinds of artefacts are invalid.
--
-- Note that when we talk about packages in this context we just mean nodes
-- in the elaborated install plan, which can be components or packages.
--
-- There's obviously a close connection between packages being out of date and
-- their output artefacts being unusable: most of the time if a package
-- remains out of date at the end of a build then some of its output artefacts
-- will be unusable. That is true most of the time because a build will have
-- attempted to build one of the out-of-date package's dependencies. If the
-- build of the dependency succeeded then it changed output artefacts (like
-- libs) and if it failed then it may have failed after already changing
-- things (think failure after updating some but not all .hi files).
--
-- There are a few reasons we may end up with still-usable output artefacts
-- for a package even when it remains out of date at the end of a build.
-- Firstly if executing a plan fails then packages can be skipped, and thus we
-- may have packages where all their dependencies were skipped. Secondly we
-- have artefacts like statically linked executables which are not affected by
-- libs they depend on being recompiled. Furthermore, packages can be out of
-- date due to changes in build tools or Setup.hs scripts they depend on, but
-- again libraries or executables in those out-of-date packages remain usable.
--
-- So we have two useful definitions of invalid. Both are useful, for
-- different purposes, so we will compute both. The first corresponds to the
-- invalid libraries and dynamic executables. We say a package is invalid by
-- changed deps if any of the packages it depends on (via library dep edges)
-- were rebuilt (successfully or unsuccessfully). The second definition
-- corresponds to invalid static executables. We say a package is invalid by
-- a failed build simply if the package was built but unsuccessfully.
--
-- So how do we find out what packages are out of date or invalid?
--
-- Obviously we know something for all the packages that were part of the plan
-- that was executed, but that is just a subset since we prune the plan down
-- to the targets and their dependencies.
--
-- Recall the steps we go though:
--
-- + starting with the initial improved plan (this is the full project);
--
-- + prune the plan to the user's build targets;
--
-- + rebuildTargetsDryRun on the pruned plan giving us a BuildStatusMap
--   covering the pruned subset of the original plan;
--
-- + execute the plan giving us BuildOutcomes which tell us success/failure
--   for each package.
--
-- So given that the BuildStatusMap and BuildOutcomes do not cover everything
-- in the original plan, what can they tell us about the original plan?
--
-- The BuildStatusMap tells us directly that some packages are up to date and
-- others out of date (but only for the pruned subset). But we know that
-- everything that is a reverse dependency of an out-of-date package is itself
-- out-of-date (whether or not it is in the pruned subset). Of course after
-- a build the BuildOutcomes may tell us that some of those out-of-date
-- packages are now up to date (ie a successful build outcome).
--
-- The difference is packages that are reverse dependencies of out-of-date
-- packages but are not brought up-to-date by the build (i.e. did not have
-- successful outcomes, either because they failed or were not in the pruned
-- subset to be built). We also know which packages were rebuilt, so we can
-- use this to find the now-invalid packages.
--
-- Note that there are still packages for which we cannot discover full status
-- information. There may be packages outside of the pruned plan that do not
-- depend on packages within the pruned plan that were discovered to be
-- out-of-date. For these packages we do not know if their build artefacts
-- are out-of-date or not. We do know however that they are not invalid, as
-- that's not possible given our definition of invalid. Intuitively it is
-- because we have not disturbed anything that these packages depend on, e.g.
-- we've not rebuilt any libs they depend on. Recall that our widest
-- definition of invalid was only concerned about dependencies on libraries
-- (to cover problems like shared libs or GHC seeing inconsistent .hi files).
--
-- So our algorithm for out-of-date packages is relatively simple: take the
-- reverse dependency closure in the original improved plan (pre-pruning) of
-- the out-of-date packages (as determined by the BuildStatusMap from the dry
-- run). That gives a set of packages that were definitely out of date after
-- the dry run. Now we remove from this set the packages that the
-- BuildOutcomes tells us are now up-to-date after the build. The remaining
-- set is the out-of-date packages.
--
-- As for packages that are invalid by changed deps, we start with the plan
-- dependency graph but keep only those edges that point to libraries (so
-- ignoring deps on exes and setup scripts). We take the packages for which a
-- build was attempted (successfully or unsuccessfully, but not counting
-- knock-on failures) and take the reverse dependency closure. We delete from
-- this set all the packages that were built successfully. Note that we do not
-- need to intersect with the out-of-date packages since this follows
-- automatically: all rev deps of packages we attempted to build must have
-- been out of date at the start of the build, and if they were not built
-- successfully then they're still out of date -- meeting our definition of
-- invalid.


type PackageIdSet     = Set UnitId
type PackagesUpToDate = PackageIdSet

331 332 333 334 335 336 337 338 339
newtype PackagesUpToDateG = PackagesUpToDateG { unPackagesUpToDateG :: PackagesUpToDate }

instance Binary.Binary PackagesUpToDateG

instance Generic PackagesUpToDateG where
    type Rep PackagesUpToDateG = Rep [UnitId]
    from = from . Set.toList . unPackagesUpToDateG
    to   = PackagesUpToDateG . Set.fromList . to

340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 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 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 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 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657
data PostBuildProjectStatus = PostBuildProjectStatus {

       -- | Packages that are known to be up to date. These were found to be
       -- up to date before the build, or they have a successful build outcome
       -- afterwards.
       --
       -- This does not include any packages outside of the subset of the plan
       -- that was executed because we did not check those and so don't know
       -- for sure that they're still up to date.
       --
       packagesDefinitelyUpToDate :: PackageIdSet,

       -- | Packages that are probably still up to date (and at least not
       -- known to be out of date, and certainly not invalid). This includes
       -- 'packagesDefinitelyUpToDate' plus packages that were up to date
       -- previously and are outside of the subset of the plan that was
       -- executed. It excludes 'packagesOutOfDate'.
       --
       packagesProbablyUpToDate :: PackageIdSet,

       -- | Packages that are known to be out of date. These are packages
       -- that were determined to be out of date before the build, and they
       -- do not have a successful build outcome afterwards.
       --
       -- Note that this can sometimes include packages outside of the subset
       -- of the plan that was executed. For example suppose package A and B
       -- depend on C, and A is the target so only A and C are in the subset
       -- to be built. Now suppose C is found to have changed, then both A
       -- and B are out-of-date before the build and since B is outside the
       -- subset to be built then it will remain out of date.
       --
       -- Note also that this is /not/ the inverse of
       -- 'packagesDefinitelyUpToDate' or 'packagesProbablyUpToDate'.
       -- There are packages where we have no information (ones that were not
       -- in the subset of the plan that was executed).
       --
       packagesOutOfDate :: PackageIdSet,

       -- | Packages that depend on libraries that have changed during the
       -- build (either build success or failure).
       --
       -- This corresponds to the fact that libraries and dynamic executables
       -- are invalid once any of the libs they depend on change.
       --
       -- This does include packages that themselves failed (i.e. it is a
       -- superset of 'packagesInvalidByFailedBuild'). It does not include
       -- changes in dependencies on executables (i.e. build tools).
       --
       packagesInvalidByChangedLibDeps :: PackageIdSet,

       -- | Packages that themselves failed during the build (i.e. them
       -- directly not a dep).
       --
       -- This corresponds to the fact that static executables are invalid
       -- in unlucky circumstances such as linking failing half way though,
       -- or data file generation failing.
       --
       -- This is a subset of 'packagesInvalidByChangedLibDeps'.
       --
       packagesInvalidByFailedBuild :: PackageIdSet,

       -- | A subset of the plan graph, including only dependency-on-library
       -- edges. That is, dependencies /on/ libraries, not dependencies /of/
       -- libraries. This tells us all the libraries that packages link to.
       --
       -- This is here as a convenience, as strictly speaking it's not status
       -- as it's just a function of the original 'ElaboratedInstallPlan'.
       --
       packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage),

       -- | As a convenience for 'Set.intersection' with any of the other
       -- 'PackageIdSet's to select only packages that are part of the
       -- project locally (i.e. with a local source dir).
       --
       packagesBuildLocal     :: PackageIdSet,

       -- | As a convenience for 'Set.intersection' with any of the other
       -- 'PackageIdSet's to select only packages that are being built
       -- in-place within the project (i.e. not destined for the store).
       --
       packagesBuildInplace   :: PackageIdSet,

       -- | As a convenience for 'Set.intersection' or 'Set.difference' with
       -- any of the other 'PackageIdSet's to select only packages that were
       -- pre-installed or already in the store prior to the build.
       --
       packagesAlreadyInStore :: PackageIdSet
     }

-- | Work out which packages are out of date or invalid after a build.
--
postBuildProjectStatus :: ElaboratedInstallPlan
                       -> PackagesUpToDate
                       -> BuildStatusMap
                       -> BuildOutcomes
                       -> PostBuildProjectStatus
postBuildProjectStatus plan previousPackagesUpToDate
                       pkgBuildStatus buildOutcomes =
    PostBuildProjectStatus {
      packagesDefinitelyUpToDate,
      packagesProbablyUpToDate,
      packagesOutOfDate,
      packagesInvalidByChangedLibDeps,
      packagesInvalidByFailedBuild,
      -- convenience stuff
      packagesLibDepGraph,
      packagesBuildLocal,
      packagesBuildInplace,
      packagesAlreadyInStore
    }
  where
    packagesDefinitelyUpToDate =
       packagesUpToDatePreBuild
        `Set.union`
       packagesSuccessfulPostBuild

    packagesProbablyUpToDate =
      packagesDefinitelyUpToDate
        `Set.union`
      (previousPackagesUpToDate' `Set.difference` packagesOutOfDatePreBuild)

    packagesOutOfDate =
      packagesOutOfDatePreBuild `Set.difference` packagesSuccessfulPostBuild

    packagesInvalidByChangedLibDeps =
      packagesDepOnChangedLib `Set.difference` packagesSuccessfulPostBuild

    packagesInvalidByFailedBuild =
      packagesFailurePostBuild

    -- Note: if any of the intermediate values below turn out to be useful in
    -- their own right then we can simply promote them to the result record

    -- The previous set of up-to-date packages will contain bogus package ids
    -- when the solver plan or config contributing to the hash changes.
    -- So keep only the ones where the package id (i.e. hash) is the same.
    previousPackagesUpToDate' =
      Set.intersection
        previousPackagesUpToDate
        (InstallPlan.keysSet plan)

    packagesUpToDatePreBuild =
      Set.filter
        (\ipkgid -> not (lookupBuildStatusRequiresBuild True ipkgid))
        -- For packages not in the plan subset we did the dry-run on we don't
        -- know anything about their status, so not known to be /up to date/.
        (InstallPlan.keysSet plan)

    packagesOutOfDatePreBuild =
      Set.fromList . map installedUnitId $
      InstallPlan.reverseDependencyClosure plan
        [ ipkgid
        | pkg <- InstallPlan.toList plan
        , let ipkgid = installedUnitId pkg
        , lookupBuildStatusRequiresBuild False ipkgid
        -- For packages not in the plan subset we did the dry-run on we don't
        -- know anything about their status, so not known to be /out of date/.
        ]

    packagesSuccessfulPostBuild =
      Set.fromList
        [ ikgid | (ikgid, Right _) <- Map.toList buildOutcomes ]

    -- direct failures, not failures due to deps
    packagesFailurePostBuild =
      Set.fromList
        [ ikgid
        | (ikgid, Left failure) <- Map.toList buildOutcomes
        , case buildFailureReason failure of
            DependentFailed _ -> False
            _                 -> True
        ]

    -- Packages that have a library dependency on a package for which a build
    -- was attempted
    packagesDepOnChangedLib =
      Set.fromList . map Graph.nodeKey $
      fromMaybe (error "packagesBuildStatusAfterBuild: broken dep closure") $
      Graph.revClosure packagesLibDepGraph
        ( Map.keys
        . Map.filter (uncurry buildAttempted)
        $ Map.intersectionWith (,) pkgBuildStatus buildOutcomes 
        )

    -- The plan graph but only counting dependency-on-library edges
    packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage)
    packagesLibDepGraph =
      Graph.fromList
        [ Graph.N pkg (installedUnitId pkg) libdeps
        | pkg <- InstallPlan.toList plan
        , let libdeps = case pkg of
                InstallPlan.PreExisting ipkg  -> installedDepends ipkg
                InstallPlan.Configured srcpkg -> elabLibDeps srcpkg
                InstallPlan.Installed  srcpkg -> elabLibDeps srcpkg
        ]
    elabLibDeps = map (newSimpleUnitId . confInstId) . elabLibDependencies

    -- Was a build was attempted for this package?
    -- If it doesn't have both a build status and outcome then the answer is no.
    buildAttempted :: BuildStatus -> BuildOutcome -> Bool
    -- And not if it didn't need rebuilding in the first place.
    buildAttempted buildStatus _buildOutcome
      | not (buildStatusRequiresBuild buildStatus)
      = False

    -- And not if it was skipped due to a dep failing first.
    buildAttempted _ (Left BuildFailure {buildFailureReason})
      | DependentFailed _ <- buildFailureReason
      = False

    -- Otherwise, succeeded or failed, yes the build was tried.
    buildAttempted _ (Left BuildFailure {}) = True
    buildAttempted _ (Right _)              = True

    lookupBuildStatusRequiresBuild def ipkgid =
      case Map.lookup ipkgid pkgBuildStatus of
        Nothing          -> def -- Not in the plan subset we did the dry-run on
        Just buildStatus -> buildStatusRequiresBuild buildStatus

    packagesBuildLocal =
      selectPlanPackageIdSet $ \pkg ->
        case pkg of
          InstallPlan.PreExisting _     -> False
          InstallPlan.Installed   _     -> False
          InstallPlan.Configured srcpkg -> elabLocalToProject srcpkg

    packagesBuildInplace =
      selectPlanPackageIdSet $ \pkg ->
        case pkg of
          InstallPlan.PreExisting _     -> False
          InstallPlan.Installed   _     -> False
          InstallPlan.Configured srcpkg -> elabBuildStyle srcpkg
                                        == BuildInplaceOnly

    packagesAlreadyInStore =
      selectPlanPackageIdSet $ \pkg ->
        case pkg of
          InstallPlan.PreExisting _ -> True
          InstallPlan.Installed   _ -> True
          InstallPlan.Configured  _ -> False

    selectPlanPackageIdSet p = Map.keysSet
                             . Map.filter p
                             $ InstallPlan.toMap plan



updatePostBuildProjectStatus :: Verbosity
                             -> DistDirLayout
                             -> ElaboratedInstallPlan
                             -> BuildStatusMap
                             -> BuildOutcomes
                             -> IO PostBuildProjectStatus
updatePostBuildProjectStatus verbosity distDirLayout
                             elaboratedInstallPlan
                             pkgsBuildStatus buildOutcomes = do

    -- Read the previous up-to-date set, update it and write it back
    previousUpToDate   <- readPackagesUpToDateCacheFile distDirLayout
    let currentBuildStatus@PostBuildProjectStatus{..}
                        = postBuildProjectStatus
                            elaboratedInstallPlan
                            previousUpToDate
                            pkgsBuildStatus
                            buildOutcomes
    let currentUpToDate = packagesProbablyUpToDate
    writePackagesUpToDateCacheFile distDirLayout currentUpToDate

    -- Report various possibly interesting things
    -- We additionally intersect with the packagesBuildInplace so that
    -- we don't show huge numbers of boring packages from the store.
    debugNoWrap verbosity $
        "packages definitely up to date: "
     ++ displayPackageIdSet (packagesDefinitelyUpToDate
          `Set.intersection` packagesBuildInplace)

    debugNoWrap verbosity $
        "packages previously probably up to date: "
     ++ displayPackageIdSet (previousUpToDate
          `Set.intersection` packagesBuildInplace)

    debugNoWrap verbosity $
        "packages now probably up to date: "
     ++ displayPackageIdSet (packagesProbablyUpToDate
          `Set.intersection` packagesBuildInplace)

    debugNoWrap verbosity $
        "packages newly up to date: "
     ++ displayPackageIdSet (packagesDefinitelyUpToDate
            `Set.difference` previousUpToDate
          `Set.intersection` packagesBuildInplace)

    debugNoWrap verbosity $
        "packages out to date: "
     ++ displayPackageIdSet (packagesOutOfDate
          `Set.intersection` packagesBuildInplace)

    debugNoWrap verbosity $
        "packages invalid due to dep change: "
     ++ displayPackageIdSet packagesInvalidByChangedLibDeps

    debugNoWrap verbosity $
        "packages invalid due to build failure: "
     ++ displayPackageIdSet packagesInvalidByFailedBuild

    return currentBuildStatus
  where
    displayPackageIdSet = intercalate ", " . map display . Set.toList

-- | Helper for reading the cache file.
--
-- This determines the type and format of the binary cache file.
--
readPackagesUpToDateCacheFile :: DistDirLayout -> IO PackagesUpToDate
readPackagesUpToDateCacheFile DistDirLayout{distProjectCacheFile} =
    handleDoesNotExist Set.empty $
    handleDecodeFailure $
      withBinaryFile (distProjectCacheFile "up-to-date") ReadMode $ \hnd ->
658 659
        fmap (fmap unPackagesUpToDateG) .
            Binary.decodeWithFingerprintOrFailIO =<< BS.hGetContents hnd
660 661 662 663 664 665 666 667 668 669
  where
    handleDecodeFailure = fmap (either (const Set.empty) id)

-- | Helper for writing the package up-to-date cache file.
--
-- This determines the type and format of the binary cache file.
--
writePackagesUpToDateCacheFile :: DistDirLayout -> PackagesUpToDate -> IO ()
writePackagesUpToDateCacheFile DistDirLayout{distProjectCacheFile} upToDate =
    writeFileAtomic (distProjectCacheFile "up-to-date") $
670
      Binary.encodeWithFingerprint (PackagesUpToDateG upToDate)
671

672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 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 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 820 821
-- Writing .ghc.environment files
--

writePlanGhcEnvironment :: FilePath
                        -> ElaboratedInstallPlan
                        -> ElaboratedSharedConfig
                        -> PostBuildProjectStatus
                        -> IO ()
writePlanGhcEnvironment projectRootDir
                        elaboratedInstallPlan
                        ElaboratedSharedConfig {
                          pkgConfigCompiler = compiler,
                          pkgConfigPlatform = platform
                        }
                        postBuildStatus
  | compilerFlavor compiler == GHC
  , supportsPkgEnvFiles (getImplInfo compiler)
  --TODO: check ghcjs compat
  = writeGhcEnvironmentFile
      projectRootDir
      platform (compilerVersion compiler)
      (renderGhcEnviromentFile projectRootDir
                               elaboratedInstallPlan
                               postBuildStatus)
    --TODO: [required eventually] support for writing user-wide package
    -- environments, e.g. like a global project, but we would not put the
    -- env file in the home dir, rather it lives under ~/.ghc/

writePlanGhcEnvironment _ _ _ _ = return ()

renderGhcEnviromentFile :: FilePath
                        -> ElaboratedInstallPlan
                        -> PostBuildProjectStatus
                        -> [GhcEnvironmentFileEntry]
renderGhcEnviromentFile projectRootDir elaboratedInstallPlan
                        postBuildStatus =
    headerComment
  : simpleGhcEnvironmentFile packageDBs unitIds
  where
    headerComment =
        GhcEnvFileComment
      $ "This is a GHC environment file written by cabal. This means you can\n"
     ++ "run ghc or ghci and get the environment of the project as a whole.\n"
     ++ "But you still need to use cabal repl $target to get the environment\n"
     ++ "of specific components (libs, exes, tests etc) because each one can\n"
     ++ "have its own source dirs, cpp flags etc.\n\n"
    unitIds    = selectGhcEnviromentFileLibraries postBuildStatus
    packageDBs = relativePackageDBPaths projectRootDir $
                 selectGhcEnviromentFilePackageDbs elaboratedInstallPlan


-- We're producing an environment for users to use in ghci, so of course
-- that means libraries only (can't put exes into the ghc package env!).
-- The library environment should be /consistent/ with the environment
-- that each of the packages in the project use (ie same lib versions).
-- So that means all the normal library dependencies of all the things
-- in the project (including deps of exes that are local to the project).
-- We do not however want to include the dependencies of Setup.hs scripts,
-- since these are generally uninteresting but also they need not in
-- general be consistent with the library versions that packages local to
-- the project use (recall that Setup.hs script's deps can be picked
-- independently of other packages in the project).
--
-- So, our strategy is as follows:
--
-- produce a dependency graph of all the packages in the install plan,
-- but only consider normal library deps as edges in the graph. Thus we
-- exclude the dependencies on Setup.hs scripts (in the case of
-- per-component granularity) or of Setup.hs scripts (in the case of
-- per-package granularity). Then take a dependency closure, using as
-- roots all the packages/components local to the project. This will
-- exclude Setup scripts and their dependencies.
--
-- Note: this algorithm will have to be adapted if/when the install plan
-- is extended to cover multiple compilers at once, and may also have to
-- change if we start to treat unshared deps of test suites in a similar
-- way to how we treat Setup.hs script deps (ie being able to pick them
-- independently).
--
-- Since we had to use all the local packages, including exes, (as roots
-- to find the libs) then those exes still end up in our list so we have
-- to filter them out at the end.
--
selectGhcEnviromentFileLibraries :: PostBuildProjectStatus -> [UnitId]
selectGhcEnviromentFileLibraries PostBuildProjectStatus{..} =
    case Graph.closure packagesLibDepGraph (Set.toList packagesBuildLocal) of
      Nothing    -> error "renderGhcEnviromentFile: broken dep closure"
      Just nodes -> [ pkgid | Graph.N pkg pkgid _ <- nodes
                            , hasUpToDateLib pkg ]
  where
    hasUpToDateLib planpkg = case planpkg of
      -- A pre-existing global lib
      InstallPlan.PreExisting  _ -> True

      -- A package in the store. Check it's a lib.
      InstallPlan.Installed  pkg -> elabRequiresRegistration pkg

      -- A package we were installing this time, either destined for the store
      -- or just locally. Check it's a lib and that it is probably up to date.
      InstallPlan.Configured pkg ->
          elabRequiresRegistration pkg
       && installedUnitId pkg `Set.member` packagesProbablyUpToDate


selectGhcEnviromentFilePackageDbs :: ElaboratedInstallPlan -> PackageDBStack
selectGhcEnviromentFilePackageDbs elaboratedInstallPlan =
    -- If we have any inplace packages then their package db stack is the
    -- one we should use since it'll include the store + the local db but
    -- it's certainly possible to have no local inplace packages
    -- e.g. just "extra" packages coming from the store.
    case (inplacePackages, sourcePackages) of
      ([], pkgs) -> checkSamePackageDBs pkgs
      (pkgs, _)  -> checkSamePackageDBs pkgs
  where
    checkSamePackageDBs pkgs =
      case ordNub (map elabBuildPackageDBStack pkgs) of
        [packageDbs] -> packageDbs
        []           -> []
        _            -> error $ "renderGhcEnviromentFile: packages with "
                             ++ "different package db stacks"
        -- This should not happen at the moment but will happen as soon
        -- as we support projects where we build packages with different
        -- compilers, at which point we have to consider how to adapt
        -- this feature, e.g. write out multiple env files, one for each
        -- compiler / project profile.

    inplacePackages =
      [ srcpkg
      | srcpkg <- sourcePackages
      , elabBuildStyle srcpkg == BuildInplaceOnly ]
    sourcePackages =
      [ srcpkg
      | pkg <- InstallPlan.toList elaboratedInstallPlan
      , srcpkg <- maybeToList $ case pkg of
                    InstallPlan.Configured srcpkg -> Just srcpkg
                    InstallPlan.Installed  srcpkg -> Just srcpkg
                    InstallPlan.PreExisting _     -> Nothing
      ]

relativePackageDBPaths :: FilePath -> PackageDBStack -> PackageDBStack
relativePackageDBPaths relroot = map (relativePackageDBPath relroot)

relativePackageDBPath :: FilePath -> PackageDB -> PackageDB
relativePackageDBPath relroot pkgdb =
    case pkgdb of
      GlobalPackageDB        -> GlobalPackageDB
      UserPackageDB          -> UserPackageDB
      SpecificPackageDB path -> SpecificPackageDB relpath
        where relpath = makeRelative relroot path