Make type import/export API Annotation friendly
[ghc.git] / compiler / hsSyn / HsImpExp.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 HsImpExp: Abstract syntax: imports, exports, interfaces
7 -}
8
9 {-# LANGUAGE DeriveDataTypeable #-}
10
11 module HsImpExp where
12
13 import Module ( ModuleName )
14 import HsDoc ( HsDocString )
15 import OccName ( HasOccName(..), isTcOcc, isSymOcc )
16 import BasicTypes ( SourceText(..), StringLiteral(..), pprWithSourceText )
17 import FieldLabel ( FieldLbl(..) )
18
19 import Outputable
20 import FastString
21 import SrcLoc
22
23 import Data.Data
24
25 {-
26 ************************************************************************
27 * *
28 \subsection{Import and export declaration lists}
29 * *
30 ************************************************************************
31
32 One per \tr{import} declaration in a module.
33 -}
34
35 -- | Located Import Declaration
36 type LImportDecl name = Located (ImportDecl name)
37 -- ^ When in a list this may have
38 --
39 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
40
41 -- For details on above see note [Api annotations] in ApiAnnotation
42
43 -- | Import Declaration
44 --
45 -- A single Haskell @import@ declaration.
46 data ImportDecl name
47 = ImportDecl {
48 ideclSourceSrc :: SourceText,
49 -- Note [Pragma source text] in BasicTypes
50 ideclName :: Located ModuleName, -- ^ Module name.
51 ideclPkgQual :: Maybe StringLiteral, -- ^ Package qualifier.
52 ideclSource :: Bool, -- ^ True <=> {-\# SOURCE \#-} import
53 ideclSafe :: Bool, -- ^ True => safe import
54 ideclQualified :: Bool, -- ^ True => qualified
55 ideclImplicit :: Bool, -- ^ True => implicit import (of Prelude)
56 ideclAs :: Maybe (Located ModuleName), -- ^ as Module
57 ideclHiding :: Maybe (Bool, Located [LIE name])
58 -- ^ (True => hiding, names)
59 }
60 -- ^
61 -- 'ApiAnnotation.AnnKeywordId's
62 --
63 -- - 'ApiAnnotation.AnnImport'
64 --
65 -- - 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnClose' for ideclSource
66 --
67 -- - 'ApiAnnotation.AnnSafe','ApiAnnotation.AnnQualified',
68 -- 'ApiAnnotation.AnnPackageName','ApiAnnotation.AnnAs',
69 -- 'ApiAnnotation.AnnVal'
70 --
71 -- - 'ApiAnnotation.AnnHiding','ApiAnnotation.AnnOpen',
72 -- 'ApiAnnotation.AnnClose' attached
73 -- to location in ideclHiding
74
75 -- For details on above see note [Api annotations] in ApiAnnotation
76 deriving Data
77
78 simpleImportDecl :: ModuleName -> ImportDecl name
79 simpleImportDecl mn = ImportDecl {
80 ideclSourceSrc = NoSourceText,
81 ideclName = noLoc mn,
82 ideclPkgQual = Nothing,
83 ideclSource = False,
84 ideclSafe = False,
85 ideclImplicit = False,
86 ideclQualified = False,
87 ideclAs = Nothing,
88 ideclHiding = Nothing
89 }
90
91 instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name) where
92 ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'
93 , ideclPkgQual = pkg
94 , ideclSource = from, ideclSafe = safe
95 , ideclQualified = qual, ideclImplicit = implicit
96 , ideclAs = as, ideclHiding = spec })
97 = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,
98 pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])
99 4 (pp_spec spec)
100 where
101 pp_implicit False = empty
102 pp_implicit True = ptext (sLit ("(implicit)"))
103
104 pp_pkg Nothing = empty
105 pp_pkg (Just (StringLiteral st p))
106 = pprWithSourceText st (doubleQuotes (ftext p))
107
108 pp_qual False = empty
109 pp_qual True = text "qualified"
110
111 pp_safe False = empty
112 pp_safe True = text "safe"
113
114 pp_as Nothing = empty
115 pp_as (Just a) = text "as" <+> ppr a
116
117 ppr_imp True = case mSrcText of
118 NoSourceText -> text "{-# SOURCE #-}"
119 SourceText src -> text src <+> text "#-}"
120 ppr_imp False = empty
121
122 pp_spec Nothing = empty
123 pp_spec (Just (False, (L _ ies))) = ppr_ies ies
124 pp_spec (Just (True, (L _ ies))) = text "hiding" <+> ppr_ies ies
125
126 ppr_ies [] = text "()"
127 ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'
128
129 {-
130 ************************************************************************
131 * *
132 \subsection{Imported and exported entities}
133 * *
134 ************************************************************************
135 -}
136
137 -- | A name in an import or export specfication which may have adornments. Used
138 -- primarily for accurate pretty printing of ParsedSource, and API Annotation
139 -- placement.
140 data IEWrappedName name
141 = IEName (Located name) -- ^ no extra
142 | IEPattern (Located name) -- ^ pattern X
143 | IEType (Located name) -- ^ type (:+:)
144 deriving (Eq,Data)
145
146 -- | Located name with possible adornment
147 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType',
148 -- 'ApiAnnotation.AnnPattern'
149 type LIEWrappedName name = Located (IEWrappedName name)
150 -- For details on above see note [Api annotations] in ApiAnnotation
151
152
153 -- | Located Import or Export
154 type LIE name = Located (IE name)
155 -- ^ When in a list this may have
156 --
157 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
158
159 -- For details on above see note [Api annotations] in ApiAnnotation
160
161 -- | Imported or exported entity.
162 data IE name
163 = IEVar (LIEWrappedName name)
164 -- ^ Imported or Exported Variable
165
166 | IEThingAbs (LIEWrappedName name)
167 -- ^ Imported or exported Thing with Absent list
168 --
169 -- The thing is a Class/Type (can't tell)
170 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern',
171 -- 'ApiAnnotation.AnnType','ApiAnnotation.AnnVal'
172
173 -- For details on above see note [Api annotations] in ApiAnnotation
174 -- See Note [Located RdrNames] in HsExpr
175 | IEThingAll (LIEWrappedName name)
176 -- ^ Imported or exported Thing with All imported or exported
177 --
178 -- The thing is a Class/Type and the All refers to methods/constructors
179 --
180 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
181 -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose',
182 -- 'ApiAnnotation.AnnType'
183
184 -- For details on above see note [Api annotations] in ApiAnnotation
185 -- See Note [Located RdrNames] in HsExpr
186
187 | IEThingWith (LIEWrappedName name)
188 IEWildcard
189 [LIEWrappedName name]
190 [Located (FieldLbl name)]
191 -- ^ Imported or exported Thing With given imported or exported
192 --
193 -- The thing is a Class/Type and the imported or exported things are
194 -- methods/constructors and record fields; see Note [IEThingWith]
195 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
196 -- 'ApiAnnotation.AnnClose',
197 -- 'ApiAnnotation.AnnComma',
198 -- 'ApiAnnotation.AnnType'
199
200 -- For details on above see note [Api annotations] in ApiAnnotation
201 | IEModuleContents (Located ModuleName)
202 -- ^ Imported or exported module contents
203 --
204 -- (Export Only)
205 --
206 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule'
207
208 -- For details on above see note [Api annotations] in ApiAnnotation
209 | IEGroup Int HsDocString -- ^ Doc section heading
210 | IEDoc HsDocString -- ^ Some documentation
211 | IEDocNamed String -- ^ Reference to named doc
212 deriving (Eq, Data)
213
214 -- | Imported or Exported Wildcard
215 data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)
216
217 {-
218 Note [IEThingWith]
219 ~~~~~~~~~~~~~~~~~~
220
221 A definition like
222
223 module M ( T(MkT, x) ) where
224 data T = MkT { x :: Int }
225
226 gives rise to
227
228 IEThingWith T [MkT] [FieldLabel "x" False x)] (without DuplicateRecordFields)
229 IEThingWith T [MkT] [FieldLabel "x" True $sel:x:MkT)] (with DuplicateRecordFields)
230
231 See Note [Representing fields in AvailInfo] in Avail for more details.
232 -}
233
234 ieName :: IE name -> name
235 ieName (IEVar (L _ n)) = ieWrappedName n
236 ieName (IEThingAbs (L _ n)) = ieWrappedName n
237 ieName (IEThingWith (L _ n) _ _ _) = ieWrappedName n
238 ieName (IEThingAll (L _ n)) = ieWrappedName n
239 ieName _ = panic "ieName failed pattern match!"
240
241 ieNames :: IE a -> [a]
242 ieNames (IEVar (L _ n) ) = [ieWrappedName n]
243 ieNames (IEThingAbs (L _ n) ) = [ieWrappedName n]
244 ieNames (IEThingAll (L _ n) ) = [ieWrappedName n]
245 ieNames (IEThingWith (L _ n) _ ns _) = ieWrappedName n
246 : map (ieWrappedName . unLoc) ns
247 ieNames (IEModuleContents _ ) = []
248 ieNames (IEGroup _ _ ) = []
249 ieNames (IEDoc _ ) = []
250 ieNames (IEDocNamed _ ) = []
251
252 ieWrappedName :: IEWrappedName name -> name
253 ieWrappedName (IEName (L _ n)) = n
254 ieWrappedName (IEPattern (L _ n)) = n
255 ieWrappedName (IEType (L _ n)) = n
256
257 ieLWrappedName :: LIEWrappedName name -> Located name
258 ieLWrappedName (L l n) = L l (ieWrappedName n)
259
260 replaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2
261 replaceWrappedName (IEName (L l _)) n = IEName (L l n)
262 replaceWrappedName (IEPattern (L l _)) n = IEPattern (L l n)
263 replaceWrappedName (IEType (L l _)) n = IEType (L l n)
264
265 replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2
266 replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
267
268 instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
269 ppr (IEVar var) = ppr (unLoc var)
270 ppr (IEThingAbs thing) = ppr (unLoc thing)
271 ppr (IEThingAll thing) = hcat [ppr (unLoc thing), text "(..)"]
272 ppr (IEThingWith thing wc withs flds)
273 = ppr (unLoc thing) <> parens (fsep (punctuate comma
274 (ppWiths ++
275 map (ppr . flLabel . unLoc) flds)))
276 where
277 ppWiths =
278 case wc of
279 NoIEWildcard ->
280 map (ppr . unLoc) withs
281 IEWildcard pos ->
282 let (bs, as) = splitAt pos (map (ppr . unLoc) withs)
283 in bs ++ [text ".."] ++ as
284 ppr (IEModuleContents mod')
285 = text "module" <+> ppr mod'
286 ppr (IEGroup n _) = text ("<IEGroup: " ++ show n ++ ">")
287 ppr (IEDoc doc) = ppr doc
288 ppr (IEDocNamed string) = text ("<IEDocNamed: " ++ string ++ ">")
289
290 instance (HasOccName name) => HasOccName (IEWrappedName name) where
291 occName w = occName (ieWrappedName w)
292
293 instance (OutputableBndr name, HasOccName name)
294 => OutputableBndr (IEWrappedName name) where
295 pprBndr bs w = pprBndr bs (ieWrappedName w)
296 pprPrefixOcc w = pprPrefixOcc (ieWrappedName w)
297 pprInfixOcc w = pprInfixOcc (ieWrappedName w)
298
299 instance (HasOccName name, OutputableBndr name)
300 => Outputable (IEWrappedName name) where
301 ppr (IEName n) = pprPrefixOcc (unLoc n)
302 ppr (IEPattern n) = text "pattern" <+> pprPrefixOcc (unLoc n)
303 ppr (IEType n) = text "type" <+> pprPrefixOcc (unLoc n)
304
305 pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
306 pprImpExp name = type_pref <+> pprPrefixOcc name
307 where
308 occ = occName name
309 type_pref | isTcOcc occ && isSymOcc occ = text "type"
310 | otherwise = empty