never executed always true always false
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE DeriveFunctor #-}
4 {-# LANGUAGE FlexibleInstances #-}
5
6 module GHC.Parser.Annotation (
7 -- * Core Exact Print Annotation types
8 AnnKeywordId(..),
9 EpaComment(..), EpaCommentTok(..),
10 IsUnicodeSyntax(..),
11 unicodeAnn,
12 HasE(..),
13
14 -- * In-tree Exact Print Annotations
15 AddEpAnn(..),
16 EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn,
17 TokenLocation(..),
18 DeltaPos(..), deltaPos, getDeltaLine,
19
20 EpAnn(..), Anchor(..), AnchorOperation(..),
21 spanAsAnchor, realSpanAsAnchor,
22 noAnn,
23
24 -- ** Comments in Annotations
25
26 EpAnnComments(..), LEpaComment, emptyComments,
27 getFollowingComments, setFollowingComments, setPriorComments,
28 EpAnnCO,
29
30 -- ** Annotations in 'GenLocated'
31 LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP,
32 SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN,
33 SrcSpanAnn'(..), SrcAnn,
34
35 -- ** Annotation data types used in 'GenLocated'
36
37 AnnListItem(..), AnnList(..),
38 AnnParen(..), ParenType(..), parenTypeKws,
39 AnnPragma(..),
40 AnnContext(..),
41 NameAnn(..), NameAdornment(..),
42 NoEpAnns(..),
43 AnnSortKey(..),
44
45 -- ** Trailing annotations in lists
46 TrailingAnn(..), addTrailingAnnToA, addTrailingAnnToL, addTrailingCommaToN,
47
48 -- ** Utilities for converting between different 'GenLocated' when
49 -- ** we do not care about the annotations.
50 la2na, na2la, n2l, l2n, l2l, la2la,
51 reLoc, reLocA, reLocL, reLocC, reLocN,
52
53 la2r, realSrcSpan,
54
55 -- ** Building up annotations
56 extraToAnnList, reAnn,
57 reAnnL, reAnnC,
58 addAnns, addAnnsA, widenSpan, widenAnchor, widenAnchorR, widenLocatedAn,
59
60 -- ** Querying annotations
61 getLocAnn,
62 epAnnAnns, epAnnAnnsL,
63 annParen2AddEpAnn,
64 epAnnComments,
65
66 -- ** Working with locations of annotations
67 sortLocatedA,
68 mapLocA,
69 combineLocsA,
70 combineSrcSpansA,
71 addCLocA, addCLocAA,
72
73 -- ** Constructing 'GenLocated' annotation types when we do not care
74 -- about annotations.
75 noLocA, getLocA,
76 noSrcSpanA,
77 noAnnSrcSpan,
78
79 -- ** Working with comments in annotations
80 noComments, comment, addCommentsToSrcAnn, setCommentsSrcAnn,
81 addCommentsToEpAnn, setCommentsEpAnn,
82 transferAnnsA, commentsOnlyA, removeCommentsA,
83
84 placeholderRealSpan,
85 ) where
86
87 import GHC.Prelude
88
89 import Data.Data
90 import Data.Function (on)
91 import Data.List (sortBy)
92 import Data.Semigroup
93 import GHC.Data.FastString
94 import GHC.Types.Name
95 import GHC.Types.SrcLoc
96 import GHC.Utils.Binary
97 import GHC.Utils.Outputable hiding ( (<>) )
98 import GHC.Utils.Panic
99 import qualified GHC.Data.Strict as Strict
100
101 {-
102 Note [exact print annotations]
103 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
104 Given a parse tree of a Haskell module, how can we reconstruct
105 the original Haskell source code, retaining all whitespace and
106 source code comments? We need to track the locations of all
107 elements from the original source: this includes keywords such as
108 'let' / 'in' / 'do' etc as well as punctuation such as commas and
109 braces, and also comments. We collectively refer to this
110 metadata as the "exact print annotations".
111
112 NON-COMMENT ELEMENTS
113
114 Intuitively, every AST element directly contains a bag of keywords
115 (keywords can show up more than once in a node: a semicolon i.e. newline
116 can show up multiple times before the next AST element), each of which
117 needs to be associated with its location in the original source code.
118
119 These keywords are recorded directly in the AST element in which they
120 occur, for the GhcPs phase.
121
122 For any given element in the AST, there is only a set number of
123 keywords that are applicable for it (e.g., you'll never see an
124 'import' keyword associated with a let-binding.) The set of allowed
125 keywords is documented in a comment associated with the constructor
126 of a given AST element, although the ground truth is in GHC.Parser
127 and GHC.Parser.PostProcess (which actually add the annotations).
128
129 COMMENT ELEMENTS
130
131 We associate comments with the lowest (most specific) AST element
132 enclosing them
133
134 PARSER STATE
135
136 There are three fields in PState (the parser state) which play a role
137 with annotation comments.
138
139 > comment_q :: [LEpaComment],
140 > header_comments :: Maybe [LEpaComment],
141 > eof_pos :: Maybe (RealSrcSpan, RealSrcSpan), -- pos, gap to prior token
142
143 The 'comment_q' field captures comments as they are seen in the token stream,
144 so that when they are ready to be allocated via the parser they are
145 available.
146
147 The 'header_comments' capture the comments coming at the top of the
148 source file. They are moved there from the `comment_q` when comments
149 are allocated for the first top-level declaration.
150
151 The 'eof_pos' captures the final location in the file, and the
152 location of the immediately preceding token to the last location, so
153 that the exact-printer can work out how far to advance to add the
154 trailing whitespace.
155
156 PARSER EMISSION OF ANNOTATIONS
157
158 The parser interacts with the lexer using the functions
159
160 > getCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
161 > getPriorCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
162 > getFinalCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
163
164 The 'getCommentsFor' function is the one used most often. It takes
165 the AST element SrcSpan and removes and returns any comments in the
166 'comment_q' that are inside the span. 'allocateComments' in 'Lexer' is
167 responsible for making sure we only return comments that actually fit
168 in the 'SrcSpan'.
169
170 The 'getPriorCommentsFor' function is used for top-level declarations,
171 and removes and returns any comments in the 'comment_q' that either
172 precede or are included in the given SrcSpan. This is to ensure that
173 preceding documentation comments are kept together with the
174 declaration they belong to.
175
176 The 'getFinalCommentsFor' function is called right at the end when EOF
177 is hit. This drains the 'comment_q' completely, and returns the
178 'header_comments', remaining 'comment_q' entries and the
179 'eof_pos'. These values are inserted into the 'HsModule' AST element.
180
181 The wiki page describing this feature is
182 https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations
183
184 -}
185
186 -- --------------------------------------------------------------------
187
188 -- | Exact print annotations exist so that tools can perform source to
189 -- source conversions of Haskell code. They are used to keep track of
190 -- the various syntactic keywords that are not otherwise captured in the
191 -- AST.
192 --
193 -- The wiki page describing this feature is
194 -- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations
195 -- https://gitlab.haskell.org/ghc/ghc/-/wikis/implementing-trees-that-grow/in-tree-api-annotations
196 --
197 -- Note: in general the names of these are taken from the
198 -- corresponding token, unless otherwise noted
199 -- See note [exact print annotations] above for details of the usage
200 data AnnKeywordId
201 = AnnAnyclass
202 | AnnAs
203 | AnnAt
204 | AnnBang -- ^ '!'
205 | AnnBackquote -- ^ '`'
206 | AnnBy
207 | AnnCase -- ^ case or lambda case
208 | AnnClass
209 | AnnClose -- ^ '\#)' or '\#-}' etc
210 | AnnCloseB -- ^ '|)'
211 | AnnCloseBU -- ^ '|)', unicode variant
212 | AnnCloseC -- ^ '}'
213 | AnnCloseQ -- ^ '|]'
214 | AnnCloseQU -- ^ '|]', unicode variant
215 | AnnCloseP -- ^ ')'
216 | AnnClosePH -- ^ '\#)'
217 | AnnCloseS -- ^ ']'
218 | AnnColon
219 | AnnComma -- ^ as a list separator
220 | AnnCommaTuple -- ^ in a RdrName for a tuple
221 | AnnDarrow -- ^ '=>'
222 | AnnDarrowU -- ^ '=>', unicode variant
223 | AnnData
224 | AnnDcolon -- ^ '::'
225 | AnnDcolonU -- ^ '::', unicode variant
226 | AnnDefault
227 | AnnDeriving
228 | AnnDo
229 | AnnDot -- ^ '.'
230 | AnnDotdot -- ^ '..'
231 | AnnElse
232 | AnnEqual
233 | AnnExport
234 | AnnFamily
235 | AnnForall
236 | AnnForallU -- ^ Unicode variant
237 | AnnForeign
238 | AnnFunId -- ^ for function name in matches where there are
239 -- multiple equations for the function.
240 | AnnGroup
241 | AnnHeader -- ^ for CType
242 | AnnHiding
243 | AnnIf
244 | AnnImport
245 | AnnIn
246 | AnnInfix -- ^ 'infix' or 'infixl' or 'infixr'
247 | AnnInstance
248 | AnnLam
249 | AnnLarrow -- ^ '<-'
250 | AnnLarrowU -- ^ '<-', unicode variant
251 | AnnLet
252 | AnnLollyU -- ^ The '⊸' unicode arrow
253 | AnnMdo
254 | AnnMinus -- ^ '-'
255 | AnnModule
256 | AnnNewtype
257 | AnnName -- ^ where a name loses its location in the AST, this carries it
258 | AnnOf
259 | AnnOpen -- ^ '{-\# DEPRECATED' etc. Opening of pragmas where
260 -- the capitalisation of the string can be changed by
261 -- the user. The actual text used is stored in a
262 -- 'SourceText' on the relevant pragma item.
263 | AnnOpenB -- ^ '(|'
264 | AnnOpenBU -- ^ '(|', unicode variant
265 | AnnOpenC -- ^ '{'
266 | AnnOpenE -- ^ '[e|' or '[e||'
267 | AnnOpenEQ -- ^ '[|'
268 | AnnOpenEQU -- ^ '[|', unicode variant
269 | AnnOpenP -- ^ '('
270 | AnnOpenS -- ^ '['
271 | AnnOpenPH -- ^ '(\#'
272 | AnnDollar -- ^ prefix '$' -- TemplateHaskell
273 | AnnDollarDollar -- ^ prefix '$$' -- TemplateHaskell
274 | AnnPackageName
275 | AnnPattern
276 | AnnPercent -- ^ '%' -- for HsExplicitMult
277 | AnnPercentOne -- ^ '%1' -- for HsLinearArrow
278 | AnnProc
279 | AnnQualified
280 | AnnRarrow -- ^ '->'
281 | AnnRarrowU -- ^ '->', unicode variant
282 | AnnRec
283 | AnnRole
284 | AnnSafe
285 | AnnSemi -- ^ ';'
286 | AnnSimpleQuote -- ^ '''
287 | AnnSignature
288 | AnnStatic -- ^ 'static'
289 | AnnStock
290 | AnnThen
291 | AnnThTyQuote -- ^ double '''
292 | AnnTilde -- ^ '~'
293 | AnnType
294 | AnnUnit -- ^ '()' for types
295 | AnnUsing
296 | AnnVal -- ^ e.g. INTEGER
297 | AnnValStr -- ^ String value, will need quotes when output
298 | AnnVbar -- ^ '|'
299 | AnnVia -- ^ 'via'
300 | AnnWhere
301 | Annlarrowtail -- ^ '-<'
302 | AnnlarrowtailU -- ^ '-<', unicode variant
303 | Annrarrowtail -- ^ '->'
304 | AnnrarrowtailU -- ^ '->', unicode variant
305 | AnnLarrowtail -- ^ '-<<'
306 | AnnLarrowtailU -- ^ '-<<', unicode variant
307 | AnnRarrowtail -- ^ '>>-'
308 | AnnRarrowtailU -- ^ '>>-', unicode variant
309 deriving (Eq, Ord, Data, Show)
310
311 instance Outputable AnnKeywordId where
312 ppr x = text (show x)
313
314 -- | Certain tokens can have alternate representations when unicode syntax is
315 -- enabled. This flag is attached to those tokens in the lexer so that the
316 -- original source representation can be reproduced in the corresponding
317 -- 'EpAnnotation'
318 data IsUnicodeSyntax = UnicodeSyntax | NormalSyntax
319 deriving (Eq, Ord, Data, Show)
320
321 -- | Convert a normal annotation into its unicode equivalent one
322 unicodeAnn :: AnnKeywordId -> AnnKeywordId
323 unicodeAnn AnnForall = AnnForallU
324 unicodeAnn AnnDcolon = AnnDcolonU
325 unicodeAnn AnnLarrow = AnnLarrowU
326 unicodeAnn AnnRarrow = AnnRarrowU
327 unicodeAnn AnnDarrow = AnnDarrowU
328 unicodeAnn Annlarrowtail = AnnlarrowtailU
329 unicodeAnn Annrarrowtail = AnnrarrowtailU
330 unicodeAnn AnnLarrowtail = AnnLarrowtailU
331 unicodeAnn AnnRarrowtail = AnnRarrowtailU
332 unicodeAnn AnnOpenB = AnnOpenBU
333 unicodeAnn AnnCloseB = AnnCloseBU
334 unicodeAnn AnnOpenEQ = AnnOpenEQU
335 unicodeAnn AnnCloseQ = AnnCloseQU
336 unicodeAnn ann = ann
337
338
339 -- | Some template haskell tokens have two variants, one with an `e` the other
340 -- not:
341 --
342 -- > [| or [e|
343 -- > [|| or [e||
344 --
345 -- This type indicates whether the 'e' is present or not.
346 data HasE = HasE | NoE
347 deriving (Eq, Ord, Data, Show)
348
349 -- ---------------------------------------------------------------------
350
351 data EpaComment =
352 EpaComment
353 { ac_tok :: EpaCommentTok
354 , ac_prior_tok :: RealSrcSpan
355 -- ^ The location of the prior token, used in exact printing. The
356 -- 'EpaComment' appears as an 'LEpaComment' containing its
357 -- location. The difference between the end of the prior token
358 -- and the start of this location is used for the spacing when
359 -- exact printing the comment.
360 }
361 deriving (Eq, Ord, Data, Show)
362
363 data EpaCommentTok =
364 -- Documentation annotations
365 EpaDocCommentNext String -- ^ something beginning '-- |'
366 | EpaDocCommentPrev String -- ^ something beginning '-- ^'
367 | EpaDocCommentNamed String -- ^ something beginning '-- $'
368 | EpaDocSection Int String -- ^ a section heading
369 | EpaDocOptions String -- ^ doc options (prune, ignore-exports, etc)
370 | EpaLineComment String -- ^ comment starting by "--"
371 | EpaBlockComment String -- ^ comment in {- -}
372 | EpaEofComment -- ^ empty comment, capturing
373 -- location of EOF
374
375 -- See #19697 for a discussion of EpaEofComment's use and how it
376 -- should be removed in favour of capturing it in the location for
377 -- 'Located HsModule' in the parser.
378
379 deriving (Eq, Ord, Data, Show)
380 -- Note: these are based on the Token versions, but the Token type is
381 -- defined in GHC.Parser.Lexer and bringing it in here would create a loop
382
383 instance Outputable EpaComment where
384 ppr x = text (show x)
385
386 -- ---------------------------------------------------------------------
387
388 -- | Captures an annotation, storing the @'AnnKeywordId'@ and its
389 -- location. The parser only ever inserts @'EpaLocation'@ fields with a
390 -- RealSrcSpan being the original location of the annotation in the
391 -- source file.
392 -- The @'EpaLocation'@ can also store a delta position if the AST has been
393 -- modified and needs to be pretty printed again.
394 -- The usual way an 'AddEpAnn' is created is using the 'mj' ("make
395 -- jump") function, and then it can be inserted into the appropriate
396 -- annotation.
397 data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Eq)
398
399 -- | The anchor for an @'AnnKeywordId'@. The Parser inserts the
400 -- @'EpaSpan'@ variant, giving the exact location of the original item
401 -- in the parsed source. This can be replaced by the @'EpaDelta'@
402 -- version, to provide a position for the item relative to the end of
403 -- the previous item in the source. This is useful when editing an
404 -- AST prior to exact printing the changed one. The list of comments
405 -- in the @'EpaDelta'@ variant captures any comments between the prior
406 -- output and the thing being marked here, since we cannot otherwise
407 -- sort the relative order.
408 data EpaLocation = EpaSpan !RealSrcSpan
409 | EpaDelta !DeltaPos ![LEpaComment]
410 deriving (Data,Eq,Ord)
411
412 -- | Tokens embedded in the AST have an EpaLocation, unless they come from
413 -- generated code (e.g. by TH).
414 data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation
415 deriving (Data,Eq,Ord)
416
417 -- | Spacing between output items when exact printing. It captures
418 -- the spacing from the current print position on the page to the
419 -- position required for the thing about to be printed. This is
420 -- either on the same line in which case is is simply the number of
421 -- spaces to emit, or it is some number of lines down, with a given
422 -- column offset. The exact printing algorithm keeps track of the
423 -- column offset pertaining to the current anchor position, so the
424 -- `deltaColumn` is the additional spaces to add in this case. See
425 -- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations for
426 -- details.
427 data DeltaPos
428 = SameLine { deltaColumn :: !Int }
429 | DifferentLine
430 { deltaLine :: !Int, -- ^ deltaLine should always be > 0
431 deltaColumn :: !Int
432 } deriving (Show,Eq,Ord,Data)
433
434 -- | Smart constructor for a 'DeltaPos'. It preserves the invariant
435 -- that for the 'DifferentLine' constructor 'deltaLine' is always > 0.
436 deltaPos :: Int -> Int -> DeltaPos
437 deltaPos l c = case l of
438 0 -> SameLine c
439 _ -> DifferentLine l c
440
441 getDeltaLine :: DeltaPos -> Int
442 getDeltaLine (SameLine _) = 0
443 getDeltaLine (DifferentLine r _) = r
444
445 -- | Used in the parser only, extract the 'RealSrcSpan' from an
446 -- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the
447 -- partial function is safe.
448 epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
449 epaLocationRealSrcSpan (EpaSpan r) = r
450 epaLocationRealSrcSpan (EpaDelta _ _) = panic "epaLocationRealSrcSpan"
451
452 epaLocationFromSrcAnn :: SrcAnn ann -> EpaLocation
453 epaLocationFromSrcAnn (SrcSpanAnn EpAnnNotUsed l) = EpaSpan (realSrcSpan l)
454 epaLocationFromSrcAnn (SrcSpanAnn (EpAnn anc _ _) _) = EpaSpan (anchor anc)
455
456 instance Outputable EpaLocation where
457 ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
458 ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
459
460 instance Outputable AddEpAnn where
461 ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss
462
463 instance Ord AddEpAnn where
464 compare (AddEpAnn kw1 loc1) (AddEpAnn kw2 loc2) = compare (loc1, kw1) (loc2,kw2)
465
466 -- ---------------------------------------------------------------------
467
468 -- | The exact print annotations (EPAs) are kept in the HsSyn AST for
469 -- the GhcPs phase. We do not always have EPAs though, only for code
470 -- that has been parsed as they do not exist for generated
471 -- code. This type captures that they may be missing.
472 --
473 -- A goal of the annotations is that an AST can be edited, including
474 -- moving subtrees from one place to another, duplicating them, and so
475 -- on. This means that each fragment must be self-contained. To this
476 -- end, each annotated fragment keeps track of the anchor position it
477 -- was originally captured at, being simply the start span of the
478 -- topmost element of the ast fragment. This gives us a way to later
479 -- re-calculate all Located items in this layer of the AST, as well as
480 -- any annotations captured. The comments associated with the AST
481 -- fragment are also captured here.
482 --
483 -- The 'ann' type parameter allows this general structure to be
484 -- specialised to the specific set of locations of original exact
485 -- print annotation elements. So for 'HsLet' we have
486 --
487 -- type instance XLet GhcPs = EpAnn AnnsLet
488 -- data AnnsLet
489 -- = AnnsLet {
490 -- alLet :: EpaLocation,
491 -- alIn :: EpaLocation
492 -- } deriving Data
493 --
494 -- The spacing between the items under the scope of a given EpAnn is
495 -- normally derived from the original 'Anchor'. But if a sub-element
496 -- is not in its original position, the required spacing can be
497 -- directly captured in the 'anchor_op' field of the 'entry' Anchor.
498 -- This allows us to freely move elements around, and stitch together
499 -- new AST fragments out of old ones, and have them still printed out
500 -- in a precise way.
501 data EpAnn ann
502 = EpAnn { entry :: !Anchor
503 -- ^ Base location for the start of the syntactic element
504 -- holding the annotations.
505 , anns :: !ann -- ^ Annotations added by the Parser
506 , comments :: !EpAnnComments
507 -- ^ Comments enclosed in the SrcSpan of the element
508 -- this `EpAnn` is attached to
509 }
510 | EpAnnNotUsed -- ^ No Annotation for generated code,
511 -- e.g. from TH, deriving, etc.
512 deriving (Data, Eq, Functor)
513
514 -- | An 'Anchor' records the base location for the start of the
515 -- syntactic element holding the annotations, and is used as the point
516 -- of reference for calculating delta positions for contained
517 -- annotations.
518 -- It is also normally used as the reference point for the spacing of
519 -- the element relative to its container. If it is moved, that
520 -- relationship is tracked in the 'anchor_op' instead.
521
522 data Anchor = Anchor { anchor :: RealSrcSpan
523 -- ^ Base location for the start of
524 -- the syntactic element holding
525 -- the annotations.
526 , anchor_op :: AnchorOperation }
527 deriving (Data, Eq, Show)
528
529 -- | If tools modify the parsed source, the 'MovedAnchor' variant can
530 -- directly provide the spacing for this item relative to the previous
531 -- one when printing. This allows AST fragments with a particular
532 -- anchor to be freely moved, without worrying about recalculating the
533 -- appropriate anchor span.
534 data AnchorOperation = UnchangedAnchor
535 | MovedAnchor DeltaPos
536 deriving (Data, Eq, Show)
537
538
539 spanAsAnchor :: SrcSpan -> Anchor
540 spanAsAnchor s = Anchor (realSrcSpan s) UnchangedAnchor
541
542 realSpanAsAnchor :: RealSrcSpan -> Anchor
543 realSpanAsAnchor s = Anchor s UnchangedAnchor
544
545 -- ---------------------------------------------------------------------
546
547 -- | When we are parsing we add comments that belong a particular AST
548 -- element, and print them together with the element, interleaving
549 -- them into the output stream. But when editing the AST to move
550 -- fragments around it is useful to be able to first separate the
551 -- comments into those occuring before the AST element and those
552 -- following it. The 'EpaCommentsBalanced' constructor is used to do
553 -- this. The GHC parser will only insert the 'EpaComments' form.
554 data EpAnnComments = EpaComments
555 { priorComments :: ![LEpaComment] }
556 | EpaCommentsBalanced
557 { priorComments :: ![LEpaComment]
558 , followingComments :: ![LEpaComment] }
559 deriving (Data, Eq)
560
561 type LEpaComment = GenLocated Anchor EpaComment
562
563 emptyComments :: EpAnnComments
564 emptyComments = EpaComments []
565
566 -- ---------------------------------------------------------------------
567 -- Annotations attached to a 'SrcSpan'.
568 -- ---------------------------------------------------------------------
569
570 -- | The 'SrcSpanAnn\'' type wraps a normal 'SrcSpan', together with
571 -- an extra annotation type. This is mapped to a specific `GenLocated`
572 -- usage in the AST through the `XRec` and `Anno` type families.
573
574 -- Important that the fields are strict as these live inside L nodes which
575 -- are live for a long time.
576 data SrcSpanAnn' a = SrcSpanAnn { ann :: !a, locA :: !SrcSpan }
577 deriving (Data, Eq)
578 -- See Note [XRec and Anno in the AST]
579
580 -- | We mostly use 'SrcSpanAnn\'' with an 'EpAnn\''
581 type SrcAnn ann = SrcSpanAnn' (EpAnn ann)
582
583 type LocatedA = GenLocated SrcSpanAnnA
584 type LocatedN = GenLocated SrcSpanAnnN
585
586 type LocatedL = GenLocated SrcSpanAnnL
587 type LocatedP = GenLocated SrcSpanAnnP
588 type LocatedC = GenLocated SrcSpanAnnC
589
590 type SrcSpanAnnA = SrcAnn AnnListItem
591 type SrcSpanAnnN = SrcAnn NameAnn
592
593 type SrcSpanAnnL = SrcAnn AnnList
594 type SrcSpanAnnP = SrcAnn AnnPragma
595 type SrcSpanAnnC = SrcAnn AnnContext
596
597 -- | General representation of a 'GenLocated' type carrying a
598 -- parameterised annotation type.
599 type LocatedAn an = GenLocated (SrcAnn an)
600
601 {-
602 Note [XRec and Anno in the AST]
603 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
604
605 The exact print annotations are captured directly inside the AST, using
606 TTG extension points. However certain annotations need to be captured
607 on the Located versions too. While there is a general form for these,
608 captured in the type SrcSpanAnn', there are also specific usages in
609 different contexts.
610
611 Some of the particular use cases are
612
613 1) RdrNames, which can have additional items such as backticks or parens
614
615 2) Items which occur in lists, and the annotation relates purely
616 to its usage inside a list.
617
618 See the section above this note for the rest.
619
620 The Anno type family maps the specific SrcSpanAnn' variant for a given
621 item.
622
623 So
624
625 type instance XRec (GhcPass p) a = GenLocated (Anno a) a
626 type instance Anno RdrName = SrcSpanAnnN
627 type LocatedN = GenLocated SrcSpanAnnN
628
629 meaning we can have type LocatedN RdrName
630
631 -}
632
633 -- ---------------------------------------------------------------------
634 -- Annotations for items in a list
635 -- ---------------------------------------------------------------------
636
637 -- | Captures the location of punctuation occuring between items,
638 -- normally in a list. It is captured as a trailing annotation.
639 data TrailingAnn
640 = AddSemiAnn EpaLocation -- ^ Trailing ';'
641 | AddCommaAnn EpaLocation -- ^ Trailing ','
642 | AddVbarAnn EpaLocation -- ^ Trailing '|'
643 deriving (Data, Eq, Ord)
644
645 instance Outputable TrailingAnn where
646 ppr (AddSemiAnn ss) = text "AddSemiAnn" <+> ppr ss
647 ppr (AddCommaAnn ss) = text "AddCommaAnn" <+> ppr ss
648 ppr (AddVbarAnn ss) = text "AddVbarAnn" <+> ppr ss
649
650 -- | Annotation for items appearing in a list. They can have one or
651 -- more trailing punctuations items, such as commas or semicolons.
652 data AnnListItem
653 = AnnListItem {
654 lann_trailing :: [TrailingAnn]
655 }
656 deriving (Data, Eq)
657
658 -- ---------------------------------------------------------------------
659 -- Annotations for the context of a list of items
660 -- ---------------------------------------------------------------------
661
662 -- | Annotation for the "container" of a list. This captures
663 -- surrounding items such as braces if present, and introductory
664 -- keywords such as 'where'.
665 data AnnList
666 = AnnList {
667 al_anchor :: Maybe Anchor, -- ^ start point of a list having layout
668 al_open :: Maybe AddEpAnn,
669 al_close :: Maybe AddEpAnn,
670 al_rest :: [AddEpAnn], -- ^ context, such as 'where' keyword
671 al_trailing :: [TrailingAnn] -- ^ items appearing after the
672 -- list, such as '=>' for a
673 -- context
674 } deriving (Data,Eq)
675
676 -- ---------------------------------------------------------------------
677 -- Annotations for parenthesised elements, such as tuples, lists
678 -- ---------------------------------------------------------------------
679
680 -- | exact print annotation for an item having surrounding "brackets", such as
681 -- tuples or lists
682 data AnnParen
683 = AnnParen {
684 ap_adornment :: ParenType,
685 ap_open :: EpaLocation,
686 ap_close :: EpaLocation
687 } deriving (Data)
688
689 -- | Detail of the "brackets" used in an 'AnnParen' exact print annotation.
690 data ParenType
691 = AnnParens -- ^ '(', ')'
692 | AnnParensHash -- ^ '(#', '#)'
693 | AnnParensSquare -- ^ '[', ']'
694 deriving (Eq, Ord, Data)
695
696 -- | Maps the 'ParenType' to the related opening and closing
697 -- AnnKeywordId. Used when actually printing the item.
698 parenTypeKws :: ParenType -> (AnnKeywordId, AnnKeywordId)
699 parenTypeKws AnnParens = (AnnOpenP, AnnCloseP)
700 parenTypeKws AnnParensHash = (AnnOpenPH, AnnClosePH)
701 parenTypeKws AnnParensSquare = (AnnOpenS, AnnCloseS)
702
703 -- ---------------------------------------------------------------------
704
705 -- | Exact print annotation for the 'Context' data type.
706 data AnnContext
707 = AnnContext {
708 ac_darrow :: Maybe (IsUnicodeSyntax, EpaLocation),
709 -- ^ location and encoding of the '=>', if present.
710 ac_open :: [EpaLocation], -- ^ zero or more opening parentheses.
711 ac_close :: [EpaLocation] -- ^ zero or more closing parentheses.
712 } deriving (Data)
713
714
715 -- ---------------------------------------------------------------------
716 -- Annotations for names
717 -- ---------------------------------------------------------------------
718
719 -- | exact print annotations for a 'RdrName'. There are many kinds of
720 -- adornment that can be attached to a given 'RdrName'. This type
721 -- captures them, as detailed on the individual constructors.
722 data NameAnn
723 -- | Used for a name with an adornment, so '`foo`', '(bar)'
724 = NameAnn {
725 nann_adornment :: NameAdornment,
726 nann_open :: EpaLocation,
727 nann_name :: EpaLocation,
728 nann_close :: EpaLocation,
729 nann_trailing :: [TrailingAnn]
730 }
731 -- | Used for @(,,,)@, or @(#,,,#)#
732 | NameAnnCommas {
733 nann_adornment :: NameAdornment,
734 nann_open :: EpaLocation,
735 nann_commas :: [EpaLocation],
736 nann_close :: EpaLocation,
737 nann_trailing :: [TrailingAnn]
738 }
739 -- | Used for @()@, @(##)@, @[]@
740 | NameAnnOnly {
741 nann_adornment :: NameAdornment,
742 nann_open :: EpaLocation,
743 nann_close :: EpaLocation,
744 nann_trailing :: [TrailingAnn]
745 }
746 -- | Used for @->@, as an identifier
747 | NameAnnRArrow {
748 nann_name :: EpaLocation,
749 nann_trailing :: [TrailingAnn]
750 }
751 -- | Used for an item with a leading @'@. The annotation for
752 -- unquoted item is stored in 'nann_quoted'.
753 | NameAnnQuote {
754 nann_quote :: EpaLocation,
755 nann_quoted :: SrcSpanAnnN,
756 nann_trailing :: [TrailingAnn]
757 }
758 -- | Used when adding a 'TrailingAnn' to an existing 'LocatedN'
759 -- which has no Api Annotation (via the 'EpAnnNotUsed' constructor.
760 | NameAnnTrailing {
761 nann_trailing :: [TrailingAnn]
762 }
763 deriving (Data, Eq)
764
765 -- | A 'NameAnn' can capture the locations of surrounding adornments,
766 -- such as parens or backquotes. This data type identifies what
767 -- particular pair are being used.
768 data NameAdornment
769 = NameParens -- ^ '(' ')'
770 | NameParensHash -- ^ '(#' '#)'
771 | NameBackquotes -- ^ '`'
772 | NameSquare -- ^ '[' ']'
773 deriving (Eq, Ord, Data)
774
775 -- ---------------------------------------------------------------------
776
777 -- | exact print annotation used for capturing the locations of
778 -- annotations in pragmas.
779 data AnnPragma
780 = AnnPragma {
781 apr_open :: AddEpAnn,
782 apr_close :: AddEpAnn,
783 apr_rest :: [AddEpAnn]
784 } deriving (Data,Eq)
785
786 -- ---------------------------------------------------------------------
787 -- | Captures the sort order of sub elements. This is needed when the
788 -- sub-elements have been split (as in a HsLocalBind which holds separate
789 -- binds and sigs) or for infix patterns where the order has been
790 -- re-arranged. It is captured explicitly so that after the Delta phase a
791 -- SrcSpan is used purely as an index into the annotations, allowing
792 -- transformations of the AST including the introduction of new Located
793 -- items or re-arranging existing ones.
794 data AnnSortKey
795 = NoAnnSortKey
796 | AnnSortKey [RealSrcSpan]
797 deriving (Data, Eq)
798
799 -- ---------------------------------------------------------------------
800
801
802 -- | Helper function used in the parser to add a 'TrailingAnn' items
803 -- to an existing annotation.
804 addTrailingAnnToL :: SrcSpan -> TrailingAnn -> EpAnnComments
805 -> EpAnn AnnList -> EpAnn AnnList
806 addTrailingAnnToL s t cs EpAnnNotUsed
807 = EpAnn (spanAsAnchor s) (AnnList (Just $ spanAsAnchor s) Nothing Nothing [] [t]) cs
808 addTrailingAnnToL _ t cs n = n { anns = addTrailing (anns n)
809 , comments = comments n <> cs }
810 where
811 -- See Note [list append in addTrailing*]
812 addTrailing n = n { al_trailing = al_trailing n ++ [t]}
813
814 -- | Helper function used in the parser to add a 'TrailingAnn' items
815 -- to an existing annotation.
816 addTrailingAnnToA :: SrcSpan -> TrailingAnn -> EpAnnComments
817 -> EpAnn AnnListItem -> EpAnn AnnListItem
818 addTrailingAnnToA s t cs EpAnnNotUsed
819 = EpAnn (spanAsAnchor s) (AnnListItem [t]) cs
820 addTrailingAnnToA _ t cs n = n { anns = addTrailing (anns n)
821 , comments = comments n <> cs }
822 where
823 -- See Note [list append in addTrailing*]
824 addTrailing n = n { lann_trailing = lann_trailing n ++ [t] }
825
826 -- | Helper function used in the parser to add a comma location to an
827 -- existing annotation.
828 addTrailingCommaToN :: SrcSpan -> EpAnn NameAnn -> EpaLocation -> EpAnn NameAnn
829 addTrailingCommaToN s EpAnnNotUsed l
830 = EpAnn (spanAsAnchor s) (NameAnnTrailing [AddCommaAnn l]) emptyComments
831 addTrailingCommaToN _ n l = n { anns = addTrailing (anns n) l }
832 where
833 -- See Note [list append in addTrailing*]
834 addTrailing :: NameAnn -> EpaLocation -> NameAnn
835 addTrailing n l = n { nann_trailing = nann_trailing n ++ [AddCommaAnn l]}
836
837 {-
838 Note [list append in addTrailing*]
839 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
840 The addTrailingAnnToL, addTrailingAnnToA and addTrailingCommaToN
841 functions are used to add a separator for an item when it occurs in a
842 list. So they are used to capture a comma, vbar, semicolon and similar.
843
844 In general, a given element will have zero or one of these. In
845 extreme (test) cases, there may be multiple semicolons.
846
847 In exact printing we sometimes convert the EpaLocation variant for an
848 trailing annotation to the EpaDelta variant, which cannot be sorted.
849
850 Hence it is critical that these annotations are captured in the order
851 they appear in the original source file.
852
853 And so we use the less efficient list append to preserve the order,
854 knowing that in most cases the original list is empty.
855 -}
856
857 -- ---------------------------------------------------------------------
858
859 -- |Helper function (temporary) during transition of names
860 -- Discards any annotations
861 l2n :: LocatedAn a1 a2 -> LocatedN a2
862 l2n (L la a) = L (noAnnSrcSpan (locA la)) a
863
864 n2l :: LocatedN a -> LocatedA a
865 n2l (L la a) = L (na2la la) a
866
867 -- |Helper function (temporary) during transition of names
868 -- Discards any annotations
869 la2na :: SrcSpanAnn' a -> SrcSpanAnnN
870 la2na l = noAnnSrcSpan (locA l)
871
872 -- |Helper function (temporary) during transition of names
873 -- Discards any annotations
874 la2la :: LocatedAn ann1 a2 -> LocatedAn ann2 a2
875 la2la (L la a) = L (noAnnSrcSpan (locA la)) a
876
877 l2l :: SrcSpanAnn' a -> SrcAnn ann
878 l2l l = noAnnSrcSpan (locA l)
879
880 -- |Helper function (temporary) during transition of names
881 -- Discards any annotations
882 na2la :: SrcSpanAnn' a -> SrcAnn ann
883 na2la l = noAnnSrcSpan (locA l)
884
885 reLoc :: LocatedAn a e -> Located e
886 reLoc (L (SrcSpanAnn _ l) a) = L l a
887
888 reLocA :: Located e -> LocatedAn ann e
889 reLocA (L l a) = (L (SrcSpanAnn EpAnnNotUsed l) a)
890
891 reLocL :: LocatedN e -> LocatedA e
892 reLocL (L l a) = (L (na2la l) a)
893
894 reLocC :: LocatedN e -> LocatedC e
895 reLocC (L l a) = (L (na2la l) a)
896
897 reLocN :: LocatedN a -> Located a
898 reLocN (L (SrcSpanAnn _ l) a) = L l a
899
900 -- ---------------------------------------------------------------------
901
902 realSrcSpan :: SrcSpan -> RealSrcSpan
903 realSrcSpan (RealSrcSpan s _) = s
904 realSrcSpan _ = mkRealSrcSpan l l -- AZ temporary
905 where
906 l = mkRealSrcLoc (fsLit "foo") (-1) (-1)
907
908 la2r :: SrcSpanAnn' a -> RealSrcSpan
909 la2r l = realSrcSpan (locA l)
910
911 extraToAnnList :: AnnList -> [AddEpAnn] -> AnnList
912 extraToAnnList (AnnList a o c e t) as = AnnList a o c (e++as) t
913
914 reAnn :: [TrailingAnn] -> EpAnnComments -> Located a -> LocatedA a
915 reAnn anns cs (L l a) = L (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnListItem anns) cs) l) a
916
917 reAnnC :: AnnContext -> EpAnnComments -> Located a -> LocatedC a
918 reAnnC anns cs (L l a) = L (SrcSpanAnn (EpAnn (spanAsAnchor l) anns cs) l) a
919
920 reAnnL :: ann -> EpAnnComments -> Located e -> GenLocated (SrcAnn ann) e
921 reAnnL anns cs (L l a) = L (SrcSpanAnn (EpAnn (spanAsAnchor l) anns cs) l) a
922
923 getLocAnn :: Located a -> SrcSpanAnnA
924 getLocAnn (L l _) = SrcSpanAnn EpAnnNotUsed l
925
926
927 getLocA :: GenLocated (SrcSpanAnn' a) e -> SrcSpan
928 getLocA (L (SrcSpanAnn _ l) _) = l
929
930 noLocA :: a -> LocatedAn an a
931 noLocA = L (SrcSpanAnn EpAnnNotUsed noSrcSpan)
932
933 noAnnSrcSpan :: SrcSpan -> SrcAnn ann
934 noAnnSrcSpan l = SrcSpanAnn EpAnnNotUsed l
935
936 noSrcSpanA :: SrcAnn ann
937 noSrcSpanA = noAnnSrcSpan noSrcSpan
938
939 -- | Short form for 'EpAnnNotUsed'
940 noAnn :: EpAnn a
941 noAnn = EpAnnNotUsed
942
943
944 addAnns :: EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
945 addAnns (EpAnn l as1 cs) as2 cs2
946 = EpAnn (widenAnchor l (as1 ++ as2)) (as1 ++ as2) (cs <> cs2)
947 addAnns EpAnnNotUsed [] (EpaComments []) = EpAnnNotUsed
948 addAnns EpAnnNotUsed [] (EpaCommentsBalanced [] []) = EpAnnNotUsed
949 addAnns EpAnnNotUsed as cs = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) as cs
950
951 -- AZ:TODO use widenSpan here too
952 addAnnsA :: SrcSpanAnnA -> [TrailingAnn] -> EpAnnComments -> SrcSpanAnnA
953 addAnnsA (SrcSpanAnn (EpAnn l as1 cs) loc) as2 cs2
954 = SrcSpanAnn (EpAnn l (AnnListItem (lann_trailing as1 ++ as2)) (cs <> cs2)) loc
955 addAnnsA (SrcSpanAnn EpAnnNotUsed loc) [] (EpaComments [])
956 = SrcSpanAnn EpAnnNotUsed loc
957 addAnnsA (SrcSpanAnn EpAnnNotUsed loc) [] (EpaCommentsBalanced [] [])
958 = SrcSpanAnn EpAnnNotUsed loc
959 addAnnsA (SrcSpanAnn EpAnnNotUsed loc) as cs
960 = SrcSpanAnn (EpAnn (spanAsAnchor loc) (AnnListItem as) cs) loc
961
962 -- | The annotations need to all come after the anchor. Make sure
963 -- this is the case.
964 widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan
965 widenSpan s as = foldl combineSrcSpans s (go as)
966 where
967 go [] = []
968 go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Strict.Nothing : go rest
969 go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
970
971 -- | The annotations need to all come after the anchor. Make sure
972 -- this is the case.
973 widenRealSpan :: RealSrcSpan -> [AddEpAnn] -> RealSrcSpan
974 widenRealSpan s as = foldl combineRealSrcSpans s (go as)
975 where
976 go [] = []
977 go (AddEpAnn _ (EpaSpan s):rest) = s : go rest
978 go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
979
980 widenAnchor :: Anchor -> [AddEpAnn] -> Anchor
981 widenAnchor (Anchor s op) as = Anchor (widenRealSpan s as) op
982
983 widenAnchorR :: Anchor -> RealSrcSpan -> Anchor
984 widenAnchorR (Anchor s op) r = Anchor (combineRealSrcSpans s r) op
985
986 widenLocatedAn :: SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an
987 widenLocatedAn (SrcSpanAnn a l) as = SrcSpanAnn a (widenSpan l as)
988
989 epAnnAnnsL :: EpAnn a -> [a]
990 epAnnAnnsL EpAnnNotUsed = []
991 epAnnAnnsL (EpAnn _ anns _) = [anns]
992
993 epAnnAnns :: EpAnn [AddEpAnn] -> [AddEpAnn]
994 epAnnAnns EpAnnNotUsed = []
995 epAnnAnns (EpAnn _ anns _) = anns
996
997 annParen2AddEpAnn :: EpAnn AnnParen -> [AddEpAnn]
998 annParen2AddEpAnn EpAnnNotUsed = []
999 annParen2AddEpAnn (EpAnn _ (AnnParen pt o c) _)
1000 = [AddEpAnn ai o, AddEpAnn ac c]
1001 where
1002 (ai,ac) = parenTypeKws pt
1003
1004 epAnnComments :: EpAnn an -> EpAnnComments
1005 epAnnComments EpAnnNotUsed = EpaComments []
1006 epAnnComments (EpAnn _ _ cs) = cs
1007
1008 -- ---------------------------------------------------------------------
1009 -- sortLocatedA :: [LocatedA a] -> [LocatedA a]
1010 sortLocatedA :: [GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e]
1011 sortLocatedA = sortBy (leftmost_smallest `on` getLocA)
1012
1013 mapLocA :: (a -> b) -> GenLocated SrcSpan a -> GenLocated (SrcAnn ann) b
1014 mapLocA f (L l a) = L (noAnnSrcSpan l) (f a)
1015
1016 -- AZ:TODO: move this somewhere sane
1017
1018 combineLocsA :: Semigroup a => GenLocated (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn a
1019 combineLocsA (L a _) (L b _) = combineSrcSpansA a b
1020
1021 combineSrcSpansA :: Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
1022 combineSrcSpansA (SrcSpanAnn aa la) (SrcSpanAnn ab lb)
1023 = case SrcSpanAnn (aa <> ab) (combineSrcSpans la lb) of
1024 SrcSpanAnn EpAnnNotUsed l -> SrcSpanAnn EpAnnNotUsed l
1025 SrcSpanAnn (EpAnn anc an cs) l ->
1026 SrcSpanAnn (EpAnn (widenAnchorR anc (realSrcSpan l)) an cs) l
1027
1028 -- | Combine locations from two 'Located' things and add them to a third thing
1029 addCLocA :: GenLocated (SrcSpanAnn' a) e1 -> GenLocated SrcSpan e2 -> e3 -> GenLocated (SrcAnn ann) e3
1030 addCLocA a b c = L (noAnnSrcSpan $ combineSrcSpans (locA $ getLoc a) (getLoc b)) c
1031
1032 addCLocAA :: GenLocated (SrcSpanAnn' a1) e1 -> GenLocated (SrcSpanAnn' a2) e2 -> e3 -> GenLocated (SrcAnn ann) e3
1033 addCLocAA a b c = L (noAnnSrcSpan $ combineSrcSpans (locA $ getLoc a) (locA $ getLoc b)) c
1034
1035 -- ---------------------------------------------------------------------
1036 -- Utilities for manipulating EpAnnComments
1037 -- ---------------------------------------------------------------------
1038
1039 getFollowingComments :: EpAnnComments -> [LEpaComment]
1040 getFollowingComments (EpaComments _) = []
1041 getFollowingComments (EpaCommentsBalanced _ cs) = cs
1042
1043 setFollowingComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
1044 setFollowingComments (EpaComments ls) cs = EpaCommentsBalanced ls cs
1045 setFollowingComments (EpaCommentsBalanced ls _) cs = EpaCommentsBalanced ls cs
1046
1047 setPriorComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
1048 setPriorComments (EpaComments _) cs = EpaComments cs
1049 setPriorComments (EpaCommentsBalanced _ ts) cs = EpaCommentsBalanced cs ts
1050
1051 -- ---------------------------------------------------------------------
1052 -- Comment-only annotations
1053 -- ---------------------------------------------------------------------
1054
1055 type EpAnnCO = EpAnn NoEpAnns -- ^ Api Annotations for comments only
1056
1057 data NoEpAnns = NoEpAnns
1058 deriving (Data,Eq,Ord)
1059
1060 noComments ::EpAnnCO
1061 noComments = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) NoEpAnns emptyComments
1062
1063 -- TODO:AZ get rid of this
1064 placeholderRealSpan :: RealSrcSpan
1065 placeholderRealSpan = realSrcLocSpan (mkRealSrcLoc (mkFastString "placeholder") (-1) (-1))
1066
1067 comment :: RealSrcSpan -> EpAnnComments -> EpAnnCO
1068 comment loc cs = EpAnn (Anchor loc UnchangedAnchor) NoEpAnns cs
1069
1070 -- ---------------------------------------------------------------------
1071 -- Utilities for managing comments in an `EpAnn a` structure.
1072 -- ---------------------------------------------------------------------
1073
1074 -- | Add additional comments to a 'SrcAnn', used for manipulating the
1075 -- AST prior to exact printing the changed one.
1076 addCommentsToSrcAnn :: (Monoid ann) => SrcAnn ann -> EpAnnComments -> SrcAnn ann
1077 addCommentsToSrcAnn (SrcSpanAnn EpAnnNotUsed loc) cs
1078 = SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs) loc
1079 addCommentsToSrcAnn (SrcSpanAnn (EpAnn a an cs) loc) cs'
1080 = SrcSpanAnn (EpAnn a an (cs <> cs')) loc
1081
1082 -- | Replace any existing comments on a 'SrcAnn', used for manipulating the
1083 -- AST prior to exact printing the changed one.
1084 setCommentsSrcAnn :: (Monoid ann) => SrcAnn ann -> EpAnnComments -> SrcAnn ann
1085 setCommentsSrcAnn (SrcSpanAnn EpAnnNotUsed loc) cs
1086 = SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs) loc
1087 setCommentsSrcAnn (SrcSpanAnn (EpAnn a an _) loc) cs
1088 = SrcSpanAnn (EpAnn a an cs) loc
1089
1090 -- | Add additional comments, used for manipulating the
1091 -- AST prior to exact printing the changed one.
1092 addCommentsToEpAnn :: (Monoid a)
1093 => SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
1094 addCommentsToEpAnn loc EpAnnNotUsed cs
1095 = EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs
1096 addCommentsToEpAnn _ (EpAnn a an ocs) ncs = EpAnn a an (ocs <> ncs)
1097
1098 -- | Replace any existing comments, used for manipulating the
1099 -- AST prior to exact printing the changed one.
1100 setCommentsEpAnn :: (Monoid a)
1101 => SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
1102 setCommentsEpAnn loc EpAnnNotUsed cs
1103 = EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs
1104 setCommentsEpAnn _ (EpAnn a an _) cs = EpAnn a an cs
1105
1106 -- | Transfer comments and trailing items from the annotations in the
1107 -- first 'SrcSpanAnnA' argument to those in the second.
1108 transferAnnsA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
1109 transferAnnsA from@(SrcSpanAnn EpAnnNotUsed _) to = (from, to)
1110 transferAnnsA (SrcSpanAnn (EpAnn a an cs) l) to
1111 = ((SrcSpanAnn (EpAnn a mempty emptyComments) l), to')
1112 where
1113 to' = case to of
1114 (SrcSpanAnn EpAnnNotUsed loc)
1115 -> SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) an cs) loc
1116 (SrcSpanAnn (EpAnn a an' cs') loc)
1117 -> SrcSpanAnn (EpAnn a (an' <> an) (cs' <> cs)) loc
1118
1119 -- | Remove the exact print annotations payload, leaving only the
1120 -- anchor and comments.
1121 commentsOnlyA :: Monoid ann => SrcAnn ann -> SrcAnn ann
1122 commentsOnlyA (SrcSpanAnn EpAnnNotUsed loc) = SrcSpanAnn EpAnnNotUsed loc
1123 commentsOnlyA (SrcSpanAnn (EpAnn a _ cs) loc) = (SrcSpanAnn (EpAnn a mempty cs) loc)
1124
1125 -- | Remove the comments, leaving the exact print annotations payload
1126 removeCommentsA :: SrcAnn ann -> SrcAnn ann
1127 removeCommentsA (SrcSpanAnn EpAnnNotUsed loc) = SrcSpanAnn EpAnnNotUsed loc
1128 removeCommentsA (SrcSpanAnn (EpAnn a an _) loc)
1129 = (SrcSpanAnn (EpAnn a an emptyComments) loc)
1130
1131 -- ---------------------------------------------------------------------
1132 -- Semigroup instances, to allow easy combination of annotaion elements
1133 -- ---------------------------------------------------------------------
1134
1135 instance (Semigroup an) => Semigroup (SrcSpanAnn' an) where
1136 (SrcSpanAnn a1 l1) <> (SrcSpanAnn a2 l2) = SrcSpanAnn (a1 <> a2) (combineSrcSpans l1 l2)
1137 -- The critical part about the location is its left edge, and all
1138 -- annotations must follow it. So we combine them which yields the
1139 -- largest span
1140
1141 instance (Semigroup a) => Semigroup (EpAnn a) where
1142 EpAnnNotUsed <> x = x
1143 x <> EpAnnNotUsed = x
1144 (EpAnn l1 a1 b1) <> (EpAnn l2 a2 b2) = EpAnn (l1 <> l2) (a1 <> a2) (b1 <> b2)
1145 -- The critical part about the anchor is its left edge, and all
1146 -- annotations must follow it. So we combine them which yields the
1147 -- largest span
1148
1149 instance Ord Anchor where
1150 compare (Anchor s1 _) (Anchor s2 _) = compare s1 s2
1151
1152 instance Semigroup Anchor where
1153 Anchor r1 o1 <> Anchor r2 _ = Anchor (combineRealSrcSpans r1 r2) o1
1154
1155 instance Semigroup EpAnnComments where
1156 EpaComments cs1 <> EpaComments cs2 = EpaComments (cs1 ++ cs2)
1157 EpaComments cs1 <> EpaCommentsBalanced cs2 as2 = EpaCommentsBalanced (cs1 ++ cs2) as2
1158 EpaCommentsBalanced cs1 as1 <> EpaComments cs2 = EpaCommentsBalanced (cs1 ++ cs2) as1
1159 EpaCommentsBalanced cs1 as1 <> EpaCommentsBalanced cs2 as2 = EpaCommentsBalanced (cs1 ++ cs2) (as1++as2)
1160
1161
1162 instance (Monoid a) => Monoid (EpAnn a) where
1163 mempty = EpAnnNotUsed
1164
1165 instance Semigroup NoEpAnns where
1166 _ <> _ = NoEpAnns
1167
1168 instance Semigroup AnnListItem where
1169 (AnnListItem l1) <> (AnnListItem l2) = AnnListItem (l1 <> l2)
1170
1171 instance Monoid AnnListItem where
1172 mempty = AnnListItem []
1173
1174
1175 instance Semigroup AnnList where
1176 (AnnList a1 o1 c1 r1 t1) <> (AnnList a2 o2 c2 r2 t2)
1177 = AnnList (a1 <> a2) (c o1 o2) (c c1 c2) (r1 <> r2) (t1 <> t2)
1178 where
1179 -- Left biased combination for the open and close annotations
1180 c Nothing x = x
1181 c x Nothing = x
1182 c f _ = f
1183
1184 instance Monoid AnnList where
1185 mempty = AnnList Nothing Nothing Nothing [] []
1186
1187 instance Semigroup NameAnn where
1188 _ <> _ = panic "semigroup nameann"
1189
1190 instance Monoid NameAnn where
1191 mempty = NameAnnTrailing []
1192
1193
1194 instance Semigroup AnnSortKey where
1195 NoAnnSortKey <> x = x
1196 x <> NoAnnSortKey = x
1197 AnnSortKey ls1 <> AnnSortKey ls2 = AnnSortKey (ls1 <> ls2)
1198
1199 instance Monoid AnnSortKey where
1200 mempty = NoAnnSortKey
1201
1202 instance (Outputable a) => Outputable (EpAnn a) where
1203 ppr (EpAnn l a c) = text "EpAnn" <+> ppr l <+> ppr a <+> ppr c
1204 ppr EpAnnNotUsed = text "EpAnnNotUsed"
1205
1206 instance Outputable NoEpAnns where
1207 ppr NoEpAnns = text "NoEpAnns"
1208
1209 instance Outputable Anchor where
1210 ppr (Anchor a o) = text "Anchor" <+> ppr a <+> ppr o
1211
1212 instance Outputable AnchorOperation where
1213 ppr UnchangedAnchor = text "UnchangedAnchor"
1214 ppr (MovedAnchor d) = text "MovedAnchor" <+> ppr d
1215
1216 instance Outputable DeltaPos where
1217 ppr (SameLine c) = text "SameLine" <+> ppr c
1218 ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c
1219
1220 instance Outputable (GenLocated Anchor EpaComment) where
1221 ppr (L l c) = text "L" <+> ppr l <+> ppr c
1222
1223 instance Outputable EpAnnComments where
1224 ppr (EpaComments cs) = text "EpaComments" <+> ppr cs
1225 ppr (EpaCommentsBalanced cs ts) = text "EpaCommentsBalanced" <+> ppr cs <+> ppr ts
1226
1227 instance (NamedThing (Located a)) => NamedThing (LocatedAn an a) where
1228 getName (L l a) = getName (L (locA l) a)
1229
1230 instance Outputable AnnContext where
1231 ppr (AnnContext a o c) = text "AnnContext" <+> ppr a <+> ppr o <+> ppr c
1232
1233 instance Outputable AnnSortKey where
1234 ppr NoAnnSortKey = text "NoAnnSortKey"
1235 ppr (AnnSortKey ls) = text "AnnSortKey" <+> ppr ls
1236
1237 instance Outputable IsUnicodeSyntax where
1238 ppr = text . show
1239
1240 instance Binary a => Binary (LocatedL a) where
1241 -- We do not serialise the annotations
1242 put_ bh (L l x) = do
1243 put_ bh (locA l)
1244 put_ bh x
1245
1246 get bh = do
1247 l <- get bh
1248 x <- get bh
1249 return (L (noAnnSrcSpan l) x)
1250
1251 instance (Outputable a) => Outputable (SrcSpanAnn' a) where
1252 ppr (SrcSpanAnn a l) = text "SrcSpanAnn" <+> ppr a <+> ppr l
1253
1254 instance (Outputable a, Outputable e)
1255 => Outputable (GenLocated (SrcSpanAnn' a) e) where
1256 ppr = pprLocated
1257
1258 instance (Outputable a, OutputableBndr e)
1259 => OutputableBndr (GenLocated (SrcSpanAnn' a) e) where
1260 pprInfixOcc = pprInfixOcc . unLoc
1261 pprPrefixOcc = pprPrefixOcc . unLoc
1262
1263 instance Outputable AnnListItem where
1264 ppr (AnnListItem ts) = text "AnnListItem" <+> ppr ts
1265
1266 instance Outputable NameAdornment where
1267 ppr NameParens = text "NameParens"
1268 ppr NameParensHash = text "NameParensHash"
1269 ppr NameBackquotes = text "NameBackquotes"
1270 ppr NameSquare = text "NameSquare"
1271
1272 instance Outputable NameAnn where
1273 ppr (NameAnn a o n c t)
1274 = text "NameAnn" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t
1275 ppr (NameAnnCommas a o n c t)
1276 = text "NameAnnCommas" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t
1277 ppr (NameAnnOnly a o c t)
1278 = text "NameAnnOnly" <+> ppr a <+> ppr o <+> ppr c <+> ppr t
1279 ppr (NameAnnRArrow n t)
1280 = text "NameAnnRArrow" <+> ppr n <+> ppr t
1281 ppr (NameAnnQuote q n t)
1282 = text "NameAnnQuote" <+> ppr q <+> ppr n <+> ppr t
1283 ppr (NameAnnTrailing t)
1284 = text "NameAnnTrailing" <+> ppr t
1285
1286 instance Outputable AnnList where
1287 ppr (AnnList a o c r t)
1288 = text "AnnList" <+> ppr a <+> ppr o <+> ppr c <+> ppr r <+> ppr t
1289
1290 instance Outputable AnnPragma where
1291 ppr (AnnPragma o c r) = text "AnnPragma" <+> ppr o <+> ppr c <+> ppr r