Cabal/src/Distribution/Backpack/ModuleScope.hs

   1 {-# LANGUAGE DeriveFoldable #-}
   2 {-# LANGUAGE DeriveFunctor #-}
   3 {-# LANGUAGE DeriveTraversable #-}
   4
   5 -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
   6 module Distribution.Backpack.ModuleScope
   7   ( -- * Module scopes
   8     ModuleScope (..)
   9   , ModuleProvides
  10   , ModuleRequires
  11   , ModuleSource (..)
  12   , dispModuleSource
  13   , WithSource (..)
  14   , unWithSource
  15   , getSource
  16   , ModuleWithSource
  17   , emptyModuleScope
  18   ) where
  19
  20 import Distribution.Compat.Prelude
  21 import Prelude ()
  22
  23 import Distribution.ModuleName
  24 import Distribution.Pretty
  25 import Distribution.Types.ComponentName
  26 import Distribution.Types.IncludeRenaming
  27 import Distribution.Types.LibraryName
  28 import Distribution.Types.PackageName
  29
  30 import Distribution.Backpack
  31 import Distribution.Backpack.ModSubst
  32
  33 import qualified Data.Map as Map
  34 import Text.PrettyPrint
  35
  36 -----------------------------------------------------------------------
  37 -- Module scopes
  38
  39 -- Why is ModuleProvides so complicated?  The basic problem is that
  40 -- we want to support this:
  41 --
  42 --  package p where
  43 --      include q (A)
  44 --      include r (A)
  45 --      module B where
  46 --          import "q" A
  47 --          import "r" A
  48 --
  49 -- Specifically, in Cabal today it is NOT an error have two modules in
  50 -- scope with the same identifier.  So we need to preserve this for
  51 -- Backpack.  The modification is that an ambiguous module name is
  52 -- OK... as long as it is NOT used to fill a requirement!
  53 --
  54 -- So as a first try, we might try deferring unifying provisions that
  55 -- are being glommed together, and check for equality after the fact.
  56 -- But this doesn't work, because what if a multi-module provision
  57 -- is used to fill a requirement?!  So you do the equality test
  58 -- IMMEDIATELY before a requirement fill happens... or never at all.
  59 --
  60 -- Alternate strategy: go ahead and unify, and then if it is revealed
  61 -- that some requirements got filled "out-of-thin-air", error.
  62
  63 -- | A 'ModuleScope' describes the modules and requirements that
  64 -- are in-scope as we are processing a Cabal package.  Unlike
  65 -- a 'ModuleShape', there may be multiple modules in scope at
  66 -- the same 'ModuleName'; this is only an error if we attempt
  67 -- to use those modules to fill a requirement.  A 'ModuleScope'
  68 -- can influence the 'ModuleShape' via a reexport.
  69 data ModuleScope = ModuleScope
  70   { modScopeProvides :: ModuleProvides
  71   , modScopeRequires :: ModuleRequires
  72   }
  73
  74 -- | An empty 'ModuleScope'.
  75 emptyModuleScope :: ModuleScope
  76 emptyModuleScope = ModuleScope Map.empty Map.empty
  77
  78 -- | Every 'Module' in scope at a 'ModuleName' is annotated with
  79 -- the 'PackageName' it comes from.
  80 type ModuleProvides = Map ModuleName [ModuleWithSource]
  81
  82 -- | INVARIANT: entries for ModuleName m, have msrc_module is OpenModuleVar m
  83 type ModuleRequires = Map ModuleName [ModuleWithSource]
  84
  85 -- TODO: consider newtping the two types above.
  86
  87 -- | Description of where a module participating in mixin linking came
  88 -- from.
  89 data ModuleSource
  90   = FromMixins PackageName ComponentName IncludeRenaming
  91   | FromBuildDepends PackageName ComponentName
  92   | FromExposedModules ModuleName
  93   | FromOtherModules ModuleName
  94   | FromSignatures ModuleName
  95
  96 -- We don't have line numbers, but if we did, we'd want to record that
  97 -- too
  98
  99 -- TODO: Deduplicate this with Distribution.Backpack.UnifyM.ci_msg
 100 dispModuleSource :: ModuleSource -> Doc
 101 dispModuleSource (FromMixins pn cn incls) =
 102   text "mixins:" <+> dispComponent pn cn <+> pretty incls
 103 dispModuleSource (FromBuildDepends pn cn) =
 104   text "build-depends:" <+> dispComponent pn cn
 105 dispModuleSource (FromExposedModules m) =
 106   text "exposed-modules:" <+> pretty m
 107 dispModuleSource (FromOtherModules m) =
 108   text "other-modules:" <+> pretty m
 109 dispModuleSource (FromSignatures m) =
 110   text "signatures:" <+> pretty m
 111
 112 -- Dependency
 113 dispComponent :: PackageName -> ComponentName -> Doc
 114 dispComponent pn cn =
 115   -- NB: This syntax isn't quite the source syntax, but it
 116   -- should be clear enough.  To do source syntax, we'd
 117   -- need to know what the package we're linking is.
 118   case cn of
 119     CLibName LMainLibName -> pretty pn
 120     CLibName (LSubLibName ucn) -> pretty pn <<>> colon <<>> pretty ucn
 121     -- Case below shouldn't happen
 122     _ -> pretty pn <+> parens (pretty cn)
 123
 124 -- | An 'OpenModule', annotated with where it came from in a Cabal file.
 125 data WithSource a = WithSource ModuleSource a
 126   deriving (Functor, Foldable, Traversable)
 127
 128 unWithSource :: WithSource a -> a
 129 unWithSource (WithSource _ x) = x
 130 getSource :: WithSource a -> ModuleSource
 131 getSource (WithSource s _) = s
 132 type ModuleWithSource = WithSource OpenModule
 133
 134 instance ModSubst a => ModSubst (WithSource a) where
 135   modSubst subst (WithSource s m) = WithSource s (modSubst subst m)