116fe84 · ormolu · git.iko.soy

git.iko.soy/ormolu

Preserve newlines in class and instance declarations

Preserve user-added newlines with the following normalizations: * No newlines below where * Consecutive newlines are compressed into a single newline * Always surround documented declarations with blank lines

commit116fe842b4a82b1ea6a60fd0a61f304f989c6fd0 authorSridhar Ratnakumar <srid@srid.ca> dateFri 6 Dec 2019, 15:41 (7 years ago) parent6ee0365

40 files changed+236−60

compare with master

unifiedsplit

CHANGELOG.md+5

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

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

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

2020

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+

2126## Ormolu 0.0.2.0

2227

2328* 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

55-- | Something.

66class Bar a where

7−

87 -- | Bar bar

98 data BarBar a

109

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

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

55-- | Something more.

66class Baz a where

7−

87 -- | Baz bar

98 data

109 BazBar

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

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

55-- | Something.

66class Bar a where

7−

87 -- Define bar

98 type

109 BarBar a =

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

1817 a

1918

2019class Baz a where

21−

2220 type

2321 BazBar

2422 a

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

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

55-- | Something.

66class Bar a where

7−

87 -- | Bar bar

98 type BarBar a

109

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

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

55-- | Something more.

66class Baz a where

7−

87 -- | Baz bar

98 type

109 BazBar

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

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

33-- | Baz

44class Baz a where

5−

65 foobar :: a -> a

76 foobar a =

87 barbaz (bazbar a)

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

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

55-- | Something else.

66class Bar a where

7−

87 -- | Bar

98 bar ::

109 String ->

1110 String ->

1211 a

13−

1412 -- Pointless comment

1513 default bar ::

1614 ( Read a,

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

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

33-- | Something.

44class Foo a where

5−

65 -- | Foo

76 foo :: a -> String

8−

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

108 foo = show

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

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

55-- | Something.

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

7−

87 get :: m s

9−

108 put :: s -> m ()

119

1210-- | 'MonadParsec'

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

1614 ) =>

1715 MonadParsec e s m

1816 | m -> e s where

19−

2017 -- | 'getState' returns state

2118 getState ::

2219 m s

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

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

1111 d -- Baz baz

1212 e -- Rest

1313 f where

14−

1514 barbaz ::

1615 a -> f

17−

1816 bazbar ::

1917 e ->

2018 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

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

4+class Num a where

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 = ()

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 = ()

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

5+ -- | Another Haddock

6+ bar :: a

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

6+ -- Comment before definition

7+ negate :: a -> a

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

6+ -- Comment before definition

7+ negate :: a -> a

8+ -- Comment after definition

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

2121 a

2222

2323class BarBaz a where

24−

2524 barbaz ::

2625 a -> b

27−

2826 bazbar :: b -> a

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

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

1111 Double

1212

1313instance Foo [a] where

14−

1514 data Bar [a]

1615 = ListBar [Bar a]

17−

1816 data Baz [a]

1917 = ListBaz

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

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

1313

1414instance Foo [a]

1515 where

16+

1617 data Bar [a] =

1718 ListBar [Bar a]

1819 data Baz [a] =

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

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

33instance Foo Int where type Bar Int = Double

55instance Foo Double where

6−

76 type

87 Bar

98 Double =

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

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

99 Double

1010 =

1111 [Double]

12+

13+

1214 type instance Baz Double

1315 = [Double]

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

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

11{-# LANGUAGE InstanceSigs #-}

33instance Applicative [] where

4−

54 pure ::

65 a ->

76 [a]

87 pure a = [a]

9−

108 (<*>) ::

119 [a] -> [a] -> [a]

1210 (<*>) _ _ = []

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

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

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

33instance MonadState s (State s) where

4−

54 get = State.get

6−

75 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

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

4+instance Num Y where

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)

6+ -- Comment before definition

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

8+ negate (Z u dudx) = undefined

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)

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 @@

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

33instance Enum Int where

4−

54 fromEnum x = x

6−

75 toEnum =

86 \x ->

97 x

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

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

11class Foo a where

2−

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

54 {-# MINIMAL

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

1211 #-}

1312

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

15−

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

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

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

33data VT v m r = VT v m r

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

6−

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

8−

97 (==) (Foo a) (Foo b) = (==) a b

108

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

12−

1310 {-# SPECIALIZE instance

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

1512 )

1613 #-}

17−

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

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

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

11class Foo a where

2−

32 -- | Foo.

43 foo ::

54 Int ->

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

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

77-- | Rendering of declarations.

88module Ormolu.Printer.Meat.Declaration

99 ( p_hsDecls,

10− hasSeparatedDecls,

10+ p_hsDeclsRespectGrouping,

1111 )

1212where

1313

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

3636import Ormolu.Utils

3737import RdrName (rdrNameOcc)

3838

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+

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

40−p_hsDecls style decls = sepSemi id $

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

58+p_hsDecls' grouping style decls = sepSemi id $

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

4260 -- groups.

4361 case groupDecls decls of

4462 [] -> []

45− (x : xs) ->

46− NE.toList (renderGroup x)

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

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

4864 where

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

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

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

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

5185

5286-- | Group relevant declarations together.

5387--

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

139173 HsDecl GhcPs ->

140174 Bool

141175groupedDecls (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'

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

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

144181groupedDecls 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

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

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

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

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

152190groupedDecls DocNext _ = True

153191groupedDecls _ DocPrev = True

154192groupedDecls _ _ = False

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

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

165203 | otherwise = True

166204

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−

174205isPragma ::

175206 HsDecl GhcPs ->

176207 Maybe [RdrName]

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

206237

207238pattern

208239 TypeSignature,

240+ DefaultSignature,

209241 FunctionBody,

210242 PatternSignature,

211243 WarningPragma ::

212244 [RdrName] -> HsDecl GhcPs

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

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

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

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

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

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

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

226259sigRdrNames _ = Nothing

227260

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

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

263+defSigRdrNames _ = Nothing

264+

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

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

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

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

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

11module Ormolu.Printer.Meat.Declaration

22 ( p_hsDecls,

3− hasSeparatedDecls,

3+ p_hsDeclsRespectGrouping,

44 )

55where

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

1010

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

1212

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

6868 space

6969 txt "where"

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

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

7673

7774p_classContext :: LHsContext GhcPs -> R ()

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

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

9595 $ do

9696 -- Ensure whitespace is added after where clause.

9797 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

10299 XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"

103100 XClsInstDecl NoExt -> notImplemented "XClsInstDecl"

104101

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

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

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

1818import GHC

1919import OccName (mkVarOcc)

20+import Ormolu.Utils (unSrcSpan)

2021import RdrName (mkRdrUnqual)

2122import SrcLoc (combineSrcSpans)

2223

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

171172 maybe 0 srcSpanStartCol (unSrcSpan o),

172173 go r

173174 ]

174− unSrcSpan (RealSrcSpan r) = Just r

175− unSrcSpan (UnhelpfulSpan _) = Nothing

176175

177176----------------------------------------------------------------------------

178177-- Helpers

src/Ormolu/Utils.hs+16

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

99 showOutputable,

1010 splitDocString,

1111 typeArgToType,

12+ unSrcSpan,

13+ separatedByBlank,

1214 )

1315where

1416

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

1618import Data.List (dropWhileEnd)

19+import qualified Data.List.NonEmpty as NE

1720import Data.List.NonEmpty (NonEmpty (..))

21+import Data.Maybe (fromMaybe)

1822import Data.Text (Text)

1923import qualified Data.Text as T

2024import GHC

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

7983 HsValArg tm -> tm

8084 HsTypeArg _ ty -> ty

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