1{-# LANGUAGE DeriveFunctor #-}
2{-# LANGUAGE DeriveTraversable #-}
3{-# LANGUAGE DeriveFoldable #-}
4-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
5module Distribution.Backpack.ModuleScope (
6    -- * Module scopes
7    ModuleScope(..),
8    ModuleProvides,
9    ModuleRequires,
10    ModuleSource(..),
11    dispModuleSource,
12    WithSource(..),
13    unWithSource,
14    getSource,
15    ModuleWithSource,
16    emptyModuleScope,
17) where
18
19import Prelude ()
20import Distribution.Compat.Prelude
21
22import Distribution.ModuleName
23import Distribution.Types.IncludeRenaming
24import Distribution.Types.PackageName
25import Distribution.Types.ComponentName
26import Distribution.Types.LibraryName
27import Distribution.Pretty
28
29import Distribution.Backpack
30import Distribution.Backpack.ModSubst
31
32import qualified Data.Map as Map
33import Text.PrettyPrint
34
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
64-- | A 'ModuleScope' describes the modules and requirements that
65-- are in-scope as we are processing a Cabal package.  Unlike
66-- a 'ModuleShape', there may be multiple modules in scope at
67-- the same 'ModuleName'; this is only an error if we attempt
68-- to use those modules to fill a requirement.  A 'ModuleScope'
69-- can influence the 'ModuleShape' via a reexport.
70data ModuleScope = ModuleScope {
71    modScopeProvides :: ModuleProvides,
72    modScopeRequires :: ModuleRequires
73    }
74
75-- | An empty 'ModuleScope'.
76emptyModuleScope :: ModuleScope
77emptyModuleScope = ModuleScope Map.empty Map.empty
78
79-- | Every 'Module' in scope at a 'ModuleName' is annotated with
80-- the 'PackageName' it comes from.
81type ModuleProvides = Map ModuleName [ModuleWithSource]
82-- | INVARIANT: entries for ModuleName m, have msrc_module is OpenModuleVar m
83type ModuleRequires = Map ModuleName [ModuleWithSource]
84-- TODO: consider newtping the two types above.
85
86-- | Description of where a module participating in mixin linking came
87-- from.
88data ModuleSource
89    = FromMixins         PackageName ComponentName IncludeRenaming
90    | FromBuildDepends   PackageName ComponentName
91    | FromExposedModules ModuleName
92    | FromOtherModules   ModuleName
93    | FromSignatures     ModuleName
94-- We don't have line numbers, but if we did, we'd want to record that
95-- too
96
97-- TODO: Deduplicate this with Distribution.Backpack.UnifyM.ci_msg
98dispModuleSource :: ModuleSource -> Doc
99dispModuleSource (FromMixins pn cn incls)
100  = text "mixins:" <+> dispComponent pn cn <+> pretty incls
101dispModuleSource (FromBuildDepends pn cn)
102  = text "build-depends:" <+> dispComponent pn cn
103dispModuleSource (FromExposedModules m)
104  = text "exposed-modules:" <+> pretty m
105dispModuleSource (FromOtherModules m)
106  = text "other-modules:" <+> pretty m
107dispModuleSource (FromSignatures m)
108  = text "signatures:" <+> pretty m
109
110-- Dependency
111dispComponent :: PackageName -> ComponentName -> Doc
112dispComponent pn cn =
113    -- NB: This syntax isn't quite the source syntax, but it
114    -- should be clear enough.  To do source syntax, we'd
115    -- need to know what the package we're linking is.
116    case cn of
117        CLibName LMainLibName -> pretty pn
118        CLibName (LSubLibName ucn) -> pretty pn <<>> colon <<>> pretty ucn
119        -- Case below shouldn't happen
120        _ -> pretty pn <+> parens (pretty cn)
121
122-- | An 'OpenModule', annotated with where it came from in a Cabal file.
123data WithSource a = WithSource ModuleSource a
124    deriving (Functor, Foldable, Traversable)
125unWithSource :: WithSource a -> a
126unWithSource (WithSource _ x) = x
127getSource :: WithSource a -> ModuleSource
128getSource (WithSource s _) = s
129type ModuleWithSource = WithSource OpenModule
130
131instance ModSubst a => ModSubst (WithSource a) where
132    modSubst subst (WithSource s m) = WithSource s (modSubst subst m)
133