@@ -1,186 +1,205 @@
1−-- | Helpers for formatting of comments.
2−
31{-# LANGUAGE LambdaCase #-}
42{-# LANGUAGE OverloadedStrings #-}
53
4+-- | Helpers for formatting of comments.
5+
66module Ormolu.Printer.Comments
7− ( -- * Types
8− Decoration (..)
9− , Decorator (..)
10− , Position (..)
11− , CommentMode (..)
12− -- * Functions for working with comments
13− , spitComments
14− , partitionDPs
15− , addDecoration
7+ ( spitPrecedingComments
8+ , spitFollowingComments
9+ , spitRemainingComments
1610 )
1711where
1812
19−import ApiAnnotation (AnnKeywordId (AnnModule))
2013import Control.Monad
21−import Data.Bifunctor
22−import Data.Maybe (mapMaybe)
23−import Language.Haskell.GHC.ExactPrint.Types
24−import Ormolu.Comments
14+import Data.Coerce (coerce)
15+import Data.Data (Data)
16+import Data.Maybe (isJust)
17+import Ormolu.CommentStream
2518import Ormolu.Printer.Internal
19+import Ormolu.Utils (isModule, getSpan)
2620import SrcLoc
21+import qualified Data.List.NonEmpty as NE
2722import qualified Data.Text as T
2823
29−-- | Placement instructions for comments.
30−
31−data Decoration
32− = Decoration Decorator Decorator
33− deriving (Eq, Show)
34−
35−-- | Decorator in this context is a thing to put before\/after a comment.
36−
37−data Decorator
38− = NoDec -- ^ Output nothing
39− | SpaceDec -- ^ Output single space
40− | NewlineDec -- ^ Output single newline
41− deriving (Eq, Show)
42−
43−-- | Position: before vs after.
44−
45−data Position
46− = Before -- ^ Before
47− | After -- ^ After
48− deriving (Eq, Show)
49−
50−-- | For which type of AST leaf we're preparing the comments.
51−
52−data CommentMode
53− = Module -- ^ Module
54− | Other -- ^ Other element
55− deriving (Eq, Show)
56−
57−-- | Output a bunch of 'Comment's. 'DeltaPos'es are used to insert extra
58−-- space between the comments when necessary.
59−
60−spitComments :: [(Comment, Decoration)] -> R ()
61−spitComments = mapM_ $ \(comment, (Decoration d0 d1)) -> do
62− let spitDecorator = \case
63− NoDec -> return ()
64− SpaceDec -> spit " "
65− NewlineDec -> newline
66− spitDecorator d0
67− spitComment comment
68− spitDecorator d1
69−
70−-- | Output a 'Comment'.
71−
72−spitComment :: Comment -> R ()
73−spitComment (Comment str _ _) =
74− forM_ (normalizeComment str) $ \x -> do
75− ensureIndent
76− spit (T.pack x)
77−
78−-- | Partition annotations to get a collection of 'Comment's preceding a
79−-- definition and following it. Every 'Comment' has corresponding
80−-- 'Decoration' which is used to understand how to decorate it.
81−
82−partitionDPs
83− :: CommentMode -- ^ For which type of element we prepare comments
84− -> SrcSpan -- ^ Span of element the comments are attached to
85− -> [(KeywordId, DeltaPos)] -- ^ Annotations
86− -> ([(Comment, Decoration)], [(Comment, Decoration)])
87−partitionDPs cmode refSpan anns =
88− case cmode of
89− Module -> partitionDPsModule refSpan anns
90− Other -> partitionDPsOther refSpan anns
91−
92−-- | Try to partition comments as if for a module.
93−
94−partitionDPsModule
95− :: SrcSpan -- ^ Span of element the comments are attached to
96− -> [(KeywordId, DeltaPos)] -- ^ Annotations
97− -> ([(Comment, Decoration)], [(Comment, Decoration)])
98−partitionDPsModule refSpan xs
99− = bimap (takeComments Before) (takeComments After) $
100− -- NOTE If there is no annotation corresponding to module keyword, then
101− -- the module doesn't have a header and all comments shoud go after.
102− if G AnnModule `elem` fmap fst xs
103− then break ((== G AnnModule) . fst) xs
104− else ([], xs)
24+----------------------------------------------------------------------------
25+-- Top-level
26+
27+-- | Output all preceding comments for an element at given location.
28+
29+spitPrecedingComments
30+ :: Data a
31+ => RealLocated a -- ^ AST element to attach comments to
32+ -> R ()
33+spitPrecedingComments = handleCommentSeries . spitPrecedingComment
34+
35+-- | Output all comments following an element at given location.
36+
37+spitFollowingComments
38+ :: Data a
39+ => RealLocated a -- ^ AST element of attach comments to
40+ -> R ()
41+spitFollowingComments ref = do
42+ trimSpanStream (getSpan ref)
43+ handleCommentSeries (spitFollowingComment ref)
44+
45+-- | Output all remaining comments in the comment stream.
46+
47+spitRemainingComments :: R ()
48+spitRemainingComments = handleCommentSeries spitRemainingComment
49+
50+----------------------------------------------------------------------------
51+-- Single-comment functions
52+
53+-- | Output a single preceding comment for an element at given location.
54+
55+spitPrecedingComment
56+ :: Data a
57+ => RealLocated a -- ^ AST element to attach comments to
58+ -> Maybe RealSrcSpan -- ^ Location of last comment in the series
59+ -> R (Maybe RealSrcSpan) -- ^ Location of this comment
60+spitPrecedingComment (L ref a) mlastSpn = do
61+ let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref
62+ withPoppedComment p $ \l comment -> do
63+ when (needsNewlineBefore l mlastSpn) newline
64+ spitComment comment
65+ if theSameLine l ref && not (isModule a)
66+ then spit " "
67+ else newline
68+
69+-- | Output a comment that follows element at given location immediately on
70+-- the same line, if there is any.
71+
72+spitFollowingComment
73+ :: Data a
74+ => RealLocated a -- ^ AST element to attach comments to
75+ -> Maybe RealSrcSpan -- ^ Location of last comment in the series
76+ -> R (Maybe RealSrcSpan) -- ^ Location of this comment
77+spitFollowingComment (L ref a) mlastSpn = do
78+ mnSpn <- nextEltSpan
79+ meSpn <- getEnclosingSpan
80+ i <- getIndent
81+ withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastSpn) $ \l comment ->
82+ if theSameLine l ref && not (isModule a)
83+ then modNextline $ \m -> setIndent i $ do
84+ spit " "
85+ spitComment comment
86+ m
87+ else modNextline $ \m -> setIndent i $ do
88+ m
89+ when (needsNewlineBefore l mlastSpn) newline
90+ spitComment comment
91+ newline
92+
93+-- | Output a single remaining comment from the comment stream.
94+
95+spitRemainingComment
96+ :: Maybe RealSrcSpan -- ^ Location of last comment in the series
97+ -> R (Maybe RealSrcSpan) -- ^ Location of this comment
98+spitRemainingComment mlastSpn =
99+ withPoppedComment (const True) $ \l comment -> do
100+ when (needsNewlineBefore l mlastSpn) newline
101+ spitComment comment
102+ newline
103+
104+----------------------------------------------------------------------------
105+-- Helpers
106+
107+-- | Output series of comments.
108+
109+handleCommentSeries
110+ :: (Maybe RealSrcSpan -> R (Maybe RealSrcSpan))
111+ -- ^ Given location of previous comment, output the next comment
112+ -- returning its location, or 'Nothing' if we are done
113+ -> R ()
114+handleCommentSeries f = go Nothing
105115 where
106− takeComments pos = mapMaybe $ \(keywordId, dpos) -> do
107− c <- annComment keywordId
108− return (c, getDecoration Module pos refSpan (c, dpos))
109−
110−-- | Partition comments according to their spans (works for everything but
111−-- modules).
112−
113−partitionDPsOther
114− :: SrcSpan -- ^ Span of element the comments are attached to
115− -> [(KeywordId, DeltaPos)] -- ^ Annotations
116− -> ([(Comment, Decoration)], [(Comment, Decoration)])
117−partitionDPsOther refSpan
118− = bimap (fmap (addDecoration Other Before refSpan))
119− (fixupLastDec . fmap (addDecoration Other After refSpan))
120− . break (followedBySpan refSpan . commentIdentifier . fst)
121− . mapMaybe annComment'
116+ go mlastSpn = do
117+ r <- f mlastSpn
118+ case r of
119+ Nothing -> return ()
120+ Just spn -> go (Just spn)
121+
122+-- | Try to pop a comment using given predicate and if there is a comment
123+-- matching the predicate, print it out.
124+
125+withPoppedComment
126+ :: (RealLocated Comment -> Bool) -- ^ Comment predicate
127+ -> (RealSrcSpan -> Comment -> R ()) -- ^ Priting function
128+ -> R (Maybe RealSrcSpan)
129+withPoppedComment p f = do
130+ r <- popComment p
131+ case r of
132+ Nothing -> return Nothing
133+ Just (L l comment) -> Just l <$ f l comment
134+
135+-- | Determine if we need to insert a newline between current comment and
136+-- last printed comment.
137+
138+needsNewlineBefore
139+ :: RealSrcSpan -- ^ Current comment span
140+ -> Maybe RealSrcSpan -- ^ Last printed comment span
141+ -> Bool
142+needsNewlineBefore l mlastSpn =
143+ case mlastSpn of
144+ Nothing -> False
145+ Just lastSpn ->
146+ srcSpanStartLine l > srcSpanEndLine lastSpn + 1
147+
148+-- | Is the comment and AST element are on the same line?
149+
150+theSameLine
151+ :: RealSrcSpan -- ^ Current comment span
152+ -> RealSrcSpan -- ^ AST element location
153+ -> Bool
154+theSameLine l ref =
155+ srcSpanEndLine l == srcSpanStartLine ref
156+
157+-- | Determine if given comment follows AST element.
158+
159+commentFollowsElt
160+ :: RealSrcSpan -- ^ Location of AST element
161+ -> Maybe RealSrcSpan -- ^ Location of next AST element
162+ -> Maybe RealSrcSpan -- ^ Location of enclosing AST element
163+ -> Maybe RealSrcSpan -- ^ Location of last comment in the series
164+ -> RealLocated Comment -- ^ Comment to test
165+ -> Bool
166+commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =
167+ -- A comment follows a AST element if all 4 conditions are satisfied:
168+ goesAfter && logicallyFollows && noEltBetween && supersedesParentElt
122169 where
123− annComment' :: (KeywordId, DeltaPos) -> Maybe (Comment, DeltaPos)
124− annComment' (keywordId, dpos) = do
125− c <- annComment keywordId
126− return (c, dpos)
127− followedBySpan :: SrcSpan -> SrcSpan -> Bool
128− followedBySpan spn0 spn1 =
129− if srcSpanEnd spn0 < srcSpanStart spn1
130− then True
131− else False
132−
133−-- | Last following comment cannot be standalone because in that case we get
134−-- redundant newlines.
135−
136−fixupLastDec :: [(Comment, Decoration)] -> [(Comment, Decoration)]
137−fixupLastDec [] = []
138−fixupLastDec [(c, Decoration d0 _)] = [(c, Decoration d0 NoDec)]
139−fixupLastDec (c:cs) = c : fixupLastDec cs
140−
141−-- | Replace 'DeltaPos' with 'Decoration'.
142−
143−addDecoration
144− :: CommentMode -- ^ For which type of element we prepare comments
145− -> Position -- ^ Is this for comments before or after?
146− -> SrcSpan -- ^ Span of element the comments are attached to
147− -> (Comment, DeltaPos) -- ^ Thing to decorate
148− -> (Comment, Decoration)
149−addDecoration cmode pos refSpan (comment, dpos) =
150− ( comment
151− , getDecoration cmode pos refSpan (comment, dpos)
152− )
170+ -- 1) The comment starts after end of the AST element:
171+ goesAfter =
172+ realSrcSpanStart l >= realSrcSpanEnd ref
173+ -- 2) The comment logically belongs to the element, three cases:
174+ logicallyFollows
175+ = theSameLine l ref -- a) it's on the same line
176+ || isPrevHaddock comment -- b) it's a Haddock string starting with -- ^
177+ || isJust mlastSpn -- c) it's a continuation of a comment block
178+ -- 3) There is no other AST element between this element and the comment:
179+ noEltBetween =
180+ case mnSpn of
181+ Nothing -> True
182+ Just nspn ->
183+ realSrcSpanStart nspn >= realSrcSpanEnd l
184+ -- Less obvious: if column of comment is closer to the start of
185+ -- enclosing element, it probably related to that parent element, not to
186+ -- the current child element. This rule is important because otherwise
187+ -- all comments would end up assigned to closest inner elements, and
188+ -- parent elements won't have a chance to get any comments assigned to
189+ -- them. This is not OK because comments will get indented according to
190+ -- the AST elements they are attached to.
191+ supersedesParentElt =
192+ case meSpn of
193+ Nothing -> True
194+ Just espn ->
195+ let startColumn = srcLocCol . realSrcSpanStart
196+ in abs (startColumn espn - startColumn l)
197+ > abs (startColumn ref - startColumn l)
198+
199+-- | Output a 'Comment'. This is a low-level printing function.
153200
154−-- | Calculate decoration for a comment.
155−
156−getDecoration
157− :: CommentMode -- ^ For which type of element we prepare comments
158− -> Position -- ^ Is this for comment before or after?
159− -> SrcSpan -- ^ Span of element the comments are attached to
160− -> (Comment, DeltaPos) -- ^ Thing to decorate
161− -> Decoration
162−getDecoration cmode pos refSpan (c, (DP (r, _))) =
163− Decoration preceedingDec followingDec
201+spitComment :: Comment -> R ()
202+spitComment =
203+ sequence_ . NE.intersperse newline . fmap f . coerce
164204 where
165− preceedingDec =
166− if sameLine
167− then case pos of
168− Before -> NoDec
169− After -> SpaceDec
170− else if r > 1
171− then NewlineDec
172− else NoDec
173− followingDec =
174− if sameLine
175− then case pos of
176− Before -> SpaceDec
177− After -> NewlineDec
178− else NewlineDec
179− sameLine =
180− case cmode of
181− Module -> False
182− Other ->
183− case (refSpan, commentIdentifier c) of
184− (RealSrcSpan spn0, RealSrcSpan spn1) ->
185− srcSpanEndLine spn0 == srcSpanStartLine spn1
186− (_, _) -> False
205+ f x = ensureIndent >> spit (T.pack x)