    {-# 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 = AnnotatedId ComponentId -> ComponentId
    forall id. AnnotatedId id -> id
    ann_id (AnnotatedId ComponentId -> ComponentId)
    -> (LinkedComponent -> AnnotatedId ComponentId)
    -> LinkedComponent
    -> ComponentId
    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 = AnnotatedId ComponentId -> PackageId
    forall id. AnnotatedId id -> PackageId
    ann_pid (AnnotatedId ComponentId -> PackageId)
    -> (LinkedComponent -> AnnotatedId ComponentId)
    -> LinkedComponent
    -> PackageId
    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) (OpenModuleSubst -> OpenUnitId)
    -> ([(ModuleName, OpenModule)] -> OpenModuleSubst)
    -> [(ModuleName, OpenModule)]
    -> OpenUnitId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(ModuleName, OpenModule)] -> OpenModuleSubst
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(ModuleName, OpenModule)] -> OpenUnitId)
    -> [(ModuleName, OpenModule)] -> OpenUnitId
    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 <- Set ModuleName -> [ModuleName]
    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
    <+> OpenUnitId -> Doc
    forall a. Pretty a => a -> Doc
    pretty (LinkedComponent -> OpenUnitId
    lc_uid LinkedComponent
    lc)) Int
    4 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
             [Doc] -> Doc
    vcat [ String -> Doc
    text String
    "include" Doc -> Doc -> Doc
    <+> OpenUnitId -> Doc
    forall a. Pretty a => a -> Doc
    pretty (ComponentInclude OpenUnitId ModuleRenaming -> OpenUnitId
    forall id rn. ComponentInclude id rn -> id
    ci_id ComponentInclude OpenUnitId ModuleRenaming
    incl) Doc -> Doc -> Doc
    <+> ModuleRenaming -> Doc
    forall a. Pretty a => a -> Doc
    pretty (ComponentInclude OpenUnitId ModuleRenaming -> ModuleRenaming
    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
    <+> OpenUnitId -> Doc
    forall a. Pretty a => a -> Doc
    pretty (ComponentInclude OpenUnitId ModuleRenaming -> OpenUnitId
    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 = [ AnnotatedId (OpenUnitId, ModuleShape)
    -> IncludeRenaming
    -> Bool
    -> ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    forall id rn.
    AnnotatedId id -> rn -> Bool -> ComponentInclude id rn
    ComponentInclude ((ComponentId -> (OpenUnitId, ModuleShape))
    -> AnnotatedId ComponentId -> AnnotatedId (OpenUnitId, ModuleShape)
    forall a b. (a -> b) -> AnnotatedId a -> AnnotatedId b
    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 = (OpenUnitId, ModuleShape)
    -> Maybe (OpenUnitId, ModuleShape) -> (OpenUnitId, ModuleShape)
    forall a. a -> Maybe a -> a
    fromMaybe (String -> (OpenUnitId, ModuleShape)
    forall a. HasCallStack => String -> a
    error String
    "linkComponent: lookupUid")
                                        (ComponentId
    -> LinkedComponentMap -> Maybe (OpenUnitId, ModuleShape)
    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) = a -> LogProgress a
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
            orErr (Left [Doc
    err]) = Doc -> LogProgress a
    forall a. Doc -> LogProgress a
    dieProgress Doc
    err
            orErr (Left [Doc]
    errs) = do
                Doc -> LogProgress a
    forall a. Doc -> LogProgress a
    dieProgress ([Doc] -> Doc
    vcat (Doc -> [Doc] -> [Doc]
    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 ([PreModuleShape] -> PreModuleShape)
    -> [PreModuleShape] -> PreModuleShape
    forall a b. (a -> b) -> a -> b
    $
                PreModuleShape {
                    preModShapeProvides :: Set ModuleName
    preModShapeProvides = [ModuleName] -> Set ModuleName
    forall a. Ord a => [a] -> Set a
    Set.fromList ([ModuleName]
    src_provs [ModuleName] -> [ModuleName] -> [ModuleName]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleName]
    src_hidden),
                    preModShapeRequires :: Set ModuleName
    preModShapeRequires = [ModuleName] -> Set ModuleName
    forall a. Ord a => [a] -> Set a
    Set.fromList [ModuleName]
    src_reqs
                } PreModuleShape -> [PreModuleShape] -> [PreModuleShape]
    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 <- Set ModuleName -> [ModuleName]
    forall a. Set a -> [a]
    Set.toList Set ModuleName
    reqs ]
            this_uid :: OpenUnitId
    this_uid = ComponentId -> OpenModuleSubst -> OpenUnitId
    IndefFullUnitId ComponentId
    this_cid (OpenModuleSubst -> OpenUnitId)
    -> ([(ModuleName, OpenModule)] -> OpenModuleSubst)
    -> [(ModuleName, OpenModule)]
    -> OpenUnitId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(ModuleName, OpenModule)] -> OpenModuleSubst
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(ModuleName, OpenModule)] -> OpenUnitId)
    -> [(ModuleName, OpenModule)] -> OpenUnitId
    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])
          <- Either
      [Doc]
      (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
       [ComponentInclude OpenUnitId ModuleRenaming])
    -> LogProgress
         (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
          [ComponentInclude OpenUnitId ModuleRenaming])
    forall {a}. Either [Doc] a -> LogProgress a
    orErr (Either
       [Doc]
       (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
        [ComponentInclude OpenUnitId ModuleRenaming])
     -> LogProgress
          (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
           [ComponentInclude OpenUnitId ModuleRenaming]))
    -> Either
         [Doc]
         (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
          [ComponentInclude OpenUnitId ModuleRenaming])
    -> LogProgress
         (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
          [ComponentInclude OpenUnitId ModuleRenaming])
    forall a b. (a -> b) -> a -> b
    $ Verbosity
    -> ComponentId
    -> FullDb
    -> (forall {s}.
        UnifyM
          s
          (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
           [ComponentInclude OpenUnitId ModuleRenaming]))
    -> Either
         [Doc]
         (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
          [ComponentInclude OpenUnitId ModuleRenaming])
    forall a.
    Verbosity
    -> ComponentId
    -> FullDb
    -> (forall s. UnifyM s a)
    -> Either [Doc] a
    runUnifyM Verbosity
    verbosity ComponentId
    this_cid FullDb
    db ((forall {s}.
      UnifyM
        s
        (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
         [ComponentInclude OpenUnitId ModuleRenaming]))
     -> Either
          [Doc]
          (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
           [ComponentInclude OpenUnitId ModuleRenaming]))
    -> (forall {s}.
        UnifyM
          s
          (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
           [ComponentInclude OpenUnitId ModuleRenaming]))
    -> Either
         [Doc]
         (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
          [ComponentInclude OpenUnitId ModuleRenaming])
    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 <- OpenModule -> UnifyM s (ModuleU s)
    forall s. OpenModule -> UnifyM s (ModuleU s)
    convertModule (OpenUnitId -> ModuleName -> OpenModule
    OpenModule OpenUnitId
    this_uid ModuleName
    m)
                    ModuleScopeU s -> UnifyM s (ModuleScopeU s)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleName
    -> [ModuleWithSourceU s] -> Map ModuleName [ModuleWithSourceU s]
    forall k a. k -> a -> Map k a
    Map.singleton ModuleName
    m [ModuleSource -> ModuleU s -> ModuleWithSourceU s
    forall a. ModuleSource -> a -> WithSource a
    WithSource (ModuleName -> ModuleSource
    from ModuleName
    m) ModuleU s
    m_u], Map ModuleName [ModuleWithSourceU s]
    forall k a. Map k a
    Map.empty)
            -- Handle 'exposed-modules'
            [ModuleScopeU s]
    exposed_mod_shapes_u <- (ModuleName -> UnifyM s (ModuleScopeU s))
    -> [ModuleName] -> UnifyM s [ModuleScopeU s]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((ModuleName -> ModuleSource)
    -> ModuleName -> UnifyM s (ModuleScopeU s)
    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 <- (ModuleName -> UnifyM s (ModuleScopeU s))
    -> [ModuleName] -> UnifyM s [ModuleScopeU s]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((ModuleName -> ModuleSource)
    -> ModuleName -> UnifyM s (ModuleScopeU s)
    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 <- OpenModule -> UnifyM s (ModuleU s)
    forall s. OpenModule -> UnifyM s (ModuleU s)
    convertModule (ModuleName -> OpenModule
    OpenModuleVar ModuleName
    req)
                    ModuleScopeU s -> UnifyM s (ModuleScopeU s)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map ModuleName [ModuleWithSourceU s]
    forall k a. Map k a
    Map.empty, ModuleName
    -> [ModuleWithSourceU s] -> Map ModuleName [ModuleWithSourceU s]
    forall k a. k -> a -> Map k a
    Map.singleton ModuleName
    req [ModuleSource -> ModuleU s -> ModuleWithSourceU s
    forall a. ModuleSource -> a -> WithSource a
    WithSource (ModuleName -> ModuleSource
    FromSignatures ModuleName
    req) ModuleU s
    req_u])
            [ModuleScopeU s]
    req_shapes_u <- (ModuleName -> UnifyM s (ModuleScopeU s))
    -> [ModuleName] -> UnifyM s [ModuleScopeU s]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ModuleName -> UnifyM s (ModuleScopeU s)
    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) <- ([(ModuleScopeU s,
       Either
         (ComponentInclude (UnitIdU s) ModuleRenaming)
         (ComponentInclude (UnitIdU s) ModuleRenaming))]
     -> ([ModuleScopeU s],
         [Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming)]))
    -> UnifyM
         s
         [(ModuleScopeU s,
           Either
             (ComponentInclude (UnitIdU s) ModuleRenaming)
             (ComponentInclude (UnitIdU s) ModuleRenaming))]
    -> UnifyM
         s
         ([ModuleScopeU s],
          [Either
             (ComponentInclude (UnitIdU s) ModuleRenaming)
             (ComponentInclude (UnitIdU s) ModuleRenaming)])
    forall a b. (a -> b) -> UnifyM s a -> UnifyM s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [(ModuleScopeU s,
      Either
        (ComponentInclude (UnitIdU s) ModuleRenaming)
        (ComponentInclude (UnitIdU s) ModuleRenaming))]
    -> ([ModuleScopeU s],
        [Either
           (ComponentInclude (UnitIdU s) ModuleRenaming)
           (ComponentInclude (UnitIdU s) ModuleRenaming)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ((ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
     -> UnifyM
          s
          (ModuleScopeU s,
           Either
             (ComponentInclude (UnitIdU s) ModuleRenaming)
             (ComponentInclude (UnitIdU s) ModuleRenaming)))
    -> [ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming]
    -> UnifyM
         s
         [(ModuleScopeU s,
           Either
             (ComponentInclude (UnitIdU s) ModuleRenaming)
             (ComponentInclude (UnitIdU s) ModuleRenaming))]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    -> UnifyM
         s
         (ModuleScopeU s,
          Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming))
    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)

            UnifyM s ()
    forall s. UnifyM s ()
    failIfErrs -- Prevent error cascade
            -- Mix-in link everything!  mixLink is the real workhorse.
            ModuleScopeU s
    shape_u <- [ModuleScopeU s] -> UnifyM s (ModuleScopeU s)
    forall s. [ModuleScopeU s] -> UnifyM s (ModuleScopeU s)
    mixLink ([ModuleScopeU s] -> UnifyM s (ModuleScopeU s))
    -> [ModuleScopeU s] -> UnifyM s (ModuleScopeU s)
    forall a b. (a -> b) -> a -> b
    $ [ModuleScopeU s]
    exposed_mod_shapes_u
                              [ModuleScopeU s] -> [ModuleScopeU s] -> [ModuleScopeU s]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleScopeU s]
    other_mod_shapes_u
                              [ModuleScopeU s] -> [ModuleScopeU s] -> [ModuleScopeU s]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleScopeU s]
    req_shapes_u
                              [ModuleScopeU s] -> [ModuleScopeU s] -> [ModuleScopeU s]
    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
                    let component_name :: Doc
    component_name = ComponentName -> Doc
    forall a. Pretty a => a -> Doc
    pretty (ComponentName -> Doc) -> ComponentName -> Doc
    forall a b. (a -> b) -> a -> b
    $ AnnotatedId (UnitIdU s) -> ComponentName
    forall id. AnnotatedId id -> ComponentName
    ann_cname AnnotatedId (UnitIdU s)
    dep_aid
                    OpenUnitId
    uid <- UnitIdU s -> Doc -> UnifyM s OpenUnitId
    forall s. UnitIdU s -> Doc -> UnifyM s OpenUnitId
    convertUnitIdU (AnnotatedId (UnitIdU s) -> UnitIdU s
    forall id. AnnotatedId id -> id
    ann_id AnnotatedId (UnitIdU s)
    dep_aid) Doc
    component_name
                    ComponentInclude OpenUnitId rn
    -> UnifyM s (ComponentInclude OpenUnitId rn)
    forall a. a -> UnifyM s a
    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 = uid },
                            ci_renaming :: rn
    ci_renaming = rn
    rns,
                            ci_implicit :: Bool
    ci_implicit = Bool
    i
                        })

            ModuleScope
    shape <- ModuleScopeU s -> UnifyM s ModuleScope
    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) = [Either
       (ComponentInclude (UnitIdU s) ModuleRenaming)
       (ComponentInclude (UnitIdU s) ModuleRenaming)]
    -> ([ComponentInclude (UnitIdU s) ModuleRenaming],
        [ComponentInclude (UnitIdU s) ModuleRenaming])
    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 <- (ComponentInclude (UnitIdU s) ModuleRenaming
     -> UnifyM s (ComponentInclude OpenUnitId ModuleRenaming))
    -> [ComponentInclude (UnitIdU s) ModuleRenaming]
    -> UnifyM s [ComponentInclude OpenUnitId ModuleRenaming]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ComponentInclude (UnitIdU s) ModuleRenaming
    -> UnifyM s (ComponentInclude OpenUnitId ModuleRenaming)
    forall {s} {rn}.
    ComponentInclude (UnitIdU s) rn
    -> UnifyM s (ComponentInclude OpenUnitId rn)
    convertIncludeU [ComponentInclude (UnitIdU s) ModuleRenaming]
    includes_u
            [ComponentInclude OpenUnitId ModuleRenaming]
    sig_incls <- (ComponentInclude (UnitIdU s) ModuleRenaming
     -> UnifyM s (ComponentInclude OpenUnitId ModuleRenaming))
    -> [ComponentInclude (UnitIdU s) ModuleRenaming]
    -> UnifyM s [ComponentInclude OpenUnitId ModuleRenaming]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ComponentInclude (UnitIdU s) ModuleRenaming
    -> UnifyM s (ComponentInclude OpenUnitId ModuleRenaming)
    forall {s} {rn}.
    ComponentInclude (UnitIdU s) rn
    -> UnifyM s (ComponentInclude OpenUnitId rn)
    convertIncludeU [ComponentInclude (UnitIdU s) ModuleRenaming]
    sig_includes_u
            (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
     [ComponentInclude OpenUnitId ModuleRenaming])
    -> UnifyM
         s
         (ModuleScope, [ComponentInclude OpenUnitId ModuleRenaming],
          [ComponentInclude OpenUnitId ModuleRenaming])
    forall a. a -> UnifyM s a
    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
        Bool -> LogProgress () -> LogProgress ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Set ModuleName -> Bool
    forall a. Set a -> Bool
    Set.null Set ModuleName
    reqs) Bool -> Bool -> Bool
    && Component -> Bool
    isNotLib Component
    component) (LogProgress () -> LogProgress ())
    -> LogProgress () -> LogProgress ()
    forall a b. (a -> b) -> a -> b
    $
            Doc -> LogProgress ()
    forall a. Doc -> LogProgress a
    dieProgress (Doc -> LogProgress ()) -> Doc -> LogProgress ()
    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 [ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    req | ModuleName
    req <- Set ModuleName -> [ModuleName]
    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 = [ModuleName] -> Set ModuleName
    forall a. Ord a => [a] -> Set a
    Set.fromList [ModuleName]
    src_hidden
            linked_shape :: ModuleScope
    linked_shape = ModuleScope
    linked_shape0 {
                modScopeProvides =
                    -- Would rather use withoutKeys but need BC
                    Map.filterWithKey
                        (\ModuleName
    k [ModuleWithSource]
    _ -> Bool -> Bool
    not (ModuleName
    k ModuleName -> Set ModuleName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set ModuleName
    src_hidden_set))
                        (modScopeProvides 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 [Either Doc a] -> ([Doc], [a])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either Doc a]
    es of
                    ([], [a]
    rs) -> [a] -> LogProgress [a]
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [a]
    rs
                    ([Doc]
    ls, [a]
    _) ->
                        Doc -> LogProgress [a]
    forall a. Doc -> LogProgress a
    dieProgress (Doc -> LogProgress [a]) -> Doc -> LogProgress [a]
    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 <- [Either Doc (ModuleName, OpenModule)]
    -> LogProgress [(ModuleName, OpenModule)]
    forall a. [Either Doc a] -> LogProgress [a]
    hdl ([Either Doc (ModuleName, OpenModule)]
     -> LogProgress [(ModuleName, OpenModule)])
    -> ((ModuleReexport -> Either Doc (ModuleName, OpenModule))
        -> [Either Doc (ModuleName, OpenModule)])
    -> (ModuleReexport -> Either Doc (ModuleName, OpenModule))
    -> LogProgress [(ModuleName, OpenModule)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((ModuleReexport -> Either Doc (ModuleName, OpenModule))
     -> [ModuleReexport] -> [Either Doc (ModuleName, OpenModule)])
    -> [ModuleReexport]
    -> (ModuleReexport -> Either Doc (ModuleName, OpenModule))
    -> [Either Doc (ModuleName, OpenModule)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (ModuleReexport -> Either Doc (ModuleName, OpenModule))
    -> [ModuleReexport] -> [Either Doc (ModuleName, OpenModule)]
    forall a b. (a -> b) -> [a] -> [b]
    map) [ModuleReexport]
    src_reexports ((ModuleReexport -> Either Doc (ModuleName, OpenModule))
     -> LogProgress [(ModuleName, OpenModule)])
    -> (ModuleReexport -> Either Doc (ModuleName, OpenModule))
    -> LogProgress [(ModuleName, OpenModule)]
    forall a b. (a -> b) -> a -> b
    $ \reex :: ModuleReexport
    reex@(ModuleReexport Maybe PackageName
    mb_pn ModuleName
    from ModuleName
    to) -> do
          case ModuleName
    -> Map ModuleName [ModuleWithSource] -> Maybe [ModuleWithSource]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ModuleName
    from (ModuleScope -> Map ModuleName [ModuleWithSource]
    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 PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageName
    pn'
                        matches_pn (FromBuildDepends PackageName
    pn' ComponentName
    _) = PackageName
    pn PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageName
    pn'
                        matches_pn (FromExposedModules ModuleName
    _) = PackageName
    pn PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageId -> PackageName
    forall pkg. Package pkg => pkg -> PackageName
    packageName PackageId
    this_pid
                        matches_pn (FromOtherModules ModuleName
    _)   = PackageName
    pn PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageId -> PackageName
    forall pkg. Package pkg => pkg -> PackageName
    packageName PackageId
    this_pid
                        matches_pn (FromSignatures ModuleName
    _)     = PackageName
    pn PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageId -> PackageName
    forall pkg. Package pkg => pkg -> PackageName
    packageName PackageId
    this_pid
                    in case (ModuleWithSource -> Bool)
    -> [ModuleWithSource] -> [ModuleWithSource]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (ModuleSource -> Bool
    matches_pn (ModuleSource -> Bool)
    -> (ModuleWithSource -> ModuleSource) -> ModuleWithSource -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleWithSource -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource) [ModuleWithSource]
    cands of
                        (ModuleWithSource
    x1:[ModuleWithSource]
    xs1) -> (ModuleWithSource, [ModuleWithSource])
    -> Either Doc (ModuleWithSource, [ModuleWithSource])
    forall a. a -> Either Doc a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleWithSource
    x1, [ModuleWithSource]
    xs1)
                        [ModuleWithSource]
    _ -> Doc -> Either Doc (ModuleWithSource, [ModuleWithSource])
    forall a b. a -> Either a b
    Left (ModuleReexport -> Doc
    brokenReexportMsg ModuleReexport
    reex)
                  Maybe PackageName
    Nothing -> (ModuleWithSource, [ModuleWithSource])
    -> Either Doc (ModuleWithSource, [ModuleWithSource])
    forall a. a -> Either Doc a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleWithSource
    x0, [ModuleWithSource]
    xs0)
              -- Test that all the candidates are consistent
              case (ModuleWithSource -> Bool)
    -> [ModuleWithSource] -> [ModuleWithSource]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\ModuleWithSource
    x' -> ModuleWithSource -> OpenModule
    forall a. WithSource a -> a
    unWithSource ModuleWithSource
    x OpenModule -> OpenModule -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ModuleWithSource -> OpenModule
    forall a. WithSource a -> a
    unWithSource ModuleWithSource
    x') [ModuleWithSource]
    xs of
                [] -> () -> Either Doc ()
    forall a. a -> Either Doc a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                [ModuleWithSource]
    _ -> Doc -> Either Doc ()
    forall a b. a -> Either a b
    Left (Doc -> Either Doc ()) -> Doc -> Either Doc ()
    forall a b. (a -> b) -> a -> b
    $ ModuleReexport -> ModuleWithSource -> [ModuleWithSource] -> Doc
    ambiguousReexportMsg ModuleReexport
    reex ModuleWithSource
    x [ModuleWithSource]
    xs
              (ModuleName, OpenModule) -> Either Doc (ModuleName, OpenModule)
    forall a. a -> Either Doc a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleName
    to, ModuleWithSource -> OpenModule
    forall a. WithSource a -> a
    unWithSource ModuleWithSource
    x)
            Maybe [ModuleWithSource]
    _ ->
              Doc -> Either Doc (ModuleName, OpenModule)
    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)
                | k -> Map k a -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member k
    k Map k a
    m =
                    Doc -> LogProgress (Map k a)
    forall a. Doc -> LogProgress a
    dieProgress (Doc -> LogProgress (Map k a)) -> Doc -> LogProgress (Map k a)
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    hsep
                        [ String -> Doc
    text String
    "Module name ", k -> Doc
    forall a. Pretty a => a -> Doc
    pretty k
    k, String -> Doc
    text String
    " is exported multiple times." ]
                | Bool
    otherwise = Map k a -> LogProgress (Map k a)
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (k -> a -> Map k a -> Map k a
    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 <- (OpenModuleSubst
     -> (ModuleName, OpenModule) -> LogProgress OpenModuleSubst)
    -> OpenModuleSubst
    -> [(ModuleName, OpenModule)]
    -> LogProgress OpenModuleSubst
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM OpenModuleSubst
    -> (ModuleName, OpenModule) -> LogProgress OpenModuleSubst
    forall {k} {a}.
    (Ord k, Pretty k) =>
    Map k a -> (k, a) -> LogProgress (Map k a)
    build_reexports OpenModuleSubst
    forall k a. Map k a
    Map.empty ([(ModuleName, OpenModule)] -> LogProgress OpenModuleSubst)
    -> [(ModuleName, OpenModule)] -> LogProgress OpenModuleSubst
    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 ] [(ModuleName, OpenModule)]
    -> [(ModuleName, OpenModule)] -> [(ModuleName, OpenModule)]
    forall a. [a] -> [a] -> [a]
    ++
                    [(ModuleName, OpenModule)]
    reexports_list

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

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

        LinkedComponent -> LogProgress LinkedComponent
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LinkedComponent -> LogProgress LinkedComponent)
    -> LinkedComponent -> LogProgress LinkedComponent
    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 = (AnnotatedId ComponentId -> AnnotatedId OpenUnitId)
    -> [AnnotatedId ComponentId] -> [AnnotatedId OpenUnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ComponentId -> OpenUnitId)
    -> AnnotatedId ComponentId -> AnnotatedId OpenUnitId
    forall a b. (a -> b) -> AnnotatedId a -> AnnotatedId b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\ComponentId
    cid -> ComponentId -> OpenModuleSubst -> OpenUnitId
    IndefFullUnitId ComponentId
    cid OpenModuleSubst
    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
       = ((LinkedComponentMap, [LinkedComponent]) -> [LinkedComponent])
    -> LogProgress (LinkedComponentMap, [LinkedComponent])
    -> LogProgress [LinkedComponent]
    forall a b. (a -> b) -> LogProgress a -> LogProgress b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (LinkedComponentMap, [LinkedComponent]) -> [LinkedComponent]
    forall a b. (a, b) -> b
    snd ((LinkedComponentMap
     -> ConfiguredComponent
     -> LogProgress (LinkedComponentMap, LinkedComponent))
    -> LinkedComponentMap
    -> [ConfiguredComponent]
    -> LogProgress (LinkedComponentMap, [LinkedComponent])
    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 <- Doc -> LogProgress LinkedComponent -> LogProgress LinkedComponent
    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))) (LogProgress LinkedComponent -> LogProgress LinkedComponent)
    -> LogProgress LinkedComponent -> LogProgress LinkedComponent
    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
        (LinkedComponentMap, LinkedComponent)
    -> LogProgress (LinkedComponentMap, LinkedComponent)
    forall a. a -> LogProgress a
    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 =
        ComponentId
    -> (OpenUnitId, ModuleShape)
    -> LinkedComponentMap
    -> LinkedComponentMap
    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 (PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn)
           , String -> Doc
    text String
    "does not export a module" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (ModuleName -> Doc
    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 (ModuleName -> Doc
    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 (ModuleName -> Doc
    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 Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : [Doc]
    msgs))
           , Maybe PackageName -> Doc
    forall {a}. Maybe a -> Doc
    help_msg Maybe PackageName
    mb_pn ]
      where
        msg :: Doc
    msg  = String -> Doc
    text String
    "  " Doc -> Doc -> Doc
    <+> ModuleWithSource -> Doc
    forall {a}. Pretty a => WithSource a -> Doc
    displayModuleWithSource ModuleWithSource
    y1
        msgs :: [Doc]
    msgs = [String -> Doc
    text String
    "or" Doc -> Doc -> Doc
    <+> ModuleWithSource -> 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 (a -> Doc
    forall a. Pretty a => a -> Doc
    pretty (WithSource a -> a
    forall a. WithSource a -> a
    unWithSource WithSource a
    y))
                 , String -> Doc
    text String
    "brought into scope by" Doc -> Doc -> Doc
    <+>
                    ModuleSource -> Doc
    dispModuleSource (WithSource a -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource WithSource a
    y)
                 ]