0abedcc · ormolu · git.iko.soy

git.iko.soy/ormolu

Prevent the equality sign from “disconnecting” comments

This resolves a class of idempotence issues when the equality sign happens to be inserted between an element and its comment that follows on the same line. I had to special-case equality sign for this, because all alternative approaches (changing comment association logic or trying to find a more general rule) did not work or fixed this issue yet made other things worse. There is nothing special about the equality sign per se, but it (always?) starts definitions which have their own ‘Located’ wrappers and it is those spans interfere with the logic of comment association (they are detected as AST elements between the “host” element and its comment) on subsequent passes. This results in non-idempotent formatting. The solution is OKish in that it fixes 99% of problems that one will encounter in practice, but I see how an input can be crafted to show that there is still an issue with idempotence.

commit0abedcce03b0054f0076a5f8ce3a73be6e8f0986 authorMark Karpov <markkarpov92@gmail.com> dateWed 6 May 2020, 15:58 (6 years ago) parent194da3a

16 files changed+108−100

compare with master

unifiedsplit

CHANGELOG.md+4 data/examples/declaration/value/function/awkward-comment-0-out.hs+6 data/examples/declaration/value/function/awkward-comment-0.hs+5 data/examples/declaration/value/function/awkward-comment-1-out.hs+9 data/examples/declaration/value/function/awkward-comment-1.hs+7 default.nix+1 expected-failures/Agda.txt+6−6 expected-failures/idris.txt+1−55 expected-failures/intero.txt+3−3 src/Ormolu/Printer/Combinators.hs+5 src/Ormolu/Printer/Internal.hs+41−16 src/Ormolu/Printer/Meat/Declaration/Data.hs+1−1 src/Ormolu/Printer/Meat/Declaration/Rule.hs+1−1 src/Ormolu/Printer/Meat/Declaration/Type.hs+1−1 src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+2−2 src/Ormolu/Printer/Meat/Declaration/Value.hs+15−15

CHANGELOG.md+4

@@ -13,6 +13,10 @@

1313* Fixed an idempotence issue related to different indentation levels in a

1414 comment series. [Issue 512](https://github.com/tweag/ormolu/issues/512).

1515

16+* Fixed an idempotence related to comments which may happen to be separated

17+ from the elements they are attached to by the equality sign. [Issue

18+ 340](https://github.com/tweag/ormolu/issues/340).

19+

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

1721 Apparently only the latter is correct.

1822

data/examples/declaration/value/function/awkward-comment-0-out.hsnew file+6

@@ -0,0 +1,6 @@

1+mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a

2+mergeErrorReply err1 reply -- XXX where to put it?

3+ =

4+ case reply of

5+ Ok x state err2 -> Ok x state (mergeError err1 err2)

6+ Error err2 -> Error (mergeError err1 err2)

data/examples/declaration/value/function/awkward-comment-0.hsnew file+5

@@ -0,0 +1,5 @@

1+mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a

2+mergeErrorReply err1 reply -- XXX where to put it?

3+ = case reply of

4+ Ok x state err2 -> Ok x state (mergeError err1 err2)

5+ Error err2 -> Error (mergeError err1 err2)

data/examples/declaration/value/function/awkward-comment-1-out.hsnew file+9

@@ -0,0 +1,9 @@

1+doForeign :: Vars -> [Name] -> [Term] -> Idris LExp

2+doForeign x = x

3+ where

4+ splitArg tm | (_, [_, _, l, r]) <- unApply tm -- pair, two implicits

5+ =

6+ do

7+ let l' = toFDesc l

8+ r' <- irTerm (sMN 0 "__foreignCall") vs env r

9+ return (l', r')

data/examples/declaration/value/function/awkward-comment-1.hsnew file+7

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

1+doForeign :: Vars -> [Name] -> [Term] -> Idris LExp

2+doForeign x = x

3+ where

4+ splitArg tm | (_, [_,_,l,r]) <- unApply tm -- pair, two implicits

5+ = do let l' = toFDesc l

6+ r' <- irTerm (sMN 0 "__foreignCall") vs env r

7+ return (l', r')

default.nix+1

@@ -107,6 +107,7 @@ in {

107107 "optics"

108108 "ormolu"

109109 "pandoc"

110+ "parsec3"

110111 "pipes"

111112 "postgrest"

112113 "purescript"

expected-failures/Agda.txt+6−6

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

1+Formatting is not idempotent:

2+ dist/build/Agda/Syntax/Parser/Lexer.hs<rendered>:1597:17

3+ before: " = (check_ac"

4+ after: " =\n "

5+Please, consider reporting the bug.

17Formatting is not idempotent:

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

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

@@ -9,12 +15,6 @@ Parsing of formatted code failed:

915 parse error on input `C.QName'

1016Please, consider reporting the bug.

1117

12−Formatting is not idempotent:

13− src/full/Agda/Termination/CallGraph.hs<rendered>:151:38

14− before: "2, old2) = -- TODO: "

15− after: "2, old2) =\n -"

16−Please, consider reporting the bug.

17−

1818Formatting is not idempotent:

1919 src/full/Agda/TypeChecking/MetaVars.hs<rendered>:1448:16

2020 before: "ubstCand = -- | a po"

expected-failures/idris.txt+1−55

@@ -10,12 +10,6 @@ Formatting is not idempotent:

1010 after: "++ showEnv\n "

1111Please, consider reporting the bug.

1212

13−Formatting is not idempotent:

14− src/Idris/Core/ProofTerm.hs<rendered>:351:19

15− before: "f c e pt = -- @(PT p"

16− after: "f c e pt =\n -- @(PT"

17−Please, consider reporting the bug.

18−

1913Formatting is not idempotent:

2014 src/Idris/Core/TT.hs<rendered>:1963:13

2115 before: " text op <> pretty"

@@ -23,29 +17,11 @@ Formatting is not idempotent:

2317Please, consider reporting the bug.

2418

2519Formatting is not idempotent:

26− src/Idris/Core/WHNF.hs<rendered>:105:46

27− before: " n b sc) = -- stk mu"

28− after: " n b sc) =\n -- "

29−Please, consider reporting the bug.

30−

31−Formatting is not idempotent:

32− src/Idris/Delaborate.hs<rendered>:627:6

20+ src/Idris/Delaborate.hs<rendered>:628:6

3321 before: "ity\n -- Issue #"

3422 after: "ity\n -- Issue"

3523Please, consider reporting the bug.

3624

37−Formatting is not idempotent:

38− src/Idris/Elab/Term.hs<rendered>:432:47

39− before: "K\" _ _)) = -- for ch"

40− after: "K\" _ _)) =\n -- "

41−Please, consider reporting the bug.

42−

43−Formatting is not idempotent:

44− src/Idris/ModeCommon.hs<rendered>:34:26

45− before: "s toline = -- furthe"

46− after: "s toline =\n -- furt"

47−Please, consider reporting the bug.

48−

4925Formatting is not idempotent:

5026 src/Idris/Options.hs<rendered>:177:17

5127 before: "timisation = PETrans"

@@ -64,38 +40,8 @@ The GHC parser (in Haddock mode) failed:

6440 src/Idris/Parser/Expr.hs:75:1

6541 parse error on input `@'

6642

67−Formatting is not idempotent:

68− src/Idris/PartialEval.hs<rendered>:281:42

69− before: ": ns) as = -- Droppe"

70− after: ": ns) as =\n -- "

71−Please, consider reporting the bug.

72−

73−Formatting is not idempotent:

74− src/Idris/ProofSearch.hs<rendered>:487:20

75− before: "OK ty hs = -- if any"

76− after: "OK ty hs =\n -- "

77−Please, consider reporting the bug.

78−

7943Formatting is not idempotent:

8044 src/Idris/Prover.hs<rendered>:239:10

8145 before: " line <> bindin"

8246 after: " line\n <"

8347Please, consider reporting the bug.

84−

85−Formatting is not idempotent:

86− src/Idris/REPL.hs<rendered>:1270:33

87− before: "ht c) _) = -- consta"

88− after: "ht c) _) =\n -- cons"

89−Please, consider reporting the bug.

90−

91−Formatting is not idempotent:

92− src/Idris/Reflection.hs<rendered>:934:27

93− before: "attern _ = -- for al"

94− after: "attern _ =\n -- for "

95−Please, consider reporting the bug.

96−

97−Formatting is not idempotent:

98− src/Idris/Transforms.hs<rendered>:26:32

99− before: "s, rhs)) = -- apply "

100− after: "s, rhs)) =\n -- "

101−Please, consider reporting the bug.

expected-failures/intero.txt+3−3

@@ -1,5 +1,5 @@

11Formatting is not idempotent:

2− src/InteractiveUI.hs<rendered>:2635:36

3− before: "Decl d2) = -- A bit "

4− after: "Decl d2) =\n -- A bi"

2+ src/InteractiveUI.hs<rendered>:3688:33

3+ before: "text \"Try\" <+> doWha"

4+ after: "text \"Try\"\n "

55Please, consider reporting the bug.

src/Ormolu/Printer/Combinators.hs+5

@@ -51,6 +51,7 @@ module Ormolu.Printer.Combinators

5151

5252 -- ** Literals

5353 comma,

54+ equals,

5455

5556 -- ** Stateful markers

5657 SpanMark (..),

@@ -275,3 +276,7 @@ brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)

275276-- | Print @,@.

276277comma :: R ()

277278comma = txt ","

279+

280+-- | Print @=@. Do not use @'txt' "="@.

281+equals :: R ()

282+equals = interferingTxt "="

src/Ormolu/Printer/Internal.hs+41−16

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

1414

1515 -- * Internal functions

1616 txt,

17+ interferingTxt,

1718 atom,

1819 space,

1920 newline,

@@ -186,6 +187,23 @@ runR (R m) sstream cstream anns recDot =

186187----------------------------------------------------------------------------

187188-- Internal functions

188189

190+-- | Type of the thing to output. Influences the primary low-level rendering

191+-- function 'spit'.

192+data SpitType

193+ = -- | Simple opaque text that breaks comment series.

194+ SimpleText

195+ | -- | Like 'SimpleText', but assume that when this text is inserted it

196+ -- will separate an 'Atom' and its pending comments, so insert an extra

197+ -- 'newline' in that case to force the pending comments and continue on

198+ -- a fresh line.

199+ InterferingText

200+ | -- | An atom that typically have span information in the AST and can

201+ -- have comments attached to it.

202+ Atom

203+ | -- | Used for rendering comment lines.

204+ CommentPart

205+ deriving (Show, Eq)

206+

189207-- | Output a fixed 'Text' fragment. The argument may not contain any line

190208-- breaks. 'txt' is used to output all sorts of “fixed” bits of syntax like

191209-- keywords and pipes @|@ in functional dependencies.

@@ -197,7 +215,14 @@ txt ::

197215 -- | 'Text' to output

198216 Text ->

199217 R ()

200−txt = spit False False

218+txt = spit SimpleText

219+

220+-- |

221+interferingTxt ::

222+ -- | 'Text' to output

223+ Text ->

224+ R ()

225+interferingTxt = spit InterferingText

201226

202227-- | Output 'Outputable' fragment of AST. This can be used to output numeric

203228-- literals and similar. Everything that doesn't have inner structure but

@@ -206,33 +231,33 @@ atom ::

206231 Outputable a =>

207232 a ->

208233 R ()

209−atom = spit True False . T.pack . showOutputable

234+atom = spit Atom . T.pack . showOutputable

210235

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

212237spit ::

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

214− Bool ->

215− -- | Used during outputting of pending comments?

216− Bool ->

238+ -- | Type of the thing to spit

239+ SpitType ->

217240 -- | 'Text' to output

218241 Text ->

219242 R ()

220−spit registerSpan printingComments text = do

243+spit stype text = do

221244 requestedDel <- R (gets scRequestedDelimiter)

245+ pendingComments <- R (gets scPendingComments)

246+ when (stype == InterferingText && not (null pendingComments)) newline

222247 case requestedDel of

223248 RequestedNewline -> do

224249 R . modify $ \sc ->

225250 sc

226251 { scRequestedDelimiter = RequestedNothing

227252 }

228− if printingComments

229− then newlineRaw

230− else newline

253+ case stype of

254+ CommentPart -> newlineRaw

255+ _ -> newline

231256 _ -> return ()

232257 R $ do

233258 i <- asks rcIndent

234259 c <- gets scColumn

235− outermostEnclosing <- listToMaybe <$> asks rcEnclosingSpans

260+ closestEnclosing <- listToMaybe <$> asks rcEnclosingSpans

236261 let spaces =

237262 if c < i

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

@@ -244,16 +269,16 @@ spit registerSpan printingComments text = do

244269 scColumn = scColumn sc + T.length indentedTxt,

245270 scThisLineSpans =

246271 let xs = scThisLineSpans sc

247− in if registerSpan

248− then case outermostEnclosing of

272+ in case stype of

273+ Atom -> case closestEnclosing of

249274 Nothing -> xs

250275 Just x -> x : xs

251− else xs,

276+ _ -> xs,

252277 scRequestedDelimiter = RequestedNothing,

253278 scSpanMark =

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

255280 -- location.

256− if printingComments || (not . null . scPendingComments) sc

281+ if (stype == CommentPart) || (not . null . scPendingComments) sc

257282 then scSpanMark sc

258283 else Nothing

259284 }

@@ -309,7 +334,7 @@ newline = do

309334 }

310335 R m = do

311336 unless (T.null text) $

312− spit False True text

337+ spit CommentPart text

313338 newlineRaw

314339 in local modRC m

315340 R . modify $ \sc ->

src/Ormolu/Printer/Meat/Declaration/Data.hs+1−1

@@ -67,7 +67,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

6767 if singleConstRec

6868 then space

6969 else breakpoint

70− txt "="

70+ equals

7171 space

7272 let s =

7373 vlayout

src/Ormolu/Printer/Meat/Declaration/Rule.hs+1−1

@@ -43,7 +43,7 @@ p_ruleDecl = \case

4343 inci $ do

4444 located lhs p_hsExpr

4545 space

46− txt "="

46+ equals

4747 inci $ do

4848 breakpoint

4949 located rhs p_hsExpr

src/Ormolu/Printer/Meat/Declaration/Type.hs+1−1

@@ -32,7 +32,7 @@ p_synDecl name fixity HsQTvs {..} t = do

3232 (p_rdrName name)

3333 (map (located' p_hsTyVarBndr) hsq_explicit)

3434 space

35− txt "="

35+ equals

3636 breakpoint

3737 inci (located t p_hsType)

3838p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+2−2

@@ -69,7 +69,7 @@ p_familyResultSigL l =

6969 breakpoint

7070 located k p_hsType

7171 TyVarSig NoExtField bndr -> Just $ do

72− txt "="

72+ equals

7373 breakpoint

7474 located bndr p_hsTyVarBndr

7575 XFamilyResultSig x ->

@@ -101,7 +101,7 @@ p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do

101101 (p_rdrName feqn_tycon)

102102 (located' p_hsType . typeArgToType <$> feqn_pats)

103103 space

104− txt "="

104+ equals

105105 breakpoint

106106 inci (located feqn_rhs p_hsType)

107107p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x

src/Ormolu/Printer/Meat/Declaration/Value.hs+15−15

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

225225 LambdaCase -> True

226226 _ -> False

227227 let hasGuards = withGuards grhssGRHSs

228− unless (length grhssGRHSs > 1) $

229− case style of

230− Function _ | hasGuards -> return ()

231− Function _ -> space >> txt "="

232− PatternBind -> space >> txt "="

233− s | isCase s && hasGuards -> return ()

234− _ -> space >> txt "->"

235− let grhssSpan =

228+ grhssSpan =

236229 combineSrcSpans' $

237230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

238231 patGrhssSpan =

@@ -261,6 +254,13 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

261254 unless whereIsEmpty breakpoint

262255 inci $ located grhssLocalBinds p_hsLocalBinds

263256 inci' $ do

257+ unless (length grhssGRHSs > 1) $

258+ case style of

259+ Function _ | hasGuards -> return ()

260+ Function _ -> space >> inci equals

261+ PatternBind -> space >> inci equals

262+ s | isCase s && hasGuards -> return ()

263+ _ -> space >> txt "->"

264264 switchLayout [patGrhssSpan] $

265265 placeHanging placement p_body

266266 inci p_where

@@ -286,9 +286,9 @@ p_grhs' placer render style (GRHS NoExtField guards body) =

286286 space

287287 sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)

288288 space

289− txt $ case style of

290− EqualSign -> "="

291− RightArrow -> "->"

289+ inci $ case style of

290+ EqualSign -> equals

291+ RightArrow -> txt "->"

292292 placeHanging placement p_body

293293 where

294294 placement =

@@ -494,7 +494,7 @@ p_hsLocalBinds = \case

494494 let p_ipBind (IPBind NoExtField (Left name) expr) = do

495495 atom name

496496 space

497− txt "="

497+ equals

498498 breakpoint

499499 useBraces $ inci $ located expr p_hsExpr

500500 p_ipBind (IPBind NoExtField (Right _) _) =

@@ -513,7 +513,7 @@ p_hsRecField HsRecField {..} = do

513513 p_rdrName hsRecFieldLbl

514514 unless hsRecPun $ do

515515 space

516− txt "="

516+ equals

517517 let placement =

518518 if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)

519519 then exprPlacement (unLoc hsRecFieldArg)

@@ -821,7 +821,7 @@ p_patSynBind PSB {..} = do

821821 breakpoint

822822 located psb_def p_pat

823823 ImplicitBidirectional -> do

824− txt "="

824+ equals

825825 breakpoint

826826 located psb_def p_pat

827827 ExplicitBidirectional mgroup -> do

@@ -1006,7 +1006,7 @@ p_pat_hsRecField HsRecField {..} = do

10061006 p_rdrName (rdrNameFieldOcc x)

10071007 unless hsRecPun $ do

10081008 space

1009− txt "="

1009+ equals

10101010 breakpoint

10111011 inci (located hsRecFieldArg p_pat)

10121012