16f2c64 · ormolu · git.iko.soy

data/examples/declaration/class/associated-data-out.hs+1−3

compare with master

unifiedsplit

@@ -1,8 +1,6 @@

1{-# LANGUAGE TypeFamilies #-}

2

3−class Foo a where

3+class Foo a where data FooBar a

4−

5− data FooBar a

6

4

7-- | Something.

5-- | Something.

8class Bar a where

6class Bar a where

data/examples/declaration/class/associated-type-defaults-out.hs+1−3

@@ -1,8 +1,6 @@

1{-# LANGUAGE TypeFamilies #-}

2

3−class Foo a where

3+class Foo a where type FooBar a = Int

4−

5− type FooBar a = Int

6

4

7-- | Something.

5-- | Something.

8class Bar a where

6class Bar a where

data/examples/declaration/class/associated-types-out.hs+1−3

@@ -1,8 +1,6 @@

1{-# LANGUAGE TypeFamilies #-}

2

3−class Foo a where

3+class Foo a where type FooBar a

4−

5− type FooBar a

6

4

7-- | Something.

5-- | Something.

8class Bar a where

6class Bar a where

data/examples/declaration/class/functional-dependencies-out.hs+1−3

@@ -3,9 +3,7 @@

3-- | Something.

4class Foo a b | a -> b

5

6−class Bar a b | a -> b, b -> a where

6+class Bar a b | a -> b, b -> a where bar :: a

7−

8− bar :: a

9

7

10-- | Something else.

8-- | Something else.

11class

9class

data/examples/declaration/class/multi-parameters-out.hs+1−3

@@ -1,8 +1,6 @@

1{-# LANGUAGE MultiParamTypeClasses #-}

2

3−class Foo a b where

3+class Foo a b where foo :: a -> b

4−

5− foo :: a -> b

6

4

7-- | Something.

5-- | Something.

8class Bar a b c d where

6class Bar a b c d where

data/examples/declaration/class/single-parameters-out.hs+1−3

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

1-- | Something.

2−class Foo a where

2+class Foo a where foo :: a

3−

4− foo :: a

5

3

6-- | Something more.

4-- | Something more.

7class Bar a where

5class Bar a where

data/examples/declaration/instance/associated-data-out.hs+1−3

@@ -1,8 +1,6 @@

1{-# LANGUAGE TypeFamilies #-}

2

3−instance Foo Int where

4−

5− data Bar Int = IntBar Int Int

3+instance Foo Int where data Bar Int = IntBar Int Int

6

4

7instance Foo Double where

5instance Foo Double where

8

6

data/examples/declaration/instance/associated-types-out.hs+1−3

@@ -1,8 +1,6 @@

1{-# LANGUAGE TypeFamilies #-}

2

3−instance Foo Int where

3+instance Foo Int where type Bar Int = Double

4−

5− type Bar Int = Double

6

4

7instance Foo Double where

5instance Foo Double where

8

6

data/examples/declaration/instance/contexts-out.hs+1−3

@@ -1,6 +1,4 @@

1−instance Eq a => Eq [a] where

1+instance Eq a => Eq [a] where (==) _ _ = False

2−

3− (==) _ _ = False

4

2

5instance

3instance

6 ( Ord a,

4 ( Ord a,

data/examples/declaration/instance/multi-parameter-out.hs+1−3

@@ -1,6 +1,4 @@

1−instance MonadReader a ((->) a) where

1+instance MonadReader a ((->) a) where ask = id

2−

3− ask = id

4

2

5instance MonadState s (State s) where

3instance MonadState s (State s) where

6

4

data/examples/declaration/instance/overlappable-instances-out.hs+1−3

@@ -1,6 +1,4 @@

1−instance {-# OVERLAPPABLE #-} Eq Int where

1+instance {-# OVERLAPPABLE #-} Eq Int where (==) _ _ = False

2−

3− (==) _ _ = False

4

2

5instance {-# OVERLAPPING #-} Ord Int where

3instance {-# OVERLAPPING #-} Ord Int where

6

4

data/examples/declaration/instance/single-parameter-out.hs+3−3

@@ -1,6 +1,4 @@

1−instance Monoid Int where

1+instance Monoid Int where (<>) x y = x + y

2−

3− (<>) x y = x + y

4

2

5instance Enum Int where

3instance Enum Int where

6

4

@@ -9,3 +7,5 @@ instance Enum Int where

9 toEnum =

7 toEnum =

10 \x ->

8 \x ->

11 x

9 x

10+

11+instance Foo Int where foo x = x; bar y = y

data/examples/declaration/instance/single-parameter.hs+2

@@ -6,3 +6,5 @@ instance Enum Int

6 toEnum

7 = \x ->

8 x

9+

10+instance Foo Int where { foo x = x; bar y = y }

data/examples/declaration/value/function/case-single-line-out.hs+5

@@ -1,2 +1,7 @@

1foo :: Int -> Int

2foo x = case x of x -> x

3+

4+foo :: IO ()

5+foo = case [1] of [_] -> "singleton"; _ -> "not singleton"

6+

7+foo = case [1] of { [] -> foo; _ -> bar } `finally` baz

data/examples/declaration/value/function/case-single-line.hs+4

@@ -1,2 +1,6 @@

1foo :: Int -> Int

2foo x = case x of x -> x

3+

4+foo :: IO ()

5+foo = case [1] of [_] -> "singleton"; _ -> "not singleton"

6+foo = case [1] of { [] -> foo; _ -> bar } `finally` baz

data/examples/declaration/value/function/do-out.hs+37−7

@@ -1,8 +1,6 @@

1{-# LANGUAGE RecursiveDo #-}

2

3−bar = do

3+bar = do foo; bar

4− foo

5− bar

6

4

7baz =

5baz =

8 mdo

6 mdo

@@ -60,15 +58,22 @@ g = unFoo

60 . foo

58 . foo

61 bar

59 bar

62 baz

60 baz

61+ 3

63− 3 $ do

62+ $ do

64− act

63+ act

65− ret

64+ ret

66

65

67main =

66main =

68 do stuff

67 do stuff

69 `finally` do

68 `finally` do

70 recover

69 recover

71

70

71+main = do stuff `finally` recover

72+

73+main = do { stuff } `finally` recover

74+

75+foo = do do { foo; bar }; baz

76+

72foo =

77foo =

73 do

78 do

74 1

79 1

@@ -77,5 +82,30 @@ foo =

77-- single line let-where

82-- single line let-where

78samples n f = do

83samples n f = do

79 gen <- newQCGen

84 gen <- newQCGen

80− let rands g = g1 : rands g2 where (g1, g2) = split g

85+ let rands g = g1 : rands g2 where { (g1, g2) = split g }

81 return $ rands gen

86 return $ rands gen

87+

88+main = do bar

89+

90+main = do bar; baz

91+

92+main = do

93+ bar

94+ baz

95+

96+main = do

97+ a <- bar

98+ let a = b; c = d

99+ baz d

100+ let e = f

101+ g = h

102+ return c

103+

104+readInClause = do

105+ do

106+ lookAhead g_Do

107+ parseNote ErrorC 1063 "You need a line feed or semicolon before the 'do'."

108+ <|> do

109+ optional g_Semi

110+ void allspacing

111+ return things

data/examples/declaration/value/function/do.hs+32

@@ -67,6 +67,12 @@ main =

67 `finally` do

68 recover

69

70+main = do stuff `finally` recover

71+

72+main = do { stuff } `finally` recover

73+

74+foo = do { do {foo; bar}; baz }

75+

70foo = do

76foo = do

71 1

77 1

72 +

78 +

@@ -77,3 +83,29 @@ samples n f = do

77 gen <- newQCGen

83 gen <- newQCGen

78 let rands g = g1 : rands g2 where (g1, g2) = split g

84 let rands g = g1 : rands g2 where (g1, g2) = split g

79 return $ rands gen

85 return $ rands gen

86+

87+main = do bar

88+main = do { bar; baz }

89+main = do { bar

90+ ; baz

91+ }

92+

93+main = do

94+ a <- bar

95+ let a = b; c = d

96+ baz d

97+ let e = f

98+ g = h

99+ return c

100+

101+readInClause = do

102+ do {

103+ lookAhead g_Do;

104+ parseNote ErrorC 1063 "You need a line feed or semicolon before the 'do'.";

105+ } <|> do {

106+ optional g_Semi;

107+ void allspacing;

108+ }

109+

110+ return things

111+

data/examples/declaration/value/function/lambda-multi-line-out.hs+5

@@ -20,3 +20,8 @@ tricky2 =

20 flip all (zip ws gs)

21 $ \(wt, gt) ->

22 canUnify poly_given_ok wt gt || go False wt gt

23+

24+foo =

25+ prop "is inverse to closure" $ \(f :: StaticPtr (Int -> Int))

26+ (x :: Int) ->

27+ (unclosure . closure) f x == deRefStaticPtr f x

data/examples/declaration/value/function/lambda-multi-line.hs+6

@@ -20,3 +20,9 @@ tricky2 =

20 flip all (zip ws gs) $

21 \(wt, gt) ->

22 canUnify poly_given_ok wt gt || go False wt gt

23+

24+foo =

25+ prop "is inverse to closure" $ \(f :: StaticPtr (Int -> Int))

26+ (x :: Int) ->

27+ (unclosure . closure) f x == deRefStaticPtr f x

28+

data/examples/declaration/value/function/let-single-line-out.hs+7−1

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

1foo :: a -> a

2foo x = let x = x in x

3−foo x = let x = z where z = 2 in x

3+foo x = let x = z where { z = 2 } in x

4+foo x = let x = z where { z = 2 }; a = 3 in x

5+foo x = let g :: Int -> Int; g = id in ()

6+

7+let a = b; c = do { foo; bar }; d = baz in b

8+

9+let a = case True of { True -> foo; False -> bar }; b = foo a in b

data/examples/declaration/value/function/let-single-line.hs+5

@@ -1,3 +1,8 @@

1foo :: a -> a

2foo x = let x = x in x

3foo x = let x = z where z = 2 in x

4+foo x = let x = z where { z = 2; }; a = 3 in x

5+foo x = let {g :: Int -> Int; g = id} in ()

6+let a = b; c = do { foo; bar }; d = baz in b

7+let a = case True of { True -> foo; False -> bar }; b = foo a in b

8+

data/examples/declaration/value/function/operators-out.hs+4−3

@@ -38,7 +38,8 @@ lenses =

38 .= ("user.connection" :: Text)

39 # "connection"

40 .= uc

41+ # "user"

41− # "user" .= case name of

42+ .= case name of

42− Just n -> Just $ object ["name" .= n]

43+ Just n -> Just $ object ["name" .= n]

43− Nothing -> Nothing

44+ Nothing -> Nothing

44 # []

45 # []

data/examples/declaration/value/function/pattern/pattern-bind-out.hs+4−1

@@ -1,6 +1,9 @@

1−foo :: Int

2foo = bar

1foo = bar

3 where

2 where

4 Foo bar baz = quux

3 Foo bar baz = quux

5 Baz

4 Baz

6 quux = zoo

5 quux = zoo

6+

7+foo = bar

8+ where

9+ Foo bar baz = quux

data/examples/declaration/value/function/pattern/pattern-bind.hs+4−1

@@ -1,6 +1,9 @@

1−foo :: Int

2foo = bar

1foo = bar

3 where

2 where

4 Foo bar baz = quux

3 Foo bar baz = quux

5 Baz

4 Baz

6 quux = zoo

5 quux = zoo

6+

7+foo = bar

8+ where Foo bar baz = quux

9+

src/Ormolu/Printer/Combinators.hs+35

@@ -24,6 +24,9 @@ module Ormolu.Printer.Combinators

24 , breakpoint'

25 -- ** Formatting lists

26 , sep

27+ , sepSemi

28+ , useBraces

29+ , dontUseBraces

27 -- ** Wrapping

30 -- ** Wrapping

28 , sitcc

31 , sitcc

29 , line

32 , line

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

42 )

45 )

43where

46where

44

47

48+import Control.Monad

45import Data.Data (Data)

49import Data.Data (Data)

46import Data.List (intersperse)

50import Data.List (intersperse)

47import Data.Text (Text)

51import Data.Text (Text)

@@ -156,6 +160,37 @@ sep

156 -> R ()

160 -> R ()

157sep s f xs = sequence_ (intersperse s (f <$> xs))

161sep s f xs = sequence_ (intersperse s (f <$> xs))

158

162

163+-- | Render a collection of elements layout-sensitively using given printer,

164+-- inserting semicolons if necessary and respecting 'useBraces' and

165+-- 'dontUseBraces' combinators.

166+--

167+-- > useBraces $ sepSemi txt ["foo", "bar"]

168+-- > == vlayout (txt "{ foo; bar }") (txt "foo\nbar")

169+--

170+-- > dontUseBraces $ sepSemi txt ["foo", "bar"]

171+-- > == vlayout (txt "foo; bar") (txt "foo\nbar")

172+

173+sepSemi

174+ :: (a -> R ()) -- ^ How to render an element

175+ -> [a] -- ^ Elements to render

176+ -> R ()

177+sepSemi f xs = vlayout singleLine multiLine

178+ where

179+ singleLine = do

180+ ub <- canUseBraces

181+ case xs of

182+ [] -> when ub $ txt "{}"

183+ xs' ->

184+ if ub

185+ then do

186+ txt "{ "

187+ sep (txt "; ") (dontUseBraces . f) xs'

188+ txt " }"

189+ else

190+ sep (txt "; ") f xs'

191+ multiLine =

192+ sep newline (dontUseBraces . f) xs

193+

159----------------------------------------------------------------------------

194----------------------------------------------------------------------------

160-- Wrapping

195-- Wrapping

161

196

src/Ormolu/Printer/Internal.hs+25

@@ -23,6 +23,10 @@ module Ormolu.Printer.Internal

23 , Layout (..)

24 , enterLayout

25 , vlayout

26+ -- * Helpers for braces

27+ , useBraces

28+ , dontUseBraces

29+ , canUseBraces

26 -- * Special helpers for comment placement

30 -- * Special helpers for comment placement

27 , trimSpanStream

31 , trimSpanStream

28 , nextEltSpan

32 , nextEltSpan

@@ -75,6 +79,8 @@ data RC = RC

75 -- ^ Span of enclosing element of AST

79 -- ^ Span of enclosing element of AST

76 , rcAnns :: Anns

80 , rcAnns :: Anns

77 -- ^ Collection of annotations

81 -- ^ Collection of annotations

82+ , rcCanUseBraces :: Bool

83+ -- ^ If the last expression in the layout can use braces

78 }

84 }

79

85

80-- | State context of 'R'.

86-- | State context of 'R'.

@@ -117,6 +123,7 @@ runR debug (R m) sstream cstream anns =

117 , rcDebug = debug

123 , rcDebug = debug

118 , rcEnclosingSpans = []

124 , rcEnclosingSpans = []

119 , rcAnns = anns

125 , rcAnns = anns

126+ , rcCanUseBraces = False

120 }

127 }

121 sc = SC

128 sc = SC

122 { scColumn = 0

129 { scColumn = 0

@@ -344,6 +351,24 @@ getAnns

344 -> R [AnnKeywordId]

351 -> R [AnnKeywordId]

345getAnns spn = lookupAnns spn <$> R (asks rcAnns)

352getAnns spn = lookupAnns spn <$> R (asks rcAnns)

346

353

354+----------------------------------------------------------------------------

355+-- Helpers for braces

356+

357+-- | Make the inner computation use braces around single-line layouts.

358+

359+useBraces :: R () -> R ()

360+useBraces (R r) = R (local (\i -> i {rcCanUseBraces = True}) r)

361+

362+-- | Make the inner computation omit braces around single-line layouts.

363+

364+dontUseBraces :: R () -> R ()

365+dontUseBraces (R r) = R (local (\i -> i {rcCanUseBraces = False}) r)

366+

367+-- | Return 'True' if we can use braces in this context.

368+

369+canUseBraces :: R Bool

370+canUseBraces = R $ asks rcCanUseBraces

371+

347----------------------------------------------------------------------------

372----------------------------------------------------------------------------

348-- Debug helpers

373-- Debug helpers

349

374

src/Ormolu/Printer/Meat/Declaration.hs+11−10

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

1{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE PatternSynonyms #-}

3{-# LANGUAGE PatternSynonyms #-}

3{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE ViewPatterns #-}

5{-# LANGUAGE ViewPatterns #-}

@@ -10,7 +11,6 @@ module Ormolu.Printer.Meat.Declaration

10 )

11 )

11where

12where

12

13

13−import Control.Monad (forM_)

14import GHC

15import OccName (occNameFS)

16import Ormolu.Printer.Combinators

@@ -34,16 +34,17 @@ import Ormolu.Utils

34import RdrName (rdrNameOcc)

35

36p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

37−p_hsDecls style decls =

37+p_hsDecls style decls = do

38− forM_ (zip decls ((Just <$> drop 1 decls) ++ [Nothing])) $ \(d, md) ->

39− case md of

40− Nothing -> located d pDecl

38+ sepSemi (\(x, r) -> located x pDecl >> r) (separated decls)

41− Just d' ->

42− line $ if separatedDecls (unLoc d) (unLoc d')

43− then line (located d pDecl)

44− else located d pDecl

45 where

39 where

46− pDecl = p_hsDecl style

40+ pDecl = dontUseBraces . p_hsDecl style

41+

42+ separated [] = []

43+ separated [x] = [(x, return ())]

44+ separated (x:y:xs) =

45+ if separatedDecls (unLoc x) (unLoc y)

46+ then (x, breakpoint') : separated (y:xs)

47+ else (x, return ()) : separated (y:xs)

47

48

48p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()

49p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()

49p_hsDecl style = \case

50p_hsDecl style = \case

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

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

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

67 unless (null allDecls) $ do

68 txt " where"

69− newline -- Ensure line is added after where clause.

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

70− newline -- Add newline before first declaration.

70+ breakpoint' -- Add newline before first declaration.

71 inci (p_hsDecls Associated allDecls)

72

73p_classContext :: LHsContext GhcPs -> R ()

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

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

52 then do

53 txt " where"

54 breakpoint

55− inci . sitcc $ sep newline (sitcc . located' p_conDecl) dd_cons

55+ inci $ sepSemi (located' p_conDecl) dd_cons

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

57 inci $ do

58 breakpoint

src/Ormolu/Printer/Meat/Declaration/Instance.hs+12−10

@@ -67,11 +67,7 @@ p_clsInstDecl = \case

67 ClsInstDecl {..} -> do

68 txt "instance"

69 case cid_poly_ty of

70− HsIB {..} -> located hsib_body $ \x -> do

70+ HsIB {..} -> do

71− breakpoint

72− inci $ do

73− match_overlap_mode cid_overlap_mode breakpoint

74− p_hsType x

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

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

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

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

77 -- different lists. Consequently, to get all the declarations in proper

73 -- different lists. Consequently, to get all the declarations in proper

@@ -87,13 +83,19 @@ p_clsInstDecl = \case

87 allDecls =

83 allDecls =

88 snd <$>

84 snd <$>

89 sortBy (comparing fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)

85 sortBy (comparing fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)

86+ located hsib_body $ \x -> do

87+ breakpoint

88+ inci $ do

89+ match_overlap_mode cid_overlap_mode breakpoint

90+ p_hsType x

91+ unless (null allDecls) $ do

92+ breakpoint

93+ txt "where"

90 unless (null allDecls) $ do

94 unless (null allDecls) $ do

91− switchLayout [getLoc hsib_body] breakpoint

92 inci $ do

95 inci $ do

93− txt "where"

94− newline -- Ensure line is added after where clause.

96+ breakpoint -- Ensure whitespace is added after where clause.

95− newline -- Add newline before first declaration.

97+ breakpoint' -- Add newline before first declaration

96− p_hsDecls Associated allDecls

98+ dontUseBraces $ p_hsDecls Associated allDecls

97 XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"

99 XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"

98 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

100 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

99

101

src/Ormolu/Printer/Meat/Declaration/Value.hs+60−55

@@ -81,8 +81,15 @@ p_matchGroup'

81 -> MatchGroupStyle

82 -> MatchGroup GhcPs (Located body)

83 -> R ()

84−p_matchGroup' placer pretty style MG {..} =

84+p_matchGroup' placer pretty style MG {..} = do

85+ let ob = case style of

86+ Case -> id

87+ LambdaCase -> id

88+ _ -> dontUseBraces

89+ -- NOTE since we are forcing braces on 'sepSemi' based on 'ob', we have to

90+ -- restore the brace state inside the sepsemi.

91+ ub <- bool dontUseBraces useBraces <$> canUseBraces

85− sep newline (located' p_Match) (unLoc mg_alts)

92+ ob $ sepSemi (located' (ub . p_Match)) (unLoc mg_alts)

86 where

93 where

87 p_Match m@Match {..} =

94 p_Match m@Match {..} =

88 p_match'

95 p_match'

@@ -179,7 +186,6 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do

179 stdCase

186 stdCase

180 LambdaCase -> stdCase

187 LambdaCase -> stdCase

181 return inci'

188 return inci'

182−

183 let

189 let

184 -- Calculate position of end of patterns. This is useful when we decide

190 -- Calculate position of end of patterns. This is useful when we decide

185 -- about putting certain constructions in hanging positions.

191 -- about putting certain constructions in hanging positions.

@@ -192,49 +198,44 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do

192 Case -> True

198 Case -> True

193 LambdaCase -> True

199 LambdaCase -> True

194 _ -> False

200 _ -> False

201+ let GRHSs {..} = m_grhss

202+ hasGuards = withGuards grhssGRHSs

203+ unless (length grhssGRHSs > 1) $ do

204+ case style of

205+ Function _ | hasGuards -> return ()

206+ Function _ -> txt " ="

207+ PatternBind -> txt " ="

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

209+ _ -> txt " ->"

210+ let grhssSpan = combineSrcSpans' $

211+ getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

212+ patGrhssSpan = maybe grhssSpan

213+ (combineSrcSpans grhssSpan . srcLocSpan) endOfPats

214+ placement =

215+ case endOfPats of

216+ Nothing -> blockPlacement placer grhssGRHSs

217+ Just spn ->

218+ if isOneLineSpan

219+ (mkSrcSpan spn (srcSpanStart grhssSpan))

220+ then blockPlacement placer grhssGRHSs

221+ else Normal

222+ p_body = do

223+ let groupStyle =

224+ if isCase style && hasGuards

225+ then RightArrow

226+ else EqualSign

227+ sep newline (located' (p_grhs' pretty groupStyle)) grhssGRHSs

228+ p_where = do

229+ let whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)

230+ unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do

231+ breakpoint

232+ txt "where"

233+ unless whereIsEmpty breakpoint

234+ inci $ located grhssLocalBinds p_hsLocalBinds

195 inci' $ do

235 inci' $ do

196− let GRHSs {..} = m_grhss

197− hasGuards = withGuards grhssGRHSs

198− unless (length grhssGRHSs > 1) $ do

199− case style of

200− Function _ | hasGuards -> return ()

201− Function _ -> txt " ="

202− PatternBind -> txt " ="

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

204− _ -> txt " ->"

205− let grhssSpan = combineSrcSpans' $

206− getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

207− patGrhssSpan = maybe grhssSpan

208− (combineSrcSpans grhssSpan . srcLocSpan) endOfPats

209− placement =

210− case endOfPats of

211− Nothing -> blockPlacement placer grhssGRHSs

212− Just spn ->

213− if isOneLineSpan

214− (mkSrcSpan spn (srcSpanStart grhssSpan))

215− then blockPlacement placer grhssGRHSs

216− else Normal

217− inciLocalBinds = case placement of

218− Normal -> id

219− Hanging -> inci

220− p_body = do

221− let groupStyle =

222− if isCase style && hasGuards

223− then RightArrow

224− else EqualSign

225− sep newline (located' (p_grhs' pretty groupStyle)) grhssGRHSs

226− let whereLocation = combineSrcSpans patGrhssSpan $ getLoc grhssLocalBinds

227− whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)

228− unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds))

229− . inciLocalBinds

230− . switchLayout [whereLocation] $ do

231− if whereIsEmpty then newline else breakpoint

232− txt "where"

233− unless whereIsEmpty $ do

234− breakpoint

235− inci (located grhssLocalBinds p_hsLocalBinds)

236 switchLayout [patGrhssSpan] $

237 placeHanging placement p_body

238+ inci p_where

238

239

239p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()

240p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()

240p_grhs = p_grhs' p_hsExpr

241p_grhs = p_grhs' p_hsExpr

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

386 inci (p_hsExpr x)

387 inci (p_hsExpr x)

387 RecStmt {..} -> do

388 RecStmt {..} -> do

388 txt "rec "

389 txt "rec "

389− sitcc $ sep newline (located' (p_stmt' pretty)) recS_stmts

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

390 XStmtLR {} -> notImplemented "XStmtLR"

391 XStmtLR {} -> notImplemented "XStmtLR"

391

392

392gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]

393gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]

@@ -411,7 +412,7 @@ p_hsLocalBinds = \case

411 (Left <$> bagToList bag) ++ (Right <$> lsigs)

412 (Left <$> bagToList bag) ++ (Right <$> lsigs)

412 p_item (Left x) = located x p_valDecl

413 p_item (Left x) = located x p_valDecl

413 p_item (Right x) = located x p_sigDecl

414 p_item (Right x) = located x p_sigDecl

414− sitcc $ sep newline (sitcc . p_item) (sortOn ssStart items)

415+ sitcc $ sepSemi (useBraces . p_item) (sortOn ssStart items)

415 HsValBinds NoExt _ -> notImplemented "HsValBinds"

416 HsValBinds NoExt _ -> notImplemented "HsValBinds"

416 HsIPBinds NoExt _ -> notImplemented "HsIPBinds"

417 HsIPBinds NoExt _ -> notImplemented "HsIPBinds"

417 EmptyLocalBinds NoExt -> return ()

418 EmptyLocalBinds NoExt -> return ()

@@ -468,18 +469,23 @@ p_hsExpr = \case

468 txt "@"

469 txt "@"

469 located (hswc_body a) p_hsType

470 located (hswc_body a) p_hsType

470 OpApp NoExt x op y -> do

471 OpApp NoExt x op y -> do

471− located x p_hsExpr

472− -- NOTE If the end of the first argument and the beginning of the second

472+ -- NOTE If the beginning of the first argument and the second argument

473− -- argument are on the same line, and the second argument has a hanging

473+ -- are on the same line, and the second argument has a hanging form, use

474− -- form, use hanging placement.

474+ -- hanging placement.

475 let placement =

476 if isOneLineSpan

477− (mkSrcSpan (srcSpanEnd (getLoc x)) (srcSpanStart (getLoc y)))

477+ (mkSrcSpan (srcSpanStart (getLoc x)) (srcSpanStart (getLoc y)))

478 then exprPlacement (unLoc y)

479 else Normal

480 opWrapper = case unLoc op of

481 EWildPat NoExt -> backticks

482 _ -> id

483+ ub <- vlayout

484+ (return useBraces)

485+ (return $ case placement of

486+ Hanging -> useBraces

487+ Normal -> dontUseBraces)

488+ ub $ located x p_hsExpr

483 placeHanging placement $ do

489 placeHanging placement $ do

484 located op (opWrapper . p_hsExpr)

490 located op (opWrapper . p_hsExpr)

485 space

491 space

@@ -543,10 +549,9 @@ p_hsExpr = \case

543 HsDo NoExt ctx es -> do

549 HsDo NoExt ctx es -> do

544 let doBody header = do

550 let doBody header = do

545 txt header

551 txt header

546− if length (unLoc es) <= 1

547− then breakpoint

552+ breakpoint

548− else newline

553+ ub <- vlayout (return useBraces) (return id)

549− inci $ located es (sep newline (located' (sitcc . p_stmt)))

554+ inci $ sepSemi (located' (ub . p_stmt)) (unLoc es)

550 compBody = brackets $ located es $ \xs -> do

555 compBody = brackets $ located es $ \xs -> do

551 let p_parBody = sitcc . sep

556 let p_parBody = sitcc . sep

552 (breakpoint >> txt "| ")

557 (breakpoint >> txt "| ")

@@ -864,7 +869,7 @@ p_hsBracket = \case

864 txt "|"

869 txt "|"

865 breakpoint'

870 breakpoint'

866 inci $ do

871 inci $ do

867− body

872+ dontUseBraces body

868 breakpoint'

873 breakpoint'

869 txt "|]"

874 txt "|]"

870

875

src/Ormolu/Printer/Meat/Module.hs+12−11

@@ -57,14 +57,15 @@ p_hsModule pragmas (L moduleSpan HsModule {..}) = do

57 when (hasImports || hasDecls) newline

58 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

59 when (hasImports && hasDecls) newline

60+ switchLayout (map getLoc hsmodDecls) $ do

60− p_hsDecls Free hsmodDecls

61+ p_hsDecls Free hsmodDecls

61− trailingComments <- hasMoreComments

62+ trailingComments <- hasMoreComments

62− when hasDecls $ do

63+ when hasDecls $ do

63− newlineModified <- isNewlineModified

64+ newlineModified <- isNewlineModified

64− newline

65+ newline

65− -- In this case we need to insert a newline between the comments

66+ -- In this case we need to insert a newline between the comments

66− -- output as a side effect of the previous newline and trailing

67+ -- output as a side effect of the previous newline and trailing

67− -- comments to prevent them from merging.

68+ -- comments to prevent them from merging.

68− when (newlineModified && trailingComments) newline

69+ when (newlineModified && trailingComments) newline

69− when (trailingComments && hasModuleHeader) newline

70+ when (trailingComments && hasModuleHeader) newline

70− spitRemainingComments

71+ spitRemainingComments