bdc8738 · ormolu · git.iko.soy

git.iko.soy/ormolu

Add newlines between most declarations in a type class

Certain other kinds of declarations (such as associated type signatures and bindings) are grouped together without newlines. The process for determining which declarations are grouped reuses the same logic as for modules.

commitbdc8738fa89d37ca330221d8b75427f466f9e08a authoryumiova <yumiova@protonmail.ch> dateSun 23 Jun 2019, 20:07 (7 years ago) parentca49003

16 files changed+107−58

compare with master

unifiedsplit

data/examples/declaration/class/associated-data-out.hs+5

@@ -1,11 +1,14 @@

11{-# LANGUAGE TypeFamilies #-}

22class Foo a where

34 data FooBar a

56-- | Something.

67class Bar a where

79 -- | Bar bar

810 data BarBar a

11+

912 -- | Bar baz

1013 data

1114 BarBaz

@@ -13,12 +16,14 @@ class Bar a where

1316

1417-- | Something more.

1518class Baz a where

19+

1620 -- | Baz bar

1721 data

1822 BazBar

1923 a

2024 b

2125 c

26+

2227 -- | Baz baz

2328 data

2429 BazBaz

data/examples/declaration/class/associated-type-defaults-out.hs+5

@@ -1,13 +1,16 @@

11{-# LANGUAGE TypeFamilies #-}

22class Foo a where

34 type FooBar a = Int

56-- | Something.

67class Bar a where

79 -- Define bar

810 type

911 BarBar a =

1012 BarBaz a

13+

1114 -- Define baz

1215 type

1316 BarBaz

@@ -16,9 +19,11 @@ class Bar a where

1619 a

1720

1821class Baz a where

22+

1923 type

2024 BazBar

2125 a

26+

2227 type

2328 BazBar a =

2429 Bar a

data/examples/declaration/class/associated-types-out.hs+5

@@ -1,11 +1,14 @@

11{-# LANGUAGE TypeFamilies #-}

22class Foo a where

34 type FooBar a

56-- | Something.

67class Bar a where

79 -- | Bar bar

810 type BarBar a

11+

912 -- | Bar baz

1013 type

1114 BarBaz

@@ -13,12 +16,14 @@ class Bar a where

1316

1417-- | Something more.

1518class Baz a where

19+

1620 -- | Baz bar

1721 type

1822 BazBar

1923 a -- Foo

2024 b -- Bar

2125 c

26+

2227 -- | Baz baz

2328 type

2429 -- After type

data/examples/declaration/class/default-implementations-out.hs+7

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

11-- | Foo

22class Foo a where

34 foo :: a -> a

45 foo a = a

67-- | Bar

78class Bar a where

810 bar

911 :: a

1012 -> Int

@@ -12,20 +14,25 @@ class Bar a where

1214

1315-- | Baz

1416class Baz a where

17+

1518 foobar :: a -> a

1619 foobar a =

1720 barbaz (bazbar a)

21+

1822 -- | Bar baz

1923 barbaz

2024 :: a -> a

25+

2126 -- | Baz bar

2227 bazbar

2328 :: a

2429 -> a

30+

2531 -- First comment

2632 barbaz a =

2733 bazbar -- Middle comment

2834 a

35+

2936 -- Last comment

3037 bazbar a =

3138 barbaz

data/examples/declaration/class/default-signatures-out.hs+4

@@ -2,18 +2,22 @@

33-- | Something.

44class Foo a where

56 -- | Foo

67 foo :: a -> String

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

810 foo = show

911

1012-- | Something else.

1113class Bar a where

14+

1215 -- | Bar

1316 bar

1417 :: String

1518 -> String

1619 -> a

20+

1721 -- Pointless comment

1822 default bar

1923 :: ( Read a

data/examples/declaration/class/dependency-super-classes-out.hs+4

@@ -2,7 +2,9 @@

33-- | Something.

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

56 get :: m s

68 put :: s -> m ()

810-- | 'MonadParsec'

@@ -11,9 +13,11 @@ class ( Stream s -- Token streams

1113 )

1214 => MonadParsec e s m

1315 | m -> e s where

16+

1417 -- | 'getState' returns state

1518 getState

1619 :: m s

20+

1721 -- | 'putState' sets state

1822 putState

1923 :: s

data/examples/declaration/class/functional-dependencies-out.hs+2

@@ -4,6 +4,7 @@

44class Foo a b | a -> b

66class Bar a b | a -> b, b -> a where

78 bar :: a

910-- | Something else.

@@ -13,4 +14,5 @@ class Baz a b c d

1314 , a c -> b d -- Baz

1415 , a c d -> b

1516 , a b d -> a b c d where

17+

1618 baz :: a -> b

data/examples/declaration/class/multi-parameters-out.hs+5

@@ -1,9 +1,11 @@

11{-# LANGUAGE MultiParamTypeClasses #-}

22class Foo a b where

34 foo :: a -> b

56-- | Something.

67class Bar a b c d where

79 bar

810 :: a

911 -> b

@@ -12,6 +14,7 @@ class Bar a b c d where

1214

1315class -- Before name

1416 Baz where

17+

1518 baz :: Int

1619

1720-- | Something else.

@@ -22,8 +25,10 @@ class BarBaz

2225 d -- Baz baz

2326 e -- Rest

2427 f where

28+

2529 barbaz

2630 :: a -> f

31+

2732 bazbar

2833 :: e

2934 -> f

data/examples/declaration/class/single-parameters-out.hs+5

@@ -1,13 +1,16 @@

11-- | Something.

22class Foo a where

34 foo :: a

56-- | Something more.

67class Bar a where

79 -- | Bar

810 bar :: a -> a -> a

911

1012class Baz a where

13+

1114 -- | Baz

1215 baz

1316 :: ( a

@@ -17,6 +20,8 @@ class Baz a where

1720 -> a -- ^ Return value

1821

1922class BarBaz a where

23+

2024 barbaz

2125 :: a -> b

26+

2227 bazbar :: b -> a

data/examples/declaration/signature/minimal/minimal-out.hs+4

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

11class Foo a where

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

35 {-# MINIMAL

46 a

57 | ( b, c, d

@@ -8,5 +10,7 @@ class Foo a where

810 )

911 | g

1012 #-}

13+

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

15+

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

src/Ormolu/Printer/Meat/Common.hs+2−2

@@ -27,8 +27,8 @@ import RdrName (RdrName (..))

2727-- | Data and type family style.

2828

2929data FamilyStyle

30− = Associated

31− | Free

30+ = Associated -- ^ Declarations in type classes

31+ | Free -- ^ Top-level declarations

3232

3333p_hsmodName :: ModuleName -> R ()

3434p_hsmodName mname = do

src/Ormolu/Printer/Meat/Declaration.hs+29−22

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

11{-# LANGUAGE LambdaCase #-}

22{-# LANGUAGE PatternSynonyms #-}

33{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE ViewPatterns #-}

56-- | Rendering of declarations.

@@ -29,23 +30,24 @@ import Ormolu.Printer.Meat.Declaration.Value

2930import Ormolu.Printer.Meat.Type

3031import Ormolu.Utils

3132

32−p_hsDecls :: [LHsDecl GhcPs] -> R ()

33−p_hsDecls decls =

34− forM_ (zip decls ((Just <$> drop 1 decls) ++ [Nothing])) $

35− \(d, md) -> do

36− case md of

37− Nothing -> located d p_hsDecl

38− Just d' ->

39− if separatedDecls (unLoc d) (unLoc d')

40− then line (located d p_hsDecl)

41− else located d p_hsDecl

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

34+p_hsDecls style decls =

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

36+ case md of

37+ Nothing -> located d pDecl

38+ Just d' ->

39+ if separatedDecls (unLoc d) (unLoc d')

40+ then line (located d pDecl)

41+ else located d pDecl

42+ where

43+ pDecl = p_hsDecl style

4244

43−p_hsDecl :: HsDecl GhcPs -> R ()

44−p_hsDecl = \case

45− TyClD NoExt x -> p_tyClDecl x

45+p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()

46+p_hsDecl style = \case

47+ TyClD NoExt x -> p_tyClDecl style x

4648 ValD NoExt x -> p_valDecl x

4749 SigD NoExt x -> p_sigDecl x

48− InstD NoExt x -> p_instDecl x

50+ InstD NoExt x -> p_instDecl style x

4951 DerivD NoExt x -> p_derivDecl x

5052 DefD NoExt x -> p_defaultDecl x

5153 ForD NoExt x -> p_foreignDecl x

@@ -57,9 +59,9 @@ p_hsDecl = \case

5759 RoleAnnotD NoExt x -> p_roleAnnot x

5860 XHsDecl _ -> notImplemented "XHsDecl"

5961

60−p_tyClDecl :: TyClDecl GhcPs -> R ()

61−p_tyClDecl = \case

62− FamDecl NoExt x -> p_famDecl Free x

62+p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R ()

63+p_tyClDecl style = \case

64+ FamDecl NoExt x -> p_famDecl style x

6365 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs

6466 DataDecl {..} ->

6567 p_dataDecl Associated tcdLName (tyVarsToTypes tcdTyVars) tcdDataDefn

@@ -76,11 +78,11 @@ p_tyClDecl = \case

7678 tcdATDefs

7779 XTyClDecl {} -> notImplemented "XTyClDecl"

7880

79−p_instDecl :: InstDecl GhcPs -> R ()

80−p_instDecl = \case

81+p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R ()

82+p_instDecl style = \case

8183 ClsInstD NoExt x -> p_clsInstDecl x

82− TyFamInstD NoExt x -> p_tyFamInstDecl Free x

83− DataFamInstD NoExt x -> p_dataFamInstDecl Free x

84+ TyFamInstD NoExt x -> p_tyFamInstDecl style x

85+ DataFamInstD NoExt x -> p_dataFamInstDecl style x

8486 XInstDecl _ -> notImplemented "XInstDecl"

8587

8688p_derivDecl :: DerivDecl GhcPs -> R ()

@@ -114,8 +116,13 @@ pattern TypeSignature

114116 , InlinePragma

115117 , SpecializePragma

116118 , SCCPragma :: RdrName -> HsDecl GhcPs

117−pattern TypeSignature n <- SigD NoExt (TypeSig NoExt ((L _ n):_) _)

119+pattern TypeSignature n <- (sigRdrName -> Just n)

118120pattern FunctionBody n <- ValD NoExt (FunBind NoExt (L _ n) _ _ _)

119121pattern InlinePragma n <- SigD NoExt (InlineSig NoExt (L _ n) _)

120122pattern SpecializePragma n <- SigD NoExt (SpecSig NoExt (L _ n) _ _)

121123pattern SCCPragma n <- SigD NoExt (SCCFunSig NoExt _ (L _ n) _)

124+

125+sigRdrName :: HsDecl GhcPs -> Maybe RdrName

126+sigRdrName (SigD NoExt (TypeSig NoExt ((L _ n):_) _)) = Just n

127+sigRdrName (SigD NoExt (ClassOpSig NoExt _ ((L _ n):_) _)) = Just n

128+sigRdrName _ = Nothing

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

@@ -6,7 +6,8 @@ where

77import GHC

88import Ormolu.Printer.Combinators

9+import Ormolu.Printer.Meat.Common

910

10−p_hsDecls :: [LHsDecl GhcPs] -> R ()

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

1112

12−p_hsDecl :: HsDecl GhcPs -> R ()

13+p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()

src/Ormolu/Printer/Meat/Declaration/Class.hs+25−30

@@ -13,18 +13,16 @@ import Class

1313import Control.Arrow

1414import Control.Monad

1515import Data.Foldable

16−import Data.Function

1716import Data.List (sortBy)

17+import Data.Ord (comparing)

18+import GHC

1819import Ormolu.Printer.Combinators

19−import Ormolu.Printer.Meat.Declaration.Signature

20−import Ormolu.Printer.Meat.Declaration.Value

21−import Ormolu.Printer.Meat.Declaration.TypeFamily

2220import Ormolu.Printer.Meat.Common

2321import Ormolu.Printer.Meat.Type

2422import Ormolu.Utils

25−import GHC

2623import RdrName (RdrName (..))

2724import SrcLoc (Located, combineSrcSpans)

25+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration

2826

2927p_classDecl

3028 :: LHsContext GhcPs

@@ -60,21 +58,21 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do

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

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

6260 -- they need to be manually sorted.

63− let sigs = (getLoc &&& located' p_sigDecl) <$> csigs

64− defs = (getLoc &&& located' p_valDecl) <$> cdefs

65− tyfam_decls = (getLoc &&& located' (p_famDecl Associated)) <$> cats

66− tyfam_defs = (getLoc &&& located' p_famDefDecl) <$> catdefs

67− decls =

68− snd <$>

69− sortBy

70− (compare `on` fst)

71− (sigs <> toList defs <> tyfam_decls <> tyfam_defs)

72− if not (null decls)

73− then do

74− txt " where"

75− newline

76− inci (sequence_ decls)

77− else newline

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

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

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

64+ tyFamDefs =

65+ ( getLoc &&& fmap (InstD NoExt . TyFamInstD NoExt . defltEqnToInstDecl)

66+ ) <$> catdefs

67+ allDecls =

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

69+ if not (null allDecls)

70+ then do

71+ txt " where"

72+ newline -- Ensure line is added after where clause.

73+ newline -- Add newline before first declaration.

74+ inci (p_hsDecls Associated allDecls)

75+ else newline

7876

7977p_classContext :: LHsContext GhcPs -> R ()

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

@@ -88,16 +86,6 @@ p_classFundeps fdeps = unless (null fdeps) $ do

8886 txt "| "

8987 velt $ withSep comma (located' p_funDep) fdeps

9088

91−p_famDefDecl :: TyFamDefltEqn GhcPs -> R ()

92−p_famDefDecl FamEqn {..} = do

93− txt "type"

94− breakpoint

95− let eqn = FamEqn { feqn_pats = tyVarsToTypes feqn_pats, .. }

96− hsib = HsIB { hsib_ext = NoExt, hsib_body = eqn }

97− inci (p_tyFamInstEqn hsib)

98− newline

99−p_famDefDecl XFamEqn {} = notImplemented "XFamEqn"

100−

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

10290p_funDep (before, after) = do

10391 spaceSep p_rdrName before

@@ -107,6 +95,13 @@ p_funDep (before, after) = do

10795----------------------------------------------------------------------------

10896-- Helpers

10997

98+defltEqnToInstDecl :: TyFamDefltEqn GhcPs -> TyFamInstDecl GhcPs

99+defltEqnToInstDecl FamEqn {..} = TyFamInstDecl {..}

100+ where

101+ eqn = FamEqn {feqn_pats = tyVarsToTypes feqn_pats, ..}

102+ tfid_eqn = HsIB {hsib_ext = NoExt, hsib_body = eqn}

103+defltEqnToInstDecl XFamEqn {} = notImplemented "XFamEqn"

104+

110105isInfix :: LexicalFixity -> Bool

111106isInfix = \case

112107 Infix -> True

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

@@ -605,7 +605,7 @@ p_hsBracket :: HsBracket GhcPs -> R ()

605605p_hsBracket = \case

606606 ExpBr NoExt expr -> quote "e" (located expr p_hsExpr)

607607 PatBr NoExt pat -> quote "p" (located pat p_pat)

608− DecBrL NoExt decls -> quote "d" (p_hsDecls decls)

608+ DecBrL NoExt decls -> quote "d" (p_hsDecls Free decls)

609609 DecBrG NoExt _ -> notImplemented "DecBrG" -- result of renamer

610610 TypBr NoExt ty -> quote "t" (located ty p_hsType)

611611 VarBr NoExt _ _ -> notImplemented "VarBr"

src/Ormolu/Printer/Meat/Module.hs+1−1

@@ -49,7 +49,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do

4949 when (not (null hsmodImports) || not (null hsmodDecls)) newline

5050 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

5151 when (not (null hsmodImports) && not (null hsmodDecls)) newline

52− p_hsDecls hsmodDecls

52+ p_hsDecls Free hsmodDecls

5353 trailingComments <- hasMoreComments

5454 when (trailingComments && isJust hsmodName) newline

5555 spitRemainingComments