    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
    module Distribution.Backpack.ModuleShape (
        -- * Module shapes
        ModuleShape(..),
        emptyModuleShape,
        shapeInstalledPackage,
    ) where

    import Prelude ()
    import Distribution.Compat.Prelude hiding (mod)

    import Distribution.ModuleName
    import Distribution.InstalledPackageInfo as IPI

    import Distribution.Backpack.ModSubst
    import Distribution.Backpack

    import qualified Data.Map as Map
    import qualified Data.Set as Set

    -----------------------------------------------------------------------
    -- Module shapes

    -- | A 'ModuleShape' describes the provisions and requirements of
    -- a library.  We can extract a 'ModuleShape' from an
    -- 'InstalledPackageInfo'.
    data ModuleShape = ModuleShape {
        ModuleShape -> OpenModuleSubst
    modShapeProvides :: OpenModuleSubst,
        ModuleShape -> Set ModuleName
    modShapeRequires :: Set ModuleName
        }
        deriving (ModuleShape -> ModuleShape -> Bool
    (ModuleShape -> ModuleShape -> Bool)
    -> (ModuleShape -> ModuleShape -> Bool) -> Eq ModuleShape
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ModuleShape -> ModuleShape -> Bool
    $c/= :: ModuleShape -> ModuleShape -> Bool
    == :: ModuleShape -> ModuleShape -> Bool
    $c== :: ModuleShape -> ModuleShape -> Bool
    Eq, Int -> ModuleShape -> ShowS
    [ModuleShape] -> ShowS
    ModuleShape -> String
    (Int -> ModuleShape -> ShowS)
    -> (ModuleShape -> String)
    -> ([ModuleShape] -> ShowS)
    -> Show ModuleShape
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [ModuleShape] -> ShowS
    $cshowList :: [ModuleShape] -> ShowS
    show :: ModuleShape -> String
    $cshow :: ModuleShape -> String
    showsPrec :: Int -> ModuleShape -> ShowS
    $cshowsPrec :: Int -> ModuleShape -> ShowS
    Show, (forall x. ModuleShape -> Rep ModuleShape x)
    -> (forall x. Rep ModuleShape x -> ModuleShape)
    -> Generic ModuleShape
    forall x. Rep ModuleShape x -> ModuleShape
    forall x. ModuleShape -> Rep ModuleShape x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep ModuleShape x -> ModuleShape
    $cfrom :: forall x. ModuleShape -> Rep ModuleShape x
    Generic, Typeable)

    instance Binary ModuleShape
    instance Structured ModuleShape

    instance ModSubst ModuleShape where
        modSubst :: OpenModuleSubst -> ModuleShape -> ModuleShape
    modSubst OpenModuleSubst
    subst (ModuleShape OpenModuleSubst
    provs Set ModuleName
    reqs)
            = OpenModuleSubst -> Set ModuleName -> ModuleShape
    ModuleShape (OpenModuleSubst -> OpenModuleSubst -> OpenModuleSubst
    forall a. ModSubst a => OpenModuleSubst -> a -> a
    modSubst OpenModuleSubst
    subst OpenModuleSubst
    provs) (OpenModuleSubst -> Set ModuleName -> Set ModuleName
    forall a. ModSubst a => OpenModuleSubst -> a -> a
    modSubst OpenModuleSubst
    subst Set ModuleName
    reqs)

    -- | The default module shape, with no provisions and no requirements.
    emptyModuleShape :: ModuleShape
    emptyModuleShape :: ModuleShape
    emptyModuleShape = OpenModuleSubst -> Set ModuleName -> ModuleShape
    ModuleShape OpenModuleSubst
    forall k a. Map k a
    Map.empty Set ModuleName
    forall a. Set a
    Set.empty

    -- Food for thought: suppose we apply the Merkel tree optimization.
    -- Imagine this situation:
    --
    --      component p
    --          signature H
    --          module P
    --      component h
    --          module H
    --      component a
    --          signature P
    --          module A
    --      component q(P)
    --          include p
    --          include h
    --      component r
    --          include q (P)
    --          include p (P) requires (H)
    --          include h (H)
    --          include a (A) requires (P)
    --
    -- Component r should not have any conflicts, since after mix-in linking
    -- the two P imports will end up being the same, so we can properly
    -- instantiate it.  But to know that q's P is p:P instantiated with h:H,
    -- we have to be able to expand its unit id.  Maybe we can expand it
    -- lazily but in some cases it will need to be expanded.
    --
    -- FWIW, the way that GHC handles this is by improving unit IDs as
    -- soon as it sees an improved one in the package database.  This
    -- is a bit disgusting.
    shapeInstalledPackage :: IPI.InstalledPackageInfo -> ModuleShape
    shapeInstalledPackage :: InstalledPackageInfo -> ModuleShape
    shapeInstalledPackage InstalledPackageInfo
    ipi = OpenModuleSubst -> Set ModuleName -> ModuleShape
    ModuleShape ([(ModuleName, OpenModule)] -> OpenModuleSubst
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(ModuleName, OpenModule)]
    provs) Set ModuleName
    reqs
      where
        uid :: OpenUnitId
    uid = InstalledPackageInfo -> OpenUnitId
    installedOpenUnitId InstalledPackageInfo
    ipi
        provs :: [(ModuleName, OpenModule)]
    provs = (ExposedModule -> (ModuleName, OpenModule))
    -> [ExposedModule] -> [(ModuleName, OpenModule)]
    forall a b. (a -> b) -> [a] -> [b]
    map ExposedModule -> (ModuleName, OpenModule)
    shapeExposedModule (InstalledPackageInfo -> [ExposedModule]
    IPI.exposedModules InstalledPackageInfo
    ipi)
        reqs :: Set ModuleName
    reqs = InstalledPackageInfo -> Set ModuleName
    requiredSignatures InstalledPackageInfo
    ipi
        shapeExposedModule :: ExposedModule -> (ModuleName, OpenModule)
    shapeExposedModule (IPI.ExposedModule ModuleName
    mod_name Maybe OpenModule
    Nothing)
            = (ModuleName
    mod_name, OpenUnitId -> ModuleName -> OpenModule
    OpenModule OpenUnitId
    uid ModuleName
    mod_name)
        shapeExposedModule (IPI.ExposedModule ModuleName
    mod_name (Just OpenModule
    mod))
            = (ModuleName
    mod_name, OpenModule
    mod)