Cabal/src/Distribution/Backpack/ModuleShape.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3
   4 -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
   5 module Distribution.Backpack.ModuleShape
   6   ( -- * Module shapes
   7     ModuleShape (..)
   8   , emptyModuleShape
   9   , shapeInstalledPackage
  10   ) where
  11
  12 import Distribution.Compat.Prelude hiding (mod)
  13 import Prelude ()
  14
  15 import Distribution.InstalledPackageInfo as IPI
  16 import Distribution.ModuleName
  17
  18 import Distribution.Backpack
  19 import Distribution.Backpack.ModSubst
  20
  21 import qualified Data.Map as Map
  22 import qualified Data.Set as Set
  23
  24 -----------------------------------------------------------------------
  25 -- Module shapes
  26
  27 -- | A 'ModuleShape' describes the provisions and requirements of
  28 -- a library.  We can extract a 'ModuleShape' from an
  29 -- 'InstalledPackageInfo'.
  30 data ModuleShape = ModuleShape
  31   { modShapeProvides :: OpenModuleSubst
  32   , modShapeRequires :: Set ModuleName
  33   }
  34   deriving (Eq, Show, Generic, Typeable)
  35
  36 instance Binary ModuleShape
  37 instance Structured ModuleShape
  38
  39 instance ModSubst ModuleShape where
  40   modSubst subst (ModuleShape provs reqs) =
  41     ModuleShape (modSubst subst provs) (modSubst subst reqs)
  42
  43 -- | The default module shape, with no provisions and no requirements.
  44 emptyModuleShape :: ModuleShape
  45 emptyModuleShape = ModuleShape Map.empty Set.empty
  46
  47 -- Food for thought: suppose we apply the Merkel tree optimization.
  48 -- Imagine this situation:
  49 --
  50 --      component p
  51 --          signature H
  52 --          module P
  53 --      component h
  54 --          module H
  55 --      component a
  56 --          signature P
  57 --          module A
  58 --      component q(P)
  59 --          include p
  60 --          include h
  61 --      component r
  62 --          include q (P)
  63 --          include p (P) requires (H)
  64 --          include h (H)
  65 --          include a (A) requires (P)
  66 --
  67 -- Component r should not have any conflicts, since after mix-in linking
  68 -- the two P imports will end up being the same, so we can properly
  69 -- instantiate it.  But to know that q's P is p:P instantiated with h:H,
  70 -- we have to be able to expand its unit id.  Maybe we can expand it
  71 -- lazily but in some cases it will need to be expanded.
  72 --
  73 -- FWIW, the way that GHC handles this is by improving unit IDs as
  74 -- soon as it sees an improved one in the package database.  This
  75 -- is a bit disgusting.
  76 shapeInstalledPackage :: IPI.InstalledPackageInfo -> ModuleShape
  77 shapeInstalledPackage ipi = ModuleShape (Map.fromList provs) reqs
  78   where
  79     uid = installedOpenUnitId ipi
  80     provs = map shapeExposedModule (IPI.exposedModules ipi)
  81     reqs = requiredSignatures ipi
  82     shapeExposedModule (IPI.ExposedModule mod_name Nothing) =
  83       (mod_name, OpenModule uid mod_name)
  84     shapeExposedModule (IPI.ExposedModule mod_name (Just mod)) =
  85       (mod_name, mod)