Merge pull request #10634 from cabalism/hlint/unused-lang-pragma
[cabal.git] / Cabal-syntax / src / Distribution / Types / ModuleRenaming.hs
blob022a321a05567983879cae41e98eb78df60d5eba
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE DeriveGeneric #-}
3 {-# LANGUAGE RankNTypes #-}
5 module Distribution.Types.ModuleRenaming
6 ( ModuleRenaming (..)
7 , interpModuleRenaming
8 , defaultRenaming
9 , isDefaultRenaming
10 ) where
12 import Distribution.CabalSpecVersion
13 import Distribution.Compat.Prelude hiding (empty)
14 import Prelude ()
16 import Distribution.ModuleName
17 import Distribution.Parsec
18 import Distribution.Pretty
20 import qualified Data.Map as Map
21 import qualified Data.Set as Set
22 import qualified Distribution.Compat.CharParsing as P
23 import Text.PrettyPrint (comma, hsep, parens, punctuate, text)
25 -- | Renaming applied to the modules provided by a package.
26 -- The boolean indicates whether or not to also include all of the
27 -- original names of modules. Thus, @ModuleRenaming False []@ is
28 -- "don't expose any modules, and @ModuleRenaming True [("Data.Bool", "Bool")]@
29 -- is, "expose all modules, but also expose @Data.Bool@ as @Bool@".
30 -- If a renaming is omitted you get the 'DefaultRenaming'.
32 -- (NB: This is a list not a map so that we can preserve order.)
33 data ModuleRenaming
34 = -- | A module renaming/thinning; e.g., @(A as B, C as C)@
35 -- brings @B@ and @C@ into scope.
36 ModuleRenaming [(ModuleName, ModuleName)]
37 | -- | The default renaming, bringing all exported modules
38 -- into scope.
39 DefaultRenaming
40 | -- | Hiding renaming, e.g., @hiding (A, B)@, bringing all
41 -- exported modules into scope except the hidden ones.
42 HidingRenaming [ModuleName]
43 deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
45 -- | Interpret a 'ModuleRenaming' as a partial map from 'ModuleName'
46 -- to 'ModuleName'. For efficiency, you should partially apply it
47 -- with 'ModuleRenaming' and then reuse it.
48 interpModuleRenaming :: ModuleRenaming -> ModuleName -> Maybe ModuleName
49 interpModuleRenaming DefaultRenaming = Just
50 interpModuleRenaming (ModuleRenaming rns) =
51 let m = Map.fromList rns
52 in \k -> Map.lookup k m
53 interpModuleRenaming (HidingRenaming hs) =
54 let s = Set.fromList hs
55 in \k -> if k `Set.member` s then Nothing else Just k
57 -- | The default renaming, if something is specified in @build-depends@
58 -- only.
59 defaultRenaming :: ModuleRenaming
60 defaultRenaming = DefaultRenaming
62 -- | Tests if its the default renaming; we can use a more compact syntax
63 -- in 'Distribution.Types.IncludeRenaming.IncludeRenaming' in this case.
64 isDefaultRenaming :: ModuleRenaming -> Bool
65 isDefaultRenaming DefaultRenaming = True
66 isDefaultRenaming _ = False
68 instance Binary ModuleRenaming
69 instance Structured ModuleRenaming
71 instance NFData ModuleRenaming where rnf = genericRnf
73 -- NB: parentheses are mandatory, because later we may extend this syntax
74 -- to allow "hiding (A, B)" or other modifier words.
75 instance Pretty ModuleRenaming where
76 pretty DefaultRenaming = mempty
77 pretty (HidingRenaming hides) =
78 text "hiding" <+> parens (hsep (punctuate comma (map pretty hides)))
79 pretty (ModuleRenaming rns) =
80 parens . hsep $ punctuate comma (map dispEntry rns)
81 where
82 dispEntry (orig, new)
83 | orig == new = pretty orig
84 | otherwise = pretty orig <+> text "as" <+> pretty new
86 instance Parsec ModuleRenaming where
87 parsec = do
88 csv <- askCabalSpecVersion
89 if csv >= CabalSpecV3_0
90 then moduleRenamingParsec parensLax lexemeParsec
91 else moduleRenamingParsec parensStrict parsec
92 where
93 -- For cabal spec versions < 3.0 white spaces were not skipped
94 -- after the '(' and ')' tokens in the mixin field. This
95 -- parser checks the cabal file version and does the correct
96 -- skipping of spaces.
97 parensLax p = P.between (P.char '(' >> P.spaces) (P.char ')' >> P.spaces) p
98 parensStrict p = P.between (P.char '(' >> warnSpaces) (P.char ')') p
100 warnSpaces =
101 P.optional $
102 P.space *> fail "space after parenthesis, use cabal-version: 3.0 or higher"
104 moduleRenamingParsec
105 :: CabalParsing m
106 => (forall a. m a -> m a)
107 -- ^ between parens
108 -> m ModuleName
109 -- ^ module name parser
110 -> m ModuleRenaming
111 moduleRenamingParsec bp mn =
112 -- NB: try not necessary as the first token is obvious
113 P.choice [parseRename, parseHiding, return DefaultRenaming]
114 where
115 cma = P.char ',' >> P.spaces
116 parseRename = do
117 rns <- bp parseList
118 P.spaces
119 return (ModuleRenaming rns)
120 parseHiding = do
121 _ <- P.string "hiding"
122 P.spaces -- space isn't strictly required as next is an open paren
123 hides <- bp (P.sepBy mn cma)
124 return (HidingRenaming hides)
125 parseList =
126 P.sepBy parseEntry cma
127 parseEntry = do
128 orig <- parsec
129 P.spaces
130 P.option (orig, orig) $ do
131 _ <- P.string "as"
132 P.skipSpaces1 -- require space after "as"
133 new <- parsec
134 P.spaces
135 return (orig, new)