96390b2 · ormolu · git.iko.soy

git.iko.soy/ormolu

Fix idempotence bug due to wandering comments

Previously, if an operator had preceding comments attached to its second argument, they would end up printed right after the operator: a + -- b comment b On second run however, the comment would be interpreted as attached to ‘(+)’ and the result would be: a + b -- b comment Breaking the idempotence guarantees. The solution that this commit implements includes several steps: * Introduce the concept of “dirty line”. A line is dirty if it has something on it that can have a comment attached to it. * ‘txt’ is supposed to output fixed bits of syntax that cannot have comments attached to them (at least in Ormolu's model). * ‘atom’ on the other hand outputs things that mark the current line dirty. * When we're to print preceding comments for the second argument we check if the current line is dirty. If it is, we output an extra newline to prevent the first comment from changing “hosts”. * Now there is another problem with trailing whitespace after the operator in that case. We solve that by making spaces a bit “lazy”. When the ‘space’ combinator is used (which is the recommeneded way to separate different constructs now) it just guarantees that the next thing we'll output on the same line will be separated from previous output by a single space. So, using ‘space’ twice results in single space in output still. This has the extra benefit of simplifying all the logic that made sure that we have only single space and not 0 or 2 spaces when spaces are inserted conditionally and independently.

commit96390b24052f2443f2bbea12b16f7f4837b6edff authormrkkrp <mark.karpov@tweag.io> dateSun 25 Aug 2019, 16:24 (7 years ago) parenteffb5cd

20 files changed+334−182

compare with master

unifiedsplit

data/examples/declaration/value/function/infix/comments-out.hs+3−2

@@ -4,6 +4,7 @@ main =

44 -- baz

66bar

7− $ {- foo

8− -}

7+ $

8+ {- foo

9+ -}

910 bar

data/examples/declaration/value/function/infix/comments.hs−3

@@ -6,6 +6,3 @@ bar $

66 {- foo

77 -}

88 bar

9−

10−

11−

data/examples/declaration/value/function/operator-comments-out.hsnew file+16

@@ -0,0 +1,16 @@

1+foo =

2+ bar

3+ ++

4+ {- some comment -}

5+ case foo of

6+ a -> a

8+foo =

9+ bar

10+ ++ case foo of {- some comment -}

11+ a -> a

12+

13+foo =

14+ bar

15+ ++ case foo of {- some comment -}

16+ a -> a

data/examples/declaration/value/function/operator-comments.hsnew file+17

@@ -0,0 +1,17 @@

1+foo =

2+ bar

3+ ++

4+ {- some comment -}

5+ case foo of

6+ a -> a

8+foo =

9+ bar

10+ ++ {- some comment -}

11+ case foo of

12+ a -> a

13+

14+foo =

15+ bar

16+ ++ case foo of {- some comment -}

17+ a -> a

src/Ormolu/Printer/Combinators.hs+2−23

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

1616 -- ** Basic

1717 , txt

1818 , atom

19+ , space

1920 , newline

2021 , inci

2122 , located

@@ -44,7 +45,6 @@ module Ormolu.Printer.Combinators

4445 , pragma

4546 -- ** Literals

4647 , comma

47− , space

4848 )

4949where

5050

@@ -54,28 +54,12 @@ import Data.List (intersperse)

5454import Data.Text (Text)

5555import Ormolu.Printer.Comments

5656import Ormolu.Printer.Internal

57−import Ormolu.Utils (isModule, showOutputable)

58−import Outputable (Outputable)

57+import Ormolu.Utils (isModule)

5958import SrcLoc

60−import qualified Data.Text as T

6159

6260----------------------------------------------------------------------------

6361-- Basic

6462

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

66−-- breaks or tab characters. 'txt' is used to output all sorts of “fixed”

67−-- bits of syntax like keywords and pipes @|@ in functional dependencies.

68−

69−txt :: Text -> R ()

70−txt t = ensureIndent >> spit t

71−

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

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

74−-- does have an 'Outputable' instance.

75−

76−atom :: Outputable a => a -> R ()

77−atom = txt . T.pack . showOutputable

78−

7963-- | Enter a 'Located' entity. This combinator handles outputting comments

8064-- and sets layout (single-line vs multi-line) for the inner computation.

8165-- Roughly, the rule for using 'located' is that every time there is a

@@ -303,8 +287,3 @@ ospaces m = vlayout m $ do

303287

304288comma :: R ()

305289comma = txt ","

306−

307−-- | Print single space.

308−

309−space :: R ()

310−space = txt " "

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

@@ -62,10 +62,20 @@ spitPrecedingComment

6262spitPrecedingComment (L ref a) mlastSpn = do

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

6464 withPoppedComment p $ \l comment -> do

65− when (needsNewlineBefore l mlastSpn) newline

65+ dirtyLine <-

66+ case mlastSpn of

67+ -- NOTE When the current line is dirty it means that something that

68+ -- can have comments attached to it is already on the line. To avoid

69+ -- problems with idempotence we cannot output the first comment

70+ -- immediately because it'll be attached to the previous element (on

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

72+ -- an extra 'newline' in this case.

73+ Nothing -> isLineDirty -- only for very first preceding comment

74+ Just _ -> return False

75+ when (dirtyLine || needsNewlineBefore l mlastSpn) newline

6676 spitComment comment

67− if theSameLine l ref && not (isModule a)

68− then spit " "

77+ if theSameLinePre l ref && not (isModule a)

78+ then space

6979 else newline

7080

7181-- | Output a comment that follows element at given location immediately on

@@ -84,7 +94,7 @@ spitFollowingComment (L ref a) mlastSpn = do

8494 newlineModified <- isNewlineModified

8595 i <- getIndent

8696 withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastSpn) $ \l comment ->

87− if theSameLine l ref && not (isModule a)

97+ if theSameLinePost l ref && not (isModule a)

8898 then modNewline $ \m -> setIndent i $ do

8999 if newlineModified

90100 then do

@@ -94,7 +104,7 @@ spitFollowingComment (L ref a) mlastSpn = do

94104 spitComment comment

95105 newline

96106 else do

97− spit " "

107+ space

98108 spitComment comment

99109 m

100110 else modNewline $ \m -> setIndent i $ do

@@ -158,15 +168,24 @@ needsNewlineBefore l mlastSpn =

158168 Just lastSpn ->

159169 srcSpanStartLine l > srcSpanEndLine lastSpn + 1

160170

161−-- | Is the comment and AST element are on the same line?

171+-- | Is the preceding comment and AST element are on the same line?

162172

163−theSameLine

173+theSameLinePre

164174 :: RealSrcSpan -- ^ Current comment span

165175 -> RealSrcSpan -- ^ AST element location

166176 -> Bool

167−theSameLine l ref =

177+theSameLinePre l ref =

168178 srcSpanEndLine l == srcSpanStartLine ref

169179

180+-- | Is the following comment and AST element are on the same line?

181+

182+theSameLinePost

183+ :: RealSrcSpan -- ^ Current comment span

184+ -> RealSrcSpan -- ^ AST element location

185+ -> Bool

186+theSameLinePost l ref =

187+ srcSpanStartLine l == srcSpanEndLine ref

188+

170189-- | Determine if given comment follows AST element.

171190

172191commentFollowsElt

@@ -188,7 +207,7 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =

188207 realSrcSpanStart l >= realSrcSpanEnd ref

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

190209 logicallyFollows

191− = theSameLine l ref -- a) it's on the same line

210+ = theSameLinePost l ref -- a) it's on the same line

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

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

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

@@ -235,6 +254,4 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =

235254

236255spitComment :: Comment -> R ()

237256spitComment =

238− sitcc . sequence_ . NE.intersperse newline . fmap f . coerce

239− where

240− f x = ensureIndent >> spit (T.pack x)

257+ sitcc . sequence_ . NE.intersperse newline . fmap (txt . T.pack) . coerce

src/Ormolu/Printer/Internal.hs+74−17

@@ -13,11 +13,13 @@ module Ormolu.Printer.Internal

1313 R

1414 , runR

1515 -- * Internal functions

16− , spit

16+ , txt

17+ , atom

18+ , space

1719 , newline

1820 , modNewline

1921 , isNewlineModified

20− , ensureIndent

22+ , isLineDirty

2123 , inci

2224 , sitcc

2325 , Layout (..)

@@ -43,6 +45,7 @@ where

4345

4446import Control.Monad.Reader

4547import Control.Monad.State.Strict

48+import Data.Bool (bool)

4649import Data.Coerce

4750import Data.Maybe (fromMaybe, isJust, listToMaybe)

4851import Data.Text (Text)

@@ -52,6 +55,8 @@ import GHC

5255import Ormolu.Parser.Anns

5356import Ormolu.Parser.CommentStream

5457import Ormolu.Printer.SpanStream

58+import Ormolu.Utils (showOutputable)

59+import Outputable (Outputable)

5560import SrcLoc

5661import qualified Data.Text as T

5762import qualified Data.Text.Lazy as TL

@@ -96,6 +101,10 @@ data SC = SC

96101 -- ^ Comment stream

97102 , scNewline :: Maybe (R ())

98103 -- ^ What to render as newline, or 'Nothing' ('newlineRaw' will be used)

104+ , scDirtyLine :: !Bool

105+ -- ^ Whether the current line is “dirty”

106+ , scSpace :: !Bool

107+ -- ^ Whether to output a space before the next output

99108 }

100109

101110-- | 'Layout' options.

@@ -131,23 +140,71 @@ runR debug (R m) sstream cstream anns =

131140 , scSpanStream = sstream

132141 , scCommentStream = cstream

133142 , scNewline = Nothing

143+ , scDirtyLine = False

144+ , scSpace = False

134145 }

135146

136147----------------------------------------------------------------------------

137148-- Internal functions

138149

139−-- | Grow current output by appending given 'Text' to it, which may not

140−-- contain newlines.

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

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

152+-- keywords and pipes @|@ in functional dependencies.

153+--

154+-- To separate various bits of syntax with white space use 'space' instead

155+-- of @'txt' " "@. To output 'Outputable' Haskell entities like numbers use

156+-- 'atom'.

157+

158+txt

159+ :: Text -- ^ 'Text' to output

160+ -> R ()

161+txt = spit False

162+

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

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

165+-- does have an 'Outputable' instance.

141166

142−spit :: Text -> R ()

143−spit x = do

167+atom

168+ :: Outputable a

169+ => a

170+ -> R ()

171+atom = spit True . T.pack . showOutputable

172+

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

174+

175+spit :: Bool -> Text -> R ()

176+spit dirty x' = do

177+ i <- R (asks rcIndent)

178+ c <- R (gets scColumn)

179+ needsSpace <- R (gets scSpace)

180+ let spaces =

181+ if (c < i)

182+ then T.replicate (i - c) " "

183+ else bool mempty " " needsSpace

184+ x = spaces <> x'

144185 traceR "spit_before" (Just x)

145186 R . modify $ \sc -> sc

146187 { scBuilder = scBuilder sc <> fromText x

147188 , scColumn = scColumn sc + T.length x

189+ , scDirtyLine = scDirtyLine sc || dirty

190+ , scSpace = False

148191 }

149192 traceR "spit_after" Nothing

150193

194+-- | This primitive /does not/ necessarily output a space. It just ensures

195+-- that the next thing that will be printed on the same line will be

196+-- separated by a single space from the previous output. Using this

197+-- combinator twice results in at most one space.

198+--

199+-- In practice this design prevents trailing white space and makes it hard

200+-- to output more than one delimiting space in a row, which is what we

201+-- usually want.

202+

203+space :: R ()

204+space = R . modify $ \sc -> sc

205+ { scSpace = True

206+ }

207+

151208-- | Output a newline.

152209

153210newline :: R ()

@@ -167,6 +224,8 @@ newlineRaw = do

167224 R . modify $ \sc -> sc

168225 { scBuilder = scBuilder sc <> "\n"

169226 , scColumn = 0

227+ , scDirtyLine = False

228+ , scSpace = False

170229 }

171230 traceR "newline_after" Nothing

172231

@@ -192,16 +251,11 @@ modNewline f = R $ do

192251isNewlineModified :: R Bool

193252isNewlineModified = isJust <$> R (gets scNewline)

194253

195−-- | Ensure that indentation level is satisfied. Insert correct number of

196−-- spaces if it isn't.

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

255+-- that can have comments attached to it.

197256

198−ensureIndent :: R ()

199−ensureIndent = do

200− traceR "ensure_indent" Nothing

201− i <- R (asks rcIndent)

202− c <- R (gets scColumn)

203− when (c < i) $

204− spit (T.replicate (i - c) " ")

257+isLineDirty :: R Bool

258+isLineDirty = R (gets scDirtyLine)

205259

206260-- | Increase indentation level by one indentation step for the inner

207261-- computation. 'inci' should be used when a part of code must be more

@@ -229,11 +283,14 @@ sitcc m' = do

229283 traceR "sitcc_before" Nothing

230284 i <- R (asks rcIndent)

231285 c <- R (gets scColumn)

286+ needsSpace <- R (gets scSpace)

232287 let R m = traceR "sitcc_inside" Nothing >> m'

233288 modRC rc = rc

234− { rcIndent = max i c

289+ { rcIndent = max i c + bool 0 1 needsSpace

235290 }

236− vlayout m' (R (local modRC m))

291+ vlayout m' . R $ do

292+ modify $ \sc -> sc { scSpace = False }

293+ local modRC m

237294 traceR "sitcc_ended" Nothing

238295

239296-- | Set 'Layout' for internal computation.

src/Ormolu/Printer/Meat/Common.hs+6−3

@@ -30,17 +30,20 @@ data FamilyStyle

3030

3131p_hsmodName :: ModuleName -> R ()

3232p_hsmodName mname = do

33− txt "module "

33+ txt "module"

34+ space

3435 atom mname

3536

3637p_ieWrappedName :: IEWrappedName RdrName -> R ()

3738p_ieWrappedName = \case

3839 IEName x -> p_rdrName x

3940 IEPattern x -> do

40− txt "pattern "

41+ txt "pattern"

42+ space

4143 p_rdrName x

4244 IEType x -> do

43− txt "type "

45+ txt "type"

46+ space

4447 p_rdrName x

4548

4649-- | Render a @'Located' 'RdrName'@.

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

@@ -23,5 +23,5 @@ p_annDecl = \case

2323p_annProv :: AnnProvenance (IdP GhcPs) -> R ()

2424p_annProv = \case

2525 ValueAnnProvenance name -> p_rdrName name

26− TypeAnnProvenance name -> txt "type " >> p_rdrName name

26+ TypeAnnProvenance name -> txt "type" >> space >> p_rdrName name

2727 ModuleAnnProvenance -> txt "module"

src/Ormolu/Printer/Meat/Declaration/Class.hs+14−9

@@ -52,10 +52,10 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do

5252 (p_rdrName name)

5353 (located' p_hsTyVarBndr <$> hsq_explicit)

5454 inci (p_classFundeps fdeps)

55− -- GHC's AST does not necessarily store each kind of element in source

56− -- location order. This happens because different declarations are stored in

57− -- different lists. Consequently, to get all the declarations in proper order,

58− -- they need to be manually sorted.

55+ -- NOTE GHC's AST does not necessarily store each kind of element in

56+ -- source location order. This happens because different declarations are

57+ -- stored in different lists. Consequently, to get all the declarations in

58+ -- proper order, they need to be manually sorted.

5959 let sigs = (getLoc &&& fmap (SigD NoExt)) <$> csigs

6060 vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cdefs

6161 tyFams = (getLoc &&& fmap (TyClD NoExt . FamDecl NoExt)) <$> cats

@@ -65,10 +65,11 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do

6565 allDecls =

6666 snd <$> sortBy (comparing fst) (sigs <> vals <> tyFams <> tyFamDefs)

6767 unless (null allDecls) $ do

68− txt " where"

68+ space

69+ txt "where"

6970 breakpoint -- Ensure whitespace is added after where clause.

7071 -- Add newline before first declaration if the body contains separate

71− -- declarations

72+ -- declarations.

7273 when (hasSeparatedDecls allDecls) breakpoint'

7374 inci (p_hsDecls Associated allDecls)

7475

@@ -76,18 +77,22 @@ p_classContext :: LHsContext GhcPs -> R ()

7677p_classContext ctx = unless (null (unLoc ctx)) $ do

7778 located ctx p_hsContext

7879 breakpoint

79− txt "=> "

80+ txt "=>"

81+ space

8082

8183p_classFundeps :: [Located (FunDep (Located RdrName))] -> R ()

8284p_classFundeps fdeps = unless (null fdeps) $ do

8385 breakpoint

84− txt "| "

86+ txt "|"

87+ space

8588 sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps

8689

8790p_funDep :: FunDep (Located RdrName) -> R ()

8891p_funDep (before, after) = do

8992 sep space p_rdrName before

90− txt " -> "

93+ space

94+ txt "->"

95+ space

9196 sep space p_rdrName after

9297

9398----------------------------------------------------------------------------

src/Ormolu/Printer/Meat/Declaration/Data.hs+24−13

@@ -44,19 +44,22 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

4444 Nothing -> return ()

4545 Just k -> do

4646 space

47− txt ":: "

47+ txt "::"

48+ space

4849 located k p_hsType

4950 let gadt = isJust dd_kindSig || any (isGadt . unLoc) dd_cons

5051 unless (null dd_cons) $

5152 if gadt

5253 then do

53− txt " where"

54+ space

55+ txt "where"

5456 breakpoint

5557 inci $ sepSemi (located' p_conDecl) dd_cons

5658 else switchLayout (getLoc name : (getLoc <$> dd_cons)) $

5759 inci $ do

5860 breakpoint

59− txt "= "

61+ txt "="

62+ space

6063 let s = vlayout (txt " | ") (newline >> txt "| ")

6164 sep s (sitcc . located' p_conDecl) dd_cons

6265

@@ -78,7 +81,8 @@ p_conDecl = \case

7881 sitcc $ sep (comma >> breakpoint) p_rdrName cs

7982 breakpoint

8083 inci $ do

81− txt ":: "

84+ txt "::"

85+ space

8286 p_forallBndrs (hsq_explicit con_qvars)

8387 forM_ con_mb_cxt p_lhsContext

8488 case con_args of

@@ -86,12 +90,14 @@ p_conDecl = \case

8690 sep breakpoint (located' p_hsType) xs

8791 unless (null xs) $ do

8892 breakpoint

89− txt "-> "

93+ txt "->"

94+ space

9095 RecCon l -> do

9196 located l p_conDeclFields

9297 unless (null $ unLoc l) $ do

9398 breakpoint

94− txt "-> "

99+ txt "->"

100+ space

95101 InfixCon _ _ -> notImplemented "InfixCon"

96102 p_hsType (unLoc con_res_ty)

97103 ConDeclH98 {..} -> do

@@ -121,9 +127,11 @@ p_forallBndrs

121127p_forallBndrs = \case

122128 [] -> return ()

123129 bndrs -> do

124− txt "forall "

130+ txt "forall"

131+ space

125132 sep space (located' p_hsTyVarBndr) bndrs

126− txt ". "

133+ txt "."

134+ space

127135

128136p_lhsContext

129137 :: LHsContext GhcPs

@@ -133,7 +141,8 @@ p_lhsContext = \case

133141 ctx -> do

134142 located ctx p_hsContext

135143 breakpoint

136− txt "=> "

144+ txt "=>"

145+ space

137146

138147isGadt :: ConDecl GhcPs -> Bool

139148isGadt = \case

@@ -152,21 +161,22 @@ p_hsDerivingClause HsDerivingClause {..} = do

152161 (comma >> breakpoint)

153162 (sitcc . located' p_hsType . hsib_body)

154163 xs

164+ space

155165 case deriv_clause_strategy of

156166 Nothing -> do

157167 breakpoint

158168 inci derivingWhat

159169 Just (L _ a) -> case a of

160170 StockStrategy -> do

161− txt " stock"

171+ txt "stock"

162172 breakpoint

163173 inci derivingWhat

164174 AnyclassStrategy -> do

165− txt " anyclass"

175+ txt "anyclass"

166176 breakpoint

167177 inci derivingWhat

168178 NewtypeStrategy -> do

169− txt " newtype"

179+ txt "newtype"

170180 breakpoint

171181 inci derivingWhat

172182 ViaStrategy HsIB {..} -> do

@@ -174,7 +184,8 @@ p_hsDerivingClause HsDerivingClause {..} = do

174184 inci $ do

175185 derivingWhat

176186 breakpoint

177− txt "via "

187+ txt "via"

188+ space

178189 located hsib_body p_hsType

179190 ViaStrategy (XHsImplicitBndrs NoExt) ->

180191 notImplemented "XHsImplicitBndrs"

src/Ormolu/Printer/Meat/Declaration/Foreign.hs+4−2

@@ -54,7 +54,8 @@ p_foreignTypeSig fd = do

5454

5555p_foreignImport :: ForeignImport -> R ()

5656p_foreignImport (CImport cCallConv safety _ _ sourceText) = do

57− txt "foreign import "

57+ txt "foreign import"

58+ space

5859 located cCallConv atom

5960 -- Need to check for 'noLoc' for the 'safe' annotation

6061 when (isGoodSrcSpan $ getLoc safety) (space >> atom safety)

@@ -62,7 +63,8 @@ p_foreignImport (CImport cCallConv safety _ _ sourceText) = do

6263

6364p_foreignExport :: ForeignExport -> R ()

6465p_foreignExport (CExport (L loc (CExportStatic _ _ cCallConv)) sourceText) = do

65− txt "foreign export "

66+ txt "foreign export"

67+ space

6668 located (L loc cCallConv) atom

6769 located sourceText p_sourceText

6870

src/Ormolu/Printer/Meat/Declaration/Instance.hs+5−5

@@ -38,22 +38,22 @@ p_standaloneDerivDecl DerivDecl {..} = do

3838 then inci typesAfterInstance

3939 else typesAfterInstance

4040 txt "deriving"

41+ space

4142 case deriv_strategy of

4243 Nothing -> do

43− space

4444 instTypes False

4545 Just (L _ a) -> case a of

4646 StockStrategy -> do

47− txt " stock "

47+ txt "stock "

4848 instTypes False

4949 AnyclassStrategy -> do

50− txt " anyclass "

50+ txt "anyclass "

5151 instTypes False

5252 NewtypeStrategy -> do

53− txt " newtype "

53+ txt "newtype "

5454 instTypes False

5555 ViaStrategy HsIB {..} -> do

56− txt " via"

56+ txt "via"

5757 breakpoint

5858 inci (located hsib_body p_hsType)

5959 breakpoint

src/Ormolu/Printer/Meat/Declaration/Rule.hs+4−5

@@ -8,7 +8,6 @@ module Ormolu.Printer.Meat.Declaration.Rule

88where

1010import BasicTypes

11−import Control.Monad

1211import GHC

1312import Ormolu.Printer.Combinators

1413import Ormolu.Printer.Meat.Common

@@ -26,15 +25,15 @@ p_ruleDecl :: RuleDecl GhcPs -> R ()

2625p_ruleDecl = \case

2726 HsRule NoExt ruleName activation ruleBndrs lhs rhs -> do

2827 located ruleName p_ruleName

29− let gotBinders = not (null ruleBndrs)

30− when (visibleActivation activation || gotBinders) space

28+ space

3129 p_activation activation

32− when (visibleActivation activation && gotBinders) space

30+ space

3331 p_ruleBndrs ruleBndrs

3432 breakpoint

3533 inci $ do

3634 located lhs p_hsExpr

37− txt " ="

35+ space

36+ txt "="

3837 inci $ do

3938 breakpoint

4039 located rhs p_hsExpr

src/Ormolu/Printer/Meat/Declaration/Signature.hs+16−18

@@ -8,7 +8,6 @@ module Ormolu.Printer.Meat.Declaration.Signature

88 ( p_sigDecl

99 , p_typeAscription

1010 , p_activation

11− , visibleActivation

1211 )

1312where

1413

@@ -56,7 +55,8 @@ p_typeAscription

5655p_typeAscription HsWC {..} = do

5756 breakpoint

5857 inci $ do

59− txt ":: "

58+ txt "::"

59+ space

6060 located (hsib_body hswc_body) p_hsType

6161p_typeAscription (XHsWildCardBndrs NoExt) = notImplemented "XHsWildCardBndrs"

6262

@@ -74,7 +74,7 @@ p_classOpSig

7474 -> HsImplicitBndrs GhcPs (LHsType GhcPs) -- ^ Type

7575 -> R ()

7676p_classOpSig def names hsib = do

77− when def (txt "default ")

77+ when def (txt "default" >> space)

7878 p_typeSig names HsWC {hswc_ext = NoExt, hswc_body = hsib}

7979

8080p_fixSig

@@ -98,11 +98,13 @@ p_inlineSig

9898 -> R ()

9999p_inlineSig name InlinePragma {..} = pragmaBraces $ do

100100 p_inlineSpec inl_inline

101+ space

101102 case inl_rule of

102− ConLike -> txt "CONLIKE "

103+ ConLike -> txt "CONLIKE"

103104 FunLike -> return ()

105+ space

104106 p_activation inl_act

105− when (visibleActivation inl_act) space

107+ space

106108 p_rdrName name

107109

108110p_specSig

@@ -114,8 +116,9 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do

114116 txt "SPECIALIZE"

115117 space

116118 p_inlineSpec inl_inline

119+ space

117120 p_activation inl_act

118− when (visibleActivation inl_act) space

121+ space

119122 p_rdrName name

120123 breakpoint

121124 inci $ do

@@ -123,11 +126,11 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do

123126 sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts

124127

125128p_inlineSpec :: InlineSpec -> R ()

126−p_inlineSpec = txt . \case

127− Inline -> "INLINE "

128− Inlinable -> "INLINEABLE "

129− NoInline -> "NOINLINE "

130− NoUserInline -> ""

129+p_inlineSpec = \case

130+ Inline -> txt "INLINE"

131+ Inlinable -> txt "INLINEABLE"

132+ NoInline -> txt "NOINLINE"

133+ NoUserInline -> return ()

131134

132135p_activation :: Activation -> R ()

133136p_activation = \case

@@ -142,12 +145,6 @@ p_activation = \case

142145 atom n

143146 txt "]"

144147

145−visibleActivation :: Activation -> Bool

146−visibleActivation = \case

147− NeverActive -> False

148− AlwaysActive -> False

149− _ -> True

150−

151148p_specInstSig :: LHsSigType GhcPs -> R ()

152149p_specInstSig hsib = pragma "SPECIALIZE instance" . inci $

153150 located (hsib_body hsib) p_hsType

@@ -185,7 +182,8 @@ p_completeSig cs' mty =

185182 forM_ mty $ \ty -> do

186183 breakpoint

187184 inci $ do

188− txt ":: "

185+ txt "::"

186+ space

189187 p_rdrName ty

190188

191189p_sccSig :: Located (IdP GhcPs) -> Maybe (Located StringLiteral) -> R ()

src/Ormolu/Printer/Meat/Declaration/Type.hs+6−2

@@ -22,7 +22,8 @@ p_synDecl

2222 -> LHsType GhcPs -- ^ RHS of type declaration

2323 -> R ()

2424p_synDecl name fixity tvars t = do

25− txt "type "

25+ txt "type"

26+ space

2627 let HsQTvs {..} = tvars

2728 switchLayout (getLoc name : map getLoc hsq_explicit) $ do

2829 p_infixDefHelper

@@ -31,4 +32,7 @@ p_synDecl name fixity tvars t = do

3132 (p_rdrName name)

3233 (map (located' p_hsTyVarBndr) hsq_explicit)

3334 breakpoint

34− inci (txt "= " >> located t p_hsType)

35+ inci $ do

36+ txt "="

37+ space

38+ located t p_hsType

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+15−7

@@ -48,9 +48,12 @@ p_famDecl style FamilyDecl {..} = do

4848 case mmeqs of

4949 Nothing -> return ()

5050 Just meqs -> do

51− txt " where"

51+ space

52+ txt "where"

5253 case meqs of

53− Nothing -> txt " .."

54+ Nothing -> do

55+ space

56+ txt ".."

5457 Just eqs -> do

5558 newline

5659 sep newline (located' (inci . p_tyFamInstEqn)) eqs

@@ -65,20 +68,24 @@ p_familyResultSigL injAnn l =

6568 L _ a -> case a of

6669 NoSig NoExt -> Nothing

6770 KindSig NoExt k -> Just $ do

68− if injAnn then txt "= " else txt ":: "

71+ if injAnn then txt "=" else txt "::"

72+ space

6973 located k p_hsType

7074 TyVarSig NoExt bndr -> Just $ do

71− if injAnn then txt "= " else txt ":: "

75+ if injAnn then txt "=" else txt "::"

76+ space

7277 located bndr p_hsTyVarBndr

7378 XFamilyResultSig NoExt ->

7479 notImplemented "XFamilyResultSig"

7580

7681p_injectivityAnn :: InjectivityAnn GhcPs -> R ()

7782p_injectivityAnn (InjectivityAnn a bs) = do

78− txt "| "

83+ txt "|"

84+ space

7985 p_rdrName a

8086 space

81− txt "-> "

87+ txt "->"

88+ space

8289 sep space p_rdrName bs

8390

8491p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

@@ -89,7 +96,8 @@ p_tyFamInstEqn HsIB {..} = do

8996 inci

9097 (p_rdrName feqn_tycon)

9198 (located' p_hsType <$> feqn_pats)

92− txt " ="

99+ space

100+ txt "="

93101 breakpoint

94102 inci (located feqn_rhs p_hsType)

95103p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"

src/Ormolu/Printer/Meat/Declaration/Value.hs+64−35

@@ -182,7 +182,8 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do

182182 BangPat _ _ -> True

183183 SplicePat _ _ -> True

184184 _ -> False

185− txt (if needsSpace then "\\ " else "\\")

185+ txt "\\"

186+ when needsSpace space

186187 sitcc stdCase

187188 LambdaCase -> stdCase

188189 return inci'

@@ -203,10 +204,10 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do

203204 unless (length grhssGRHSs > 1) $ do

204205 case style of

205206 Function _ | hasGuards -> return ()

206− Function _ -> txt " ="

207− PatternBind -> txt " ="

207+ Function _ -> space >> txt "="

208+ PatternBind -> space >> txt "="

208209 s | isCase s && hasGuards -> return ()

209− _ -> txt " ->"

210+ _ -> space >> txt "->"

210211 let grhssSpan = combineSrcSpans' $

211212 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

212213 patGrhssSpan = maybe grhssSpan

@@ -250,7 +251,8 @@ p_grhs' pretty style (GRHS NoExt guards body) =

250251 case guards of

251252 [] -> p_body

252253 xs -> do

253− txt "| "

254+ txt "|"

255+ space

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

255257 space

256258 txt $ case style of

@@ -266,9 +268,10 @@ p_hsCmd :: HsCmd GhcPs -> R ()

266268p_hsCmd = \case

267269 HsCmdArrApp NoExt body input arrType _ -> do

268270 located body p_hsExpr

269− txt $ case arrType of

270− HsFirstOrderApp -> " -<"

271− HsHigherOrderApp -> " -<<"

271+ space

272+ case arrType of

273+ HsFirstOrderApp -> txt "-<"

274+ HsHigherOrderApp -> txt "-<<"

272275 placeHanging (exprPlacement (unLoc input)) $

273276 located input p_hsExpr

274277 HsCmdArrForm NoExt form Prefix _ cmds -> banana $ sitcc $ do

@@ -290,13 +293,16 @@ p_hsCmd = \case

290293 HsCmdLam NoExt mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup

291294 HsCmdPar NoExt c -> parens (located c p_hsCmd)

292295 HsCmdCase NoExt e mgroup -> do

293− txt "case "

296+ txt "case"

297+ space

294298 located e p_hsExpr

295− txt " of"

299+ space

300+ txt "of"

296301 breakpoint

297302 inci (p_matchGroup' cmdPlacement p_hsCmd Case mgroup)

298303 HsCmdIf NoExt _ if' then' else' -> do

299− txt "if "

304+ txt "if"

305+ space

300306 located if' p_hsExpr

301307 breakpoint

302308 txt "then"

@@ -309,10 +315,12 @@ p_hsCmd = \case

309315 breakpoint

310316 inci (p_hsCmd x)

311317 HsCmdLet NoExt localBinds c -> do

312− txt "let "

318+ txt "let"

319+ space

313320 sitcc (located localBinds p_hsLocalBinds)

314321 breakpoint

315− txt "in "

322+ txt "in"

323+ space

316324 sitcc (located c p_hsCmd)

317325 HsCmdDo NoExt es -> do

318326 txt "do"

@@ -345,7 +353,8 @@ p_stmt' pretty = \case

345353 ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer

346354 BodyStmt NoExt body _ _ -> located body pretty

347355 LetStmt NoExt binds -> do

348− txt "let "

356+ txt "let"

357+ space

349358 sitcc $ located binds p_hsLocalBinds

350359 ParStmt {} ->

351360 -- NOTE 'ParStmt' should always be eliminated in 'gatherStmt' already,

@@ -386,7 +395,8 @@ p_stmt' pretty = \case

386395 breakpoint

387396 inci (p_hsExpr x)

388397 RecStmt {..} -> do

389− txt "rec "

398+ txt "rec"

399+ space

390400 sitcc $ sepSemi (located' (p_stmt' pretty)) recS_stmts

391401 XStmtLR {} -> notImplemented "XStmtLR"

392402

@@ -429,7 +439,8 @@ p_hsLocalBinds = \case

429439 -- Second argument of IPBind is always Left before type-checking.

430440 let p_ipBind (IPBind NoExt (Left name) expr) = do

431441 atom name

432− txt " ="

442+ space

443+ txt "="

433444 breakpoint

434445 useBraces $ inci $ located expr p_hsExpr

435446 p_ipBind _ = notImplemented "XHsIPBinds"

@@ -445,7 +456,8 @@ p_hsRecField

445456p_hsRecField = \HsRecField {..} -> do

446457 located hsRecFieldLbl atom

447458 unless hsRecPun $ do

448− txt " ="

459+ space

460+ txt "="

449461 let placement = exprPlacement (unLoc hsRecFieldArg)

450462 placeHanging placement $ located hsRecFieldArg p_hsExpr

451463

@@ -513,7 +525,8 @@ p_hsExpr = \case

513525 space

514526 located y p_hsExpr

515527 NegApp NoExt e _ -> do

516− txt "- "

528+ txt "-"

529+ space

517530 located e p_hsExpr

518531 HsPar NoExt e -> parens (located e p_hsExpr)

519532 SectionL NoExt x op -> do

@@ -541,13 +554,16 @@ p_hsExpr = \case

541554 ExplicitSum NoExt tag arity e ->

542555 p_unboxedSum tag arity (located e p_hsExpr)

543556 HsCase NoExt e mgroup -> do

544− txt "case "

557+ txt "case"

558+ space

545559 located e p_hsExpr

546− txt " of"

560+ space

561+ txt "of"

547562 breakpoint

548563 inci (p_matchGroup Case mgroup)

549564 HsIf NoExt _ if' then' else' -> do

550− txt "if "

565+ txt "if"

566+ space

551567 located if' p_hsExpr

552568 breakpoint

553569 inci $ do

@@ -563,10 +579,12 @@ p_hsExpr = \case

563579 breakpoint

564580 inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards

565581 HsLet NoExt localBinds e -> do

566− txt "let "

582+ txt "let"

583+ space

567584 dontUseBraces $ sitcc (located localBinds p_hsLocalBinds)

568− vlayout space (newline >> space)

569− txt "in "

585+ vlayout space (newline >> txt " ")

586+ txt "in"

587+ space

570588 sitcc (located e p_hsExpr)

571589 HsDo NoExt ctx es -> do

572590 let doBody header = do

@@ -586,7 +604,8 @@ p_hsExpr = \case

586604 lists = foldr (liftAppend . gatherStmt) [] stmts

587605 located yield p_stmt

588606 breakpoint

589− txt "| "

607+ txt "|"

608+ space

590609 p_parBody lists

591610 case ctx of

592611 DoExpr -> doBody "do"

@@ -619,7 +638,8 @@ p_hsExpr = \case

619638 located x p_hsExpr

620639 breakpoint

621640 inci $ do

622− txt ":: "

641+ txt "::"

642+ space

623643 let HsWC {..} = affix

624644 HsIB {..} = hswc_body

625645 located hsib_body p_hsType

@@ -636,12 +656,14 @@ p_hsExpr = \case

636656 FromTo from to -> brackets . sitcc $ do

637657 located from p_hsExpr

638658 breakpoint

639− txt ".. "

659+ txt ".."

660+ space

640661 located to p_hsExpr

641662 FromThenTo from next to -> brackets . sitcc $ do

642663 sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]

643664 breakpoint

644− txt ".. "

665+ txt ".."

666+ space

645667 located to p_hsExpr

646668 HsSCC NoExt _ name x -> do

647669 txt "{-# SCC "

@@ -688,27 +710,31 @@ p_hsExpr = \case

688710

689711p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()

690712p_patSynBind PSB {..} = do

691− txt "pattern "

713+ txt "pattern"

714+ space

692715 case psb_dir of

693716 Unidirectional -> do

694717 p_rdrName psb_id

695718 inci $ do

696719 p_patSynDetails psb_args

697− txt " <-"

720+ space

721+ txt "<-"

698722 breakpoint

699723 located psb_def p_pat

700724 ImplicitBidirectional -> do

701725 p_rdrName psb_id

702726 inci $ do

703727 p_patSynDetails psb_args

704− txt " ="

728+ space

729+ txt "="

705730 breakpoint

706731 located psb_def p_pat

707732 ExplicitBidirectional mgroup -> do

708733 p_rdrName psb_id

709734 inci $ do

710735 p_patSynDetails psb_args

711− txt " <-"

736+ space

737+ txt "<-"

712738 breakpoint

713739 located psb_def p_pat

714740 newline

@@ -779,7 +805,8 @@ p_pat = \case

779805 ConPatOut {} -> notImplemented "ConPatOut" -- presumably created by renamer?

780806 ViewPat NoExt expr pat -> sitcc $ do

781807 located expr p_hsExpr

782− txt " ->"

808+ space

809+ txt "->"

783810 breakpoint

784811 inci (located pat p_pat)

785812 SplicePat NoExt splice -> p_hsSplice splice

@@ -789,7 +816,8 @@ p_pat = \case

789816 p_rdrName n

790817 breakpoint

791818 inci $ do

792− txt "+ "

819+ txt "+"

820+ space

793821 located k (atom . ol_val)

794822 SigPat hswc pat -> do

795823 located pat p_pat

@@ -802,7 +830,8 @@ p_pat_hsRecField HsRecField {..} = do

802830 located hsRecFieldLbl $ \x ->

803831 p_rdrName (rdrNameFieldOcc x)

804832 unless hsRecPun $ do

805− txt " ="

833+ space

834+ txt "="

806835 breakpoint

807836 inci (located hsRecFieldArg p_pat)

808837

src/Ormolu/Printer/Meat/ImportExport.hs+17−14

@@ -27,29 +27,31 @@ p_hsmodExports xs =

2727

2828p_hsmodImport :: ImportDecl GhcPs -> R ()

2929p_hsmodImport ImportDecl {..} = line $ do

30− txt "import "

31− when ideclSource $

32− txt "{-# SOURCE #-} "

33− when ideclSafe $

34− txt "safe "

35− when ideclQualified $

36− txt "qualified "

30+ txt "import"

31+ space

32+ when ideclSource (txt "{-# SOURCE #-}")

33+ space

34+ when ideclSafe (txt "safe")

35+ space

36+ when ideclQualified (txt "qualified")

37+ space

3738 case ideclPkgQual of

3839 Nothing -> return ()

39− Just slit -> do

40− atom slit

41− space

40+ Just slit -> atom slit

41+ space

4242 located ideclName atom

4343 case ideclAs of

4444 Nothing -> return ()

4545 Just l -> do

46− txt " as "

46+ space

47+ txt "as"

48+ space

4749 located l atom

50+ space

4851 case ideclHiding of

4952 Nothing -> return ()

5053 Just (hiding, _) ->

51− when hiding $

52− txt " hiding"

54+ when hiding (txt "hiding")

5355 case ideclHiding of

5456 Nothing -> return ()

5557 Just (_, (L _ a)) -> do

@@ -64,7 +66,8 @@ p_lie = \case

6466 IEThingAbs NoExt l1 -> located l1 p_ieWrappedName

6567 IEThingAll NoExt l1 -> do

6668 located l1 p_ieWrappedName

67− txt " (..)"

69+ space

70+ txt "(..)"

6871 IEThingWith NoExt l1 w xs _ -> sitcc $ do

6972 -- XXX I have no idea what field labels are in this context.

7073 located l1 p_ieWrappedName

src/Ormolu/Printer/Meat/Type.hs+17−11

@@ -25,12 +25,14 @@ p_hsType = \case

2525 HsForAllTy NoExt bndrs t -> do

2626 txt "forall "

2727 sep space (located' p_hsTyVarBndr) bndrs

28− txt ". "

28+ txt "."

29+ space

2930 p_hsType (unLoc t)

3031 HsQualTy NoExt qs t -> do

3132 located qs p_hsContext

3233 breakpoint

33− txt "=> "

34+ txt "=>"

35+ space

3436 case unLoc t of

3537 HsQualTy {} -> p_hsType (unLoc t)

3638 HsFunTy {} -> p_hsType (unLoc t)

@@ -50,7 +52,8 @@ p_hsType = \case

5052 HsFunTy NoExt x y@(L _ y') -> do

5153 located x p_hsType

5254 breakpoint

53− txt "-> "

55+ txt "->"

56+ space

5457 case y' of

5558 HsFunTy{} -> p_hsType y'

5659 _ -> located y p_hsType

@@ -66,7 +69,7 @@ p_hsType = \case

6669 sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

6770 HsSumTy NoExt xs ->

6871 parensHash . sitcc $

69− sep (txt "| " >> breakpoint') (sitcc . located' p_hsType) xs

72+ sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs

7073 HsOpTy NoExt x op y -> sitcc $ do

7174 -- In the AST, type operators are right-associative instead of left-associative

7275 -- like value level operators. This makes similar constructs look inconsistent.

@@ -99,7 +102,8 @@ p_hsType = \case

99102 located n atom

100103 breakpoint

101104 inci $ do

102− txt ":: "

105+ txt "::"

106+ space

103107 located t p_hsType

104108 HsStarTy NoExt _ -> txt "*"

105109 HsKindSig NoExt t k ->

@@ -108,14 +112,15 @@ p_hsType = \case

108112 located t p_hsType

109113 space -- FIXME

110114 inci $ do

111− txt ":: "

115+ txt "::"

116+ space

112117 located k p_hsType

113118 HsSpliceTy NoExt splice -> p_hsSplice splice

114119 HsDocTy NoExt _ _ -> error "HsDocTy"

115120 HsBangTy NoExt (HsSrcBang _ u s) t -> do

116121 case u of

117− SrcUnpack -> txt "{-# UNPACK #-} "

118− SrcNoUnpack -> txt "{-# NOUNPACK #-} "

122+ SrcUnpack -> txt "{-# UNPACK #-}" >> space

123+ SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space

119124 NoSrcUnpack -> return ()

120125 case s of

121126 SrcLazy -> txt "~"

@@ -152,7 +157,6 @@ p_hsType = \case

152157 HsExplicitTupleTy _ _ -> True

153158 _ -> False

154159

155−

156160p_hsContext :: HsContext GhcPs -> R ()

157161p_hsContext = \case

158162 [] -> txt "()"

@@ -168,7 +172,8 @@ p_hsTyVarBndr = \case

168172 located l atom

169173 breakpoint

170174 inci $ do

171− txt ":: "

175+ txt "::"

176+ space

172177 located k p_hsType

173178 XTyVarBndr NoExt -> notImplemented "XTyVarBndr"

174179

@@ -183,7 +188,8 @@ p_conDeclField ConDeclField {..} = do

183188 cd_fld_names

184189 breakpoint

185190 sitcc . inci $ do

186− txt ":: "

191+ txt "::"

192+ space

187193 p_hsType (unLoc cd_fld_type)

188194p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"

189195