{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE NondecreasingIndentation #-}
module Distribution.Backpack.Configure (
configureComponentLocalBuildInfos,
) where
import Prelude ()
import Distribution.Compat.Prelude hiding ((<>))
import Distribution.Backpack
import Distribution.Backpack.FullUnitId
import Distribution.Backpack.PreExistingComponent
import Distribution.Backpack.ConfiguredComponent
import Distribution.Backpack.LinkedComponent
import Distribution.Backpack.ReadyComponent
import Distribution.Backpack.ComponentsGraph
import Distribution.Backpack.Id
import Distribution.Simple.Compiler
import Distribution.Package
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.InstalledPackageInfo (InstalledPackageInfo
,emptyInstalledPackageInfo)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.PackageDescription
import Distribution.ModuleName
import Distribution.Simple.Setup as Setup
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.AnnotatedId
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ComponentInclude
import Distribution.Types.MungedPackageName
import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Graph, IsNode(..))
import Distribution.Utils.LogProgress
import Data.Either
( lefts )
import qualified Data.Set as Set
import qualified Data.Map as Map
import Distribution.Pretty
import Text.PrettyPrint
configureComponentLocalBuildInfos
:: Verbosity
-> Bool
-> ComponentRequestedSpec
-> Bool
-> Flag String
-> Flag ComponentId
-> PackageDescription
-> [PreExistingComponent]
-> FlagAssignment
-> [(ModuleName, Module)]
-> InstalledPackageIndex
-> Compiler
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
configureComponentLocalBuildInfos :: Verbosity
-> Bool
-> ComponentRequestedSpec
-> Bool
-> Flag [Char]
-> Flag ComponentId
-> PackageDescription
-> [PreExistingComponent]
-> FlagAssignment
-> [(ModuleName, Module)]
-> InstalledPackageIndex
-> Compiler
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
configureComponentLocalBuildInfos
Verbosity
verbosity Bool
use_external_internal_deps ComponentRequestedSpec
enabled Bool
deterministic Flag [Char]
ipid_flag Flag ComponentId
cid_flag PackageDescription
pkg_descr
[PreExistingComponent]
prePkgDeps FlagAssignment
flagAssignment [(ModuleName, Module)]
instantiate_with InstalledPackageIndex
installedPackageSet Compiler
comp = do
ComponentsWithDeps
graph0 <- case ComponentRequestedSpec
-> PackageDescription -> Either [ComponentName] ComponentsGraph
mkComponentsGraph ComponentRequestedSpec
enabled PackageDescription
pkg_descr of
Left [ComponentName]
ccycle -> forall a. Doc -> LogProgress a
dieProgress (PackageIdentifier -> [ComponentName] -> Doc
componentCycleMsg (PackageDescription -> PackageIdentifier
package PackageDescription
pkg_descr) [ComponentName]
ccycle)
Right ComponentsGraph
g -> forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentsGraph -> ComponentsWithDeps
componentsGraphToList ComponentsGraph
g)
Doc -> LogProgress ()
infoProgress forall a b. (a -> b) -> a -> b
$ Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"Source component graph:") Int
4
(ComponentsWithDeps -> Doc
dispComponentsWithDeps ComponentsWithDeps
graph0)
let conf_pkg_map :: Map PackageName (Map ComponentName (AnnotatedId ComponentId))
conf_pkg_map = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
[(PreExistingComponent -> PackageName
pc_pkgname PreExistingComponent
pkg,
forall k a. k -> a -> Map k a
Map.singleton (PreExistingComponent -> ComponentName
pc_compname PreExistingComponent
pkg)
(AnnotatedId {
ann_id :: ComponentId
ann_id = PreExistingComponent -> ComponentId
pc_cid PreExistingComponent
pkg,
ann_pid :: PackageIdentifier
ann_pid = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PreExistingComponent
pkg,
ann_cname :: ComponentName
ann_cname = PreExistingComponent -> ComponentName
pc_compname PreExistingComponent
pkg
}))
| PreExistingComponent
pkg <- [PreExistingComponent]
prePkgDeps]
[ConfiguredComponent]
graph1 <- Bool
-> FlagAssignment
-> Bool
-> Flag [Char]
-> Flag ComponentId
-> PackageDescription
-> Map PackageName (Map ComponentName (AnnotatedId ComponentId))
-> [Component]
-> LogProgress [ConfiguredComponent]
toConfiguredComponents Bool
use_external_internal_deps
FlagAssignment
flagAssignment
Bool
deterministic Flag [Char]
ipid_flag Flag ComponentId
cid_flag PackageDescription
pkg_descr
Map PackageName (Map ComponentName (AnnotatedId ComponentId))
conf_pkg_map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst ComponentsWithDeps
graph0)
Doc -> LogProgress ()
infoProgress forall a b. (a -> b) -> a -> b
$ Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"Configured component graph:") Int
4
([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map ConfiguredComponent -> Doc
dispConfiguredComponent [ConfiguredComponent]
graph1))
let shape_pkg_map :: Map ComponentId (OpenUnitId, ModuleShape)
shape_pkg_map = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (PreExistingComponent -> ComponentId
pc_cid PreExistingComponent
pkg, (PreExistingComponent -> OpenUnitId
pc_open_uid PreExistingComponent
pkg, PreExistingComponent -> ModuleShape
pc_shape PreExistingComponent
pkg))
| PreExistingComponent
pkg <- [PreExistingComponent]
prePkgDeps]
uid_lookup :: DefUnitId -> FullUnitId
uid_lookup DefUnitId
def_uid
| Just InstalledPackageInfo
pkg <- forall a. PackageIndex a -> UnitId -> Maybe a
PackageIndex.lookupUnitId InstalledPackageIndex
installedPackageSet UnitId
uid
= ComponentId -> OpenModuleSubst -> FullUnitId
FullUnitId (InstalledPackageInfo -> ComponentId
Installed.installedComponentId InstalledPackageInfo
pkg)
(forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
Installed.instantiatedWith InstalledPackageInfo
pkg))
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error ([Char]
"uid_lookup: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow UnitId
uid)
where uid :: UnitId
uid = DefUnitId -> UnitId
unDefUnitId DefUnitId
def_uid
[LinkedComponent]
graph2 <- Verbosity
-> (DefUnitId -> FullUnitId)
-> PackageIdentifier
-> Map ComponentId (OpenUnitId, ModuleShape)
-> [ConfiguredComponent]
-> LogProgress [LinkedComponent]
toLinkedComponents Verbosity
verbosity DefUnitId -> FullUnitId
uid_lookup
(PackageDescription -> PackageIdentifier
package PackageDescription
pkg_descr) Map ComponentId (OpenUnitId, ModuleShape)
shape_pkg_map [ConfiguredComponent]
graph1
Doc -> LogProgress ()
infoProgress forall a b. (a -> b) -> a -> b
$
Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"Linked component graph:") Int
4
([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map LinkedComponent -> Doc
dispLinkedComponent [LinkedComponent]
graph2))
let pid_map :: Map UnitId MungedPackageId
pid_map = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
[ (PreExistingComponent -> UnitId
pc_uid PreExistingComponent
pkg, PreExistingComponent -> MungedPackageId
pc_munged_id PreExistingComponent
pkg)
| PreExistingComponent
pkg <- [PreExistingComponent]
prePkgDeps] forall a. [a] -> [a] -> [a]
++
[ (InstalledPackageInfo -> UnitId
Installed.installedUnitId InstalledPackageInfo
pkg, forall pkg. HasMungedPackageId pkg => pkg -> MungedPackageId
mungedId InstalledPackageInfo
pkg)
| (ModuleName
_, Module DefUnitId
uid ModuleName
_) <- [(ModuleName, Module)]
instantiate_with
, Just InstalledPackageInfo
pkg <- [forall a. PackageIndex a -> UnitId -> Maybe a
PackageIndex.lookupUnitId
InstalledPackageIndex
installedPackageSet (DefUnitId -> UnitId
unDefUnitId DefUnitId
uid)] ]
subst :: Map ModuleName Module
subst = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ModuleName, Module)]
instantiate_with
graph3 :: [ReadyComponent]
graph3 = Map UnitId MungedPackageId
-> Map ModuleName Module -> [LinkedComponent] -> [ReadyComponent]
toReadyComponents Map UnitId MungedPackageId
pid_map Map ModuleName Module
subst [LinkedComponent]
graph2
graph4 :: [ReadyComponent]
graph4 = forall a. Graph a -> [a]
Graph.revTopSort (forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList [ReadyComponent]
graph3)
Doc -> LogProgress ()
infoProgress forall a b. (a -> b) -> a -> b
$ Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"Ready component graph:") Int
4
([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map ReadyComponent -> Doc
dispReadyComponent [ReadyComponent]
graph4))
Compiler
-> InstalledPackageIndex
-> PackageDescription
-> [PreExistingComponent]
-> [ReadyComponent]
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
toComponentLocalBuildInfos Compiler
comp InstalledPackageIndex
installedPackageSet PackageDescription
pkg_descr [PreExistingComponent]
prePkgDeps [ReadyComponent]
graph4
toComponentLocalBuildInfos
:: Compiler
-> InstalledPackageIndex
-> PackageDescription
-> [PreExistingComponent]
-> [ReadyComponent]
-> LogProgress ([ComponentLocalBuildInfo],
InstalledPackageIndex)
toComponentLocalBuildInfos :: Compiler
-> InstalledPackageIndex
-> PackageDescription
-> [PreExistingComponent]
-> [ReadyComponent]
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
toComponentLocalBuildInfos
Compiler
comp InstalledPackageIndex
installedPackageSet PackageDescription
pkg_descr [PreExistingComponent]
externalPkgDeps [ReadyComponent]
graph = do
let
external_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
external_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
external_graph = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left
forall a b. (a -> b) -> a -> b
$ forall a. PackageIndex a -> [a]
PackageIndex.allPackages InstalledPackageIndex
installedPackageSet
internal_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
internal_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
internal_graph = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right
forall a b. (a -> b) -> a -> b
$ [ReadyComponent]
graph
combined_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
combined_graph = forall a. IsNode a => Graph a -> Graph a -> Graph a
Graph.unionRight Graph (Either InstalledPackageInfo ReadyComponent)
external_graph Graph (Either InstalledPackageInfo ReadyComponent)
internal_graph
local_graph :: [Either InstalledPackageInfo ReadyComponent]
local_graph = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"toComponentLocalBuildInfos: closure returned Nothing")
forall a b. (a -> b) -> a -> b
$ forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure Graph (Either InstalledPackageInfo ReadyComponent)
combined_graph (forall a b. (a -> b) -> [a] -> [b]
map forall a. IsNode a => a -> Key a
nodeKey [ReadyComponent]
graph)
packageDependsIndex :: InstalledPackageIndex
packageDependsIndex = [InstalledPackageInfo] -> InstalledPackageIndex
PackageIndex.fromList (forall a b. [Either a b] -> [a]
lefts [Either InstalledPackageInfo ReadyComponent]
local_graph)
fullIndex :: Graph (Either InstalledPackageInfo ReadyComponent)
fullIndex = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList [Either InstalledPackageInfo ReadyComponent]
local_graph
case forall a. Graph a -> [(a, [Key a])]
Graph.broken Graph (Either InstalledPackageInfo ReadyComponent)
fullIndex of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(Either InstalledPackageInfo ReadyComponent,
[Key (Either InstalledPackageInfo ReadyComponent)])]
broken ->
forall a. Doc -> LogProgress a
dieProgress forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
text forall a b. (a -> b) -> a -> b
$
[Char]
"The following packages are broken because other"
forall a. [a] -> [a] -> [a]
++ [Char]
" packages they depend on are missing. These broken "
forall a. [a] -> [a] -> [a]
++ [Char]
"packages must be rebuilt before they can be used.\n"
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines [ [Char]
"installed package "
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId InstalledPackageInfo
pkg)
forall a. [a] -> [a] -> [a]
++ [Char]
" is broken due to missing package "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> [Char]
prettyShow [UnitId]
deps)
| (Left InstalledPackageInfo
pkg, [UnitId]
deps) <- [(Either InstalledPackageInfo ReadyComponent,
[Key (Either InstalledPackageInfo ReadyComponent)])]
broken ]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines [ [Char]
"planned package "
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ReadyComponent
pkg)
forall a. [a] -> [a] -> [a]
++ [Char]
" is broken due to missing package "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> [Char]
prettyShow [UnitId]
deps)
| (Right ReadyComponent
pkg, [UnitId]
deps) <- [(Either InstalledPackageInfo ReadyComponent,
[Key (Either InstalledPackageInfo ReadyComponent)])]
broken ]
let pseudoTopPkg :: InstalledPackageInfo
pseudoTopPkg :: InstalledPackageInfo
pseudoTopPkg = InstalledPackageInfo
emptyInstalledPackageInfo {
installedUnitId :: UnitId
Installed.installedUnitId = PackageIdentifier -> UnitId
mkLegacyUnitId (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr),
sourcePackageId :: PackageIdentifier
Installed.sourcePackageId = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr,
depends :: [UnitId]
Installed.depends = forall a b. (a -> b) -> [a] -> [b]
map PreExistingComponent -> UnitId
pc_uid [PreExistingComponent]
externalPkgDeps
}
case InstalledPackageIndex
-> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
PackageIndex.dependencyInconsistencies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo
-> InstalledPackageIndex -> InstalledPackageIndex
PackageIndex.insert InstalledPackageInfo
pseudoTopPkg
forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
packageDependsIndex of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
inconsistencies ->
Doc -> LogProgress ()
warnProgress forall a b. (a -> b) -> a -> b
$
Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"This package indirectly depends on multiple versions of the same" Doc -> Doc -> Doc
<+>
[Char] -> Doc
text [Char]
"package. This is very likely to cause a compile failure.") Int
2
([Doc] -> Doc
vcat [ [Char] -> Doc
text [Char]
"package" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty (forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
user) Doc -> Doc -> Doc
<+>
Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstalledPackageInfo
user)) Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"requires" Doc -> Doc -> Doc
<+>
forall a. Pretty a => a -> Doc
pretty UnitId
inst
| (DepUniqueKey
_dep_key, [(UnitId, [InstalledPackageInfo])]
insts) <- [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
inconsistencies
, (UnitId
inst, [InstalledPackageInfo]
users) <- [(UnitId, [InstalledPackageInfo])]
insts
, InstalledPackageInfo
user <- [InstalledPackageInfo]
users ])
let clbis :: [ComponentLocalBuildInfo]
clbis = Compiler -> [ReadyComponent] -> [ComponentLocalBuildInfo]
mkLinkedComponentsLocalBuildInfo Compiler
comp [ReadyComponent]
graph
forall (m :: * -> *) a. Monad m => a -> m a
return ([ComponentLocalBuildInfo]
clbis, InstalledPackageIndex
packageDependsIndex)
mkLinkedComponentsLocalBuildInfo
:: Compiler
-> [ReadyComponent]
-> [ComponentLocalBuildInfo]
mkLinkedComponentsLocalBuildInfo :: Compiler -> [ReadyComponent] -> [ComponentLocalBuildInfo]
mkLinkedComponentsLocalBuildInfo Compiler
comp [ReadyComponent]
rcs = forall a b. (a -> b) -> [a] -> [b]
map ReadyComponent -> ComponentLocalBuildInfo
go [ReadyComponent]
rcs
where
internalUnits :: Set UnitId
internalUnits = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map ReadyComponent -> UnitId
rc_uid [ReadyComponent]
rcs)
isInternal :: UnitId -> Bool
isInternal UnitId
x = forall a. Ord a => a -> Set a -> Bool
Set.member UnitId
x Set UnitId
internalUnits
go :: ReadyComponent -> ComponentLocalBuildInfo
go ReadyComponent
rc =
case ReadyComponent -> Component
rc_component ReadyComponent
rc of
CLib Library
lib ->
let convModuleExport :: (ModuleName, Module) -> ExposedModule
convModuleExport (ModuleName
modname', (Module DefUnitId
uid ModuleName
modname))
| UnitId
this_uid forall a. Eq a => a -> a -> Bool
== DefUnitId -> UnitId
unDefUnitId DefUnitId
uid
, ModuleName
modname' forall a. Eq a => a -> a -> Bool
== ModuleName
modname
= ModuleName -> Maybe OpenModule -> ExposedModule
Installed.ExposedModule ModuleName
modname' forall a. Maybe a
Nothing
| Bool
otherwise
= ModuleName -> Maybe OpenModule -> ExposedModule
Installed.ExposedModule ModuleName
modname'
(forall a. a -> Maybe a
Just (OpenUnitId -> ModuleName -> OpenModule
OpenModule (DefUnitId -> OpenUnitId
DefiniteUnitId DefUnitId
uid) ModuleName
modname))
convOpenModuleExport :: (ModuleName, OpenModule) -> ExposedModule
convOpenModuleExport (ModuleName
modname', modu :: OpenModule
modu@(OpenModule OpenUnitId
uid ModuleName
modname))
| OpenUnitId
uid forall a. Eq a => a -> a -> Bool
== OpenUnitId
this_open_uid
, ModuleName
modname' forall a. Eq a => a -> a -> Bool
== ModuleName
modname
= ModuleName -> Maybe OpenModule -> ExposedModule
Installed.ExposedModule ModuleName
modname' forall a. Maybe a
Nothing
| Bool
otherwise
= ModuleName -> Maybe OpenModule -> ExposedModule
Installed.ExposedModule ModuleName
modname' (forall a. a -> Maybe a
Just OpenModule
modu)
convOpenModuleExport (ModuleName
_, OpenModuleVar ModuleName
_)
= forall a. HasCallStack => [Char] -> a
error [Char]
"convOpenModuleExport: top-level modvar"
exports :: [ExposedModule]
exports =
case ReadyComponent -> Either IndefiniteComponent InstantiatedComponent
rc_i ReadyComponent
rc of
Left IndefiniteComponent
indefc -> forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, OpenModule) -> ExposedModule
convOpenModuleExport
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList (IndefiniteComponent -> OpenModuleSubst
indefc_provides IndefiniteComponent
indefc)
Right InstantiatedComponent
instc -> forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Module) -> ExposedModule
convModuleExport
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList (InstantiatedComponent -> Map ModuleName Module
instc_provides InstantiatedComponent
instc)
insts :: [(ModuleName, OpenModule)]
insts =
case ReadyComponent -> Either IndefiniteComponent InstantiatedComponent
rc_i ReadyComponent
rc of
Left IndefiniteComponent
indefc -> [ (ModuleName
m, ModuleName -> OpenModule
OpenModuleVar ModuleName
m) | ModuleName
m <- IndefiniteComponent -> [ModuleName]
indefc_requires IndefiniteComponent
indefc ]
Right InstantiatedComponent
instc -> [ (ModuleName
m, OpenUnitId -> ModuleName -> OpenModule
OpenModule (DefUnitId -> OpenUnitId
DefiniteUnitId DefUnitId
uid') ModuleName
m')
| (ModuleName
m, Module DefUnitId
uid' ModuleName
m') <- InstantiatedComponent -> [(ModuleName, Module)]
instc_insts InstantiatedComponent
instc ]
compat_name :: MungedPackageName
compat_name = PackageName -> LibraryName -> MungedPackageName
MungedPackageName (forall pkg. Package pkg => pkg -> PackageName
packageName ReadyComponent
rc) (Library -> LibraryName
libName Library
lib)
compat_key :: [Char]
compat_key = Compiler -> MungedPackageName -> Version -> UnitId -> [Char]
computeCompatPackageKey Compiler
comp MungedPackageName
compat_name (forall pkg. Package pkg => pkg -> Version
packageVersion ReadyComponent
rc) UnitId
this_uid
in LibComponentLocalBuildInfo {
componentPackageDeps :: [(UnitId, MungedPackageId)]
componentPackageDeps = [(UnitId, MungedPackageId)]
cpds,
componentUnitId :: UnitId
componentUnitId = UnitId
this_uid,
componentComponentId :: ComponentId
componentComponentId = ComponentId
this_cid,
componentInstantiatedWith :: [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts,
componentIsIndefinite_ :: Bool
componentIsIndefinite_ = Bool
is_indefinite,
componentLocalName :: ComponentName
componentLocalName = ComponentName
cname,
componentInternalDeps :: [UnitId]
componentInternalDeps = [UnitId]
internal_deps,
componentExeDeps :: [UnitId]
componentExeDeps = [UnitId]
exe_deps,
componentIncludes :: [(OpenUnitId, ModuleRenaming)]
componentIncludes = [(OpenUnitId, ModuleRenaming)]
includes,
componentExposedModules :: [ExposedModule]
componentExposedModules = [ExposedModule]
exports,
componentIsPublic :: Bool
componentIsPublic = ReadyComponent -> Bool
rc_public ReadyComponent
rc,
componentCompatPackageKey :: [Char]
componentCompatPackageKey = [Char]
compat_key,
componentCompatPackageName :: MungedPackageName
componentCompatPackageName = MungedPackageName
compat_name
}
CFLib ForeignLib
_ ->
FLibComponentLocalBuildInfo {
componentUnitId :: UnitId
componentUnitId = UnitId
this_uid,
componentComponentId :: ComponentId
componentComponentId = ComponentId
this_cid,
componentLocalName :: ComponentName
componentLocalName = ComponentName
cname,
componentPackageDeps :: [(UnitId, MungedPackageId)]
componentPackageDeps = [(UnitId, MungedPackageId)]
cpds,
componentExeDeps :: [UnitId]
componentExeDeps = [UnitId]
exe_deps,
componentInternalDeps :: [UnitId]
componentInternalDeps = [UnitId]
internal_deps,
componentIncludes :: [(OpenUnitId, ModuleRenaming)]
componentIncludes = [(OpenUnitId, ModuleRenaming)]
includes
}
CExe Executable
_ ->
ExeComponentLocalBuildInfo {
componentUnitId :: UnitId
componentUnitId = UnitId
this_uid,
componentComponentId :: ComponentId
componentComponentId = ComponentId
this_cid,
componentLocalName :: ComponentName
componentLocalName = ComponentName
cname,
componentPackageDeps :: [(UnitId, MungedPackageId)]
componentPackageDeps = [(UnitId, MungedPackageId)]
cpds,
componentExeDeps :: [UnitId]
componentExeDeps = [UnitId]
exe_deps,
componentInternalDeps :: [UnitId]
componentInternalDeps = [UnitId]
internal_deps,
componentIncludes :: [(OpenUnitId, ModuleRenaming)]
componentIncludes = [(OpenUnitId, ModuleRenaming)]
includes
}
CTest TestSuite
_ ->
TestComponentLocalBuildInfo {
componentUnitId :: UnitId
componentUnitId = UnitId
this_uid,
componentComponentId :: ComponentId
componentComponentId = ComponentId
this_cid,
componentLocalName :: ComponentName
componentLocalName = ComponentName
cname,
componentPackageDeps :: [(UnitId, MungedPackageId)]
componentPackageDeps = [(UnitId, MungedPackageId)]
cpds,
componentExeDeps :: [UnitId]
componentExeDeps = [UnitId]
exe_deps,
componentInternalDeps :: [UnitId]
componentInternalDeps = [UnitId]
internal_deps,
componentIncludes :: [(OpenUnitId, ModuleRenaming)]
componentIncludes = [(OpenUnitId, ModuleRenaming)]
includes
}
CBench Benchmark
_ ->
BenchComponentLocalBuildInfo {
componentUnitId :: UnitId
componentUnitId = UnitId
this_uid,
componentComponentId :: ComponentId
componentComponentId = ComponentId
this_cid,
componentLocalName :: ComponentName
componentLocalName = ComponentName
cname,
componentPackageDeps :: [(UnitId, MungedPackageId)]
componentPackageDeps = [(UnitId, MungedPackageId)]
cpds,
componentExeDeps :: [UnitId]
componentExeDeps = [UnitId]
exe_deps,
componentInternalDeps :: [UnitId]
componentInternalDeps = [UnitId]
internal_deps,
componentIncludes :: [(OpenUnitId, ModuleRenaming)]
componentIncludes = [(OpenUnitId, ModuleRenaming)]
includes
}
where
this_uid :: UnitId
this_uid = ReadyComponent -> UnitId
rc_uid ReadyComponent
rc
this_open_uid :: OpenUnitId
this_open_uid = ReadyComponent -> OpenUnitId
rc_open_uid ReadyComponent
rc
this_cid :: ComponentId
this_cid = ReadyComponent -> ComponentId
rc_cid ReadyComponent
rc
cname :: ComponentName
cname = Component -> ComponentName
componentName (ReadyComponent -> Component
rc_component ReadyComponent
rc)
cpds :: [(UnitId, MungedPackageId)]
cpds = ReadyComponent -> [(UnitId, MungedPackageId)]
rc_depends ReadyComponent
rc
exe_deps :: [UnitId]
exe_deps = forall a b. (a -> b) -> [a] -> [b]
map forall id. AnnotatedId id -> id
ann_id forall a b. (a -> b) -> a -> b
$ ReadyComponent -> [AnnotatedId UnitId]
rc_exe_deps ReadyComponent
rc
is_indefinite :: Bool
is_indefinite =
case ReadyComponent -> Either IndefiniteComponent InstantiatedComponent
rc_i ReadyComponent
rc of
Left IndefiniteComponent
_ -> Bool
True
Right InstantiatedComponent
_ -> Bool
False
includes :: [(OpenUnitId, ModuleRenaming)]
includes =
forall a b. (a -> b) -> [a] -> [b]
map (\ComponentInclude OpenUnitId ModuleRenaming
ci -> (forall id rn. ComponentInclude id rn -> id
ci_id ComponentInclude OpenUnitId ModuleRenaming
ci, forall id rn. ComponentInclude id rn -> rn
ci_renaming ComponentInclude OpenUnitId ModuleRenaming
ci)) forall a b. (a -> b) -> a -> b
$
case ReadyComponent -> Either IndefiniteComponent InstantiatedComponent
rc_i ReadyComponent
rc of
Left IndefiniteComponent
indefc ->
IndefiniteComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
indefc_includes IndefiniteComponent
indefc
Right InstantiatedComponent
instc ->
forall a b. (a -> b) -> [a] -> [b]
map (\ComponentInclude DefUnitId ModuleRenaming
ci -> ComponentInclude DefUnitId ModuleRenaming
ci { ci_ann_id :: AnnotatedId OpenUnitId
ci_ann_id = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefUnitId -> OpenUnitId
DefiniteUnitId (forall id rn. ComponentInclude id rn -> AnnotatedId id
ci_ann_id ComponentInclude DefUnitId ModuleRenaming
ci) })
(InstantiatedComponent
-> [ComponentInclude DefUnitId ModuleRenaming]
instc_includes InstantiatedComponent
instc)
internal_deps :: [UnitId]
internal_deps = forall a. (a -> Bool) -> [a] -> [a]
filter UnitId -> Bool
isInternal (forall a. IsNode a => a -> [Key a]
nodeNeighbors ReadyComponent
rc)