@@ -4,11 +4,16 @@
44
55-- | Functions for working with comment stream.
66module Ormolu.Parser.CommentStream
7− ( CommentStream (..),
8− Comment (..),
7+ ( -- * Comment stream
8+ CommentStream (..),
99 mkCommentStream,
10− isMultilineComment,
1110 showCommentStream,
11+
12+ -- * Comment
13+ Comment (..),
14+ unComment,
15+ hasAtomsBefore,
16+ isMultilineComment,
1217 )
1318where
1419
@@ -25,20 +30,20 @@ import Ormolu.Parser.Shebang
2530import Ormolu.Utils (showOutputable)
2631import SrcLoc
2732
33+----------------------------------------------------------------------------
34+-- Comment stream
35+
2836-- | A stream of 'RealLocated' 'Comment's in ascending order with respect to
2937-- beginning of corresponding spans.
3038newtype CommentStream = CommentStream [RealLocated Comment]
3139 deriving (Eq, Data, Semigroup, Monoid)
3240
33−-- | A wrapper for a single comment. The 'NonEmpty' list inside contains
34−-- lines of multiline comment @{- … -}@ or just single item\/line otherwise.
35−newtype Comment = Comment (NonEmpty String)
36− deriving (Eq, Show, Data)
37−
3841-- | Create 'CommentStream' from 'GHC.PState'. The pragmas and shebangs are
3942-- removed from the 'CommentStream'. Shebangs are only extracted from the
4043-- comments that come from the first argument.
4144mkCommentStream ::
45+ -- | Original input
46+ String ->
4247 -- | Extra comments to include
4348 [Located String] ->
4449 -- | Parser state to use for comment extraction
@@ -49,14 +54,14 @@ mkCommentStream ::
4954 [([RealLocated Comment], Pragma)],
5055 CommentStream
5156 )
52−mkCommentStream extraComments pstate =
57+mkCommentStream input extraComments pstate =
5358 ( mstackHeader,
5459 shebangs,
5560 pragmas,
5661 CommentStream comments
5762 )
5863 where
59− (comments, pragmas) = extractPragmas rawComments1
64+ (comments, pragmas) = extractPragmas input rawComments1
6065 (rawComments1, mstackHeader) = extractStackHeader rawComments0
6166 rawComments0 =
6267 L.sortOn (realSrcSpanStart . getRealSrcSpan) . mapMaybe toRealSpan $
@@ -67,10 +72,6 @@ mkCommentStream extraComments pstate =
6772 (GHC.annotations_comments pstate)
6873 (shebangs, otherExtraComments) = extractShebangs extraComments
6974
70−-- | Is this comment multiline-style?
71−isMultilineComment :: Comment -> Bool
72−isMultilineComment (Comment (x :| _)) = "{-" `L.isPrefixOf` x
73−
7475-- | Pretty-print a 'CommentStream'.
7576showCommentStream :: CommentStream -> String
7677showCommentStream (CommentStream xs) =
@@ -80,28 +81,67 @@ showCommentStream (CommentStream xs) =
8081 showComment (GHC.L l str) = showOutputable l ++ " " ++ show str
8182
8283----------------------------------------------------------------------------
83−-- Helpers
84+-- Comment
85+
86+-- | A wrapper for a single comment. The 'Bool' indicates whether there were
87+-- atoms before beginning of the comment in the original input. The
88+-- 'NonEmpty' list inside contains lines of multiline comment @{- … -}@ or
89+-- just single item\/line otherwise.
90+data Comment = Comment Bool (NonEmpty String)
91+ deriving (Eq, Show, Data)
8492
8593-- | Normalize comment string. Sometimes one multi-line comment is turned
8694-- into several lines for subsequent outputting with correct indentation for
8795-- each line.
88−mkComment :: RealLocated String -> RealLocated Comment
89−mkComment (L l s) =
90− L l . Comment . fmap dropTrailing $
91− if "{-" `L.isPrefixOf` s
92− then case NE.nonEmpty (lines s) of
93− Nothing -> s :| []
94− Just (x :| xs) ->
95− let getIndent y =
96− if all isSpace y
97− then startIndent
98− else length (takeWhile isSpace y)
99− n = minimum (startIndent : fmap getIndent xs)
100− in x :| (drop n <$> xs)
101− else s :| []
96+mkComment ::
97+ -- | Lines of original input with their indices
98+ [(Int, String)] ->
99+ -- | Raw comment string
100+ RealLocated String ->
101+ -- | Remaining lines of original input and the constructed 'Comment'
102+ ([(Int, String)], RealLocated Comment)
103+mkComment ls (L l s) = (ls', comment)
102104 where
105+ comment =
106+ L l . Comment atomsBefore . fmap dropTrailing $
107+ if "{-" `L.isPrefixOf` s
108+ then case NE.nonEmpty (lines s) of
109+ Nothing -> s :| []
110+ Just (x :| xs) ->
111+ let getIndent y =
112+ if all isSpace y
113+ then startIndent
114+ else length (takeWhile isSpace y)
115+ n = minimum (startIndent : fmap getIndent xs)
116+ in x :| (drop n <$> xs)
117+ else s :| []
118+ (atomsBefore, ls') =
119+ case dropWhile ((< commentLine) . fst) ls of
120+ [] -> (False, [])
121+ ((_, i) : ls'') ->
122+ case take 2 (dropWhile isSpace i) of
123+ "--" -> (False, ls'')
124+ "{-" -> (False, ls'')
125+ _ -> (True, ls'')
103126 dropTrailing = L.dropWhileEnd isSpace
104127 startIndent = srcSpanStartCol l - 1
128+ commentLine = srcSpanStartLine l
129+
130+-- | Get a collection of lines from a 'Comment'.
131+unComment :: Comment -> NonEmpty String
132+unComment (Comment _ xs) = xs
133+
134+-- | Check whether the 'Comment' had some non-whitespace atoms in front of
135+-- it in the original input.
136+hasAtomsBefore :: Comment -> Bool
137+hasAtomsBefore (Comment atomsBefore _) = atomsBefore
138+
139+-- | Is this comment multiline-style?
140+isMultilineComment :: Comment -> Bool
141+isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x
142+
143+----------------------------------------------------------------------------
144+-- Helpers
105145
106146-- | Get a 'String' from 'GHC.AnnotationComment'.
107147unAnnotationComment :: GHC.AnnotationComment -> Maybe String
@@ -130,25 +170,29 @@ extractStackHeader ::
130170extractStackHeader = \case
131171 [] -> ([], Nothing)
132172 (x : xs) ->
133− let comment = mkComment x
173+ let comment = snd (mkComment [] x)
134174 in if isStackHeader (unRealSrcSpan comment)
135175 then (xs, Just comment)
136176 else (x : xs, Nothing)
137177 where
138− isStackHeader (Comment (x :| _)) =
178+ isStackHeader (Comment _ (x :| _)) =
139179 "stack" `L.isPrefixOf` dropWhile isSpace (drop 2 x)
140180
141181-- | Extract pragmas and their associated comments.
142182extractPragmas ::
183+ String ->
143184 [RealLocated String] ->
144185 ([RealLocated Comment], [([RealLocated Comment], Pragma)])
145−extractPragmas = go id id
186+extractPragmas input = go initialLs id id
146187 where
147− go csSoFar pragmasSoFar = \case
188+ initialLs = zip [1 ..] (lines input)
189+ go ls csSoFar pragmasSoFar = \case
148190 [] -> (csSoFar [], pragmasSoFar [])
149191 (x : xs) ->
150192 case parsePragma (unRealSrcSpan x) of
151− Nothing -> go (csSoFar . (mkComment x :)) pragmasSoFar xs
193+ Nothing ->
194+ let (ls', x') = mkComment ls x
195+ in go ls' (csSoFar . (x' :)) pragmasSoFar xs
152196 Just pragma ->
153197 let combined = (csSoFar [], pragma)
154− in go id (pragmasSoFar . (combined :)) xs
198+ in go ls id (pragmasSoFar . (combined :)) xs