96390b2 · ormolu · git.iko.soy

git.iko.soy/ormolu

on master help sign in

Fix idempotence bug due to wandering comments

96390b2mrkkrp7 years ago

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

compare with master

unifiedsplit

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

4 -- baz

6bar

7+ $

7− $ {- foo

8+ {- foo

8− -}

9+ -}

9 bar

10 bar

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

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

6 {- foo

7 -}

8 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

16 -- ** Basic

17 , txt

18 , atom

19+ , space

19 , newline

20 , newline

20 , inci

21 , inci

21 , located

22 , located

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

44 , pragma

45 , pragma

45 -- ** Literals

46 -- ** Literals

46 , comma

47 , comma

47− , space

48 )

49where

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

54import Data.Text (Text)

55import Ormolu.Printer.Comments

56import Ormolu.Printer.Internal

57−import Ormolu.Utils (isModule, showOutputable)

57+import Ormolu.Utils (isModule)

58−import Outputable (Outputable)

59import SrcLoc

58import SrcLoc

60−import qualified Data.Text as T

62----------------------------------------------------------------------------

60----------------------------------------------------------------------------

63-- Basic

61-- Basic

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−

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

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

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

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

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

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

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

303

287

304comma :: R ()

288comma :: R ()

305comma = txt ","

289comma = 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

62spitPrecedingComment (L ref a) mlastSpn = do

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

64 withPoppedComment p $ \l comment -> do

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

65− when (needsNewlineBefore l mlastSpn) newline

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

66 spitComment comment

76 spitComment comment

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

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

68− then spit " "

78+ then space

69 else newline

79 else newline

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

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

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

84 newlineModified <- isNewlineModified

94 newlineModified <- isNewlineModified

85 i <- getIndent

95 i <- getIndent

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

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

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

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

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

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

89 if newlineModified

99 if newlineModified

90 then do

100 then do

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

94 spitComment comment

104 spitComment comment

95 newline

105 newline

96 else do

106 else do

97− spit " "

107+ space

98 spitComment comment

108 spitComment comment

99 m

109 m

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

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

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

158 Just lastSpn ->

168 Just lastSpn ->

159 srcSpanStartLine l > srcSpanEndLine lastSpn + 1

169 srcSpanStartLine l > srcSpanEndLine lastSpn + 1

160

170

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?

162

172

163−theSameLine

173+theSameLinePre

164 :: RealSrcSpan -- ^ Current comment span

174 :: RealSrcSpan -- ^ Current comment span

165 -> RealSrcSpan -- ^ AST element location

175 -> RealSrcSpan -- ^ AST element location

166 -> Bool

176 -> Bool

167−theSameLine l ref =

177+theSameLinePre l ref =

168 srcSpanEndLine l == srcSpanStartLine ref

178 srcSpanEndLine l == srcSpanStartLine ref

169

179

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+

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

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

171

190

172commentFollowsElt

191commentFollowsElt

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

188 realSrcSpanStart l >= realSrcSpanEnd ref

207 realSrcSpanStart l >= realSrcSpanEnd ref

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

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

190 logicallyFollows

209 logicallyFollows

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

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

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

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

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

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

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

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

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

235

254

236spitComment :: Comment -> R ()

255spitComment :: Comment -> R ()

237spitComment =

256spitComment =

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

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

239− where

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

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

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

13 R

14 , runR

15 -- * Internal functions

16− , spit

16+ , txt

17+ , atom

18+ , space

17 , newline

19 , newline

18 , modNewline

20 , modNewline

19 , isNewlineModified

21 , isNewlineModified

20− , ensureIndent

22+ , isLineDirty

21 , inci

23 , inci

22 , sitcc

24 , sitcc

23 , Layout (..)

25 , Layout (..)

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

44import Control.Monad.Reader

46import Control.Monad.Reader

45import Control.Monad.State.Strict

47import Control.Monad.State.Strict

48+import Data.Bool (bool)

46import Data.Coerce

49import Data.Coerce

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

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

48import Data.Text (Text)

51import Data.Text (Text)

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

52import Ormolu.Parser.Anns

55import Ormolu.Parser.Anns

53import Ormolu.Parser.CommentStream

56import Ormolu.Parser.CommentStream

54import Ormolu.Printer.SpanStream

57import Ormolu.Printer.SpanStream

58+import Ormolu.Utils (showOutputable)

59+import Outputable (Outputable)

55import SrcLoc

60import SrcLoc

56import qualified Data.Text as T

61import qualified Data.Text as T

57import qualified Data.Text.Lazy as TL

62import qualified Data.Text.Lazy as TL

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

96 -- ^ Comment stream

101 -- ^ Comment stream

97 , scNewline :: Maybe (R ())

102 , scNewline :: Maybe (R ())

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

103 -- ^ 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

99 }

108 }

100

109

101-- | 'Layout' options.

110-- | 'Layout' options.

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

131 , scSpanStream = sstream

140 , scSpanStream = sstream

132 , scCommentStream = cstream

141 , scCommentStream = cstream

133 , scNewline = Nothing

142 , scNewline = Nothing

143+ , scDirtyLine = False

144+ , scSpace = False

134 }

145 }

135

146

136----------------------------------------------------------------------------

147----------------------------------------------------------------------------

137-- Internal functions

148-- Internal functions

138

149

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

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

140−-- contain newlines.

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.

141

166

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+

142−spit :: Text -> R ()

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

143−spit x = do

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'

144 traceR "spit_before" (Just x)

185 traceR "spit_before" (Just x)

145 R . modify $ \sc -> sc

186 R . modify $ \sc -> sc

146 { scBuilder = scBuilder sc <> fromText x

187 { scBuilder = scBuilder sc <> fromText x

147 , scColumn = scColumn sc + T.length x

188 , scColumn = scColumn sc + T.length x

189+ , scDirtyLine = scDirtyLine sc || dirty

190+ , scSpace = False

148 }

191 }

149 traceR "spit_after" Nothing

192 traceR "spit_after" Nothing

150

193

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+

151-- | Output a newline.

208-- | Output a newline.

152

209

153newline :: R ()

210newline :: R ()

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

167 R . modify $ \sc -> sc

224 R . modify $ \sc -> sc

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

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

169 , scColumn = 0

226 , scColumn = 0

227+ , scDirtyLine = False

228+ , scSpace = False

170 }

229 }

171 traceR "newline_after" Nothing

230 traceR "newline_after" Nothing

172

231

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

192isNewlineModified :: R Bool

251isNewlineModified :: R Bool

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

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

194

253

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

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

196−-- spaces if it isn't.

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

197

256

198−ensureIndent :: R ()

257+isLineDirty :: R Bool

199−ensureIndent = do

258+isLineDirty = R (gets scDirtyLine)

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) " ")

205

259

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

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

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

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

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

229 traceR "sitcc_before" Nothing

283 traceR "sitcc_before" Nothing

230 i <- R (asks rcIndent)

284 i <- R (asks rcIndent)

231 c <- R (gets scColumn)

285 c <- R (gets scColumn)

286+ needsSpace <- R (gets scSpace)

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

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

233 modRC rc = rc

288 modRC rc = rc

234− { rcIndent = max i c

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

235 }

290 }

291+ vlayout m' . R $ do

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

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

293+ local modRC m

237 traceR "sitcc_ended" Nothing

294 traceR "sitcc_ended" Nothing

238

295

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

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

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

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

31p_hsmodName :: ModuleName -> R ()

32p_hsmodName mname = do

33− txt "module "

33+ txt "module"

34+ space

34 atom mname

35 atom mname

36p_ieWrappedName :: IEWrappedName RdrName -> R ()

37p_ieWrappedName :: IEWrappedName RdrName -> R ()

37p_ieWrappedName = \case

38p_ieWrappedName = \case

38 IEName x -> p_rdrName x

39 IEName x -> p_rdrName x

39 IEPattern x -> do

40 IEPattern x -> do

40− txt "pattern "

41+ txt "pattern"

42+ space

41 p_rdrName x

43 p_rdrName x

42 IEType x -> do

44 IEType x -> do

43− txt "type "

45+ txt "type"

46+ space

44 p_rdrName x

47 p_rdrName x

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

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

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

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

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

24p_annProv = \case

25 ValueAnnProvenance name -> p_rdrName name

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

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

27 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

52 (p_rdrName name)

53 (located' p_hsTyVarBndr <$> hsq_explicit)

54 inci (p_classFundeps fdeps)

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

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

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

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

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

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

58− -- they need to be manually sorted.

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

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

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

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

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

65 allDecls =

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

67 unless (null allDecls) $ do

68+ space

68− txt " where"

69+ txt "where"

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

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

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

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

71− -- declarations

72+ -- declarations.

72 when (hasSeparatedDecls allDecls) breakpoint'

73 when (hasSeparatedDecls allDecls) breakpoint'

73 inci (p_hsDecls Associated allDecls)

74 inci (p_hsDecls Associated allDecls)

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

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

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

77 located ctx p_hsContext

78 located ctx p_hsContext

78 breakpoint

79 breakpoint

79− txt "=> "

80+ txt "=>"

81+ space

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

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

82p_classFundeps fdeps = unless (null fdeps) $ do

84p_classFundeps fdeps = unless (null fdeps) $ do

83 breakpoint

85 breakpoint

84− txt "| "

86+ txt "|"

87+ space

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

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

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

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

88p_funDep (before, after) = do

91p_funDep (before, after) = do

89 sep space p_rdrName before

92 sep space p_rdrName before

93+ space

90− txt " -> "

94+ txt "->"

95+ space

91 sep space p_rdrName after

96 sep space p_rdrName after

93----------------------------------------------------------------------------

98----------------------------------------------------------------------------

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

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

44 Nothing -> return ()

45 Just k -> do

46 space

47− txt ":: "

47+ txt "::"

48+ space

48 located k p_hsType

49 located k p_hsType

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

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

50 unless (null dd_cons) $

51 unless (null dd_cons) $

51 if gadt

52 if gadt

52 then do

53 then do

54+ space

53− txt " where"

55+ txt "where"

54 breakpoint

56 breakpoint

55 inci $ sepSemi (located' p_conDecl) dd_cons

57 inci $ sepSemi (located' p_conDecl) dd_cons

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

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

57 inci $ do

59 inci $ do

58 breakpoint

60 breakpoint

59− txt "= "

61+ txt "="

62+ space

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

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

61 sep s (sitcc . located' p_conDecl) dd_cons

64 sep s (sitcc . located' p_conDecl) dd_cons

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

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

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

79 breakpoint

82 breakpoint

80 inci $ do

83 inci $ do

81− txt ":: "

84+ txt "::"

85+ space

82 p_forallBndrs (hsq_explicit con_qvars)

86 p_forallBndrs (hsq_explicit con_qvars)

83 forM_ con_mb_cxt p_lhsContext

87 forM_ con_mb_cxt p_lhsContext

84 case con_args of

88 case con_args of

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

86 sep breakpoint (located' p_hsType) xs

90 sep breakpoint (located' p_hsType) xs

87 unless (null xs) $ do

91 unless (null xs) $ do

88 breakpoint

92 breakpoint

89− txt "-> "

93+ txt "->"

94+ space

90 RecCon l -> do

95 RecCon l -> do

91 located l p_conDeclFields

96 located l p_conDeclFields

92 unless (null $ unLoc l) $ do

97 unless (null $ unLoc l) $ do

93 breakpoint

98 breakpoint

94− txt "-> "

99+ txt "->"

100+ space

95 InfixCon _ _ -> notImplemented "InfixCon"

101 InfixCon _ _ -> notImplemented "InfixCon"

96 p_hsType (unLoc con_res_ty)

102 p_hsType (unLoc con_res_ty)

97 ConDeclH98 {..} -> do

103 ConDeclH98 {..} -> do

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

121p_forallBndrs = \case

127p_forallBndrs = \case

122 [] -> return ()

128 [] -> return ()

123 bndrs -> do

129 bndrs -> do

124− txt "forall "

130+ txt "forall"

131+ space

125 sep space (located' p_hsTyVarBndr) bndrs

132 sep space (located' p_hsTyVarBndr) bndrs

126− txt ". "

133+ txt "."

134+ space

127

135

128p_lhsContext

136p_lhsContext

129 :: LHsContext GhcPs

137 :: LHsContext GhcPs

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

133 ctx -> do

141 ctx -> do

134 located ctx p_hsContext

142 located ctx p_hsContext

135 breakpoint

143 breakpoint

136− txt "=> "

144+ txt "=>"

145+ space

137

146

138isGadt :: ConDecl GhcPs -> Bool

147isGadt :: ConDecl GhcPs -> Bool

139isGadt = \case

148isGadt = \case

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

152 (comma >> breakpoint)

161 (comma >> breakpoint)

153 (sitcc . located' p_hsType . hsib_body)

162 (sitcc . located' p_hsType . hsib_body)

154 xs

163 xs

164+ space

155 case deriv_clause_strategy of

165 case deriv_clause_strategy of

156 Nothing -> do

166 Nothing -> do

157 breakpoint

167 breakpoint

158 inci derivingWhat

168 inci derivingWhat

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

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

160 StockStrategy -> do

170 StockStrategy -> do

161− txt " stock"

171+ txt "stock"

162 breakpoint

172 breakpoint

163 inci derivingWhat

173 inci derivingWhat

164 AnyclassStrategy -> do

174 AnyclassStrategy -> do

165− txt " anyclass"

175+ txt "anyclass"

166 breakpoint

176 breakpoint

167 inci derivingWhat

177 inci derivingWhat

168 NewtypeStrategy -> do

178 NewtypeStrategy -> do

169− txt " newtype"

179+ txt "newtype"

170 breakpoint

180 breakpoint

171 inci derivingWhat

181 inci derivingWhat

172 ViaStrategy HsIB {..} -> do

182 ViaStrategy HsIB {..} -> do

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

174 inci $ do

184 inci $ do

175 derivingWhat

185 derivingWhat

176 breakpoint

186 breakpoint

177− txt "via "

187+ txt "via"

188+ space

178 located hsib_body p_hsType

189 located hsib_body p_hsType

179 ViaStrategy (XHsImplicitBndrs NoExt) ->

190 ViaStrategy (XHsImplicitBndrs NoExt) ->

180 notImplemented "XHsImplicitBndrs"

191 notImplemented "XHsImplicitBndrs"

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

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

55p_foreignImport :: ForeignImport -> R ()

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

57− txt "foreign import "

57+ txt "foreign import"

58+ space

58 located cCallConv atom

59 located cCallConv atom

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

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

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

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

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

63p_foreignExport :: ForeignExport -> R ()

64p_foreignExport :: ForeignExport -> R ()

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

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

65− txt "foreign export "

66+ txt "foreign export"

67+ space

66 located (L loc cCallConv) atom

68 located (L loc cCallConv) atom

67 located sourceText p_sourceText

69 located sourceText p_sourceText

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

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

38 then inci typesAfterInstance

39 else typesAfterInstance

40 txt "deriving"

41+ space

41 case deriv_strategy of

42 case deriv_strategy of

42 Nothing -> do

43 Nothing -> do

43− space

44 instTypes False

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

46 StockStrategy -> do

47− txt " stock "

47+ txt "stock "

48 instTypes False

49 AnyclassStrategy -> do

50− txt " anyclass "

50+ txt "anyclass "

51 instTypes False

52 NewtypeStrategy -> do

53− txt " newtype "

53+ txt "newtype "

54 instTypes False

55 ViaStrategy HsIB {..} -> do

56− txt " via"

56+ txt "via"

57 breakpoint

58 inci (located hsib_body p_hsType)

59 breakpoint

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

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

8where

10import BasicTypes

11−import Control.Monad

12import GHC

11import GHC

13import Ormolu.Printer.Combinators

12import Ormolu.Printer.Combinators

14import Ormolu.Printer.Meat.Common

13import Ormolu.Printer.Meat.Common

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

26p_ruleDecl = \case

25p_ruleDecl = \case

27 HsRule NoExt ruleName activation ruleBndrs lhs rhs -> do

26 HsRule NoExt ruleName activation ruleBndrs lhs rhs -> do

28 located ruleName p_ruleName

27 located ruleName p_ruleName

29− let gotBinders = not (null ruleBndrs)

28+ space

30− when (visibleActivation activation || gotBinders) space

31 p_activation activation

29 p_activation activation

32− when (visibleActivation activation && gotBinders) space

30+ space

33 p_ruleBndrs ruleBndrs

31 p_ruleBndrs ruleBndrs

34 breakpoint

32 breakpoint

35 inci $ do

33 inci $ do

36 located lhs p_hsExpr

34 located lhs p_hsExpr

35+ space

37− txt " ="

36+ txt "="

38 inci $ do

37 inci $ do

39 breakpoint

38 breakpoint

40 located rhs p_hsExpr

39 located rhs p_hsExpr

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

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

8 ( p_sigDecl

9 , p_typeAscription

10 , p_activation

11− , visibleActivation

12 )

11 )

13where

12where

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

56p_typeAscription HsWC {..} = do

55p_typeAscription HsWC {..} = do

57 breakpoint

56 breakpoint

58 inci $ do

57 inci $ do

59− txt ":: "

58+ txt "::"

59+ space

60 located (hsib_body hswc_body) p_hsType

61p_typeAscription (XHsWildCardBndrs NoExt) = notImplemented "XHsWildCardBndrs"

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

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

75 -> R ()

76p_classOpSig def names hsib = do

77− when def (txt "default ")

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

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

80p_fixSig

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

98 -> R ()

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

100 p_inlineSpec inl_inline

101+ space

101 case inl_rule of

102 case inl_rule of

102− ConLike -> txt "CONLIKE "

103+ ConLike -> txt "CONLIKE"

103 FunLike -> return ()

104 FunLike -> return ()

105+ space

104 p_activation inl_act

106 p_activation inl_act

105− when (visibleActivation inl_act) space

107+ space

106 p_rdrName name

108 p_rdrName name

107

109

108p_specSig

110p_specSig

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

114 txt "SPECIALIZE"

116 txt "SPECIALIZE"

115 space

117 space

116 p_inlineSpec inl_inline

118 p_inlineSpec inl_inline

119+ space

117 p_activation inl_act

120 p_activation inl_act

118− when (visibleActivation inl_act) space

121+ space

119 p_rdrName name

122 p_rdrName name

120 breakpoint

123 breakpoint

121 inci $ do

124 inci $ do

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

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

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

124

127

125p_inlineSpec :: InlineSpec -> R ()

128p_inlineSpec :: InlineSpec -> R ()

126−p_inlineSpec = txt . \case

129+p_inlineSpec = \case

127− Inline -> "INLINE "

130+ Inline -> txt "INLINE"

128− Inlinable -> "INLINEABLE "

131+ Inlinable -> txt "INLINEABLE"

129− NoInline -> "NOINLINE "

132+ NoInline -> txt "NOINLINE"

130− NoUserInline -> ""

133+ NoUserInline -> return ()

131

134

132p_activation :: Activation -> R ()

135p_activation :: Activation -> R ()

133p_activation = \case

136p_activation = \case

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

142 atom n

145 atom n

143 txt "]"

146 txt "]"

144

147

145−visibleActivation :: Activation -> Bool

146−visibleActivation = \case

147− NeverActive -> False

148− AlwaysActive -> False

149− _ -> True

150−

151p_specInstSig :: LHsSigType GhcPs -> R ()

148p_specInstSig :: LHsSigType GhcPs -> R ()

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

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

153 located (hsib_body hsib) p_hsType

150 located (hsib_body hsib) p_hsType

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

185 forM_ mty $ \ty -> do

182 forM_ mty $ \ty -> do

186 breakpoint

183 breakpoint

187 inci $ do

184 inci $ do

188− txt ":: "

185+ txt "::"

186+ space

189 p_rdrName ty

187 p_rdrName ty

190

188

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

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

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

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

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

23 -> R ()

24p_synDecl name fixity tvars t = do

25− txt "type "

25+ txt "type"

26+ space

26 let HsQTvs {..} = tvars

27 let HsQTvs {..} = tvars

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

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

28 p_infixDefHelper

29 p_infixDefHelper

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

31 (p_rdrName name)

32 (p_rdrName name)

32 (map (located' p_hsTyVarBndr) hsq_explicit)

33 (map (located' p_hsTyVarBndr) hsq_explicit)

33 breakpoint

34 breakpoint

35+ inci $ do

36+ txt "="

37+ space

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

38+ located t p_hsType

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

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

48 case mmeqs of

49 Nothing -> return ()

50 Just meqs -> do

51+ space

51− txt " where"

52+ txt "where"

52 case meqs of

53 case meqs of

53− Nothing -> txt " .."

54+ Nothing -> do

55+ space

56+ txt ".."

54 Just eqs -> do

57 Just eqs -> do

55 newline

58 newline

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

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

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

65 L _ a -> case a of

68 L _ a -> case a of

66 NoSig NoExt -> Nothing

69 NoSig NoExt -> Nothing

67 KindSig NoExt k -> Just $ do

70 KindSig NoExt k -> Just $ do

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

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

72+ space

69 located k p_hsType

73 located k p_hsType

70 TyVarSig NoExt bndr -> Just $ do

74 TyVarSig NoExt bndr -> Just $ do

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

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

76+ space

72 located bndr p_hsTyVarBndr

77 located bndr p_hsTyVarBndr

73 XFamilyResultSig NoExt ->

78 XFamilyResultSig NoExt ->

74 notImplemented "XFamilyResultSig"

79 notImplemented "XFamilyResultSig"

76p_injectivityAnn :: InjectivityAnn GhcPs -> R ()

81p_injectivityAnn :: InjectivityAnn GhcPs -> R ()

77p_injectivityAnn (InjectivityAnn a bs) = do

82p_injectivityAnn (InjectivityAnn a bs) = do

78− txt "| "

83+ txt "|"

84+ space

79 p_rdrName a

85 p_rdrName a

80 space

86 space

81− txt "-> "

87+ txt "->"

88+ space

82 sep space p_rdrName bs

89 sep space p_rdrName bs

84p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

91p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

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

89 inci

96 inci

90 (p_rdrName feqn_tycon)

97 (p_rdrName feqn_tycon)

91 (located' p_hsType <$> feqn_pats)

98 (located' p_hsType <$> feqn_pats)

99+ space

92− txt " ="

100+ txt "="

93 breakpoint

101 breakpoint

94 inci (located feqn_rhs p_hsType)

102 inci (located feqn_rhs p_hsType)

95p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"

103p_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

182 BangPat _ _ -> True

183 SplicePat _ _ -> True

184 _ -> False

185+ txt "\\"

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

186+ when needsSpace space

186 sitcc stdCase

187 sitcc stdCase

187 LambdaCase -> stdCase

188 LambdaCase -> stdCase

188 return inci'

189 return inci'

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

203 unless (length grhssGRHSs > 1) $ do

204 unless (length grhssGRHSs > 1) $ do

204 case style of

205 case style of

205 Function _ | hasGuards -> return ()

206 Function _ | hasGuards -> return ()

206− Function _ -> txt " ="

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

207− PatternBind -> txt " ="

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

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

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

209− _ -> txt " ->"

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

210 let grhssSpan = combineSrcSpans' $

211 let grhssSpan = combineSrcSpans' $

211 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

212 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

212 patGrhssSpan = maybe grhssSpan

213 patGrhssSpan = maybe grhssSpan

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

250 case guards of

251 case guards of

251 [] -> p_body

252 [] -> p_body

252 xs -> do

253 xs -> do

253− txt "| "

254+ txt "|"

255+ space

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

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

255 space

257 space

256 txt $ case style of

258 txt $ case style of

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

266p_hsCmd = \case

268p_hsCmd = \case

267 HsCmdArrApp NoExt body input arrType _ -> do

269 HsCmdArrApp NoExt body input arrType _ -> do

268 located body p_hsExpr

270 located body p_hsExpr

271+ space

269− txt $ case arrType of

272+ case arrType of

270− HsFirstOrderApp -> " -<"

273+ HsFirstOrderApp -> txt "-<"

271− HsHigherOrderApp -> " -<<"

274+ HsHigherOrderApp -> txt "-<<"

272 placeHanging (exprPlacement (unLoc input)) $

275 placeHanging (exprPlacement (unLoc input)) $

273 located input p_hsExpr

276 located input p_hsExpr

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

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

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

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

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

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

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

292 HsCmdCase NoExt e mgroup -> do

295 HsCmdCase NoExt e mgroup -> do

293− txt "case "

296+ txt "case"

297+ space

294 located e p_hsExpr

298 located e p_hsExpr

299+ space

295− txt " of"

300+ txt "of"

296 breakpoint

301 breakpoint

297 inci (p_matchGroup' cmdPlacement p_hsCmd Case mgroup)

302 inci (p_matchGroup' cmdPlacement p_hsCmd Case mgroup)

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

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

299− txt "if "

304+ txt "if"

305+ space

300 located if' p_hsExpr

306 located if' p_hsExpr

301 breakpoint

307 breakpoint

302 txt "then"

308 txt "then"

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

309 breakpoint

315 breakpoint

310 inci (p_hsCmd x)

316 inci (p_hsCmd x)

311 HsCmdLet NoExt localBinds c -> do

317 HsCmdLet NoExt localBinds c -> do

312− txt "let "

318+ txt "let"

319+ space

313 sitcc (located localBinds p_hsLocalBinds)

320 sitcc (located localBinds p_hsLocalBinds)

314 breakpoint

321 breakpoint

315− txt "in "

322+ txt "in"

323+ space

316 sitcc (located c p_hsCmd)

324 sitcc (located c p_hsCmd)

317 HsCmdDo NoExt es -> do

325 HsCmdDo NoExt es -> do

318 txt "do"

326 txt "do"

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

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

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

346 BodyStmt NoExt body _ _ -> located body pretty

354 BodyStmt NoExt body _ _ -> located body pretty

347 LetStmt NoExt binds -> do

355 LetStmt NoExt binds -> do

348− txt "let "

356+ txt "let"

357+ space

349 sitcc $ located binds p_hsLocalBinds

358 sitcc $ located binds p_hsLocalBinds

350 ParStmt {} ->

359 ParStmt {} ->

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

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

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

386 breakpoint

395 breakpoint

387 inci (p_hsExpr x)

396 inci (p_hsExpr x)

388 RecStmt {..} -> do

397 RecStmt {..} -> do

389− txt "rec "

398+ txt "rec"

399+ space

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

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

391 XStmtLR {} -> notImplemented "XStmtLR"

401 XStmtLR {} -> notImplemented "XStmtLR"

392

402

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

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

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

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

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

431 atom name

441 atom name

442+ space

432− txt " ="

443+ txt "="

433 breakpoint

444 breakpoint

434 useBraces $ inci $ located expr p_hsExpr

445 useBraces $ inci $ located expr p_hsExpr

435 p_ipBind _ = notImplemented "XHsIPBinds"

446 p_ipBind _ = notImplemented "XHsIPBinds"

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

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

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

446 located hsRecFieldLbl atom

457 located hsRecFieldLbl atom

447 unless hsRecPun $ do

458 unless hsRecPun $ do

459+ space

448− txt " ="

460+ txt "="

449 let placement = exprPlacement (unLoc hsRecFieldArg)

461 let placement = exprPlacement (unLoc hsRecFieldArg)

450 placeHanging placement $ located hsRecFieldArg p_hsExpr

462 placeHanging placement $ located hsRecFieldArg p_hsExpr

451

463

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

513 space

525 space

514 located y p_hsExpr

526 located y p_hsExpr

515 NegApp NoExt e _ -> do

527 NegApp NoExt e _ -> do

516− txt "- "

528+ txt "-"

529+ space

517 located e p_hsExpr

530 located e p_hsExpr

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

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

519 SectionL NoExt x op -> do

532 SectionL NoExt x op -> do

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

541 ExplicitSum NoExt tag arity e ->

554 ExplicitSum NoExt tag arity e ->

542 p_unboxedSum tag arity (located e p_hsExpr)

555 p_unboxedSum tag arity (located e p_hsExpr)

543 HsCase NoExt e mgroup -> do

556 HsCase NoExt e mgroup -> do

544− txt "case "

557+ txt "case"

558+ space

545 located e p_hsExpr

559 located e p_hsExpr

560+ space

546− txt " of"

561+ txt "of"

547 breakpoint

562 breakpoint

548 inci (p_matchGroup Case mgroup)

563 inci (p_matchGroup Case mgroup)

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

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

550− txt "if "

565+ txt "if"

566+ space

551 located if' p_hsExpr

567 located if' p_hsExpr

552 breakpoint

568 breakpoint

553 inci $ do

569 inci $ do

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

563 breakpoint

579 breakpoint

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

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

565 HsLet NoExt localBinds e -> do

581 HsLet NoExt localBinds e -> do

566− txt "let "

582+ txt "let"

583+ space

567 dontUseBraces $ sitcc (located localBinds p_hsLocalBinds)

584 dontUseBraces $ sitcc (located localBinds p_hsLocalBinds)

568− vlayout space (newline >> space)

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

569− txt "in "

586+ txt "in"

587+ space

570 sitcc (located e p_hsExpr)

588 sitcc (located e p_hsExpr)

571 HsDo NoExt ctx es -> do

589 HsDo NoExt ctx es -> do

572 let doBody header = do

590 let doBody header = do

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

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

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

587 located yield p_stmt

605 located yield p_stmt

588 breakpoint

606 breakpoint

589− txt "| "

607+ txt "|"

608+ space

590 p_parBody lists

609 p_parBody lists

591 case ctx of

610 case ctx of

592 DoExpr -> doBody "do"

611 DoExpr -> doBody "do"

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

619 located x p_hsExpr

638 located x p_hsExpr

620 breakpoint

639 breakpoint

621 inci $ do

640 inci $ do

622− txt ":: "

641+ txt "::"

642+ space

623 let HsWC {..} = affix

643 let HsWC {..} = affix

624 HsIB {..} = hswc_body

644 HsIB {..} = hswc_body

625 located hsib_body p_hsType

645 located hsib_body p_hsType

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

636 FromTo from to -> brackets . sitcc $ do

656 FromTo from to -> brackets . sitcc $ do

637 located from p_hsExpr

657 located from p_hsExpr

638 breakpoint

658 breakpoint

639− txt ".. "

659+ txt ".."

660+ space

640 located to p_hsExpr

661 located to p_hsExpr

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

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

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

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

643 breakpoint

664 breakpoint

644− txt ".. "

665+ txt ".."

666+ space

645 located to p_hsExpr

667 located to p_hsExpr

646 HsSCC NoExt _ name x -> do

668 HsSCC NoExt _ name x -> do

647 txt "{-# SCC "

669 txt "{-# SCC "

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

688

710

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

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

690p_patSynBind PSB {..} = do

712p_patSynBind PSB {..} = do

691− txt "pattern "

713+ txt "pattern"

714+ space

692 case psb_dir of

715 case psb_dir of

693 Unidirectional -> do

716 Unidirectional -> do

694 p_rdrName psb_id

717 p_rdrName psb_id

695 inci $ do

718 inci $ do

696 p_patSynDetails psb_args

719 p_patSynDetails psb_args

720+ space

697− txt " <-"

721+ txt "<-"

698 breakpoint

722 breakpoint

699 located psb_def p_pat

723 located psb_def p_pat

700 ImplicitBidirectional -> do

724 ImplicitBidirectional -> do

701 p_rdrName psb_id

725 p_rdrName psb_id

702 inci $ do

726 inci $ do

703 p_patSynDetails psb_args

727 p_patSynDetails psb_args

728+ space

704− txt " ="

729+ txt "="

705 breakpoint

730 breakpoint

706 located psb_def p_pat

731 located psb_def p_pat

707 ExplicitBidirectional mgroup -> do

732 ExplicitBidirectional mgroup -> do

708 p_rdrName psb_id

733 p_rdrName psb_id

709 inci $ do

734 inci $ do

710 p_patSynDetails psb_args

735 p_patSynDetails psb_args

736+ space

711− txt " <-"

737+ txt "<-"

712 breakpoint

738 breakpoint

713 located psb_def p_pat

739 located psb_def p_pat

714 newline

740 newline

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

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

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

780 ViewPat NoExt expr pat -> sitcc $ do

806 ViewPat NoExt expr pat -> sitcc $ do

781 located expr p_hsExpr

807 located expr p_hsExpr

808+ space

782− txt " ->"

809+ txt "->"

783 breakpoint

810 breakpoint

784 inci (located pat p_pat)

811 inci (located pat p_pat)

785 SplicePat NoExt splice -> p_hsSplice splice

812 SplicePat NoExt splice -> p_hsSplice splice

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

789 p_rdrName n

816 p_rdrName n

790 breakpoint

817 breakpoint

791 inci $ do

818 inci $ do

792− txt "+ "

819+ txt "+"

820+ space

793 located k (atom . ol_val)

821 located k (atom . ol_val)

794 SigPat hswc pat -> do

822 SigPat hswc pat -> do

795 located pat p_pat

823 located pat p_pat

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

802 located hsRecFieldLbl $ \x ->

830 located hsRecFieldLbl $ \x ->

803 p_rdrName (rdrNameFieldOcc x)

831 p_rdrName (rdrNameFieldOcc x)

804 unless hsRecPun $ do

832 unless hsRecPun $ do

833+ space

805− txt " ="

834+ txt "="

806 breakpoint

835 breakpoint

807 inci (located hsRecFieldArg p_pat)

836 inci (located hsRecFieldArg p_pat)

808

837

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

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

28p_hsmodImport :: ImportDecl GhcPs -> R ()

29p_hsmodImport ImportDecl {..} = line $ do

30− txt "import "

30+ txt "import"

31+ space

31− when ideclSource $

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

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

33+ space

33− when ideclSafe $

34+ when ideclSafe (txt "safe")

34− txt "safe "

35+ space

35− when ideclQualified $

36+ when ideclQualified (txt "qualified")

36− txt "qualified "

37+ space

37 case ideclPkgQual of

38 case ideclPkgQual of

38 Nothing -> return ()

39 Nothing -> return ()

39− Just slit -> do

40− atom slit

40+ Just slit -> atom slit

41− space

41+ space

42 located ideclName atom

43 case ideclAs of

44 Nothing -> return ()

45 Just l -> do

46+ space

46− txt " as "

47+ txt "as"

48+ space

47 located l atom

49 located l atom

50+ space

48 case ideclHiding of

51 case ideclHiding of

49 Nothing -> return ()

52 Nothing -> return ()

50 Just (hiding, _) ->

53 Just (hiding, _) ->

51− when hiding $

54+ when hiding (txt "hiding")

52− txt " hiding"

53 case ideclHiding of

55 case ideclHiding of

54 Nothing -> return ()

56 Nothing -> return ()

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

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

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

64 IEThingAbs NoExt l1 -> located l1 p_ieWrappedName

66 IEThingAbs NoExt l1 -> located l1 p_ieWrappedName

65 IEThingAll NoExt l1 -> do

67 IEThingAll NoExt l1 -> do

66 located l1 p_ieWrappedName

68 located l1 p_ieWrappedName

69+ space

67− txt " (..)"

70+ txt "(..)"

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

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

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

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

70 located l1 p_ieWrappedName

73 located l1 p_ieWrappedName

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

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

25 HsForAllTy NoExt bndrs t -> do

26 txt "forall "

27 sep space (located' p_hsTyVarBndr) bndrs

28− txt ". "

28+ txt "."

29+ space

29 p_hsType (unLoc t)

30 p_hsType (unLoc t)

30 HsQualTy NoExt qs t -> do

31 HsQualTy NoExt qs t -> do

31 located qs p_hsContext

32 located qs p_hsContext

32 breakpoint

33 breakpoint

33− txt "=> "

34+ txt "=>"

35+ space

34 case unLoc t of

36 case unLoc t of

35 HsQualTy {} -> p_hsType (unLoc t)

37 HsQualTy {} -> p_hsType (unLoc t)

36 HsFunTy {} -> p_hsType (unLoc t)

38 HsFunTy {} -> p_hsType (unLoc t)

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

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

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

51 located x p_hsType

53 located x p_hsType

52 breakpoint

54 breakpoint

53− txt "-> "

55+ txt "->"

56+ space

54 case y' of

57 case y' of

55 HsFunTy{} -> p_hsType y'

58 HsFunTy{} -> p_hsType y'

56 _ -> located y p_hsType

59 _ -> located y p_hsType

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

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

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

67 HsSumTy NoExt xs ->

70 HsSumTy NoExt xs ->

68 parensHash . sitcc $

71 parensHash . sitcc $

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

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

70 HsOpTy NoExt x op y -> sitcc $ do

73 HsOpTy NoExt x op y -> sitcc $ do

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

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

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

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

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

99 located n atom

102 located n atom

100 breakpoint

103 breakpoint

101 inci $ do

104 inci $ do

102− txt ":: "

105+ txt "::"

106+ space

103 located t p_hsType

107 located t p_hsType

104 HsStarTy NoExt _ -> txt "*"

108 HsStarTy NoExt _ -> txt "*"

105 HsKindSig NoExt t k ->

109 HsKindSig NoExt t k ->

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

108 located t p_hsType

112 located t p_hsType

109 space -- FIXME

113 space -- FIXME

110 inci $ do

114 inci $ do

111− txt ":: "

115+ txt "::"

116+ space

112 located k p_hsType

117 located k p_hsType

113 HsSpliceTy NoExt splice -> p_hsSplice splice

118 HsSpliceTy NoExt splice -> p_hsSplice splice

114 HsDocTy NoExt _ _ -> error "HsDocTy"

119 HsDocTy NoExt _ _ -> error "HsDocTy"

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

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

116 case u of

121 case u of

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

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

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

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

119 NoSrcUnpack -> return ()

124 NoSrcUnpack -> return ()

120 case s of

125 case s of

121 SrcLazy -> txt "~"

126 SrcLazy -> txt "~"

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

152 HsExplicitTupleTy _ _ -> True

157 HsExplicitTupleTy _ _ -> True

153 _ -> False

158 _ -> False

154

159

155−

156p_hsContext :: HsContext GhcPs -> R ()

160p_hsContext :: HsContext GhcPs -> R ()

157p_hsContext = \case

161p_hsContext = \case

158 [] -> txt "()"

162 [] -> txt "()"

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

168 located l atom

172 located l atom

169 breakpoint

173 breakpoint

170 inci $ do

174 inci $ do

171− txt ":: "

175+ txt "::"

176+ space

172 located k p_hsType

177 located k p_hsType

173 XTyVarBndr NoExt -> notImplemented "XTyVarBndr"

178 XTyVarBndr NoExt -> notImplemented "XTyVarBndr"

174

179

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

183 cd_fld_names

188 cd_fld_names

184 breakpoint

189 breakpoint

185 sitcc . inci $ do

190 sitcc . inci $ do

186− txt ":: "

191+ txt "::"

192+ space

187 p_hsType (unLoc cd_fld_type)

193 p_hsType (unLoc cd_fld_type)

188p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"

194p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"

189

195