{-# LANGUAGE DeriveGeneric #-}
-- | See
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 Data.Set (Set)
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)
instance Binary 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)