244144d · ormolu · git.iko.soy

data/examples/declaration/instance/associated-types-out.hs+7−4

compare with master

unifiedsplit

@@ -3,7 +3,10 @@ instance Foo Int where

3 type Bar Int = Double

4

5instance Foo Double where

6+ type

7+ Bar

6− type Bar Double =

8+ Double =

7− [Double]

9+ [Double]

10+ type

8− type Baz Double =

11+ Baz Double =

9− [Double]

12+ [Double]

data/examples/declaration/instance/type-family-instances-out.hs+14−8

@@ -1,14 +1,20 @@

1{-# LANGUAGE TypeFamilies #-}

2type instance Foo Int = Int

3

4−type instance Foo [Int] =

4+type instance

5+ Foo

6+ [Int] =

5− ( Int

7+ ( Int

6− , Int

8+ , Int

7− )

9+ )

8

10

9type instance Bar Int [Int] Double = (Int, Double)

11type instance Bar Int [Int] Double = (Int, Double)

10

12

11−type instance Bar [Int] [Int] Double =

13+type instance

14+ Bar

15+ [Int]

16+ [Int]

17+ Double =

12− ( Int

18+ ( Int

13− , Double

19+ , Double

14− )

20+ )

data/examples/declaration/type-families/closed-type-family/infix-out.hsnew file+11

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

1+type family (x :: N) + (y :: N) :: N where

2+ 'Zero + y = y

3+ 'Succ n + y = 'Succ (n + y)

4+

5+type family (x :: N) `LEQ` (y :: N) :: Bool where

6+ 'Zero `LEQ` y = 'True

7+ 'Succ n `LEQ` 'Zero = 'False

8+ 'Succ n `LEQ` 'Succ m = n `LEQ` m

9+

10+type family ((x :: N) `Weird` (y :: N)) (z :: N) :: Bool where

11+ 'Zero `Weird` 'Zero 'Zero = 'True

data/examples/declaration/type-families/closed-type-family/infix.hsnew file+11

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

1+type family (x :: N) + (y :: N) :: N where

2+ 'Zero + y = y

3+ 'Succ n + y = 'Succ (n + y)

4+

5+type family (x :: N) `LEQ` (y :: N) :: Bool where

6+ 'Zero `LEQ` y = 'True

7+ 'Succ n `LEQ` 'Zero = 'False

8+ 'Succ n `LEQ` 'Succ m = n `LEQ` m

9+

10+type family ((x :: N) `Weird` (y :: N)) (z :: N) :: Bool where

11+ 'Zero `Weird` 'Zero 'Zero = 'True

data/examples/declaration/type-families/closed-type-family/multi-line-out.hs+13−5

@@ -1,14 +1,22 @@

1−type family Id a

1+type family

2+ Id a

3+ = result

2− = result | result -> a where

4+ | result -> a where

3 Id a =

5 Id a =

4 a

6 a

5

7

6−type family G (a :: k) b c

8+type family

9+ G

10+ (a :: k)

11+ b

12+ c

13+ = foo

7− = foo | foo -> k b where

14+ | foo -> k b where

8 G a b c =

15 G a b c =

9 (a, b)

16 (a, b)

10

17

11−type family F a

18+type family

19+ F a

12 :: * -> * where

20 :: * -> * where

13 F Int = Double

21 F Int = Double

14 F Bool =

22 F Bool =

data/examples/declaration/value/function/backticks-out.hsnew file+1

@@ -0,0 +1 @@

1+foo x y = x `bar` y

data/examples/declaration/value/function/backticks.hsnew file+1

@@ -0,0 +1 @@

1+foo x y = x `bar` y

data/examples/declaration/value/function/infix-out.hs+12−1

@@ -1 +1,12 @@

1+(*) :: Int -> Int -> Int

2+x * y = z

3+

4+foo :: Int -> Int -> Int

5+x `foo` y = z

6+

7+bar :: Int -> Int -> Int -> Int

1−foo x y = x `bar` y

8+(x `bar` y) z = z

9+

10+multiline :: Int -> Int -> Int

11+x `multiline`

12+ y = z

data/examples/declaration/value/function/infix.hs+12−1

@@ -1 +1,12 @@

1+(*) :: Int -> Int -> Int

2+x * y = z

3+

4+foo :: Int -> Int -> Int

5+x `foo` y = z

6+

7+bar :: Int -> Int -> Int -> Int

1−foo x y = x `bar` y

8+(x `bar` y) z = z

9+

10+multiline :: Int -> Int -> Int

11+x `multiline`

12+ y = z

src/Ormolu/Printer/Meat/Common.hs+32

@@ -10,9 +10,11 @@ module Ormolu.Printer.Meat.Common

10 , p_rdrName

11 , p_qualName

12 , p_ieWildcard

13+ , p_infixDefHelper

13 )

14 )

14where

15where

15

16

17+import Control.Monad

16import Data.List (isPrefixOf)

18import Data.List (isPrefixOf)

17import GHC hiding (GhcPs, IE)

19import GHC hiding (GhcPs, IE)

18import Module (Module (..))

20import Module (Module (..))

@@ -86,3 +88,33 @@ p_ieWildcard :: IEWildcard -> R ()

86p_ieWildcard = \case

88p_ieWildcard = \case

87 NoIEWildcard -> return ()

89 NoIEWildcard -> return ()

88 IEWildcard n -> parens (atom n)

90 IEWildcard n -> parens (atom n)

91+

92+-- | A helper for formatting infix constructions in lhs of definitions.

93+

94+p_infixDefHelper

95+ :: Bool -- ^ Whether to format in infix style

96+ -> (R () -> R ()) -- ^ Indentation-bumping wrapper

97+ -> R () -- ^ How to print the operator\/name

98+ -> [R ()] -- ^ How to print the arguments

99+ -> R ()

100+p_infixDefHelper isInfix inci' name args =

101+ case (isInfix, args) of

102+ (True, p0:p1:ps) -> do

103+ let parens' =

104+ if null ps

105+ then id

106+ else parens

107+ parens' $ do

108+ p0

109+ space

110+ name

111+ breakpoint

112+ inci' p1

113+ unless (null ps) . inci' $ do

114+ breakpoint

115+ velt' ps

116+ (_, ps) -> do

117+ name

118+ unless (null ps) $ do

119+ breakpoint

120+ inci' (velt' args)

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

@@ -69,9 +69,10 @@ p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()

69p_tyFamInstDecl style = \case

70 TyFamInstDecl {..} -> do

71 txt $ case style of

72− Associated -> "type "

72+ Associated -> "type"

73− Free -> "type instance "

73+ Free -> "type instance"

74+ breakpoint

74− p_tyFamInstEqn tfid_eqn

75+ inci (p_tyFamInstEqn tfid_eqn)

75 newline

76 newline

76

77

77p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()

78p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+37−16

@@ -10,8 +10,10 @@ module Ormolu.Printer.Meat.Declaration.TypeFamily

10 )

11where

12

13+import BasicTypes (LexicalFixity (..))

13import Control.Monad

14import Control.Monad

14−import Data.Maybe (maybeToList, isJust)

15+import Data.List.NonEmpty (NonEmpty (..))

16+import Data.Maybe (isNothing, isJust)

15import GHC

17import GHC

16import Ormolu.Printer.Combinators

18import Ormolu.Printer.Combinators

17import Ormolu.Printer.Meat.Common

19import Ormolu.Printer.Meat.Common

@@ -22,19 +24,26 @@ import SrcLoc (Located, GenLocated (..))

22p_famDecl :: FamilyDecl GhcPs -> R ()

24p_famDecl :: FamilyDecl GhcPs -> R ()

23p_famDecl FamilyDecl {..} = do

25p_famDecl FamilyDecl {..} = do

24 mmeqs <- case fdInfo of

26 mmeqs <- case fdInfo of

25− DataFamily -> Nothing <$ txt "data family "

27+ DataFamily -> Nothing <$ txt "data family"

26− OpenTypeFamily -> Nothing <$ txt "type family "

28+ OpenTypeFamily -> Nothing <$ txt "type family"

27− ClosedTypeFamily eqs -> Just eqs <$ txt "type family "

29+ ClosedTypeFamily eqs -> Just eqs <$ txt "type family"

28− p_rdrName fdLName

30+ breakpoint

29− space

30 let HsQTvs {..} = fdTyVars

31 let HsQTvs {..} = fdTyVars

31− items =

32+ combinedSpans = combineSrcSpans' $

33+ getSpan fdLName :| fmap getSpan hsq_explicit

34+ inci $ do

35+ switchLayout combinedSpans $ p_infixDefHelper

36+ (isInfix fdFixity)

37+ inci

38+ (p_rdrName fdLName)

39+ (located' p_hsTyVarBndr <$> hsq_explicit)

32− maybeToList (p_familyResultSigL (isJust fdInjectivityAnn) fdResultSig)

40+ let rsig = p_familyResultSigL (isJust fdInjectivityAnn) fdResultSig

41+ unless (isNothing rsig && isNothing fdInjectivityAnn) $

42+ breakpoint

43+ inci $ do

44+ sequence_ rsig

45+ when (isJust rsig && isJust fdInjectivityAnn) breakpoint

33− ++ (located' p_injectivityAnn <$> maybeToList fdInjectivityAnn)

46+ forM_ fdInjectivityAnn (located' p_injectivityAnn)

34− spaceSep (located' p_hsTyVarBndr) hsq_explicit

35− unless (null items) $

36− breakpoint

37− inci . inci $ spaceSep id items

38 case mmeqs of

47 case mmeqs of

39 Nothing -> newline

48 Nothing -> newline

40 Just meqs -> do

49 Just meqs -> do

@@ -74,10 +83,22 @@ p_injectivityAnn (InjectivityAnn a bs) = do

74p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

83p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

75p_tyFamInstEqn HsIB {..} = do

84p_tyFamInstEqn HsIB {..} = do

76 let FamEqn {..} = hsib_body

85 let FamEqn {..} = hsib_body

86+ combinedSpans = combineSrcSpans' $

87+ getSpan feqn_tycon :| fmap getSpan feqn_pats

88+ switchLayout combinedSpans $ p_infixDefHelper

89+ (isInfix feqn_fixity)

90+ inci

77− p_rdrName feqn_tycon

91+ (p_rdrName feqn_tycon)

78− space

79− spaceSep (located' p_hsType) feqn_pats

92+ (located' p_hsType <$> feqn_pats)

80 txt " ="

93 txt " ="

81 breakpoint

94 breakpoint

82 inci (located feqn_rhs p_hsType)

95 inci (located feqn_rhs p_hsType)

83p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"

96p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"

97+

98+----------------------------------------------------------------------------

99+-- Helpers

100+

101+isInfix :: LexicalFixity -> Bool

102+isInfix = \case

103+ Infix -> True

104+ Prefix -> False

src/Ormolu/Printer/Meat/Declaration/Value.hs+21−16

@@ -54,7 +54,7 @@ p_valDecl = line . p_valDecl'

54p_valDecl' :: HsBindLR GhcPs GhcPs -> R ()

55p_valDecl' = \case

56 FunBind NoExt funId funMatches _ _ -> p_funBind funId funMatches

57− PatBind NoExt pat grhss _ -> p_match PatternBind [pat] grhss

57+ PatBind NoExt pat grhss _ -> p_match PatternBind False [pat] grhss

58 VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker

59 AbsBinds {} -> notImplemented "AbsBinds" -- introduced by the type checker

60 PatSynBind NoExt psb -> p_patSynBind psb

@@ -73,18 +73,17 @@ p_matchGroup

73 -> R ()

74p_matchGroup style MG {..} =

75 locatedVia Nothing mg_alts $

76− newlineSep (located' (\Match {..} -> p_match style m_pats m_grhss))

76+ newlineSep (located' (\m@Match {..} ->

77+ p_match style (isInfixMatch m) m_pats m_grhss))

77p_matchGroup _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"

78p_matchGroup _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"

78

79

79p_match

80p_match

80 :: MatchGroupStyle

81 :: MatchGroupStyle

82+ -> Bool -- ^ Is this an infix match?

81 -> [LPat GhcPs]

83 -> [LPat GhcPs]

82 -> GRHSs GhcPs (LHsExpr GhcPs)

84 -> GRHSs GhcPs (LHsExpr GhcPs)

83 -> R ()

85 -> R ()

84−p_match style m_pats m_grhss = do

86+p_match style isInfix m_pats m_grhss = do

85− case style of

86− Function name -> p_rdrName name

87− _ -> return ()

88 -- NOTE Normally, since patterns may be placed in a multi-line layout, it

87 -- NOTE Normally, since patterns may be placed in a multi-line layout, it

89 -- is necessary to bump indentation for the pattern group so it's more

88 -- is necessary to bump indentation for the pattern group so it's more

90 -- indented than function name. This in turn means that indentation for

89 -- indented than function name. This in turn means that indentation for

@@ -93,7 +92,9 @@ p_match style m_pats m_grhss = do

93 -- need to be a bit more clever here and bump indentation level only when

92 -- need to be a bit more clever here and bump indentation level only when

94 -- pattern group is multiline.

93 -- pattern group is multiline.

95 inci' <- case NE.nonEmpty m_pats of

94 inci' <- case NE.nonEmpty m_pats of

96− Nothing -> return id

95+ Nothing -> id <$ case style of

96+ Function name -> p_rdrName name

97+ _ -> return ()

97 Just ne_pats -> do

98 Just ne_pats -> do

98 let combinedSpans = combineSrcSpans' $

99 let combinedSpans = combineSrcSpans' $

99 getSpan <$> ne_pats

100 getSpan <$> ne_pats

@@ -101,16 +102,20 @@ p_match style m_pats m_grhss = do

101 then id

102 then id

102 else inci

103 else inci

103 switchLayout combinedSpans $ do

104 switchLayout combinedSpans $ do

105+ let stdCase = velt' (located' p_pat <$> m_pats)

104 case style of

106 case style of

105− Function _ -> breakpoint

107+ Function name ->

106− PatternBind -> return ()

108+ p_infixDefHelper

107− Case -> return ()

109+ isInfix

108− Lambda -> txt "\\"

109− LambdaCase -> return ()

110− let wrapper = case style of

111− Function _ -> inci'

110+ inci'

112− _ -> id

111+ (p_rdrName name)

113− wrapper (velt' (located' p_pat <$> m_pats))

112+ (located' p_pat <$> m_pats)

113+ PatternBind -> stdCase

114+ Case -> stdCase

115+ Lambda -> do

116+ txt "\\"

117+ stdCase

118+ LambdaCase -> stdCase

114 return inci'

119 return inci'

115 inci' $ do

120 inci' $ do

116 let GRHSs {..} = m_grhss

121 let GRHSs {..} = m_grhss