116fe84 · ormolu · git.iko.soy

CHANGELOG.md+5

compare with master

unifiedsplit

@@ -18,6 +18,11 @@

18* Fixed indentation in presence of type applications. [Issue

19 493](https://github.com/tweag/ormolu/issues/493).

20

21+* Class and instance declarations now do not have a blank line after

22+ `where`. Grouping of methods from the original input is also preserved

23+ with some normalizations. [Issue

24+ 431](https://github.com/tweag/ormolu/issues/431).

25+

21## Ormolu 0.0.2.0

26## Ormolu 0.0.2.0

22

27

23* Switched to `ghc-lib-parser` instead of depending on the `ghc` package

28* Switched to `ghc-lib-parser` instead of depending on the `ghc` package

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

@@ -4,7 +4,6 @@ class Foo a where data FooBar a

4

5-- | Something.

6class Bar a where

7−

8 -- | Bar bar

7 -- | Bar bar

9 data BarBar a

8 data BarBar a

10

9

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

@@ -4,7 +4,6 @@ module Main where

4

5-- | Something more.

6class Baz a where

7−

8 -- | Baz bar

7 -- | Baz bar

9 data

8 data

10 BazBar

9 BazBar

data/examples/declaration/class/associated-type-defaults-out.hs−2

@@ -4,7 +4,6 @@ class Foo a where type FooBar a = Int

4

5-- | Something.

6class Bar a where

7−

8 -- Define bar

7 -- Define bar

9 type

8 type

10 BarBar a =

9 BarBar a =

@@ -18,7 +17,6 @@ class Bar a where

18 a

17 a

19

18

20class Baz a where

19class Baz a where

21−

22 type

20 type

23 BazBar

21 BazBar

24 a

22 a

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

@@ -4,7 +4,6 @@ class Foo a where type FooBar a

4

5-- | Something.

6class Bar a where

7−

8 -- | Bar bar

7 -- | Bar bar

9 type BarBar a

8 type BarBar a

10

9

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

@@ -4,7 +4,6 @@ module Main where

4

5-- | Something more.

6class Baz a where

7−

8 -- | Baz bar

7 -- | Baz bar

9 type

8 type

10 BazBar

9 BazBar

data/examples/declaration/class/default-implementations-comments-out.hs−1

@@ -2,7 +2,6 @@ module Main where

2

3-- | Baz

4class Baz a where

5−

6 foobar :: a -> a

5 foobar :: a -> a

7 foobar a =

6 foobar a =

8 barbaz (bazbar a)

7 barbaz (bazbar a)

data/examples/declaration/class/default-signatures-out.hs−2

@@ -4,13 +4,11 @@ module Main where

4

5-- | Something else.

6class Bar a where

7−

8 -- | Bar

7 -- | Bar

9 bar ::

8 bar ::

10 String ->

9 String ->

11 String ->

10 String ->

12 a

11 a

13−

14 -- Pointless comment

12 -- Pointless comment

15 default bar ::

13 default bar ::

16 ( Read a,

14 ( Read a,

data/examples/declaration/class/default-signatures-simple-out.hs−2

@@ -2,9 +2,7 @@ module Main where

2

3-- | Something.

4class Foo a where

5−

6 -- | Foo

5 -- | Foo

7 foo :: a -> String

6 foo :: a -> String

8−

9 default foo :: Show a => a -> String

7 default foo :: Show a => a -> String

10 foo = show

8 foo = show

data/examples/declaration/class/dependency-super-classes-out.hs−3

@@ -4,9 +4,7 @@ module Main where

4

5-- | Something.

6class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where

7−

8 get :: m s

7 get :: m s

9−

10 put :: s -> m ()

8 put :: s -> m ()

11

9

12-- | 'MonadParsec'

10-- | 'MonadParsec'

@@ -16,7 +14,6 @@ class

16 ) =>

14 ) =>

17 MonadParsec e s m

15 MonadParsec e s m

18 | m -> e s where

16 | m -> e s where

19−

20 -- | 'getState' returns state

17 -- | 'getState' returns state

21 getState ::

18 getState ::

22 m s

19 m s

data/examples/declaration/class/multi-parameters2-out.hs−2

@@ -11,10 +11,8 @@ class

11 d -- Baz baz

12 e -- Rest

13 f where

14−

15 barbaz ::

14 barbaz ::

16 a -> f

15 a -> f

17−

18 bazbar ::

16 bazbar ::

19 e ->

17 e ->

20 f

18 f

data/examples/declaration/class/newlines-after-where-out.hsnew file+5

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

1+class Num a where

2+ (+) :: a -> a -> a

3+

4+class Num a where

5+ (+) :: a -> a -> a

data/examples/declaration/class/newlines-after-where.hsnew file+7

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

1+class Num a where

2+ (+) :: a -> a -> a

3+

4+class Num a where

5+

6+

7+ (+) :: a -> a -> a

data/examples/declaration/class/newlines-and-default-decls-out.hsnew file+11

@@ -0,0 +1,11 @@

1+class Foo a where

2+ foo :: a

3+ default foo :: ()

4+ foo = ()

5+ bar :: a

6+ default bar :: ()

7+ bar = ()

8+

9+ qux :: a

10+ default qux :: ()

11+ qux = ()

data/examples/declaration/class/newlines-and-default-decls.hsnew file+13

@@ -0,0 +1,13 @@

1+class Foo a where

2+ foo :: a

3+ default foo :: ()

4+ foo = ()

5+ bar :: a

6+ default bar :: ()

7+ bar = ()

8+

9+ qux :: a

10+

11+ default qux :: ()

12+

13+ qux = ()

data/examples/declaration/class/newlines-and-haddocks-out.hsnew file+23

@@ -0,0 +1,23 @@

1+class Foo a where

2+ -- | Haddock

3+ foo :: a

4+

5+ -- | Another Haddock

6+ bar :: a

7+

8+ baz :: a

9+ -- ^ Post-Haddock

10+

11+ raz :: a

12+ -- ^ Another Post-Haddock

13+

14+ -- | One more Haddock

15+ qux :: a

16+

17+ -- Comment before a Haddock

18+

19+ -- | And one more Haddock

20+ xyz :: a

21+

22+ -- | Haddock followed by a blank line

23+ abc :: a

data/examples/declaration/class/newlines-and-haddocks.hsnew file+19

@@ -0,0 +1,19 @@

1+class Foo a where

2+ -- | Haddock

3+ foo :: a

4+ -- | Another Haddock

5+ bar :: a

6+ baz :: a

7+ -- ^ Post-Haddock

8+ raz :: a

9+ -- ^ Another Post-Haddock

10+

11+ -- | One more Haddock

12+ qux :: a

13+ -- Comment before a Haddock

14+ -- | And one more Haddock

15+ xyz :: a

16+

17+ -- | Haddock followed by a blank line

18+

19+ abc :: a

data/examples/declaration/class/newlines-between-methods-out.hsnew file+17

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

1+class Num a where

2+ (+) :: a -> a -> a

3+ (-) :: a -> a -> a

4+ (*) :: a -> a -> a

5+

6+ -- Comment before definition

7+ negate :: a -> a

8+

9+ -- Comment after definition

10+

11+ -- Separator

12+

13+ abs :: a -> a

14+ signum :: a -> a

15+

16+ -- Comment between unrelated definitions

17+ fromInteger :: Integer -> a

data/examples/declaration/class/newlines-between-methods.hsnew file+15

@@ -0,0 +1,15 @@

1+class Num a where

2+ (+) :: a -> a -> a

3+ (-) :: a -> a -> a

4+ (*) :: a -> a -> a

5+

6+ -- Comment before definition

7+ negate :: a -> a

8+ -- Comment after definition

9+

10+ -- Separator

11+

12+ abs :: a -> a

13+ signum :: a -> a

14+ -- Comment between unrelated definitions

15+ fromInteger :: Integer -> a

data/examples/declaration/class/single-parameters-out.hs−2

@@ -21,8 +21,6 @@ class Baz a where

21 a

22

23class BarBaz a where

24−

25 barbaz ::

24 barbaz ::

26 a -> b

25 a -> b

27−

28 bazbar :: b -> a

26 bazbar :: b -> a

data/examples/declaration/instance/associated-data-out.hs−2

@@ -11,9 +11,7 @@ instance Foo Double where

11 Double

12

13instance Foo [a] where

14−

15 data Bar [a]

14 data Bar [a]

16 = ListBar [Bar a]

15 = ListBar [Bar a]

17−

18 data Baz [a]

16 data Baz [a]

19 = ListBaz

17 = ListBaz

data/examples/declaration/instance/associated-data.hs+1

@@ -13,6 +13,7 @@ instance Foo Double where

13

14instance Foo [a]

15 where

16+

16 data Bar [a] =

17 data Bar [a] =

17 ListBar [Bar a]

18 ListBar [Bar a]

18 data Baz [a] =

19 data Baz [a] =

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

@@ -3,7 +3,6 @@

3instance Foo Int where type Bar Int = Double

4

5instance Foo Double where

6−

7 type

6 type

8 Bar

7 Bar

9 Double =

8 Double =

data/examples/declaration/instance/associated-types.hs+2

@@ -9,5 +9,7 @@ instance Foo Double

9 Double

10 =

11 [Double]

12+

13+

12 type instance Baz Double

14 type instance Baz Double

13 = [Double]

15 = [Double]

data/examples/declaration/instance/instance-sigs-multiple-out.hs−2

@@ -1,12 +1,10 @@

1{-# LANGUAGE InstanceSigs #-}

2

3instance Applicative [] where

4−

5 pure ::

4 pure ::

6 a ->

5 a ->

7 [a]

6 [a]

8 pure a = [a]

7 pure a = [a]

9−

10 (<*>) ::

8 (<*>) ::

11 [a] -> [a] -> [a]

9 [a] -> [a] -> [a]

12 (<*>) _ _ = []

10 (<*>) _ _ = []

data/examples/declaration/instance/multi-parameter-out.hs−2

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

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

2

3instance MonadState s (State s) where

4−

5 get = State.get

4 get = State.get

6−

7 put = State.put

5 put = State.put

data/examples/declaration/instance/newlines-after-where-out.hsnew file+5

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

1+instance Num X where

2+ (+) = undefined

3+

4+instance Num Y where

5+ (+) = undefined

data/examples/declaration/instance/newlines-after-where.hsnew file+7

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

1+instance Num X where

2+ (+) = undefined

3+

4+instance Num Y where

5+

6+

7+ (+) = undefined

data/examples/declaration/instance/newlines-between-methods-out.hsnew file+18

@@ -0,0 +1,18 @@

1+instance Num a => Num (Diff a) where

2+ D u dudx + D v dvdx = D (u + v) (dudx + dvdx)

3+ D u dudx - D v dvdx = D (u - v) (dudx - dvdx)

4+ D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx)

5+

6+ -- Comment before definition

7+ negate (D u dudx) = D (- u) (- dudx)

8+ negate (Z u dudx) = undefined

9+

10+ -- Comment after definition

11+

12+ -- Separator

13+

14+ abs (D u _) = D (abs u) (signum u)

15+ signum (D u _) = D (signum u) 0

16+

17+ -- Comment between unrelated definitions

18+ fromInteger n = D (fromInteger n) 0

data/examples/declaration/instance/newlines-between-methods.hsnew file+16

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

1+instance Num a => Num (Diff a) where

2+ D u dudx + D v dvdx = D (u + v) (dudx + dvdx)

3+ D u dudx - D v dvdx = D (u - v) (dudx - dvdx)

4+ D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx)

5+

6+ -- Comment before definition

7+ negate (D u dudx) = D (-u) (-dudx)

8+ negate (Z u dudx) = undefined

9+ -- Comment after definition

10+

11+ -- Separator

12+

13+ abs (D u _) = D (abs u) (signum u)

14+ signum (D u _) = D (signum u) 0

15+ -- Comment between unrelated definitions

16+ fromInteger n = D (fromInteger n) 0

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

@@ -1,9 +1,7 @@

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

2

3instance Enum Int where

4−

5 fromEnum x = x

4 fromEnum x = x

6−

7 toEnum =

5 toEnum =

8 \x ->

6 \x ->

9 x

7 x

data/examples/declaration/signature/minimal/minimal-out.hs−2

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

1class Foo a where

2−

3 {-# MINIMAL (==) | ((/=), foo) #-}

2 {-# MINIMAL (==) | ((/=), foo) #-}

4

3

5 {-# MINIMAL

4 {-# MINIMAL

@@ -12,5 +11,4 @@ class Foo a where

12 #-}

11 #-}

13

12

14 (==) :: a -> a -> Bool

13 (==) :: a -> a -> Bool

15−

16 (/=) :: a -> a -> Bool

14 (/=) :: a -> a -> Bool

data/examples/declaration/signature/specialize/specialize-instance-out.hs−4

@@ -3,16 +3,12 @@ data Foo a = Foo a

3data VT v m r = VT v m r

4

5instance (Eq a) => Eq (Foo a) where

6−

7 {-# SPECIALIZE instance Eq (Foo [(Int, Bar)]) #-}

6 {-# SPECIALIZE instance Eq (Foo [(Int, Bar)]) #-}

8−

9 (==) (Foo a) (Foo b) = (==) a b

7 (==) (Foo a) (Foo b) = (==) a b

10

8

11instance (Num r, V.Vector v r, Factored m r) => Num (VT v m r) where

9instance (Num r, V.Vector v r, Factored m r) => Num (VT v m r) where

12−

13 {-# SPECIALIZE instance

10 {-# SPECIALIZE instance

14 ( Factored m Int => Num (VT U.Vector m Int)

11 ( Factored m Int => Num (VT U.Vector m Int)

15 )

12 )

16 #-}

13 #-}

17−

18 VT x + VT y = VT $ V.zipWith (+) x y

14 VT x + VT y = VT $ V.zipWith (+) x y

data/examples/other/comment-alignment-out.hs−1

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

1class Foo a where

2−

3 -- | Foo.

2 -- | Foo.

4 foo ::

3 foo ::

5 Int ->

4 Int ->

src/Ormolu/Printer/Meat/Declaration.hs+51−14

@@ -7,7 +7,7 @@

7-- | Rendering of declarations.

8module Ormolu.Printer.Meat.Declaration

9 ( p_hsDecls,

10− hasSeparatedDecls,

10+ p_hsDeclsRespectGrouping,

11 )

12where

13

@@ -36,18 +36,52 @@ import Ormolu.Printer.Meat.Type

36import Ormolu.Utils

37import RdrName (rdrNameOcc)

38

39+data UserGrouping

40+ = -- | Always put newlines where we think they should be

41+ Disregard

42+ | -- | Respect user preferences regarding grouping

43+ Respect

44+ deriving (Eq, Show)

45+

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

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

47+p_hsDecls = p_hsDecls' Disregard

48+

49+-- | Like 'p_hsDecls' but respects user choices regarding grouping. If the

50+-- user omits newlines between declarations, we also omit them in most

51+-- cases, except when said declarations have associated Haddocks.

52+--

53+-- Does some normalization (compress subsequent newlines into a single one)

54+p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

55+p_hsDeclsRespectGrouping = p_hsDecls' Respect

56+

57+p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()

40−p_hsDecls style decls = sepSemi id $

58+p_hsDecls' grouping style decls = sepSemi id $

41 -- Return a list of rendered declarations, adding a newline to separate

59 -- Return a list of rendered declarations, adding a newline to separate

42 -- groups.

60 -- groups.

43 case groupDecls decls of

61 case groupDecls decls of

44 [] -> []

62 [] -> []

45− (x : xs) ->

63+ (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)

46− NE.toList (renderGroup x)

47− ++ concatMap (NE.toList . separateGroup . renderGroup) xs

48 where

64 where

49− renderGroup = fmap (located' $ dontUseBraces . p_hsDecl style)

65+ renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)

50− separateGroup (x :| xs) = (breakpoint' >> x) :| xs

66+ renderGroupWithPrev prev curr =

67+ -- We can omit a blank line when the user didn't add one, but we must

68+ -- ensure we always add blank lines around documented declarations

69+ if or

70+ [ grouping == Disregard,

71+ separatedByBlank getLoc prev curr,

72+ isDocumented prev,

73+ isDocumented curr

74+ ]

75+ then breakpoint : renderGroup curr

76+ else renderGroup curr

77+

78+-- | Is a declaration group documented?

79+isDocumented :: NonEmpty (LHsDecl GhcPs) -> Bool

80+isDocumented = any (isHaddock . unLoc)

81+ where

82+ isHaddock DocNext = True

83+ isHaddock DocPrev = True

84+ isHaddock _ = False

51

85

52-- | Group relevant declarations together.

86-- | Group relevant declarations together.

53--

87--

@@ -139,6 +173,9 @@ groupedDecls ::

139 HsDecl GhcPs ->

173 HsDecl GhcPs ->

140 Bool

174 Bool

141groupedDecls (TypeSignature ns) (FunctionBody ns') = ns `intersects` ns'

175groupedDecls (TypeSignature ns) (FunctionBody ns') = ns `intersects` ns'

176+groupedDecls (TypeSignature ns) (DefaultSignature ns') = ns `intersects` ns'

177+groupedDecls (DefaultSignature ns) (TypeSignature ns') = ns `intersects` ns'

178+groupedDecls (DefaultSignature ns) (FunctionBody ns') = ns `intersects` ns'

142groupedDecls x (FunctionBody ns) | Just ns' <- isPragma x = ns `intersects` ns'

179groupedDecls x (FunctionBody ns) | Just ns' <- isPragma x = ns `intersects` ns'

143groupedDecls (FunctionBody ns) x | Just ns' <- isPragma x = ns `intersects` ns'

180groupedDecls (FunctionBody ns) x | Just ns' <- isPragma x = ns `intersects` ns'

144groupedDecls x (DataDeclaration n) | Just ns <- isPragma x = n `elem` ns

181groupedDecls x (DataDeclaration n) | Just ns <- isPragma x = n `elem` ns

@@ -149,6 +186,7 @@ groupedDecls x y | Just ns <- isPragma x, Just ns' <- isPragma y = ns `intersect

149groupedDecls x (TypeSignature ns) | Just ns' <- isPragma x = ns `intersects` ns'

186groupedDecls x (TypeSignature ns) | Just ns' <- isPragma x = ns `intersects` ns'

150groupedDecls (TypeSignature ns) x | Just ns' <- isPragma x = ns `intersects` ns'

187groupedDecls (TypeSignature ns) x | Just ns' <- isPragma x = ns `intersects` ns'

151groupedDecls (PatternSignature ns) (Pattern n) = n `elem` ns

188groupedDecls (PatternSignature ns) (Pattern n) = n `elem` ns

189+-- This looks only at Haddocks, normal comments are handled elsewhere

152groupedDecls DocNext _ = True

190groupedDecls DocNext _ = True

153groupedDecls _ DocPrev = True

191groupedDecls _ DocPrev = True

154groupedDecls _ _ = False

192groupedDecls _ _ = False

@@ -164,13 +202,6 @@ intersects a b = go (sort a) (sort b)

164 | x > y = go (x : xs) ys

202 | x > y = go (x : xs) ys

165 | otherwise = True

203 | otherwise = True

166

204

167−-- | Checks if given list of declarations contain a pair which should

168−-- be separated by a blank line.

169−hasSeparatedDecls :: [LHsDecl GhcPs] -> Bool

170−hasSeparatedDecls xs = case groupDecls xs of

171− _ : _ : _ -> True

172− _ -> False

173−

174isPragma ::

205isPragma ::

175 HsDecl GhcPs ->

206 HsDecl GhcPs ->

176 Maybe [RdrName]

207 Maybe [RdrName]

@@ -206,11 +237,13 @@ pattern DataDeclaration n <- TyClD NoExt (DataDecl NoExt (L _ n) _ _ _)

206

237

207pattern

238pattern

208 TypeSignature,

239 TypeSignature,

240+ DefaultSignature,

209 FunctionBody,

241 FunctionBody,

210 PatternSignature,

242 PatternSignature,

211 WarningPragma ::

243 WarningPragma ::

212 [RdrName] -> HsDecl GhcPs

244 [RdrName] -> HsDecl GhcPs

213pattern TypeSignature n <- (sigRdrNames -> Just n)

245pattern TypeSignature n <- (sigRdrNames -> Just n)

246+pattern DefaultSignature n <- (defSigRdrNames -> Just n)

214pattern FunctionBody n <- (funRdrNames -> Just n)

247pattern FunctionBody n <- (funRdrNames -> Just n)

215pattern PatternSignature n <- (patSigRdrNames -> Just n)

248pattern PatternSignature n <- (patSigRdrNames -> Just n)

216pattern WarningPragma n <- (warnSigRdrNames -> Just n)

249pattern WarningPragma n <- (warnSigRdrNames -> Just n)

@@ -225,6 +258,10 @@ sigRdrNames (SigD NoExt (ClassOpSig NoExt _ ns _)) = Just $ map unLoc ns

225sigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns

258sigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns

226sigRdrNames _ = Nothing

259sigRdrNames _ = Nothing

227

260

261+defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

262+defSigRdrNames (SigD NoExt (ClassOpSig NoExt True ns _)) = Just $ map unLoc ns

263+defSigRdrNames _ = Nothing

264+

228funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

265funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

229funRdrNames (ValD NoExt (FunBind NoExt (L _ n) _ _ _)) = Just [n]

266funRdrNames (ValD NoExt (FunBind NoExt (L _ n) _ _ _)) = Just [n]

230funRdrNames (ValD NoExt (PatBind NoExt n _ _)) = Just $ patBindNames n

267funRdrNames (ValD NoExt (PatBind NoExt n _ _)) = Just $ patBindNames n

src/Ormolu/Printer/Meat/Declaration.hs-boot+2−2

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

1module Ormolu.Printer.Meat.Declaration

2 ( p_hsDecls,

3− hasSeparatedDecls,

3+ p_hsDeclsRespectGrouping,

4 )

5where

6

@@ -10,4 +10,4 @@ import Ormolu.Printer.Meat.Common

10

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

12

13−hasSeparatedDecls :: [LHsDecl GhcPs] -> Bool

13+p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

src/Ormolu/Printer/Meat/Declaration/Class.hs+1−4

@@ -68,10 +68,7 @@ p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = d

68 space

69 txt "where"

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

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

72− -- declarations.

73− when (hasSeparatedDecls allDecls) breakpoint'

74− inci (p_hsDecls Associated allDecls)

71+ inci (p_hsDeclsRespectGrouping Associated allDecls)

75p_classDecl _ _ XLHsQTyVars {} _ _ _ _ _ _ _ = notImplemented "XLHsQTyVars"

72p_classDecl _ _ XLHsQTyVars {} _ _ _ _ _ _ _ = notImplemented "XLHsQTyVars"

76

73

77p_classContext :: LHsContext GhcPs -> R ()

74p_classContext :: LHsContext GhcPs -> R ()

src/Ormolu/Printer/Meat/Declaration/Instance.hs+1−4

@@ -95,10 +95,7 @@ p_clsInstDecl = \case

95 $ do

96 -- Ensure whitespace is added after where clause.

97 breakpoint

98− -- Add newline before first declaration if the body contains separate

99− -- declarations

100− when (hasSeparatedDecls allDecls) breakpoint'

101− dontUseBraces $ p_hsDecls Associated allDecls

98+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

102 XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"

99 XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"

103 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

100 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

104

101

src/Ormolu/Printer/Operators.hs+1−2

@@ -17,6 +17,7 @@ import Data.Maybe (fromMaybe, mapMaybe)

17import Data.Ord (Down (Down), comparing)

18import GHC

19import OccName (mkVarOcc)

20+import Ormolu.Utils (unSrcSpan)

20import RdrName (mkRdrUnqual)

21import RdrName (mkRdrUnqual)

21import SrcLoc (combineSrcSpans)

22import SrcLoc (combineSrcSpans)

22

23

@@ -171,8 +172,6 @@ buildFixityMap getOpName opTree =

171 maybe 0 srcSpanStartCol (unSrcSpan o),

172 maybe 0 srcSpanStartCol (unSrcSpan o),

172 go r

173 go r

173 ]

174 ]

174− unSrcSpan (RealSrcSpan r) = Just r

175− unSrcSpan (UnhelpfulSpan _) = Nothing

176

175

177----------------------------------------------------------------------------

176----------------------------------------------------------------------------

178-- Helpers

177-- Helpers

src/Ormolu/Utils.hs+16

@@ -9,12 +9,16 @@ module Ormolu.Utils

9 showOutputable,

10 splitDocString,

11 typeArgToType,

12+ unSrcSpan,

13+ separatedByBlank,

12 )

14 )

13where

15where

14

16

15import Data.Data (Data, showConstr, toConstr)

17import Data.Data (Data, showConstr, toConstr)

16import Data.List (dropWhileEnd)

18import Data.List (dropWhileEnd)

19+import qualified Data.List.NonEmpty as NE

17import Data.List.NonEmpty (NonEmpty (..))

20import Data.List.NonEmpty (NonEmpty (..))

21+import Data.Maybe (fromMaybe)

18import Data.Text (Text)

22import Data.Text (Text)

19import qualified Data.Text as T

23import qualified Data.Text as T

20import GHC

24import GHC

@@ -79,3 +83,15 @@ typeArgToType = \case

79 HsValArg tm -> tm

83 HsValArg tm -> tm

80 HsTypeArg _ ty -> ty

84 HsTypeArg _ ty -> ty

81 HsArgPar _ -> notImplemented "HsArgPar"

85 HsArgPar _ -> notImplemented "HsArgPar"

86+

87+unSrcSpan :: SrcSpan -> Maybe RealSrcSpan

88+unSrcSpan (RealSrcSpan r) = Just r

89+unSrcSpan (UnhelpfulSpan _) = Nothing

90+

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

92+separatedByBlank :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool

93+separatedByBlank loc a b =

94+ fromMaybe False $ do

95+ endA <- srcSpanEndLine <$> unSrcSpan (loc $ NE.last a)

96+ startB <- srcSpanStartLine <$> unSrcSpan (loc $ NE.head b)

97+ pure (startB - endA >= 2)