{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE NondecreasingIndentation #-}

-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
--
-- WARNING: The contents of this module are HIGHLY experimental.
-- We may refactor it under you.
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

------------------------------------------------------------------------------
-- Pipeline
------------------------------------------------------------------------------

configureComponentLocalBuildInfos
    :: Verbosity
    -> Bool                   -- use_external_internal_deps
    -> ComponentRequestedSpec
    -> Bool                   -- deterministic
    -> Flag String            -- configIPID
    -> Flag ComponentId       -- configCID
    -> PackageDescription
    -> [PreExistingComponent]
    -> FlagAssignment         -- configConfigurationsFlags
    -> [(ModuleName, Module)] -- configInstantiateWith
    -> 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
    -- NB: In single component mode, this returns a *single* component.
    -- In this graph, the graph is NOT closed.
    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

------------------------------------------------------------------------------
-- ComponentLocalBuildInfo
------------------------------------------------------------------------------

toComponentLocalBuildInfos
    :: Compiler
    -> InstalledPackageIndex -- FULL set
    -> PackageDescription
    -> [PreExistingComponent] -- external package deps
    -> [ReadyComponent]
    -> LogProgress ([ComponentLocalBuildInfo],
                    InstalledPackageIndex) -- only relevant packages
toComponentLocalBuildInfos :: Compiler
-> InstalledPackageIndex
-> PackageDescription
-> [PreExistingComponent]
-> [ReadyComponent]
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
toComponentLocalBuildInfos
    Compiler
comp InstalledPackageIndex
installedPackageSet PackageDescription
pkg_descr [PreExistingComponent]
externalPkgDeps [ReadyComponent]
graph = do
    -- Check and make sure that every instantiated component exists.
    -- We have to do this now, because prior to linking/instantiating
    -- we don't actually know what the full set of 'UnitId's we need
    -- are.
    let -- TODO: This is actually a bit questionable performance-wise,
        -- since we will pay for the ALL installed packages even if
        -- they are not related to what we are building.  This was true
        -- in the old configure code.
        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)
        -- The database of transitively reachable installed packages that the
        -- external components the package (as a whole) depends on.  This will be
        -- used in several ways:
        --
        --      * We'll use it to do a consistency check so we're not depending
        --        on multiple versions of the same package (TODO: someday relax
        --        this for private dependencies.)  See right below.
        --
        --      * We'll pass it on in the LocalBuildInfo, where preprocessors
        --        and other things will incorrectly use it to determine what
        --        the include paths and everything should be.
        --
        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 ->
          -- TODO: ppr this
          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"
             -- TODO: Undupe.
             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 ]

    -- In this section, we'd like to look at the 'packageDependsIndex'
    -- and see if we've picked multiple versions of the same
    -- installed package (this is bad, because it means you might
    -- get an error could not match foo-0.1:Type with foo-0.2:Type).
    --
    -- What is pseudoTopPkg for? I have no idea.  It was used
    -- in the very original commit which introduced checking for
    -- inconsistencies 5115bb2be4e13841ea07dc9166b9d9afa5f0d012,
    -- and then moved out of PackageIndex and put here later.
    -- TODO: Try this code without it...
    --
    -- TODO: Move this into a helper function
    --
    -- TODO: This is probably wrong for Backpack
    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
    -- forM clbis $ \(clbi,deps) -> info verbosity $ "UNIT" ++ hashUnitId (componentUnitId clbi) ++ "\n" ++ intercalate "\n" (map hashUnitId deps)
    forall (m :: * -> *) a. Monad m => a -> m a
return ([ComponentLocalBuildInfo]
clbis, InstalledPackageIndex
packageDependsIndex)

-- Build ComponentLocalBuildInfo for each component we are going
-- to build.
--
-- This conversion is lossy; we lose some invariants from ReadyComponent
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 =
                -- Loses invariants
                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)