515251c · ormolu · git.iko.soy

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

compare with master

unifiedsplit

@@ -14,7 +14,11 @@ class Bar a where

14-- | Something more.

15class Baz a where

16 -- | Baz bar

17+ data

17− data BazBar a b c

18+ BazBar

19+ a

20+ b

21+ c

18 -- | Baz baz

22 -- | Baz baz

19 data

23 data

20 BazBaz

24 BazBaz

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

@@ -14,7 +14,10 @@ class Bar a

14-- | Something more.

15class Baz a where

16 -- | Baz bar

17− data BazBar a b c

17+ data BazBar

18+ a

19+ b

20+ c

18

21

19 -- | Baz baz

22 -- | Baz baz

20 data family BazBaz

23 data family BazBaz

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

@@ -14,9 +14,14 @@ class Bar a where

14-- | Something more.

15class Baz a where

16 -- | Baz bar

17+ type

17− type BazBar a b c

18+ BazBar

19+ a -- Foo

20+ b -- Bar

21+ c

18 -- | Baz baz

22 -- | Baz baz

19 type

23 type

24+ -- After type

20 BazBaz

25 BazBaz

21 b

26 b

22 a

27 a

data/examples/declaration/class/associated-types.hs+6−2

@@ -14,10 +14,14 @@ class Bar a

14-- | Something more.

15class Baz a where

16 -- | Baz bar

17− type BazBar a b c

17+ type BazBar

18+ a -- Foo

19+ b -- Bar

20+ c

18

21

19 -- | Baz baz

22 -- | Baz baz

23+ type -- After type

20− type BazBaz

24+ BazBaz

21 b

25 b

22 a

26 a

23 c

27 c

data/examples/declaration/class/multi-parameters-out.hs+9−2

@@ -10,11 +10,18 @@ class Bar a b c d where

10 -> c

11 -> d

12

13+class -- Before name

13−class Baz where

14+ Baz where

14 baz :: Int

15 baz :: Int

15

16

16-- | Something else.

17-- | Something else.

17−class BarBaz a b c d e f where

18+class BarBaz

19+ a -- Foo

20+ b -- Bar

21+ c -- Baz bar

22+ d -- Baz baz

23+ e -- Rest

24+ f where

18 barbaz

25 barbaz

19 :: a -> f

26 :: a -> f

20 bazbar

27 bazbar

data/examples/declaration/class/multi-parameters.hs+8−8

@@ -3,8 +3,7 @@

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

4

5-- | Something.

6−class Bar

6+class Bar a b c d

7− a b c d

8 where

7 where

9 bar ::

8 bar ::

10 a

9 a

@@ -12,18 +11,19 @@ class Bar

12 -> c

11 -> c

13 -> d

12 -> d

14

13

14+class -- Before name

15−class Baz

15+ Baz

16 where

17 baz :: Int

18

19-- | Something else.

20class

21 BarBaz

22− a

22+ a -- Foo

23− b

23+ b -- Bar

24− c

24+ c -- Baz bar

25− d

25+ d -- Baz baz

26− e

26+ e -- Rest

27 f where

28 barbaz ::

29 a -> f

data/examples/declaration/class/poly-kinded-classes-out.hs+4−3

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

1{-# LANGUAGE PolyKinds #-}

2class Foo (a :: k)

3

4−class Bar ( a

4+class Bar

5+ ( a -- Variable

5− :: *

6+ :: * -- Star

6− )

7+ )

data/examples/declaration/class/poly-kinded-classes.hs+3−2

@@ -3,5 +3,6 @@

3class Foo (a::k)

4

5class Bar

6− (a

6+ (a -- Variable

7− :: *)

7+ :: * -- Star

8+ )

data/examples/declaration/class/type-operators-out.hsnew file+29

@@ -0,0 +1,29 @@

1+{-# LANGUAGE MultiParamTypeClasses #-}

2+{-# LANGUAGE TypeOperators #-}

3+class (:$) a b

4+

5+class (:&)

6+ a

7+ b

8+

9+class a :* b

10+

11+class a :+ -- Before operator

12+ b -- After operator

13+

14+class ( f :.

15+ g

16+ )

17+ a

18+

19+class a `Pair` b

20+

21+class a `Sum`

22+ b

23+

24+class (f `Product` g) a

25+

26+class ( f `Sum`

27+ g

28+ )

29+ a

data/examples/declaration/class/type-operators.hsnew file+32

@@ -0,0 +1,32 @@

1+{-# LANGUAGE MultiParamTypeClasses #-}

2+{-# LANGUAGE TypeOperators #-}

3+

4+class (:$) a b

5+

6+class (:&)

7+ a

8+ b

9+

10+class a:*b

11+

12+class

13+ a -- Before operator

14+ :+

15+ b -- After operator

16+

17+class (

18+ f :. g

19+ ) a

20+

21+class

22+ a`Pair`b

23+

24+class

25+ a

26+ `Sum` b

27+

28+class (f`Product`g)a

29+

30+class (

31+ f `Sum` g

32+ ) a

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

@@ -52,6 +52,7 @@ p_tyClDecl = \case

52 tcdCtxt

53 tcdLName

54 tcdTyVars

55+ tcdFixity

55 tcdFDs

56 tcdFDs

56 tcdSigs

57 tcdSigs

57 tcdMeths

58 tcdMeths

@@ -70,6 +71,3 @@ p_derivDecl :: DerivDecl GhcPs -> R ()

70p_derivDecl = \case

71p_derivDecl = \case

71 d@DerivDecl {..} -> p_standaloneDerivDecl d

72 d@DerivDecl {..} -> p_standaloneDerivDecl d

72 XDerivDecl _ -> notImplemented "XDerivDecl standalone deriving"

73 XDerivDecl _ -> notImplemented "XDerivDecl standalone deriving"

73−

74−----------------------------------------------------------------------------

75−-- Helpers

src/Ormolu/Printer/Meat/Declaration/Class.hs+35−16

@@ -30,33 +30,32 @@ p_classDecl

30 :: LHsContext GhcPs

31 -> Located RdrName

32 -> LHsQTyVars GhcPs

33+ -> LexicalFixity

33 -> [Located (FunDep (Located RdrName))]

34 -> [Located (FunDep (Located RdrName))]

34 -> [LSig GhcPs]

35 -> [LSig GhcPs]

35 -> LHsBinds GhcPs

36 -> LHsBinds GhcPs

36 -> [LFamilyDecl GhcPs]

37 -> [LFamilyDecl GhcPs]

37 -> [LTyFamDefltEqn GhcPs]

38 -> [LTyFamDefltEqn GhcPs]

38 -> R ()

39 -> R ()

39−p_classDecl ctx name tvars fdeps csigs cdefs cats catdefs = do

40+p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do

40 let HsQTvs {..} = tvars

41 let HsQTvs {..} = tvars

42+ variableSpans = foldr (combineSrcSpans . getLoc) noSrcSpan hsq_explicit

43+ signatureSpans = getLoc name `combineSrcSpans` variableSpans

44+ dependencySpans = foldr (combineSrcSpans . getLoc) noSrcSpan fdeps

41 combinedSpans =

45 combinedSpans =

42 getLoc ctx `combineSrcSpans`

46 getLoc ctx `combineSrcSpans`

43− getLoc name `combineSrcSpans`

47+ signatureSpans `combineSrcSpans`

44− foldr (combineSrcSpans . getLoc) noSrcSpan hsq_explicit `combineSrcSpans`

48+ dependencySpans

45− foldr (combineSrcSpans . getLoc) noSrcSpan fdeps

46 txt "class "

49 txt "class "

47 sitcc $ do

50 sitcc $ do

48− switchLayout combinedSpans $ do

51+ switchLayout combinedSpans $ p_classContext ctx

49− unless (null (unLoc ctx)) $ do

52+ switchLayout signatureSpans $ do

50− located ctx p_hsContext

53+ p_infixDefHelper

51− breakpoint

54+ (isInfix fixity)

52− txt "=> "

55+ inci

53− p_rdrName name

56+ (p_rdrName name)

54− unless (null hsq_explicit) space

55− spaceSep (located' p_hsTyVarBndr) hsq_explicit

57+ (located' p_hsTyVarBndr <$> hsq_explicit)

56− unless (null fdeps) $ do

58+ switchLayout combinedSpans $ p_classFundeps fdeps

57− breakpoint

58− txt "| "

59− velt (withSep comma (located' p_funDep) fdeps)

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

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

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

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

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

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

@@ -77,6 +76,18 @@ p_classDecl ctx name tvars fdeps csigs cdefs cats catdefs = do

77 inci (sequence_ decls)

76 inci (sequence_ decls)

78 else newline

77 else newline

79

78

79+p_classContext :: LHsContext GhcPs -> R ()

80+p_classContext ctx = unless (null (unLoc ctx)) $ do

81+ located ctx p_hsContext

82+ breakpoint

83+ txt "=> "

84+

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

86+p_classFundeps fdeps = unless (null fdeps) $ do

87+ breakpoint

88+ txt "| "

89+ velt $ withSep comma (located' p_funDep) fdeps

90+

80p_famDefDecl :: TyFamDefltEqn GhcPs -> R ()

91p_famDefDecl :: TyFamDefltEqn GhcPs -> R ()

81p_famDefDecl FamEqn {..} = do

92p_famDefDecl FamEqn {..} = do

82 txt "type"

93 txt "type"

@@ -92,3 +103,11 @@ p_funDep (before, after) = do

92 spaceSep p_rdrName before

103 spaceSep p_rdrName before

93 txt " -> "

104 txt " -> "

94 spaceSep p_rdrName after

105 spaceSep p_rdrName after

106+

107+----------------------------------------------------------------------------

108+-- Helpers

109+

110+isInfix :: LexicalFixity -> Bool

111+isInfix = \case

112+ Infix -> True

113+ Prefix -> False