Distribution/Backpack/ModuleShape.hs

    {-# 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 {
        modShapeProvides :: OpenModuleSubst,
        modShapeRequires :: Set ModuleName
        }
        deriving (Eq, Show, Generic, Typeable)

    instance Binary ModuleShape
    instance Structured ModuleShape

    instance ModSubst ModuleShape where
        modSubst subst (ModuleShape provs reqs)
            = ModuleShape (modSubst subst provs) (modSubst subst reqs)

    -- | The default module shape, with no provisions and no requirements.
    emptyModuleShape :: ModuleShape
    emptyModuleShape = ModuleShape Map.empty 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 ipi = ModuleShape (Map.fromList provs) reqs
      where
        uid = installedOpenUnitId ipi
        provs = map shapeExposedModule (IPI.exposedModules ipi)
        reqs = requiredSignatures ipi
        shapeExposedModule (IPI.ExposedModule mod_name Nothing)
            = (mod_name, OpenModule uid mod_name)
        shapeExposedModule (IPI.ExposedModule mod_name (Just mod))
            = (mod_name, mod)