    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
    module Distribution.Backpack.LinkedComponent (
        LinkedComponent(..),
        lc_insts,
        lc_uid,
        lc_cid,
        lc_pkgid,
        toLinkedComponent,
        toLinkedComponents,
        dispLinkedComponent,
        LinkedComponentMap,
        extendLinkedComponentMap,
    ) where

    import Prelude ()
    import Distribution.Compat.Prelude hiding ((<>))

    import Distribution.Backpack
    import Distribution.Backpack.FullUnitId
    import Distribution.Backpack.ConfiguredComponent
    import Distribution.Backpack.ModuleShape
    import Distribution.Backpack.PreModuleShape
    import Distribution.Backpack.ModuleScope
    import Distribution.Backpack.UnifyM
    import Distribution.Backpack.MixLink
    import Distribution.Utils.MapAccum

    import Distribution.Types.AnnotatedId
    import Distribution.Types.ComponentName
    import Distribution.Types.ModuleReexport
    import Distribution.Types.ModuleRenaming
    import Distribution.Types.IncludeRenaming
    import Distribution.Types.ComponentInclude
    import Distribution.Types.ComponentId
    import Distribution.Types.PackageId
    import Distribution.Package
    import Distribution.PackageDescription
    import Distribution.ModuleName
    import Distribution.Simple.LocalBuildInfo
    import Distribution.Verbosity
    import Distribution.Utils.LogProgress

    import qualified Data.Set as Set
    import qualified Data.Map as Map
    import Distribution.Pretty (pretty)
    import Text.PrettyPrint (Doc, hang, text, vcat, ($+$), hsep, quotes)

    -- | A linked component is a component that has been mix-in linked, at
    -- which point we have determined how all the dependencies of the
    -- component are explicitly instantiated (in the form of an OpenUnitId).
    -- 'ConfiguredComponent' is mix-in linked into 'LinkedComponent', which
    -- is then instantiated into 'ReadyComponent'.
    data LinkedComponent
        = LinkedComponent {
            -- | Uniquely identifies linked component
            LinkedComponent -> AnnotatedId ComponentId
    lc_ann_id :: AnnotatedId ComponentId,
            -- | Corresponds to 'cc_component'.
            LinkedComponent -> Component
    lc_component :: Component,
            -- | @build-tools@ and @build-tool-depends@ dependencies.
            -- Corresponds to 'cc_exe_deps'.
            LinkedComponent -> [AnnotatedId OpenUnitId]
    lc_exe_deps :: [AnnotatedId OpenUnitId],
            -- | Is this the public library of a package?  Corresponds to
            -- 'cc_public'.
            LinkedComponent -> Bool
    lc_public :: Bool,
            -- | Corresponds to 'cc_includes', but (1) this does not contain
            -- includes of signature packages (packages with no exports),
            -- and (2) the 'ModuleRenaming' for requirements (stored in
            -- 'IncludeRenaming') has been removed, as it is reflected in
            -- 'OpenUnitId'.)
            LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
    lc_includes :: [ComponentInclude OpenUnitId ModuleRenaming],
            -- | Like 'lc_includes', but this specifies includes on
            -- signature packages which have no exports.
            LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
    lc_sig_includes :: [ComponentInclude OpenUnitId ModuleRenaming],
            -- | The module shape computed by mix-in linking.  This is
            -- newly computed from 'ConfiguredComponent'
            LinkedComponent -> ModuleShape
    lc_shape :: ModuleShape
          }

    -- | Uniquely identifies a 'LinkedComponent'.  Corresponds to
    -- 'cc_cid'.
    lc_cid :: LinkedComponent -> ComponentId
    lc_cid :: LinkedComponent -> ComponentId
    lc_cid = forall id. AnnotatedId id -> id
    ann_id forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LinkedComponent -> AnnotatedId ComponentId
    lc_ann_id

    -- | Corresponds to 'cc_pkgid'.
    lc_pkgid :: LinkedComponent -> PackageId
    lc_pkgid :: LinkedComponent -> PackageId
    lc_pkgid = forall id. AnnotatedId id -> PackageId
    ann_pid forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LinkedComponent -> AnnotatedId ComponentId
    lc_ann_id

    -- | The 'OpenUnitId' of this component in the "default" instantiation.
    -- See also 'lc_insts'.  'LinkedComponent's cannot be instantiated
    -- (e.g., there is no 'ModSubst' instance for them).
    lc_uid :: LinkedComponent -> OpenUnitId
    lc_uid :: LinkedComponent -> OpenUnitId
    lc_uid LinkedComponent
    lc = ComponentId -> OpenModuleSubst -> OpenUnitId
    IndefFullUnitId (LinkedComponent -> ComponentId
    lc_cid LinkedComponent
    lc) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList forall a b. (a -> b) -> a -> b
    $ LinkedComponent -> [(ModuleName, OpenModule)]
    lc_insts LinkedComponent
    lc

    -- | The instantiation of 'lc_uid'; this always has the invariant
    -- that it is a mapping from a module name @A@ to @<A>@ (the hole A).
    lc_insts :: LinkedComponent -> [(ModuleName, OpenModule)]
    lc_insts :: LinkedComponent -> [(ModuleName, OpenModule)]
    lc_insts LinkedComponent
    lc = [ (ModuleName
    req, ModuleName -> OpenModule
    OpenModuleVar ModuleName
    req)
                  | ModuleName
    req <- forall a. Set a -> [a]
    Set.toList (ModuleShape -> Set ModuleName
    modShapeRequires (LinkedComponent -> ModuleShape
    lc_shape LinkedComponent
    lc)) ]

    dispLinkedComponent :: LinkedComponent -> Doc
    dispLinkedComponent :: LinkedComponent -> Doc
    dispLinkedComponent LinkedComponent
    lc =
        Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "unit" Doc -> Doc -> Doc
    <+> forall a. Pretty a => a -> Doc
    pretty (LinkedComponent -> OpenUnitId
    lc_uid LinkedComponent
    lc)) Int
    4 forall a b. (a -> b) -> a -> b
    $
             [Doc] -> Doc
    vcat [ String -> Doc
    text String
    "include" Doc -> Doc -> Doc
    <+> forall a. Pretty a => a -> Doc
    pretty (forall id rn. ComponentInclude id rn -> id
    ci_id ComponentInclude OpenUnitId ModuleRenaming
    incl) Doc -> Doc -> Doc
    <+> forall a. Pretty a => a -> Doc
    pretty (forall id rn. ComponentInclude id rn -> rn
    ci_renaming ComponentInclude OpenUnitId ModuleRenaming
    incl)
                  | ComponentInclude OpenUnitId ModuleRenaming
    incl <- LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
    lc_includes LinkedComponent
    lc ]
                Doc -> Doc -> Doc
    $+$
             [Doc] -> Doc
    vcat [ String -> Doc
    text String
    "signature include" Doc -> Doc -> Doc
    <+> forall a. Pretty a => a -> Doc
    pretty (forall id rn. ComponentInclude id rn -> id
    ci_id ComponentInclude OpenUnitId ModuleRenaming
    incl)
                  | ComponentInclude OpenUnitId ModuleRenaming
    incl <- LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
    lc_sig_includes LinkedComponent
    lc ]
                Doc -> Doc -> Doc
    $+$ OpenModuleSubst -> Doc
    dispOpenModuleSubst (ModuleShape -> OpenModuleSubst
    modShapeProvides (LinkedComponent -> ModuleShape
    lc_shape LinkedComponent
    lc))

    instance Package LinkedComponent where
        packageId :: LinkedComponent -> PackageId
    packageId = LinkedComponent -> PackageId
    lc_pkgid

    toLinkedComponent
        :: Verbosity
        -> FullDb
        -> PackageId
        -> LinkedComponentMap
        -> ConfiguredComponent
        -> LogProgress LinkedComponent
    toLinkedComponent :: Verbosity
    -> FullDb
    -> PackageId
    -> LinkedComponentMap
    -> ConfiguredComponent
    -> LogProgress LinkedComponent
    toLinkedComponent Verbosity
    verbosity FullDb
    db PackageId
    this_pid LinkedComponentMap
    pkg_map ConfiguredComponent {
        cc_ann_id :: ConfiguredComponent -> AnnotatedId ComponentId
    cc_ann_id = aid :: AnnotatedId ComponentId
    aid@AnnotatedId { ann_id :: forall id. AnnotatedId id -> id
    ann_id = ComponentId
    this_cid },
        cc_component :: ConfiguredComponent -> Component
    cc_component = Component
    component,
        cc_exe_deps :: ConfiguredComponent -> [AnnotatedId ComponentId]
    cc_exe_deps = [AnnotatedId ComponentId]
    exe_deps,
        cc_public :: ConfiguredComponent -> Bool
    cc_public = Bool
    is_public,
        cc_includes :: ConfiguredComponent
    -> [ComponentInclude ComponentId IncludeRenaming]
    cc_includes = [ComponentInclude ComponentId IncludeRenaming]
    cid_includes
       } = do
        let
            -- The explicitly specified requirements, provisions and
            -- reexports from the Cabal file.  These are only non-empty for
            -- libraries; everything else is trivial.
            ([ModuleName]
    src_reqs      :: [ModuleName],
             [ModuleName]
    src_provs     :: [ModuleName],
             [ModuleReexport]
    src_reexports :: [ModuleReexport]) =
                case Component
    component of
                    CLib Library
    lib -> (Library -> [ModuleName]
    signatures Library
    lib,
                                 Library -> [ModuleName]
    exposedModules Library
    lib,
                                 Library -> [ModuleReexport]
    reexportedModules Library
    lib)
                    Component
    _ -> ([], [], [])
            src_hidden :: [ModuleName]
    src_hidden = BuildInfo -> [ModuleName]
    otherModules (Component -> BuildInfo
    componentBuildInfo Component
    component)

            -- Take each included ComponentId and resolve it into an
            -- *unlinked* unit identity.  We will use unification (relying
            -- on the ModuleShape) to resolve these into linked identities.
            unlinked_includes :: [ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming]
            unlinked_includes :: [ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming]
    unlinked_includes = [ forall id rn.
    AnnotatedId id -> rn -> Bool -> ComponentInclude id rn
    ComponentInclude (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ComponentId -> (OpenUnitId, ModuleShape)
    lookupUid AnnotatedId ComponentId
    dep_aid) IncludeRenaming
    rns Bool
    i
                                | ComponentInclude AnnotatedId ComponentId
    dep_aid IncludeRenaming
    rns Bool
    i <- [ComponentInclude ComponentId IncludeRenaming]
    cid_includes ]

            lookupUid :: ComponentId -> (OpenUnitId, ModuleShape)
            lookupUid :: ComponentId -> (OpenUnitId, ModuleShape)
    lookupUid ComponentId
    cid = forall a. a -> Maybe a -> a
    fromMaybe (forall a. HasCallStack => String -> a
    error String
    "linkComponent: lookupUid")
                                        (forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ComponentId
    cid LinkedComponentMap
    pkg_map)

        let orErr :: Either [Doc] a -> LogProgress a
    orErr (Right a
    x) = forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
            orErr (Left [Doc
    err]) = forall a. Doc -> LogProgress a
    dieProgress Doc
    err
            orErr (Left [Doc]
    errs) = do
                forall a. Doc -> LogProgress a
    dieProgress ([Doc] -> Doc
    vcat (forall a. a -> [a] -> [a]
    intersperse (String -> Doc
    text String
    "") -- double newline!
                                    [ Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "-") Int
    2 Doc
    err | Doc
    err <- [Doc]
    errs]))

        -- Pre-shaping
        let pre_shape :: PreModuleShape
    pre_shape = [PreModuleShape] -> PreModuleShape
    mixLinkPreModuleShape forall a b. (a -> b) -> a -> b
    $
                PreModuleShape {
                    preModShapeProvides :: Set ModuleName
    preModShapeProvides = forall a. Ord a => [a] -> Set a
    Set.fromList ([ModuleName]
    src_provs forall a. [a] -> [a] -> [a]
    ++ [ModuleName]
    src_hidden),
                    preModShapeRequires :: Set ModuleName
    preModShapeRequires = forall a. Ord a => [a] -> Set a
    Set.fromList [ModuleName]
    src_reqs
                } forall a. a -> [a] -> [a]
    : [ PreModuleShape -> IncludeRenaming -> PreModuleShape
    renamePreModuleShape (ModuleShape -> PreModuleShape
    toPreModuleShape ModuleShape
    sh) IncludeRenaming
    rns
                    | ComponentInclude (AnnotatedId { ann_id :: forall id. AnnotatedId id -> id
    ann_id = (OpenUnitId
    _, ModuleShape
    sh) }) IncludeRenaming
    rns Bool
    _ <- [ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming]
    unlinked_includes ]
            reqs :: Set ModuleName
    reqs  = PreModuleShape -> Set ModuleName
    preModShapeRequires PreModuleShape
    pre_shape
            insts :: [(ModuleName, OpenModule)]
    insts = [ (ModuleName
    req, ModuleName -> OpenModule
    OpenModuleVar ModuleName
    req)
                    | ModuleName
    req <- forall a. Set a -> [a]
    Set.toList Set ModuleName
    reqs ]
            this_uid :: OpenUnitId
    this_uid = ComponentId -> OpenModuleSubst -> OpenUnitId
    IndefFullUnitId ComponentId
    this_cid forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList forall a b. (a -> b) -> a -> b
    $ [(ModuleName, OpenModule)]
    insts

        -- OK, actually do unification
        -- TODO: the unification monad might return errors, in which
        -- case we have to deal.  Use monadic bind for now.
        (ModuleScope
    linked_shape0  :: ModuleScope,
         [ComponentInclude OpenUnitId ModuleRenaming]
    linked_includes0 :: [ComponentInclude OpenUnitId ModuleRenaming],
         [ComponentInclude OpenUnitId ModuleRenaming]
    linked_sig_includes0 :: [ComponentInclude OpenUnitId ModuleRenaming])
          <- forall {a}. Either [Doc] a -> LogProgress a
    orErr forall a b. (a -> b) -> a -> b
    $ forall a.
    Verbosity
    -> ComponentId
    -> FullDb
    -> (forall s. UnifyM s a)
    -> Either [Doc] a
    runUnifyM Verbosity
    verbosity ComponentId
    this_cid FullDb
    db forall a b. (a -> b) -> a -> b
    $ do
            -- The unification monad is implemented using mutable
            -- references.  Thus, we must convert our *pure* data
            -- structures into mutable ones to perform unification.

            let convertMod :: (ModuleName -> ModuleSource) -> ModuleName -> UnifyM s (ModuleScopeU s)
                convertMod :: forall s.
    (ModuleName -> ModuleSource)
    -> ModuleName -> UnifyM s (ModuleScopeU s)
    convertMod ModuleName -> ModuleSource
    from ModuleName
    m = do
                    ModuleU s
    m_u <- forall s. OpenModule -> UnifyM s (ModuleU s)
    convertModule (OpenUnitId -> ModuleName -> OpenModule
    OpenModule OpenUnitId
    this_uid ModuleName
    m)
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (forall k a. k -> a -> Map k a
    Map.singleton ModuleName
    m [forall a. ModuleSource -> a -> WithSource a
    WithSource (ModuleName -> ModuleSource
    from ModuleName
    m) ModuleU s
    m_u], forall k a. Map k a
    Map.empty)
            -- Handle 'exposed-modules'
            [ModuleScopeU s]
    exposed_mod_shapes_u <- forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (forall s.
    (ModuleName -> ModuleSource)
    -> ModuleName -> UnifyM s (ModuleScopeU s)
    convertMod ModuleName -> ModuleSource
    FromExposedModules) [ModuleName]
    src_provs
            -- Handle 'other-modules'
            [ModuleScopeU s]
    other_mod_shapes_u <- forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (forall s.
    (ModuleName -> ModuleSource)
    -> ModuleName -> UnifyM s (ModuleScopeU s)
    convertMod ModuleName -> ModuleSource
    FromOtherModules) [ModuleName]
    src_hidden

            -- Handle 'signatures'
            let convertReq :: ModuleName -> UnifyM s (ModuleScopeU s)
                convertReq :: forall s. ModuleName -> UnifyM s (ModuleScopeU s)
    convertReq ModuleName
    req = do
                    ModuleU s
    req_u <- forall s. OpenModule -> UnifyM s (ModuleU s)
    convertModule (ModuleName -> OpenModule
    OpenModuleVar ModuleName
    req)
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (forall k a. Map k a
    Map.empty, forall k a. k -> a -> Map k a
    Map.singleton ModuleName
    req [forall a. ModuleSource -> a -> WithSource a
    WithSource (ModuleName -> ModuleSource
    FromSignatures ModuleName
    req) ModuleU s
    req_u])
            [ModuleScopeU s]
    req_shapes_u <- forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse forall s. ModuleName -> UnifyM s (ModuleScopeU s)
    convertReq [ModuleName]
    src_reqs

            -- Handle 'mixins'
            ([ModuleScopeU s]
    incl_shapes_u, [Either
       (ComponentInclude (UnitIdU s) ModuleRenaming)
       (ComponentInclude (UnitIdU s) ModuleRenaming)]
    all_includes_u) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall a b. [(a, b)] -> ([a], [b])
    unzip (forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse forall s.
    ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    -> UnifyM
         s
         (ModuleScopeU s,
          Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming))
    convertInclude [ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming]
    unlinked_includes)

            forall s. UnifyM s ()
    failIfErrs -- Prevent error cascade
            -- Mix-in link everything!  mixLink is the real workhorse.
            ModuleScopeU s
    shape_u <- forall s. [ModuleScopeU s] -> UnifyM s (ModuleScopeU s)
    mixLink forall a b. (a -> b) -> a -> b
    $ [ModuleScopeU s]
    exposed_mod_shapes_u
                              forall a. [a] -> [a] -> [a]
    ++ [ModuleScopeU s]
    other_mod_shapes_u
                              forall a. [a] -> [a] -> [a]
    ++ [ModuleScopeU s]
    req_shapes_u
                              forall a. [a] -> [a] -> [a]
    ++ [ModuleScopeU s]
    incl_shapes_u

            -- src_reqs_u <- traverse convertReq src_reqs
            -- Read out all the final results by converting back
            -- into a pure representation.
            let convertIncludeU :: ComponentInclude (UnitIdU s) rn
    -> UnifyM s (ComponentInclude OpenUnitId rn)
    convertIncludeU (ComponentInclude AnnotatedId (UnitIdU s)
    dep_aid rn
    rns Bool
    i) = do
                    OpenUnitId
    uid <- forall s. UnitIdU s -> UnifyM s OpenUnitId
    convertUnitIdU (forall id. AnnotatedId id -> id
    ann_id AnnotatedId (UnitIdU s)
    dep_aid)
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (ComponentInclude {
                                ci_ann_id :: AnnotatedId OpenUnitId
    ci_ann_id = AnnotatedId (UnitIdU s)
    dep_aid { ann_id :: OpenUnitId
    ann_id = OpenUnitId
    uid },
                                ci_renaming :: rn
    ci_renaming = rn
    rns,
                                ci_implicit :: Bool
    ci_implicit = Bool
    i
                            })
            ModuleScope
    shape <- forall s. ModuleScopeU s -> UnifyM s ModuleScope
    convertModuleScopeU ModuleScopeU s
    shape_u
            let ([ComponentInclude (UnitIdU s) ModuleRenaming]
    includes_u, [ComponentInclude (UnitIdU s) ModuleRenaming]
    sig_includes_u) = forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either
       (ComponentInclude (UnitIdU s) ModuleRenaming)
       (ComponentInclude (UnitIdU s) ModuleRenaming)]
    all_includes_u
            [ComponentInclude OpenUnitId ModuleRenaming]
    incls <- forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse forall {s} {rn}.
    ComponentInclude (UnitIdU s) rn
    -> UnifyM s (ComponentInclude OpenUnitId rn)
    convertIncludeU [ComponentInclude (UnitIdU s) ModuleRenaming]
    includes_u
            [ComponentInclude OpenUnitId ModuleRenaming]
    sig_incls <- forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse forall {s} {rn}.
    ComponentInclude (UnitIdU s) rn
    -> UnifyM s (ComponentInclude OpenUnitId rn)
    convertIncludeU [ComponentInclude (UnitIdU s) ModuleRenaming]
    sig_includes_u
            forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleScope
    shape, [ComponentInclude OpenUnitId ModuleRenaming]
    incls, [ComponentInclude OpenUnitId ModuleRenaming]
    sig_incls)

        let isNotLib :: Component -> Bool
    isNotLib (CLib Library
    _) = Bool
    False
            isNotLib Component
    _        = Bool
    True
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (forall a. Set a -> Bool
    Set.null Set ModuleName
    reqs) Bool -> Bool -> Bool
    && Component -> Bool
    isNotLib Component
    component) forall a b. (a -> b) -> a -> b
    $
            forall a. Doc -> LogProgress a
    dieProgress forall a b. (a -> b) -> a -> b
    $
                Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Non-library component has unfilled requirements:")
                    Int
    4 ([Doc] -> Doc
    vcat [forall a. Pretty a => a -> Doc
    pretty ModuleName
    req | ModuleName
    req <- forall a. Set a -> [a]
    Set.toList Set ModuleName
    reqs])

        -- NB: do NOT include hidden modules here: GHC 7.10's ghc-pkg
        -- won't allow it (since someone could directly synthesize
        -- an 'InstalledPackageInfo' that violates abstraction.)
        -- Though, maybe it should be relaxed?
        let src_hidden_set :: Set ModuleName
    src_hidden_set = forall a. Ord a => [a] -> Set a
    Set.fromList [ModuleName]
    src_hidden
            linked_shape :: ModuleScope
    linked_shape = ModuleScope
    linked_shape0 {
                modScopeProvides :: ModuleProvides
    modScopeProvides =
                    -- Would rather use withoutKeys but need BC
                    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    Map.filterWithKey
                        (\ModuleName
    k [ModuleWithSource]
    _ -> Bool -> Bool
    not (ModuleName
    k forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set ModuleName
    src_hidden_set))
                        (ModuleScope -> ModuleProvides
    modScopeProvides ModuleScope
    linked_shape0)
                }

        -- OK, compute the reexports
        -- TODO: This code reports the errors for reexports one reexport at
        -- a time.  Better to collect them all up and report them all at
        -- once.
        let hdl :: [Either Doc a] -> LogProgress [a]
            hdl :: forall a. [Either Doc a] -> LogProgress [a]
    hdl [Either Doc a]
    es =
                case forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either Doc a]
    es of
                    ([], [a]
    rs) -> forall (m :: * -> *) a. Monad m => a -> m a
    return [a]
    rs
                    ([Doc]
    ls, [a]
    _) ->
                        forall a. Doc -> LogProgress a
    dieProgress forall a b. (a -> b) -> a -> b
    $
                         Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Problem with module re-exports:") Int
    2
                            ([Doc] -> Doc
    vcat [Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "-") Int
    2 Doc
    l | Doc
    l <- [Doc]
    ls])
        [(ModuleName, OpenModule)]
    reexports_list <- forall a. [Either Doc a] -> LogProgress [a]
    hdl forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall a b c. (a -> b -> c) -> b -> a -> c
    flip forall a b. (a -> b) -> [a] -> [b]
    map) [ModuleReexport]
    src_reexports forall a b. (a -> b) -> a -> b
    $ \reex :: ModuleReexport
    reex@(ModuleReexport Maybe PackageName
    mb_pn ModuleName
    from ModuleName
    to) -> do
          case forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ModuleName
    from (ModuleScope -> ModuleProvides
    modScopeProvides ModuleScope
    linked_shape) of
            Just cands :: [ModuleWithSource]
    cands@(ModuleWithSource
    x0:[ModuleWithSource]
    xs0) -> do
              -- Make sure there is at least one candidate
              (ModuleWithSource
    x, [ModuleWithSource]
    xs) <-
                case Maybe PackageName
    mb_pn of
                  Just PackageName
    pn ->
                    let matches_pn :: ModuleSource -> Bool
    matches_pn (FromMixins PackageName
    pn' ComponentName
    _ IncludeRenaming
    _)     = PackageName
    pn forall a. Eq a => a -> a -> Bool
    == PackageName
    pn'
                        matches_pn (FromBuildDepends PackageName
    pn' ComponentName
    _) = PackageName
    pn forall a. Eq a => a -> a -> Bool
    == PackageName
    pn'
                        matches_pn (FromExposedModules ModuleName
    _) = PackageName
    pn forall a. Eq a => a -> a -> Bool
    == forall pkg. Package pkg => pkg -> PackageName
    packageName PackageId
    this_pid
                        matches_pn (FromOtherModules ModuleName
    _)   = PackageName
    pn forall a. Eq a => a -> a -> Bool
    == forall pkg. Package pkg => pkg -> PackageName
    packageName PackageId
    this_pid
                        matches_pn (FromSignatures ModuleName
    _)     = PackageName
    pn forall a. Eq a => a -> a -> Bool
    == forall pkg. Package pkg => pkg -> PackageName
    packageName PackageId
    this_pid
                    in case forall a. (a -> Bool) -> [a] -> [a]
    filter (ModuleSource -> Bool
    matches_pn forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. WithSource a -> ModuleSource
    getSource) [ModuleWithSource]
    cands of
                        (ModuleWithSource
    x1:[ModuleWithSource]
    xs1) -> forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleWithSource
    x1, [ModuleWithSource]
    xs1)
                        [ModuleWithSource]
    _ -> forall a b. a -> Either a b
    Left (ModuleReexport -> Doc
    brokenReexportMsg ModuleReexport
    reex)
                  Maybe PackageName
    Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleWithSource
    x0, [ModuleWithSource]
    xs0)
              -- Test that all the candidates are consistent
              case forall a. (a -> Bool) -> [a] -> [a]
    filter (\ModuleWithSource
    x' -> forall a. WithSource a -> a
    unWithSource ModuleWithSource
    x forall a. Eq a => a -> a -> Bool
    /= forall a. WithSource a -> a
    unWithSource ModuleWithSource
    x') [ModuleWithSource]
    xs of
                [] -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                [ModuleWithSource]
    _ -> forall a b. a -> Either a b
    Left forall a b. (a -> b) -> a -> b
    $ ModuleReexport -> ModuleWithSource -> [ModuleWithSource] -> Doc
    ambiguousReexportMsg ModuleReexport
    reex ModuleWithSource
    x [ModuleWithSource]
    xs
              forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleName
    to, forall a. WithSource a -> a
    unWithSource ModuleWithSource
    x)
            Maybe [ModuleWithSource]
    _ ->
              forall a b. a -> Either a b
    Left (ModuleReexport -> Doc
    brokenReexportMsg ModuleReexport
    reex)

        -- TODO: maybe check this earlier; it's syntactically obvious.
        let build_reexports :: Map k a -> (k, a) -> LogProgress (Map k a)
    build_reexports Map k a
    m (k
    k, a
    v)
                | forall k a. Ord k => k -> Map k a -> Bool
    Map.member k
    k Map k a
    m =
                    forall a. Doc -> LogProgress a
    dieProgress forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    hsep
                        [ String -> Doc
    text String
    "Module name ", forall a. Pretty a => a -> Doc
    pretty k
    k, String -> Doc
    text String
    " is exported multiple times." ]
                | Bool
    otherwise = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert k
    k a
    v Map k a
    m)
        OpenModuleSubst
    provs <- forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM forall {k} {a}.
    (Ord k, Pretty k) =>
    Map k a -> (k, a) -> LogProgress (Map k a)
    build_reexports forall k a. Map k a
    Map.empty forall a b. (a -> b) -> a -> b
    $
                    -- TODO: doublecheck we have checked for
                    -- src_provs duplicates already!
                    [ (ModuleName
    mod_name, OpenUnitId -> ModuleName -> OpenModule
    OpenModule OpenUnitId
    this_uid ModuleName
    mod_name) | ModuleName
    mod_name <- [ModuleName]
    src_provs ] forall a. [a] -> [a] -> [a]
    ++
                    [(ModuleName, OpenModule)]
    reexports_list

        let final_linked_shape :: ModuleShape
    final_linked_shape = OpenModuleSubst -> Set ModuleName -> ModuleShape
    ModuleShape OpenModuleSubst
    provs (forall k a. Map k a -> Set k
    Map.keysSet (ModuleScope -> ModuleProvides
    modScopeRequires ModuleScope
    linked_shape))

        -- See Note Note [Signature package special case]
        let ([ComponentInclude OpenUnitId ModuleRenaming]
    linked_includes, [ComponentInclude OpenUnitId ModuleRenaming]
    linked_sig_includes)
                | forall a. Set a -> Bool
    Set.null Set ModuleName
    reqs = ([ComponentInclude OpenUnitId ModuleRenaming]
    linked_includes0 forall a. [a] -> [a] -> [a]
    ++ [ComponentInclude OpenUnitId ModuleRenaming]
    linked_sig_includes0, [])
                | Bool
    otherwise     = ([ComponentInclude OpenUnitId ModuleRenaming]
    linked_includes0, [ComponentInclude OpenUnitId ModuleRenaming]
    linked_sig_includes0)

        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ LinkedComponent {
                    lc_ann_id :: AnnotatedId ComponentId
    lc_ann_id = AnnotatedId ComponentId
    aid,
                    lc_component :: Component
    lc_component = Component
    component,
                    lc_public :: Bool
    lc_public = Bool
    is_public,
                    -- These must be executables
                    lc_exe_deps :: [AnnotatedId OpenUnitId]
    lc_exe_deps = forall a b. (a -> b) -> [a] -> [b]
    map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\ComponentId
    cid -> ComponentId -> OpenModuleSubst -> OpenUnitId
    IndefFullUnitId ComponentId
    cid forall k a. Map k a
    Map.empty)) [AnnotatedId ComponentId]
    exe_deps,
                    lc_shape :: ModuleShape
    lc_shape = ModuleShape
    final_linked_shape,
                    lc_includes :: [ComponentInclude OpenUnitId ModuleRenaming]
    lc_includes = [ComponentInclude OpenUnitId ModuleRenaming]
    linked_includes,
                    lc_sig_includes :: [ComponentInclude OpenUnitId ModuleRenaming]
    lc_sig_includes = [ComponentInclude OpenUnitId ModuleRenaming]
    linked_sig_includes
               }

    -- Note [Signature package special case]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- Suppose we have p-indef, which depends on str-sig and inherits
    -- the hole from that signature package.  When we instantiate p-indef,
    -- it's a bit pointless to also go ahead and build str-sig, because
    -- str-sig cannot possibly have contributed any code to the package
    -- in question.  Furthermore, because the signature was inherited to
    -- p-indef, if we test matching against p-indef, we also have tested
    -- matching against p-sig.  In fact, skipping p-sig is *mandatory*,
    -- because p-indef may have thinned it (so that an implementation may
    -- match p-indef but not p-sig.)
    --
    -- However, suppose that we have a package which mixes together str-sig
    -- and str-bytestring, with the intent of *checking* that str-sig is
    -- implemented by str-bytestring.  Here, it's quite important to
    -- build an instantiated str-sig, since that is the only way we will
    -- actually end up testing if the matching works.  Note that this
    -- admonition only applies if the package has NO requirements; if it
    -- has any requirements, we will typecheck it as an indefinite
    -- package, at which point the signature includes will be passed to
    -- GHC who will in turn actually do the checking to make sure they
    -- are instantiated correctly.

    -- Handle mix-in linking for components.  In the absence of Backpack,
    -- every ComponentId gets converted into a UnitId by way of SimpleUnitId.
    toLinkedComponents
        :: Verbosity
        -> FullDb
        -> PackageId
        -> LinkedComponentMap
        -> [ConfiguredComponent]
        -> LogProgress [LinkedComponent]
    toLinkedComponents :: Verbosity
    -> FullDb
    -> PackageId
    -> LinkedComponentMap
    -> [ConfiguredComponent]
    -> LogProgress [LinkedComponent]
    toLinkedComponents Verbosity
    verbosity FullDb
    db PackageId
    this_pid LinkedComponentMap
    lc_map0 [ConfiguredComponent]
    comps
       = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall a b. (a, b) -> b
    snd (forall (m :: * -> *) (t :: * -> *) a b c.
    (Monad m, Traversable t) =>
    (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
    mapAccumM LinkedComponentMap
    -> ConfiguredComponent
    -> LogProgress (LinkedComponentMap, LinkedComponent)
    go LinkedComponentMap
    lc_map0 [ConfiguredComponent]
    comps)
     where
      go :: Map ComponentId (OpenUnitId, ModuleShape)
         -> ConfiguredComponent
         -> LogProgress (Map ComponentId (OpenUnitId, ModuleShape), LinkedComponent)
      go :: LinkedComponentMap
    -> ConfiguredComponent
    -> LogProgress (LinkedComponentMap, LinkedComponent)
    go LinkedComponentMap
    lc_map ConfiguredComponent
    cc = do
        LinkedComponent
    lc <- forall a. Doc -> LogProgress a -> LogProgress a
    addProgressCtx (String -> Doc
    text String
    "In the stanza" Doc -> Doc -> Doc
    <+> String -> Doc
    text (ComponentName -> String
    componentNameStanza (ConfiguredComponent -> ComponentName
    cc_name ConfiguredComponent
    cc))) forall a b. (a -> b) -> a -> b
    $
                Verbosity
    -> FullDb
    -> PackageId
    -> LinkedComponentMap
    -> ConfiguredComponent
    -> LogProgress LinkedComponent
    toLinkedComponent Verbosity
    verbosity FullDb
    db PackageId
    this_pid LinkedComponentMap
    lc_map ConfiguredComponent
    cc
        forall (m :: * -> *) a. Monad m => a -> m a
    return (LinkedComponent -> LinkedComponentMap -> LinkedComponentMap
    extendLinkedComponentMap LinkedComponent
    lc LinkedComponentMap
    lc_map, LinkedComponent
    lc)

    type LinkedComponentMap = Map ComponentId (OpenUnitId, ModuleShape)

    extendLinkedComponentMap :: LinkedComponent
                             -> LinkedComponentMap
                             -> LinkedComponentMap
    extendLinkedComponentMap :: LinkedComponent -> LinkedComponentMap -> LinkedComponentMap
    extendLinkedComponentMap LinkedComponent
    lc LinkedComponentMap
    m =
        forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (LinkedComponent -> ComponentId
    lc_cid LinkedComponent
    lc) (LinkedComponent -> OpenUnitId
    lc_uid LinkedComponent
    lc, LinkedComponent -> ModuleShape
    lc_shape LinkedComponent
    lc) LinkedComponentMap
    m

    brokenReexportMsg :: ModuleReexport -> Doc
    brokenReexportMsg :: ModuleReexport -> Doc
    brokenReexportMsg (ModuleReexport (Just PackageName
    pn) ModuleName
    from ModuleName
    _to) =
      [Doc] -> Doc
    vcat [ String -> Doc
    text String
    "The package" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (forall a. Pretty a => a -> Doc
    pretty PackageName
    pn)
           , String -> Doc
    text String
    "does not export a module" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (forall a. Pretty a => a -> Doc
    pretty ModuleName
    from) ]
    brokenReexportMsg (ModuleReexport Maybe PackageName
    Nothing ModuleName
    from ModuleName
    _to) =
      [Doc] -> Doc
    vcat [ String -> Doc
    text String
    "The module" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (forall a. Pretty a => a -> Doc
    pretty ModuleName
    from)
           , String -> Doc
    text String
    "is not exported by any suitable package."
           , String -> Doc
    text String
    "It occurs in neither the 'exposed-modules' of this package,"
           , String -> Doc
    text String
    "nor any of its 'build-depends' dependencies." ]

    ambiguousReexportMsg :: ModuleReexport -> ModuleWithSource -> [ModuleWithSource] -> Doc
    ambiguousReexportMsg :: ModuleReexport -> ModuleWithSource -> [ModuleWithSource] -> Doc
    ambiguousReexportMsg (ModuleReexport Maybe PackageName
    mb_pn ModuleName
    from ModuleName
    _to) ModuleWithSource
    y1 [ModuleWithSource]
    ys =
      [Doc] -> Doc
    vcat [ String -> Doc
    text String
    "Ambiguous reexport" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (forall a. Pretty a => a -> Doc
    pretty ModuleName
    from)
           , Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "It could refer to either:") Int
    2
                ([Doc] -> Doc
    vcat (Doc
    msg forall a. a -> [a] -> [a]
    : [Doc]
    msgs))
           , forall {a}. Maybe a -> Doc
    help_msg Maybe PackageName
    mb_pn ]
      where
        msg :: Doc
    msg  = String -> Doc
    text String
    "  " Doc -> Doc -> Doc
    <+> forall {a}. Pretty a => WithSource a -> Doc
    displayModuleWithSource ModuleWithSource
    y1
        msgs :: [Doc]
    msgs = [String -> Doc
    text String
    "or" Doc -> Doc -> Doc
    <+> forall {a}. Pretty a => WithSource a -> Doc
    displayModuleWithSource ModuleWithSource
    y | ModuleWithSource
    y <- [ModuleWithSource]
    ys]
        help_msg :: Maybe a -> Doc
    help_msg Maybe a
    Nothing =
          -- TODO: This advice doesn't help if the ambiguous exports
          -- come from a package named the same thing
          [Doc] -> Doc
    vcat [ String -> Doc
    text String
    "The ambiguity can be resolved by qualifying the"
               , String -> Doc
    text String
    "re-export with a package name."
               , String -> Doc
    text String
    "The syntax is 'packagename:ModuleName [as NewName]'." ]
        -- Qualifying won't help that much.
        help_msg (Just a
    _) =
          [Doc] -> Doc
    vcat [ String -> Doc
    text String
    "The ambiguity can be resolved by using the"
               , String -> Doc
    text String
    "mixins field to rename one of the module"
               , String -> Doc
    text String
    "names differently." ]
        displayModuleWithSource :: WithSource a -> Doc
    displayModuleWithSource WithSource a
    y
          = [Doc] -> Doc
    vcat [ Doc -> Doc
    quotes (forall a. Pretty a => a -> Doc
    pretty (forall a. WithSource a -> a
    unWithSource WithSource a
    y))
                 , String -> Doc
    text String
    "brought into scope by" Doc -> Doc -> Doc
    <+>
                    ModuleSource -> Doc
    dispModuleSource (forall a. WithSource a -> ModuleSource
    getSource WithSource a
    y)
                 ]