    {-# 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 -> Doc -> LogProgress ComponentsWithDeps
    forall a. Doc -> LogProgress a
    dieProgress (PackageIdentifier -> [ComponentName] -> Doc
    componentCycleMsg (PackageDescription -> PackageIdentifier
    package PackageDescription
    pkg_descr) [ComponentName]
    ccycle)
                    Right ComponentsGraph
    g -> ComponentsWithDeps -> LogProgress ComponentsWithDeps
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ComponentsGraph -> ComponentsWithDeps
    componentsGraphToList ComponentsGraph
    g)
        Doc -> LogProgress ()
    infoProgress (Doc -> LogProgress ()) -> Doc -> LogProgress ()
    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 = (Map ComponentName (AnnotatedId ComponentId)
     -> Map ComponentName (AnnotatedId ComponentId)
     -> Map ComponentName (AnnotatedId ComponentId))
    -> [(PackageName, Map ComponentName (AnnotatedId ComponentId))]
    -> Map PackageName (Map ComponentName (AnnotatedId ComponentId))
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith Map ComponentName (AnnotatedId ComponentId)
    -> Map ComponentName (AnnotatedId ComponentId)
    -> Map ComponentName (AnnotatedId ComponentId)
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union
                [(PreExistingComponent -> PackageName
    pc_pkgname PreExistingComponent
    pkg,
                    ComponentName
    -> AnnotatedId ComponentId
    -> Map ComponentName (AnnotatedId ComponentId)
    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 = PreExistingComponent -> PackageIdentifier
    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 (((Component, [ComponentName]) -> Component)
    -> ComponentsWithDeps -> [Component]
    forall a b. (a -> b) -> [a] -> [b]
    map (Component, [ComponentName]) -> Component
    forall a b. (a, b) -> a
    fst ComponentsWithDeps
    graph0)
        Doc -> LogProgress ()
    infoProgress (Doc -> LogProgress ()) -> Doc -> LogProgress ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> Int -> Doc -> Doc
    hang ([Char] -> Doc
    text [Char]
    "Configured component graph:") Int
    4
                            ([Doc] -> Doc
    vcat ((ConfiguredComponent -> Doc) -> [ConfiguredComponent] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ConfiguredComponent -> Doc
    dispConfiguredComponent [ConfiguredComponent]
    graph1))

        let shape_pkg_map :: Map ComponentId (OpenUnitId, ModuleShape)
    shape_pkg_map = [(ComponentId, (OpenUnitId, ModuleShape))]
    -> Map ComponentId (OpenUnitId, ModuleShape)
    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 <- InstalledPackageIndex -> UnitId -> Maybe InstalledPackageInfo
    forall a. PackageIndex a -> UnitId -> Maybe a
    PackageIndex.lookupUnitId InstalledPackageIndex
    installedPackageSet UnitId
    uid
                = ComponentId -> OpenModuleSubst -> FullUnitId
    FullUnitId (InstalledPackageInfo -> ComponentId
    Installed.installedComponentId InstalledPackageInfo
    pkg)
                     ([(ModuleName, OpenModule)] -> OpenModuleSubst
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
    Installed.instantiatedWith InstalledPackageInfo
    pkg))
                | Bool
    otherwise = [Char] -> FullUnitId
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "uid_lookup: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ UnitId -> [Char]
    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 (Doc -> LogProgress ()) -> Doc -> LogProgress ()
    forall a b. (a -> b) -> a -> b
    $
            Doc -> Int -> Doc -> Doc
    hang ([Char] -> Doc
    text [Char]
    "Linked component graph:") Int
    4
                 ([Doc] -> Doc
    vcat ((LinkedComponent -> Doc) -> [LinkedComponent] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map LinkedComponent -> Doc
    dispLinkedComponent [LinkedComponent]
    graph2))

        let pid_map :: Map UnitId MungedPackageId
    pid_map = [(UnitId, MungedPackageId)] -> Map UnitId MungedPackageId
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(UnitId, MungedPackageId)] -> Map UnitId MungedPackageId)
    -> [(UnitId, MungedPackageId)] -> Map UnitId MungedPackageId
    forall a b. (a -> b) -> a -> b
    $
                [ (PreExistingComponent -> UnitId
    pc_uid PreExistingComponent
    pkg, PreExistingComponent -> MungedPackageId
    pc_munged_id PreExistingComponent
    pkg)
                | PreExistingComponent
    pkg <- [PreExistingComponent]
    prePkgDeps] [(UnitId, MungedPackageId)]
    -> [(UnitId, MungedPackageId)] -> [(UnitId, MungedPackageId)]
    forall a. [a] -> [a] -> [a]
    ++
                [ (InstalledPackageInfo -> UnitId
    Installed.installedUnitId InstalledPackageInfo
    pkg, InstalledPackageInfo -> MungedPackageId
    forall pkg. HasMungedPackageId pkg => pkg -> MungedPackageId
    mungedId InstalledPackageInfo
    pkg)
                | (ModuleName
    _, Module DefUnitId
    uid ModuleName
    _) <- [(ModuleName, Module)]
    instantiate_with
                , Just InstalledPackageInfo
    pkg <- [InstalledPackageIndex -> UnitId -> Maybe InstalledPackageInfo
    forall a. PackageIndex a -> UnitId -> Maybe a
    PackageIndex.lookupUnitId
                                    InstalledPackageIndex
    installedPackageSet (DefUnitId -> UnitId
    unDefUnitId DefUnitId
    uid)] ]
            subst :: Map ModuleName Module
    subst = [(ModuleName, Module)] -> Map ModuleName Module
    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 = Graph ReadyComponent -> [ReadyComponent]
    forall a. Graph a -> [a]
    Graph.revTopSort ([ReadyComponent] -> Graph ReadyComponent
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    Graph.fromDistinctList [ReadyComponent]
    graph3)

        Doc -> LogProgress ()
    infoProgress (Doc -> LogProgress ()) -> Doc -> LogProgress ()
    forall a b. (a -> b) -> a -> b
    $ Doc -> Int -> Doc -> Doc
    hang ([Char] -> Doc
    text [Char]
    "Ready component graph:") Int
    4
                            ([Doc] -> Doc
    vcat ((ReadyComponent -> Doc) -> [ReadyComponent] -> [Doc]
    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 = [Either InstalledPackageInfo ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    Graph.fromDistinctList
                           ([Either InstalledPackageInfo ReadyComponent]
     -> Graph (Either InstalledPackageInfo ReadyComponent))
    -> ([InstalledPackageInfo]
        -> [Either InstalledPackageInfo ReadyComponent])
    -> [InstalledPackageInfo]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (InstalledPackageInfo
     -> Either InstalledPackageInfo ReadyComponent)
    -> [InstalledPackageInfo]
    -> [Either InstalledPackageInfo ReadyComponent]
    forall a b. (a -> b) -> [a] -> [b]
    map InstalledPackageInfo -> Either InstalledPackageInfo ReadyComponent
    forall a b. a -> Either a b
    Left
                           ([InstalledPackageInfo]
     -> Graph (Either InstalledPackageInfo ReadyComponent))
    -> [InstalledPackageInfo]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a b. (a -> b) -> a -> b
    $ InstalledPackageIndex -> [InstalledPackageInfo]
    forall a. PackageIndex a -> [a]
    PackageIndex.allPackages InstalledPackageIndex
    installedPackageSet
            internal_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
            internal_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
    internal_graph = [Either InstalledPackageInfo ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    Graph.fromDistinctList
                           ([Either InstalledPackageInfo ReadyComponent]
     -> Graph (Either InstalledPackageInfo ReadyComponent))
    -> ([ReadyComponent]
        -> [Either InstalledPackageInfo ReadyComponent])
    -> [ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ReadyComponent -> Either InstalledPackageInfo ReadyComponent)
    -> [ReadyComponent] -> [Either InstalledPackageInfo ReadyComponent]
    forall a b. (a -> b) -> [a] -> [b]
    map ReadyComponent -> Either InstalledPackageInfo ReadyComponent
    forall a b. b -> Either a b
    Right
                           ([ReadyComponent]
     -> Graph (Either InstalledPackageInfo ReadyComponent))
    -> [ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a b. (a -> b) -> a -> b
    $ [ReadyComponent]
    graph
            combined_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
    combined_graph = Graph (Either InstalledPackageInfo ReadyComponent)
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    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 = [Either InstalledPackageInfo ReadyComponent]
    -> Maybe [Either InstalledPackageInfo ReadyComponent]
    -> [Either InstalledPackageInfo ReadyComponent]
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> [Either InstalledPackageInfo ReadyComponent]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "toComponentLocalBuildInfos: closure returned Nothing")
                        (Maybe [Either InstalledPackageInfo ReadyComponent]
     -> [Either InstalledPackageInfo ReadyComponent])
    -> Maybe [Either InstalledPackageInfo ReadyComponent]
    -> [Either InstalledPackageInfo ReadyComponent]
    forall a b. (a -> b) -> a -> b
    $ Graph (Either InstalledPackageInfo ReadyComponent)
    -> [Key (Either InstalledPackageInfo ReadyComponent)]
    -> Maybe [Either InstalledPackageInfo ReadyComponent]
    forall a. Graph a -> [Key a] -> Maybe [a]
    Graph.closure Graph (Either InstalledPackageInfo ReadyComponent)
    combined_graph ((ReadyComponent -> UnitId) -> [ReadyComponent] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map ReadyComponent -> Key ReadyComponent
    ReadyComponent -> UnitId
    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 ([Either InstalledPackageInfo ReadyComponent]
    -> [InstalledPackageInfo]
    forall a b. [Either a b] -> [a]
    lefts [Either InstalledPackageInfo ReadyComponent]
    local_graph)
            fullIndex :: Graph (Either InstalledPackageInfo ReadyComponent)
    fullIndex = [Either InstalledPackageInfo ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    Graph.fromDistinctList [Either InstalledPackageInfo ReadyComponent]
    local_graph
        case Graph (Either InstalledPackageInfo ReadyComponent)
    -> [(Either InstalledPackageInfo ReadyComponent,
         [Key (Either InstalledPackageInfo ReadyComponent)])]
    forall a. Graph a -> [(a, [Key a])]
    Graph.broken Graph (Either InstalledPackageInfo ReadyComponent)
    fullIndex of
            [] -> () -> LogProgress ()
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            [(Either InstalledPackageInfo ReadyComponent,
      [Key (Either InstalledPackageInfo ReadyComponent)])]
    broken ->
              -- TODO: ppr this
              Doc -> LogProgress ()
    forall a. Doc -> LogProgress a
    dieProgress (Doc -> LogProgress ())
    -> ([Char] -> Doc) -> [Char] -> LogProgress ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Doc
    text ([Char] -> LogProgress ()) -> [Char] -> LogProgress ()
    forall a b. (a -> b) -> a -> b
    $
                    [Char]
    "The following packages are broken because other"
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " packages they depend on are missing. These broken "
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "packages must be rebuilt before they can be used.\n"
                 -- TODO: Undupe.
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unlines [ [Char]
    "installed package "
                           [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ PackageIdentifier -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (InstalledPackageInfo -> PackageIdentifier
    forall pkg. Package pkg => pkg -> PackageIdentifier
    packageId InstalledPackageInfo
    pkg)
                           [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " is broken due to missing package "
                           [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " ((UnitId -> [Char]) -> [UnitId] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map UnitId -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow [UnitId]
    deps)
                            | (Left InstalledPackageInfo
    pkg, [UnitId]
    deps) <- [(Either InstalledPackageInfo ReadyComponent,
      [Key (Either InstalledPackageInfo ReadyComponent)])]
    [(Either InstalledPackageInfo ReadyComponent, [UnitId])]
    broken ]
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unlines [ [Char]
    "planned package "
                           [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ PackageIdentifier -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (ReadyComponent -> PackageIdentifier
    forall pkg. Package pkg => pkg -> PackageIdentifier
    packageId ReadyComponent
    pkg)
                           [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " is broken due to missing package "
                           [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " ((UnitId -> [Char]) -> [UnitId] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map UnitId -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow [UnitId]
    deps)
                            | (Right ReadyComponent
    pkg, [UnitId]
    deps) <- [(Either InstalledPackageInfo ReadyComponent,
      [Key (Either InstalledPackageInfo ReadyComponent)])]
    [(Either InstalledPackageInfo ReadyComponent, [UnitId])]
    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 {
                Installed.installedUnitId = mkLegacyUnitId (packageId pkg_descr),
                Installed.sourcePackageId = packageId pkg_descr,
                Installed.depends = map pc_uid externalPkgDeps
              }
        case InstalledPackageIndex
    -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    PackageIndex.dependencyInconsistencies
           (InstalledPackageIndex
     -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])])
    -> (InstalledPackageIndex -> InstalledPackageIndex)
    -> InstalledPackageIndex
    -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InstalledPackageInfo
    -> InstalledPackageIndex -> InstalledPackageIndex
    PackageIndex.insert InstalledPackageInfo
    pseudoTopPkg
           (InstalledPackageIndex
     -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])])
    -> InstalledPackageIndex
    -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    forall a b. (a -> b) -> a -> b
    $ InstalledPackageIndex
    packageDependsIndex of
          [] -> () -> LogProgress ()
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    inconsistencies ->
            Doc -> LogProgress ()
    warnProgress (Doc -> LogProgress ()) -> Doc -> LogProgress ()
    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
    <+> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty (InstalledPackageInfo -> PackageName
    forall pkg. Package pkg => pkg -> PackageName
    packageName InstalledPackageInfo
    user) Doc -> Doc -> Doc
    <+>
                           Doc -> Doc
    parens (UnitId -> Doc
    forall a. Pretty a => a -> Doc
    pretty (InstalledPackageInfo -> UnitId
    forall pkg. HasUnitId pkg => pkg -> UnitId
    installedUnitId InstalledPackageInfo
    user)) Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    "requires" Doc -> Doc -> Doc
    <+>
                           UnitId -> 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)
        ([ComponentLocalBuildInfo], InstalledPackageIndex)
    -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
    forall a. a -> LogProgress a
    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 = (ReadyComponent -> ComponentLocalBuildInfo)
    -> [ReadyComponent] -> [ComponentLocalBuildInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map ReadyComponent -> ComponentLocalBuildInfo
    go [ReadyComponent]
    rcs
      where
        internalUnits :: Set UnitId
    internalUnits = [UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    Set.fromList ((ReadyComponent -> UnitId) -> [ReadyComponent] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map ReadyComponent -> UnitId
    rc_uid [ReadyComponent]
    rcs)
        isInternal :: UnitId -> Bool
    isInternal UnitId
    x = UnitId -> Set UnitId -> Bool
    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 UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == DefUnitId -> UnitId
    unDefUnitId DefUnitId
    uid
                  , ModuleName
    modname' ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    modname
                  = ModuleName -> Maybe OpenModule -> ExposedModule
    Installed.ExposedModule ModuleName
    modname' Maybe OpenModule
    forall a. Maybe a
    Nothing
                  | Bool
    otherwise
                  = ModuleName -> Maybe OpenModule -> ExposedModule
    Installed.ExposedModule ModuleName
    modname'
                      (OpenModule -> Maybe OpenModule
    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 OpenUnitId -> OpenUnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == OpenUnitId
    this_open_uid
                  , ModuleName
    modname' ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    modname
                  = ModuleName -> Maybe OpenModule -> ExposedModule
    Installed.ExposedModule ModuleName
    modname' Maybe OpenModule
    forall a. Maybe a
    Nothing
                  | Bool
    otherwise
                  = ModuleName -> Maybe OpenModule -> ExposedModule
    Installed.ExposedModule ModuleName
    modname' (OpenModule -> Maybe OpenModule
    forall a. a -> Maybe a
    Just OpenModule
    modu)
                convOpenModuleExport (ModuleName
    _, OpenModuleVar ModuleName
    _)
                    = [Char] -> ExposedModule
    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 -> ((ModuleName, OpenModule) -> ExposedModule)
    -> [(ModuleName, OpenModule)] -> [ExposedModule]
    forall a b. (a -> b) -> [a] -> [b]
    map (ModuleName, OpenModule) -> ExposedModule
    convOpenModuleExport
                                     ([(ModuleName, OpenModule)] -> [ExposedModule])
    -> [(ModuleName, OpenModule)] -> [ExposedModule]
    forall a b. (a -> b) -> a -> b
    $ OpenModuleSubst -> [(ModuleName, OpenModule)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (IndefiniteComponent -> OpenModuleSubst
    indefc_provides IndefiniteComponent
    indefc)
                        Right InstantiatedComponent
    instc -> ((ModuleName, Module) -> ExposedModule)
    -> [(ModuleName, Module)] -> [ExposedModule]
    forall a b. (a -> b) -> [a] -> [b]
    map (ModuleName, Module) -> ExposedModule
    convModuleExport
                                     ([(ModuleName, Module)] -> [ExposedModule])
    -> [(ModuleName, Module)] -> [ExposedModule]
    forall a b. (a -> b) -> a -> b
    $ Map ModuleName Module -> [(ModuleName, Module)]
    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 (ReadyComponent -> PackageName
    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 (ReadyComponent -> Version
    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 = (AnnotatedId UnitId -> UnitId) -> [AnnotatedId UnitId] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map AnnotatedId UnitId -> UnitId
    forall id. AnnotatedId id -> id
    ann_id ([AnnotatedId UnitId] -> [UnitId])
    -> [AnnotatedId UnitId] -> [UnitId]
    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 =
            (ComponentInclude OpenUnitId ModuleRenaming
     -> (OpenUnitId, ModuleRenaming))
    -> [ComponentInclude OpenUnitId ModuleRenaming]
    -> [(OpenUnitId, ModuleRenaming)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ComponentInclude OpenUnitId ModuleRenaming
    ci -> (ComponentInclude OpenUnitId ModuleRenaming -> OpenUnitId
    forall id rn. ComponentInclude id rn -> id
    ci_id ComponentInclude OpenUnitId ModuleRenaming
    ci, ComponentInclude OpenUnitId ModuleRenaming -> ModuleRenaming
    forall id rn. ComponentInclude id rn -> rn
    ci_renaming ComponentInclude OpenUnitId ModuleRenaming
    ci)) ([ComponentInclude OpenUnitId ModuleRenaming]
     -> [(OpenUnitId, ModuleRenaming)])
    -> [ComponentInclude OpenUnitId ModuleRenaming]
    -> [(OpenUnitId, ModuleRenaming)]
    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 ->
                        (ComponentInclude DefUnitId ModuleRenaming
     -> ComponentInclude OpenUnitId ModuleRenaming)
    -> [ComponentInclude DefUnitId ModuleRenaming]
    -> [ComponentInclude OpenUnitId ModuleRenaming]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ComponentInclude DefUnitId ModuleRenaming
    ci -> ComponentInclude DefUnitId ModuleRenaming
    ci { ci_ann_id = fmap DefiniteUnitId (ci_ann_id ci) })
                            (InstantiatedComponent
    -> [ComponentInclude DefUnitId ModuleRenaming]
    instc_includes InstantiatedComponent
    instc)
          internal_deps :: [UnitId]
    internal_deps = (UnitId -> Bool) -> [UnitId] -> [UnitId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter UnitId -> Bool
    isInternal (ReadyComponent -> [Key ReadyComponent]
    forall a. IsNode a => a -> [Key a]
    nodeNeighbors ReadyComponent
    rc)