Commit d9bf6788 authored by Edward Z. Yang's avatar Edward Z. Yang

Per-component new-build support (no Custom support yet).

A bit of a megapatch.  Here's what's in it:

* First, a few miscellaneous utility functions and reexports
  in Cabal.  I could have split these into a separate commit
  but I was too lazy to.

* Distribution.Client.Install got refactored:
  instead of using PackageFixedDeps, it uses IsUnit
  instead.  This is because we weren't using ComponentDeps
  in a nontrivial way; we just need some graph structure
  and IsNode (with UnitId keys) fulfills that. I also removed the
  invariant checking and error reporting because it was
  being annoying (we check the invariants already in
  SolverInstallPlan).

* Look at Distribution.Client.ProjectPlanning.Types.
  This contains the primary type change: ElaboratedConfiguredPackage
  is now EITHER a monolithic ElaboratedPackage, or a per-component
  ElaboratedComponent (it should get renamed but I didn't do that
  in this patch.)  These are what we're going to store in our
  plans: if a package we're building has a Setup script which supports
  per-component builds, we'll explode it into a component.  Otherwise
  we'll keep it as a package.  We'll see codepaths for both
  throughout.

* OK, so the expansion happens in ProjectPlanning, mostly in
  'elaborateAndExpandSolverPackage'.  You should review the
  package hash computation code closely.  When we can separate
  components, we compute a hash for each INDEPENDENTLY.  This
  is good: we get more sharing.

* We need to adjust the target resolution and pruning code
  in ProjectOrchestration and ProjectPlanning.  I did a dumb
  but easy idea: if a user mentions 'packagename' in a
  target name, I spray the PackageTarget on every
  possibly relevant IPID in buildTargets', and then pare
  it down later.

* And of course there's code in ProjectBuilding to actual
  do a configure and then build.

* We change the layout of build directories so that we can
  track each component separately.  While I was doing that,
  I also added compiler and platform information.

Custom doesn't work yet because I need to give them their own
separate component, and teach Cabal how to build them specially.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent e6b6167d
......@@ -27,6 +27,7 @@ module Distribution.Package (
UnitId(..),
mkUnitId,
mkLegacyUnitId,
unitIdComponentId,
getHSLibraryName,
InstalledPackageId, -- backwards compat
......@@ -176,6 +177,10 @@ mkUnitId = SimpleUnitId . ComponentId
mkLegacyUnitId :: PackageId -> UnitId
mkLegacyUnitId = SimpleUnitId . ComponentId . display
-- | Extract 'ComponentId' from 'UnitId'.
unitIdComponentId :: UnitId -> ComponentId
unitIdComponentId (SimpleUnitId cid) = cid
-- ------------------------------------------------------------
-- * Package source dependencies
-- ------------------------------------------------------------
......
......@@ -35,6 +35,8 @@ module Distribution.Simple.Configure (configure,
tryGetPersistBuildConfig,
maybeGetPersistBuildConfig,
findDistPref, findDistPrefOrDefault,
mkComponentsGraph,
getInternalPackages,
computeComponentId,
computeCompatPackageKey,
computeCompatPackageName,
......
......@@ -54,7 +54,7 @@ data ComponentEnabledSpec
= ComponentEnabledSpec { testsEnabled :: Bool,
benchmarksEnabled :: Bool }
| OneComponentEnabledSpec ComponentName
deriving (Generic, Read, Show)
deriving (Generic, Read, Show, Eq)
instance Binary ComponentEnabledSpec
-- | The default set of enabled components. Historically tests and
......
......@@ -43,6 +43,7 @@ module Distribution.Types.PackageDescription (
updatePackageDescription,
pkgComponents,
pkgBuildableComponents,
enabledComponents,
lookupComponent,
getComponent,
) where
......@@ -57,6 +58,7 @@ import Distribution.Types.Benchmark
import Distribution.Types.Component
import Distribution.Types.ComponentName
import Distribution.Types.ComponentEnabledSpec
import Distribution.Types.SetupBuildInfo
import Distribution.Types.BuildInfo
import Distribution.Types.BuildType
......@@ -346,6 +348,13 @@ pkgComponents pkg =
pkgBuildableComponents :: PackageDescription -> [Component]
pkgBuildableComponents = filter componentBuildable . pkgComponents
-- | A list of all components in the package that are enabled.
--
-- @since 2.0.0.0
--
enabledComponents :: PackageDescription -> ComponentEnabledSpec -> [Component]
enabledComponents pkg enabled = filter (componentEnabled enabled) $ pkgBuildableComponents pkg
lookupComponent :: PackageDescription -> ComponentName -> Maybe Component
lookupComponent pkg CLibName = fmap CLib (library pkg)
lookupComponent pkg (CSubLibName name) =
......
......@@ -63,6 +63,7 @@ buildAction (configFlags, configExFlags, installFlags, haddockFlags)
-- repl targets (as opposed to say repl or haddock targets).
selectBuildTargets =
selectTargets
verbosity
BuildDefaultComponents
BuildSpecificComponent
......@@ -7,13 +7,11 @@ module Distribution.Client.CmdFreeze (
) where
import Distribution.Client.ProjectPlanning
( ElaboratedInstallPlan, rebuildInstallPlan )
import Distribution.Client.ProjectConfig
( ProjectConfig(..), ProjectConfigShared(..)
, commandLineFlagsToProjectConfig, writeProjectLocalFreezeConfig
, findProjectRoot )
import Distribution.Client.ProjectPlanning.Types
( ElaboratedConfiguredPackage(..) )
import Distribution.Client.Targets
( UserConstraint(..) )
import Distribution.Solver.Types.ConstraintSource
......@@ -149,8 +147,9 @@ projectFreezeConstraints plan =
flagAssignments =
Map.fromList
[ (pkgname, flags)
| InstallPlan.Configured pkg <- InstallPlan.toList plan
, let flags = pkgFlagAssignment pkg
| InstallPlan.Configured pkg_or_comp <- InstallPlan.toList plan
, let pkg = getElaboratedPackage pkg_or_comp
flags = pkgFlagAssignment pkg
pkgname = packageName pkg
, not (null flags) ]
......@@ -158,7 +157,8 @@ projectFreezeConstraints plan =
localPackages =
Map.fromList
[ (packageName pkg, ())
| InstallPlan.Configured pkg <- InstallPlan.toList plan
| InstallPlan.Configured pkg_or_comp <- InstallPlan.toList plan
, let pkg = getElaboratedPackage pkg_or_comp
, pkgLocalToProject pkg
]
......@@ -67,6 +67,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags)
-- repl targets (as opposed to say build or haddock targets).
selectReplTargets =
selectTargets
verbosity
ReplDefaultComponent
ReplSpecificComponent
......@@ -5,17 +5,43 @@
-- The layout of the .\/dist\/ directory where cabal keeps all of it's state
-- and build artifacts.
--
module Distribution.Client.DistDirLayout where
module Distribution.Client.DistDirLayout (
-- 'DistDirLayout'
DistDirLayout(..),
DistDirParams(..),
defaultDistDirLayout,
-- * 'CabalDirLayout'
CabalDirLayout(..),
defaultCabalDirLayout,
) where
import System.FilePath
import Distribution.Package
( PackageId )
( PackageId, UnitId(..) )
import Distribution.Compiler
import Distribution.Simple.Compiler (PackageDB(..))
import Distribution.Text
import Distribution.Types.ComponentName
import Distribution.System
import Distribution.Client.Types
( InstalledPackageId )
-- | Information which can be used to construct the path to
-- the build directory of a build. This is LESS fine-grained
-- than what goes into the hashed 'InstalledPackageId',
-- and for good reason: we don't want this path to change if
-- the user, say, adds a dependency to their project.
data DistDirParams = DistDirParams {
distParamUnitId :: UnitId,
distParamPackageId :: PackageId,
distParamComponentName :: Maybe ComponentName,
distParamCompilerId :: CompilerId,
distParamPlatform :: Platform
-- TODO (see #3343):
-- Flag assignments
-- Optimization
}
-- | The layout of the project state directory. Traditionally this has been
......@@ -31,11 +57,11 @@ data DistDirLayout = DistDirLayout {
-- | The directory under dist where we keep the build artifacts for a
-- package we're building from a local directory.
--
-- This uses a 'PackageId' not just a 'PackageName' because technically
-- This uses a 'UnitId' not just a 'PackageName' because technically
-- we can have multiple instances of the same package in a solution
-- (e.g. setup deps).
--
distBuildDirectory :: PackageId -> FilePath,
distBuildDirectory :: DistDirParams -> FilePath,
distBuildRootDirectory :: FilePath,
-- | The directory under dist where we put the unpacked sources of
......@@ -55,8 +81,8 @@ data DistDirLayout = DistDirLayout {
-- | The location for package-specific cache files (e.g. state used in
-- incremental rebuilds).
--
distPackageCacheFile :: PackageId -> String -> FilePath,
distPackageCacheDirectory :: PackageId -> FilePath,
distPackageCacheFile :: DistDirParams -> String -> FilePath,
distPackageCacheDirectory :: DistDirParams -> FilePath,
distTempDirectory :: FilePath,
distBinDirectory :: FilePath,
......@@ -88,7 +114,17 @@ defaultDistDirLayout projectRootDirectory =
--TODO: switch to just dist at some point, or some other new name
distBuildRootDirectory = distDirectory </> "build"
distBuildDirectory pkgid = distBuildRootDirectory </> display pkgid
distBuildDirectory params =
distBuildRootDirectory </>
display (distParamPlatform params) </>
display (distParamCompilerId params) </>
display (distParamPackageId params) </>
(case fmap componentNameString (distParamComponentName params) of
Nothing -> ""
Just Nothing -> ""
Just (Just str) -> "c" </> str) </>
(case distParamUnitId params of -- For Backpack
SimpleUnitId _ -> "")
distUnpackedSrcRootDirectory = distDirectory </> "src"
distUnpackedSrcDirectory pkgid = distUnpackedSrcRootDirectory
......@@ -97,8 +133,8 @@ defaultDistDirLayout projectRootDirectory =
distProjectCacheDirectory = distDirectory </> "cache"
distProjectCacheFile name = distProjectCacheDirectory </> name
distPackageCacheDirectory pkgid = distBuildDirectory pkgid </> "cache"
distPackageCacheFile pkgid name = distPackageCacheDirectory pkgid </> name
distPackageCacheDirectory params = distBuildDirectory params </> "cache"
distPackageCacheFile params name = distPackageCacheDirectory params </> name
distTempDirectory = distDirectory </> "tmp"
......
......@@ -116,7 +116,6 @@ import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import qualified Distribution.Solver.Types.PackageIndex as SourcePackageIndex
import Distribution.Solver.Types.PackageFixedDeps
import Distribution.Solver.Types.PkgConfigDb
( PkgConfigDb, readPkgConfigDb )
import Distribution.Solver.Types.SourcePackage as SourcePackage
......@@ -614,12 +613,12 @@ packageStatus installedPkgIndex cpkg =
changes :: Installed.InstalledPackageInfo
-> ReadyPackage
-> [MergeResult PackageIdentifier PackageIdentifier]
changes pkg pkg' = filter changed $
changes pkg (ReadyPackage pkg') = filter changed $
mergeBy (comparing packageName)
-- deps of installed pkg
(resolveInstalledIds $ Installed.depends pkg)
-- deps of configured pkg
(resolveInstalledIds $ CD.nonSetupDeps (depends pkg'))
(resolveInstalledIds $ map confInstId (CD.nonSetupDeps (confPkgDeps pkg')))
-- convert to source pkg ids via index
resolveInstalledIds :: [UnitId] -> [PackageIdentifier]
......
......@@ -43,6 +43,7 @@ import Distribution.Text
( display )
import Distribution.Client.Types
( InstalledPackageId )
import qualified Distribution.Solver.Types.ComponentDeps as CD
import qualified Hackage.Security.Client as Sec
......@@ -133,6 +134,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
--
data PackageHashInputs = PackageHashInputs {
pkgHashPkgId :: PackageId,
pkgHashComponent :: Maybe CD.Component,
pkgHashSourceHash :: PackageSourceHash,
pkgHashDirectDeps :: Set InstalledPackageId,
pkgHashOtherConfig :: PackageHashConfigInputs
......@@ -188,6 +190,7 @@ hashPackageHashInputs = hashValue . renderPackageHashInputs
renderPackageHashInputs :: PackageHashInputs -> LBS.ByteString
renderPackageHashInputs PackageHashInputs{
pkgHashPkgId,
pkgHashComponent,
pkgHashSourceHash,
pkgHashDirectDeps,
pkgHashOtherConfig =
......@@ -209,6 +212,7 @@ renderPackageHashInputs PackageHashInputs{
-- use the config file infrastructure so it can be read back in again.
LBS.pack $ unlines $ catMaybes
[ entry "pkgid" display pkgHashPkgId
, mentry "component" show pkgHashComponent
, entry "src" showHashValue pkgHashSourceHash
, entry "deps" (intercalate ", " . map display
. Set.toList) pkgHashDirectDeps
......@@ -239,6 +243,7 @@ renderPackageHashInputs PackageHashInputs{
]
where
entry key format value = Just (key ++ ": " ++ format value)
mentry key format value = fmap (\v -> key ++ ": " ++ format v) value
opt key def format value
| value == def = Nothing
| otherwise = entry key format value
......
......@@ -58,6 +58,7 @@ module Distribution.Client.ProjectOrchestration (
import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectPlanning
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.ProjectBuilding
import Distribution.Client.Types
......@@ -79,7 +80,7 @@ import qualified Distribution.PackageDescription as PD
import Distribution.PackageDescription (FlagAssignment)
import Distribution.Simple.Setup (HaddockFlags)
import Distribution.Simple.Utils (die, notice)
import Distribution.Simple.Utils (die, notice, debug)
import Distribution.Verbosity
import Distribution.Text
......@@ -183,7 +184,7 @@ runProjectPreBuildPhase
-- This also gives us more accurate reasons for the --dry-run output.
--
(elaboratedPlan'', pkgsBuildStatus) <-
rebuildTargetsDryRun distDirLayout
rebuildTargetsDryRun verbosity distDirLayout elaboratedShared
elaboratedPlan'
return ProjectBuildContext {
......@@ -243,14 +244,34 @@ runProjectBuildPhase verbosity ProjectBuildContext {..} =
-- | Adjust an 'ElaboratedInstallPlan' by selecting just those parts of it
-- required to build the given user targets.
--
-- How to get the 'PackageTarget's from the 'UserBuildTarget' is customisable.
-- How to get the 'PackageTarget's from the 'UserBuildTarget' is customisable,
-- so that we can change the meaning of @pkgname@ to target a build or
-- repl depending on which command is calling it.
--
selectTargets :: PackageTarget
-- Conceptually, every target identifies one or more roots in the
-- 'ElaboratedInstallPlan', which we then use to determine the closure
-- of what packages need to be built, dropping everything from
-- 'ElaboratedInstallPlan' that is unnecessary.
--
-- There is a complication, however: In an ideal world, every
-- possible target would be a node in the graph. However, it is
-- currently not possible (and possibly not even desirable) to invoke a
-- Setup script to build *just* one file. Similarly, it is not possible
-- to invoke a pre Cabal-1.25 custom Setup script and build only one
-- component. In these cases, we want to build the entire package, BUT
-- only actually building some of the files/components. This is what
-- 'pkgBuildTargets', 'pkgReplTarget' and 'pkgBuildHaddock' control.
-- Arguably, these should an out-of-band mechanism rather than stored
-- in 'ElaboratedInstallPlan', but it's what we have. We have
-- to fiddle around with the ElaboratedConfiguredPackage roots to say
-- what it will build.
--
selectTargets :: Verbosity -> PackageTarget
-> (ComponentTarget -> PackageTarget)
-> [UserBuildTarget]
-> ElaboratedInstallPlan
-> IO ElaboratedInstallPlan
selectTargets targetDefaultComponents targetSpecificComponent
selectTargets verbosity targetDefaultComponents targetSpecificComponent
userBuildTargets installPlan = do
-- Match the user targets against the available targets. If no targets are
......@@ -277,6 +298,7 @@ selectTargets targetDefaultComponents targetSpecificComponent
targetSpecificComponent
installPlan
buildTargets
debug verbosity ("buildTargets': " ++ show buildTargets')
-- Finally, prune the install plan to cover just those target packages
-- and their deps.
......@@ -285,7 +307,8 @@ selectTargets targetDefaultComponents targetSpecificComponent
where
localPackages =
[ (pkgDescription pkg, pkgSourceLocation pkg)
| InstallPlan.Configured pkg <- InstallPlan.toList installPlan ]
| InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan
, let pkg = getElaboratedPackage pkg_or_comp ]
--TODO: [code cleanup] is there a better way to identify local packages?
......@@ -301,7 +324,8 @@ resolveAndCheckTargets targetDefaultComponents
installPlan targets =
case partitionEithers (map checkTarget targets) of
([], targets') -> Right $ Map.fromListWith (++)
[ (ipkgid, [t]) | (ipkgid, t) <- targets' ]
[ (ipkgid, [t]) | (ipkgids, t) <- targets'
, ipkgid <- ipkgids ]
(problems, _) -> Left problems
where
-- TODO [required eventually] currently all build targets refer to packages
......@@ -342,16 +366,20 @@ resolveAndCheckTargets targetDefaultComponents
= Left (BuildTargetNotInProject (buildTargetPackage t))
projAllPkgs, projLocalPkgs :: Map PackageName InstalledPackageId
-- NB: It's a list of 'InstalledPackageId', because each component
-- in the install plan from a single package needs to be associated with
-- the same 'PackageName'.
projAllPkgs, projLocalPkgs :: Map PackageName [InstalledPackageId]
projAllPkgs =
Map.fromList
[ (packageName pkg, installedPackageId pkg)
Map.fromListWith (++)
[ (packageName pkg, [installedPackageId pkg])
| pkg <- InstallPlan.toList installPlan ]
projLocalPkgs =
Map.fromList
[ (packageName pkg, installedPackageId pkg)
| InstallPlan.Configured pkg <- InstallPlan.toList installPlan
Map.fromListWith (++)
[ (packageName pkg, [installedPackageId pkg_or_comp])
| InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan
, let pkg = getElaboratedPackage pkg_or_comp
, case pkgSourceLocation pkg of
LocalUnpackedPackage _ -> True; _ -> False
--TODO: [code cleanup] is there a better way to identify local packages?
......@@ -418,18 +446,25 @@ printPlan verbosity
wouldWill | buildSettingDryRun = "would"
| otherwise = "will"
showPkg pkg = display (packageId pkg)
showPkg (ReadyPackage (ElabPackage pkg)) = display (packageId pkg)
showPkg (ReadyPackage (ElabComponent comp)) =
display (packageId (elabComponentPackage comp)) ++
" (" ++ maybe "custom" display (elabComponentName comp) ++ ")"
showPkgAndReason :: ElaboratedReadyPackage -> String
showPkgAndReason (ReadyPackage pkg) =
display (packageId pkg) ++
showTargets pkg ++
showPkgAndReason (ReadyPackage pkg_or_comp) =
display (installedUnitId pkg_or_comp) ++
(case pkg_or_comp of
ElabPackage _ -> showTargets pkg ++ showStanzas pkg
ElabComponent comp ->
" (" ++ maybe "custom" display (elabComponentName comp) ++ ")") ++
showFlagAssignment (nonDefaultFlags pkg) ++
showStanzas pkg ++
let buildStatus = pkgsBuildStatus Map.! installedPackageId pkg in
let buildStatus = pkgsBuildStatus Map.! installedPackageId pkg_or_comp in
" (" ++ showBuildStatus buildStatus ++ ")"
where
pkg = getElaboratedPackage pkg_or_comp
nonDefaultFlags :: ElaboratedConfiguredPackage -> FlagAssignment
nonDefaultFlags :: ElaboratedPackage -> FlagAssignment
nonDefaultFlags pkg = pkgFlagAssignment pkg \\ pkgFlagDefaults pkg
showStanzas pkg = concat
......
......@@ -9,8 +9,6 @@ module Distribution.Client.ProjectPlanOutput (
) where
import Distribution.Client.ProjectPlanning.Types
( ElaboratedInstallPlan, ElaboratedConfiguredPackage(..)
, ElaboratedSharedConfig(..) )
import Distribution.Client.DistDirLayout
import qualified Distribution.Client.InstallPlan as InstallPlan
......@@ -66,27 +64,46 @@ encodePlanAsJson elaboratedInstallPlan _elaboratedSharedConfig =
J.object
[ "type" J..= J.String "pre-existing"
, "id" J..= jdisplay (installedUnitId ipi)
, "components" J..= J.object
[ "lib" J..= J.object [ "depends" J..= map jdisplay (installedDepends ipi) ] ]
, "depends" J..= map jdisplay (installedDepends ipi)
]
-- ecp :: ElaboratedConfiguredPackage
toJ (InstallPlan.Configured ecp) =
-- pkg :: ElaboratedPackage
toJ (InstallPlan.Configured (ElabPackage pkg)) =
J.object
[ "type" J..= J.String "configured"
, "id" J..= (jdisplay . installedUnitId) ecp
, "id" J..= (jdisplay . installedUnitId) pkg
, "components" J..= components
, "depends" J..= map (jdisplay . confInstId) flat_deps
, "flags" J..= J.object [ fn J..= v
| (PD.FlagName fn,v) <- pkgFlagAssignment ecp ]
| (PD.FlagName fn,v) <-
pkgFlagAssignment pkg ]
]
where
flat_deps = ordNub (ComponentDeps.flatDeps (pkgDependencies pkg))
components = J.object
[ comp2str c J..= J.object
[ "depends" J..= map (jdisplay . installedUnitId) v ]
| (c,v) <- ComponentDeps.toList (pkgDependencies ecp) ]
-- NB: does NOT contain order-only dependencies
| (c,v) <- ComponentDeps.toList (pkgDependencies pkg) ]
-- ecp :: ElaboratedConfiguredPackage
toJ (InstallPlan.Configured (ElabComponent comp)) =
J.object
[ "type" J..= J.String "configured-component"
, "id" J..= (jdisplay . installedUnitId) comp
, "name" J..= J.String (comp2str (elabComponent comp))
, "flags" J..= J.object [ fn J..= v
| (PD.FlagName fn,v) <-
pkgFlagAssignment pkg ]
-- NB: does NOT contain order-only dependencies
, "depends" J..= map (jdisplay . installedUnitId) (elabComponentDependencies comp)
]
where
pkg = elabComponentPackage comp
-- TODO: maybe move this helper to "ComponentDeps" module?
-- Or maybe define a 'Text' instance?
comp2str :: ComponentDeps.Component -> String
comp2str c = case c of
ComponentDeps.ComponentLib -> "lib"
ComponentDeps.ComponentSubLib s -> "lib:" <> s
......
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
-- | Types used while planning how to build everything in a project.
--
......@@ -10,6 +12,17 @@ module Distribution.Client.ProjectPlanning.Types (
-- * Elaborated install plan types
ElaboratedInstallPlan,
ElaboratedConfiguredPackage(..),
getElaboratedPackage,
elabInstallDirs,
elabDistDirParams,
elabRequiresRegistration,
elabBuildTargets,
elabReplTarget,
elabBuildHaddocks,
ElaboratedComponent(..),
ElaboratedPackage(..),
ElaboratedPlanPackage,
ElaboratedSharedConfig(..),
ElaboratedReadyPackage,
......@@ -32,7 +45,9 @@ import Distribution.Client.InstallPlan
( GenericInstallPlan, GenericPlanPackage )
import Distribution.Client.SolverInstallPlan
( SolverInstallPlan )
import Distribution.Client.DistDirLayout
import Distribution.Types.ComponentEnabledSpec
import Distribution.Package
hiding (InstalledPackageId, installedPackageId)
import Distribution.System
......@@ -46,9 +61,10 @@ import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.InstallDirs (PathTemplate)
import Distribution.Version
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackageFixedDeps
import Distribution.Compat.Graph (IsNode(..))
import Data.Map (Map)
import Data.Set (Set)
......@@ -91,16 +107,151 @@ data ElaboratedSharedConfig
instance Binary ElaboratedSharedConfig
-- TODO: This is a misnomer, but I didn't want to rename things
-- willy-nilly yet
data ElaboratedConfiguredPackage
= ElaboratedConfiguredPackage {
= ElabPackage ElaboratedPackage
| ElabComponent ElaboratedComponent
deriving (Eq, Show, Generic)
instance IsNode ElaboratedConfiguredPackage where
type Key ElaboratedConfiguredPackage = UnitId
nodeKey (ElabPackage pkg) = nodeKey pkg
nodeKey (ElabComponent comp) = nodeKey comp
nodeNeighbors (ElabPackage pkg) = nodeNeighbors pkg
nodeNeighbors (ElabComponent comp) = nodeNeighbors comp
elabDistDirParams :: ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams shared (ElabPackage pkg) = DistDirParams {
distParamUnitId = pkgInstalledId pkg,
distParamPackageId = pkgSourceId pkg,
distParamComponentName = Nothing,
distParamCompilerId = compilerId (pkgConfigCompiler shared),
distParamPlatform = pkgConfigPlatform shared
}
elabDistDirParams shared (ElabComponent comp) = DistDirParams {
distParamUnitId = elabComponentId comp,
distParamPackageId = packageId comp, -- NB: NOT the munged ID
distParamComponentName = elabComponentName comp, -- TODO: Ick. Change type.
distParamCompilerId = compilerId (pkgConfigCompiler shared),
distParamPlatform = pkgConfigPlatform shared
}
-- TODO: give each component a separate install dir prefix
elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs.InstallDirs FilePath
elabInstallDirs = pkgInstallDirs . getElaboratedPackage
elabRequiresRegistration :: ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration (ElabPackage pkg) = pkgRequiresRegistration pkg
elabRequiresRegistration (ElabComponent comp)
= case elabComponent comp of
CD.ComponentLib -> True
CD.ComponentSubLib _ -> True
_ -> False
elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget]
elabBuildTargets (ElabPackage pkg) = pkgBuildTargets pkg
elabBuildTargets (ElabComponent comp)
| Just cname <- elabComponentName comp
= map (ComponentTarget cname) $ elabComponentBuildTargets comp
| otherwise = []
elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget
elabReplTarget (ElabPackage pkg) = pkgReplTarget pkg
elabReplTarget (ElabComponent comp)
| Just cname <- elabComponentName comp
= fmap (ComponentTarget cname) $ elabComponentReplTarget comp
| otherwise = Nothing
elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabBuildHaddocks (ElabPackage pkg) = pkgBuildHaddocks pkg
elabBuildHaddocks (ElabComponent comp) = elabComponentBuildHaddocks comp
getElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage
getElaboratedPackage (ElabPackage pkg) = pkg
getElaboratedPackage (ElabComponent comp) = elabComponentPackage comp
instance Binary ElaboratedConfiguredPackage
instance Package ElaboratedConfiguredPackage where
packageId (ElabPackage pkg) = packageId pkg
<