22839ed · ormolu · git.iko.soy

git.iko.soy/ormolu

Improve tracking of dirty lines, better hang expressions in records

commit22839ed74c9964578ae3b2af5c693f605ac8a687 authorMark Karpov <markkarpov92@gmail.com> dateTue 28 Apr 2020, 13:19 (6 years ago) parent3fbc130

24 files changed+102−81

compare with master

unifiedsplit

CHANGELOG.md+3

@@ -3,6 +3,9 @@

33* Fixed rendering of type signatures concerning several identifiers. [Issue

44 566](https://github.com/tweag/ormolu/issues/566).

6+* Fixed an idempotence issue with inline comments in tuples and parentheses.

7+ [Issue 450](https://github.com/tweag/ormolu/issues/450).

69* Renamed the `--check-idempotency` flag to `--check-idempotence`.

710 Apparently only the latter is correct.

811

data/examples/declaration/value/function/record-constructors-out.hs → data/examples/declaration/value/function/record/constructors-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/record-constructors.hs → data/examples/declaration/value/function/record/constructors.hsrenamed

The content is the same.

data/examples/declaration/value/function/record-dot-out.hs → data/examples/declaration/value/function/record/dot-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/record-dot.hs → data/examples/declaration/value/function/record/dot.hsrenamed

The content is the same.

data/examples/declaration/value/function/record/hanging-after-equal-con-out.hsnew file+8

@@ -0,0 +1,8 @@

1+foo =

2+ Foo

3+ { foo =

4+ -- Blah blah

5+ case x of

6+ Blah -> 1

7+ Blim -> 2

8+ }

data/examples/declaration/value/function/record/hanging-after-equal-con.hsnew file+7

@@ -0,0 +1,7 @@

1+foo = Foo

2+ { foo =

3+ -- Blah blah

4+ case x of

5+ Blah -> 1

6+ Blim -> 2

7+ }

data/examples/declaration/value/function/record/hanging-after-equal-update-out.hsnew file+8

@@ -0,0 +1,8 @@

1+foo =

2+ foo

3+ { foo =

4+ -- Blah blah

5+ case x of

6+ Blah -> 1

7+ Blim -> 2

8+ }

data/examples/declaration/value/function/record/hanging-after-equal-update.hsnew file+7

@@ -0,0 +1,7 @@

1+foo = foo

2+ { foo =

3+ -- Blah blah

4+ case x of

5+ Blah -> 1

6+ Blim -> 2

7+ }

data/examples/declaration/value/function/record-inter-comments-out.hs → data/examples/declaration/value/function/record/inter-comments-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/record-inter-comments.hs → data/examples/declaration/value/function/record/inter-comments.hsrenamed

The content is the same.

data/examples/declaration/value/function/record-updaters-out.hs → data/examples/declaration/value/function/record/updaters-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/record-updaters.hs → data/examples/declaration/value/function/record/updaters.hsrenamed

The content is the same.

data/examples/declaration/value/function/record-wildcards-out.hs → data/examples/declaration/value/function/record/wildcards-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/record-wildcards.hs → data/examples/declaration/value/function/record/wildcards.hsrenamed

The content is the same.

data/examples/other/inline-comment-out.hsnew file+3

@@ -0,0 +1,3 @@

1+x = ({-a-} b, c)

3+y = ({-a-} b)

data/examples/other/inline-comment.hsnew file+3

@@ -0,0 +1,3 @@

1+x = ({-a-}b, c)

3+y = ({-a-}b)

expected-failures/Agda.txt−6

@@ -1,9 +1,3 @@

1−Formatting is not idempotent:

2− src/full/Agda/Auto/CaseSplit.hs<rendered>:176:54

3− before: ", pats') = applyperm"

4− after: ", pats') =\n "

5−Please, consider reporting the bug.

6−

71Formatting is not idempotent:

82 src/full/Agda/Syntax/Internal.hs<rendered>:236:12

93 before: "pe Elims = -- | elim"

expected-failures/leksah.txt−6

@@ -3,9 +3,3 @@ Formatting is not idempotent:

33 before: "cr\n -- show"

44 after: "cr\n in -- show"

55Please, consider reporting the bug.

6−

7−Formatting is not idempotent:

8− src/IDE/SymbolNavigation.hs<rendered>:233:8

9− before: "\n\n return [\n {-i"

10− after: "\n\n return\n [ {-i"

11−Please, consider reporting the bug.

src/Ormolu/Parser/CommentStream.hs−6

@@ -7,7 +7,6 @@ module Ormolu.Parser.CommentStream

77 ( CommentStream (..),

88 Comment (..),

99 mkCommentStream,

10− isPrevHaddock,

1110 isMultilineComment,

1211 showCommentStream,

1312 )

@@ -68,11 +67,6 @@ mkCommentStream extraComments pstate =

6867 (GHC.annotations_comments pstate)

6968 (shebangs, otherExtraComments) = extractShebangs extraComments

7069

71−-- | Test whether a 'Comment' looks like a Haddock following a definition,

72−-- i.e. something starting with @-- ^@.

73−isPrevHaddock :: Comment -> Bool

74−isPrevHaddock (Comment (x :| _)) = "-- ^" `L.isPrefixOf` x

75−

7670-- | Is this comment multiline-style?

7771isMultilineComment :: Comment -> Bool

7872isMultilineComment (Comment (x :| _)) = "{-" `L.isPrefixOf` x

src/Ormolu/Printer/Comments.hs+16−29

@@ -60,27 +60,17 @@ spitRemainingComments = do

6060spitPrecedingComment ::

6161 -- | Span of the element to attach comments to

6262 RealSrcSpan ->

63− -- | Location of last comment in the series

64− Maybe SpanMark ->

6563 -- | Are we done?

6664 R Bool

67−spitPrecedingComment ref mlastMark = do

65+spitPrecedingComment ref = do

66+ mlastMark <- getSpanMark

6867 let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref

6968 withPoppedComment p $ \l comment -> do

70− dirtyLine <-

71− case mlastMark of

72− -- When the current line is dirty it means that something that can

73− -- have comments attached to it is already on the line. To avoid

74− -- problems with idempotence we cannot output the first comment

75− -- immediately because it'll be attached to the previous element (on

76− -- the same line) on the next run, so we play safe here and output

77− -- an extra 'newline' in this case.

78− --

79− -- We check 'mlastMark' to do this only for the very first preceding

80− -- comment.

81− Just _ -> return False

82− _ -> isLineDirty

83− when (dirtyLine || needsNewlineBefore l mlastMark) newline

69+ lineSpans <- thisLineSpans

70+ let ls = srcLocLine . realSrcSpanEnd <$> lineSpans

71+ thisCommentLine = srcLocLine (realSrcSpanStart l)

72+ needsNewline = any (/= thisCommentLine) ls

73+ when (needsNewline || needsNewlineBefore l mlastMark) newline

8474 spitCommentNow l comment

8575 if theSameLinePre l ref

8676 then space

@@ -91,11 +81,10 @@ spitPrecedingComment ref mlastMark = do

9181spitFollowingComment ::

9282 -- | AST element to attach comments to

9383 RealSrcSpan ->

94− -- | Location of last comment in the series

95− Maybe SpanMark ->

9684 -- | Are we done?

9785 R Bool

98−spitFollowingComment ref mlastMark = do

86+spitFollowingComment ref = do

87+ mlastMark <- getSpanMark

9988 mnSpn <- nextEltSpan

10089 -- Get first enclosing span that is not equal to reference span, i.e. it's

10190 -- truly something enclosing the AST element.

@@ -113,11 +102,10 @@ spitFollowingComment ref mlastMark = do

113102

114103-- | Output a single remaining comment from the comment stream.

115104spitRemainingComment ::

116− -- | Location of last comment in the series

117− Maybe SpanMark ->

118105 -- | Are we done?

119106 R Bool

120−spitRemainingComment mlastMark =

107+spitRemainingComment = do

108+ mlastMark <- getSpanMark

121109 withPoppedComment (const True) $ \l comment -> do

122110 when (needsNewlineBefore l mlastMark) newline

123111 spitCommentNow l comment

@@ -130,13 +118,13 @@ spitRemainingComment mlastMark =

130118handleCommentSeries ::

131119 -- | Given location of previous comment, output the next comment

132120 -- returning 'True' if we're done

133− (Maybe SpanMark -> R Bool) ->

121+ R Bool ->

134122 -- | Whether we printed any comments

135123 R Bool

136124handleCommentSeries f = go False

137125 where

138126 go gotSome = do

139− done <- getSpanMark >>= f

127+ done <- f

140128 if done

141129 then return gotSome

142130 else go True

@@ -203,7 +191,7 @@ commentFollowsElt ::

203191 -- | Comment to test

204192 RealLocated Comment ->

205193 Bool

206−commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =

194+commentFollowsElt ref mnSpn meSpn mlastMark (L l _) =

207195 -- A comment follows a AST element if all 4 conditions are satisfied:

208196 goesAfter

209197 && logicallyFollows

@@ -216,9 +204,8 @@ commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =

216204 -- 2) The comment logically belongs to the element, four cases:

217205 logicallyFollows =

218206 theSameLinePost l ref -- a) it's on the same line

219− || isPrevHaddock comment -- b) it's a Haddock string starting with -- ^

220− || continuation -- c) it's a continuation of a comment block

221− || lastInEnclosing -- d) it's the last element in the enclosing construct

207+ || continuation -- b) it's a continuation of a comment block

208+ || lastInEnclosing -- c) it's the last element in the enclosing construct

222209

223210 -- 3) There is no other AST element between this element and the comment:

224211 noEltBetween =

src/Ormolu/Printer/Internal.hs+28−23

@@ -17,7 +17,6 @@ module Ormolu.Printer.Internal

1717 atom,

1818 space,

1919 newline,

20− isLineDirty,

2120 useRecordDot,

2221 inci,

2322 sitcc,

@@ -39,6 +38,7 @@ module Ormolu.Printer.Internal

3938 popComment,

4039 getEnclosingSpan,

4140 withEnclosingSpan,

41+ thisLineSpans,

4242

4343 -- * Stateful markers

4444 SpanMark (..),

@@ -102,14 +102,13 @@ data SC = SC

102102 scBuilder :: Builder,

103103 -- | Span stream

104104 scSpanStream :: SpanStream,

105+ -- | Spans of atoms that have been printed on the current line so far

106+ scThisLineSpans :: [RealSrcSpan],

105107 -- | Comment stream

106108 scCommentStream :: CommentStream,

107109 -- | Pending comment lines (in reverse order) to be inserted before next

108110 -- newline, 'Int' is the indentation level

109111 scPendingComments :: ![(CommentPosition, Int, Text)],

110− -- | Whether the current line is “dirty”, that is, already contains

111− -- atoms that can have comments attached to them

112− scDirtyLine :: !Bool,

113112 -- | Whether to output a space before the next output

114113 scRequestedDelimiter :: !RequestedDelimiter,

115114 -- | An auxiliary marker for keeping track of last output element

@@ -177,9 +176,9 @@ runR (R m) sstream cstream anns recDot =

177176 { scColumn = 0,

178177 scBuilder = mempty,

179178 scSpanStream = sstream,

179+ scThisLineSpans = [],

180180 scCommentStream = cstream,

181181 scPendingComments = [],

182− scDirtyLine = False,

183182 scRequestedDelimiter = VeryBeginning,

184183 scSpanMark = Nothing

185184 }

@@ -211,14 +210,14 @@ atom = spit True False . T.pack . showOutputable

211210

212211-- | Low-level non-public helper to define 'txt' and 'atom'.

213212spit ::

214− -- | Should we mark the line as dirty?

213+ -- | Whether to register the outermost enclosing span

215214 Bool ->

216215 -- | Used during outputting of pending comments?

217216 Bool ->

218217 -- | 'Text' to output

219218 Text ->

220219 R ()

221−spit dirty printingComments txt' = do

220+spit registerSpan printingComments text = do

222221 requestedDel <- R (gets scRequestedDelimiter)

223222 case requestedDel of

224223 RequestedNewline -> do

@@ -233,16 +232,23 @@ spit dirty printingComments txt' = do

233232 R $ do

234233 i <- asks rcIndent

235234 c <- gets scColumn

235+ outermostEnclosing <- listToMaybe <$> asks rcEnclosingSpans

236236 let spaces =

237237 if c < i

238238 then T.replicate (i - c) " "

239239 else bool mempty " " (requestedDel == RequestedSpace)

240− indentedTxt = spaces <> txt'

240+ indentedTxt = spaces <> text

241241 modify $ \sc ->

242242 sc

243243 { scBuilder = scBuilder sc <> fromText indentedTxt,

244244 scColumn = scColumn sc + T.length indentedTxt,

245− scDirtyLine = scDirtyLine sc || dirty,

245+ scThisLineSpans =

246+ let xs = scThisLineSpans sc

247+ in if registerSpan

248+ then case outermostEnclosing of

249+ Nothing -> xs

250+ Just x -> x : xs

251+ else xs,

246252 scRequestedDelimiter = RequestedNothing,

247253 scSpanMark =

248254 -- If there are pending comments, do not reset last comment

@@ -286,14 +292,14 @@ newline = do

286292 case position of

287293 OnTheSameLine -> space

288294 OnNextLine -> newlineRaw

289− R . forM_ cs $ \(_, indent, txt') ->

295+ R . forM_ cs $ \(_, indent, text) ->

290296 let modRC rc =

291297 rc

292298 { rcIndent = indent

293299 }

294300 R m = do

295− unless (T.null txt') $

296− spit False True txt'

301+ unless (T.null text) $

302+ spit False True text

297303 newlineRaw

298304 in local modRC m

299305 R . modify $ \sc ->

@@ -314,7 +320,7 @@ newlineRaw = R . modify $ \sc ->

314320 VeryBeginning -> builderSoFar

315321 _ -> builderSoFar <> "\n",

316322 scColumn = 0,

317− scDirtyLine = False,

323+ scThisLineSpans = [],

318324 scRequestedDelimiter = case scRequestedDelimiter sc of

319325 AfterNewline -> RequestedNewline

320326 RequestedNewline -> RequestedNewline

@@ -322,11 +328,6 @@ newlineRaw = R . modify $ \sc ->

322328 _ -> AfterNewline

323329 }

324330

325−-- | Check if the current line is “dirty”, that is, there is something on it

326−-- that can have comments attached to it.

327−isLineDirty :: R Bool

328−isLineDirty = R (gets scDirtyLine)

329−

330331-- | Return 'True' if we should print record dot syntax.

331332useRecordDot :: R Bool

332333useRecordDot = R $ asks rcUseRecDot

@@ -405,11 +406,11 @@ registerPendingCommentLine ::

405406 -- | 'Text' to output

406407 Text ->

407408 R ()

408−registerPendingCommentLine position txt' = R $ do

409+registerPendingCommentLine position text = R $ do

409410 i <- asks rcIndent

410411 modify $ \sc ->

411412 sc

412− { scPendingComments = (position, i, txt') : scPendingComments sc

413+ { scPendingComments = (position, i, text) : scPendingComments sc

413414 }

414415

415416-- | Drop elements that begin before or at the same place as given

@@ -468,6 +469,10 @@ withEnclosingSpan spn (R m) = R (local modRC m)

468469 { rcEnclosingSpans = spn : rcEnclosingSpans rc

469470 }

470471

472+-- | Get spans on this line so far.

473+thisLineSpans :: R [RealSrcSpan]

474+thisLineSpans = R (gets scThisLineSpans)

475+

471476----------------------------------------------------------------------------

472477-- Stateful markers

473478

@@ -477,15 +482,15 @@ data SpanMark

477482 HaddockSpan HaddockStyle RealSrcSpan

478483 | -- | Non-haddock comment

479484 CommentSpan RealSrcSpan

480− | -- | Non-comment span

481− OtherSpan RealSrcSpan

485+ | -- | A statement in a do-block and such span

486+ StatementSpan RealSrcSpan

482487

483488-- | Project 'RealSrcSpan' from 'SpanMark'.

484489spanMarkSpan :: SpanMark -> RealSrcSpan

485490spanMarkSpan = \case

486491 HaddockSpan _ s -> s

487492 CommentSpan s -> s

488− OtherSpan s -> s

493+ StatementSpan s -> s

489494

490495-- | Haddock string style.

491496data HaddockStyle

src/Ormolu/Printer/Meat/Declaration/Value.hs+13−11

@@ -217,9 +217,9 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

217217 -- about putting certain constructions in hanging positions.

218218 endOfPats = case NE.nonEmpty m_pats of

219219 Nothing -> case style of

220− Function name -> (Just . srcSpanEnd . getLoc) name

220+ Function name -> Just (getLoc name)

221221 _ -> Nothing

222− Just pats -> (Just . srcSpanEnd . getLoc . NE.last) pats

222+ Just pats -> (Just . getLoc . NE.last) pats

223223 isCase = \case

224224 Case -> True

225225 LambdaCase -> True

@@ -238,14 +238,13 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

238238 patGrhssSpan =

239239 maybe

240240 grhssSpan

241− (combineSrcSpans grhssSpan . srcLocSpan)

241+ (combineSrcSpans grhssSpan . srcLocSpan . srcSpanEnd)

242242 endOfPats

243243 placement =

244244 case endOfPats of

245245 Nothing -> blockPlacement placer grhssGRHSs

246246 Just spn ->

247− if isOneLineSpan

248− (mkSrcSpan spn (srcSpanStart grhssSpan))

247+ if onTheSameLine spn grhssSpan

249248 then blockPlacement placer grhssGRHSs

250249 else Normal

251250 p_body = do

@@ -296,13 +295,13 @@ p_grhs' placer render style (GRHS NoExtField guards body) =

296295 case endOfGuards of

297296 Nothing -> placer (unLoc body)

298297 Just spn ->

299− if isOneLineSpan (mkSrcSpan spn (srcSpanStart (getLoc body)))

298+ if onTheSameLine spn (getLoc body)

300299 then placer (unLoc body)

301300 else Normal

302301 endOfGuards =

303302 case NE.nonEmpty guards of

304303 Nothing -> Nothing

305− Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs

304+ Just gs -> (Just . getLoc . NE.last) gs

306305 p_body = located body render

307306p_grhs' _ _ _ (XGRHS x) = noExtCon x

308307

@@ -363,7 +362,7 @@ withSpacing f l = located l $ \x -> do

363362 -- Spacing before comments will be handled by the code

364363 -- that prints comments, so we just have to deal with

365364 -- blank lines between statements here.

366− Just (OtherSpan lastSpn) ->

365+ Just (StatementSpan lastSpn) ->

367366 if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1

368367 then newline

369368 else return ()

@@ -374,7 +373,7 @@ withSpacing f l = located l $ \x -> do

374373 getSpanMark >>= \case

375374 Just (HaddockSpan _ _) -> return ()

376375 Just (CommentSpan _) -> return ()

377− _ -> setSpanMark (OtherSpan currentSpn)

376+ _ -> setSpanMark (StatementSpan currentSpn)

378377

379378p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()

380379p_stmt = p_stmt' exprPlacement p_hsExpr

@@ -515,8 +514,11 @@ p_hsRecField HsRecField {..} = do

515514 unless hsRecPun $ do

516515 space

517516 txt "="

518− let placement = exprPlacement (unLoc hsRecFieldArg)

519− placeHanging placement $ located hsRecFieldArg p_hsExpr

517+ let placement =

518+ if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)

519+ then exprPlacement (unLoc hsRecFieldArg)

520+ else Normal

521+ placeHanging placement (located hsRecFieldArg p_hsExpr)

520522

521523p_hsTupArg :: HsTupArg GhcPs -> R ()

522524p_hsTupArg = \case

src/Ormolu/Utils.hs+6

@@ -14,6 +14,7 @@ module Ormolu.Utils

1414 incSpanLine,

1515 separatedByBlank,

1616 separatedByBlankNE,

17+ onTheSameLine,

1718 )

1819where

1920

@@ -133,3 +134,8 @@ separatedByBlank loc a b =

133134-- | Do two declaration groups have a blank between them?

134135separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool

135136separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)

137+

138+-- | Return 'True' if one span ends on the same line the second one starts.

139+onTheSameLine :: SrcSpan -> SrcSpan -> Bool

140+onTheSameLine a b =

141+ isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))