git.iko.soy/ormolu
on master help sign in
Implement rendering of type class declarations
7e31ae7yumiova
data/examples/declaration/class/associated-data-out.hsnew file+23
compare with master
unifiedsplit
@@ -0,0 +1,23 @@
1+{-# LANGUAGE TypeFamilies #-}
2+class Foo a where
3+ data FooBar a
4+
5+-- | Something.
6+class Bar a where
7+ -- | Bar bar
8+ data BarBar a
9+ -- | Bar baz
10+ data
11+ BarBaz
12+ a
13+
14+-- | Something more.
15+class Baz a where
16+ -- | Baz bar
17+ data BazBar a b c
18+ -- | Baz baz
19+ data
20+ BazBaz
21+ b
22+ a
23+ c
data/examples/declaration/class/associated-data.hsnew file+23
@@ -0,0 +1,23 @@
1+{-# LANGUAGE TypeFamilies #-}
2+
3+class Foo a where data FooBar a
4+
5+-- | Something.
6+class Bar a
7+ where
8+ -- | Bar bar
9+ data BarBar a
10+ -- | Bar baz
11+ data family BarBaz
12+ a
13+
14+-- | Something more.
15+class Baz a where
16+ -- | Baz bar
17+ data BazBar a b c
18+
19+ -- | Baz baz
20+ data family BazBaz
21+ b
22+ a
23+ c
data/examples/declaration/class/associated-type-defaults-out.hsnew file+24
@@ -0,0 +1,24 @@
1+{-# LANGUAGE TypeFamilies #-}
2+class Foo a where
3+ type FooBar a = Int
4+
5+-- | Something.
6+class Bar a where
7+ -- Define bar
8+ type
9+ BarBar a =
10+ BarBaz a
11+ -- Define baz
12+ type
13+ BarBaz
14+ a =
15+ BarBar -- Middle comment
16+ a
17+
18+class Baz a where
19+ type
20+ BazBar
21+ a
22+ type
23+ BazBar a =
24+ Bar a
data/examples/declaration/class/associated-type-defaults.hsnew file+20
@@ -0,0 +1,20 @@
1+{-# LANGUAGE TypeFamilies #-}
2+
3+class Foo a where type FooBar a = Int
4+
5+-- | Something.
6+class Bar a where
7+ -- Define bar
8+ type BarBar a
9+ = BarBaz a
10+ -- Define baz
11+ type BarBaz
12+ a = BarBar -- Middle comment
13+ a
14+
15+class Baz a where
16+ type BazBar
17+ a
18+
19+ type BazBar a =
20+ Bar a
data/examples/declaration/class/associated-types-out.hsnew file+23
@@ -0,0 +1,23 @@
1+{-# LANGUAGE TypeFamilies #-}
2+class Foo a where
3+ type FooBar a
4+
5+-- | Something.
6+class Bar a where
7+ -- | Bar bar
8+ type BarBar a
9+ -- | Bar baz
10+ type
11+ BarBaz
12+ a
13+
14+-- | Something more.
15+class Baz a where
16+ -- | Baz bar
17+ type BazBar a b c
18+ -- | Baz baz
19+ type
20+ BazBaz
21+ b
22+ a
23+ c
data/examples/declaration/class/associated-types.hsnew file+23
@@ -0,0 +1,23 @@
1+{-# LANGUAGE TypeFamilies #-}
2+
3+class Foo a where type FooBar a
4+
5+-- | Something.
6+class Bar a
7+ where
8+ -- | Bar bar
9+ type BarBar a
10+ -- | Bar baz
11+ type BarBaz
12+ a
13+
14+-- | Something more.
15+class Baz a where
16+ -- | Baz bar
17+ type BazBar a b c
18+
19+ -- | Baz baz
20+ type BazBaz
21+ b
22+ a
23+ c
data/examples/declaration/class/default-implementations-out.hsnew file+31
@@ -0,0 +1,31 @@
1+-- | Foo
2+class Foo a where
3+ foo :: a -> a
4+ foo a = a
5+
6+-- | Bar
7+class Bar a where
8+ bar
9+ :: a
10+ -> Int
11+ bar = const 0
12+
13+-- | Baz
14+class Baz a where
15+ foobar :: a -> a
16+ foobar a = barbaz (bazbar a)
17+ -- | Bar baz
18+ barbaz
19+ :: a -> a
20+ -- | Baz bar
21+ bazbar
22+ :: a
23+ -> a
24+ -- First comment
25+ barbaz a =
26+ bazbar -- Middle comment
27+ a
28+ -- Last comment
29+ bazbar a =
30+ barbaz
31+ a
data/examples/declaration/class/default-implementations.hsnew file+32
@@ -0,0 +1,32 @@
1+-- | Foo
2+class Foo a where
3+ foo :: a -> a
4+ foo a = a
5+
6+-- | Bar
7+class Bar a where
8+ bar ::
9+ a
10+ -> Int
11+ bar = const 0
12+
13+-- | Baz
14+class Baz a where
15+ foobar :: a -> a
16+ foobar a =
17+ barbaz (bazbar a)
18+ -- | Bar baz
19+ barbaz ::
20+ a -> a
21+ -- | Baz bar
22+ bazbar ::
23+ a ->
24+ a
25+ -- First comment
26+ barbaz a
27+ = bazbar -- Middle comment
28+ a
29+ -- Last comment
30+ bazbar a
31+ = barbaz
32+ a
data/examples/declaration/class/default-signatures-out.hsnew file+28
@@ -0,0 +1,28 @@
1+{-# LANGUAGE DefaultSignatures #-}
2+
3+-- | Something.
4+class Foo a where
5+ -- | Foo
6+ foo :: a -> String
7+ default foo :: Show a => a -> String
8+ foo = show
9+
10+-- | Something else.
11+class Bar a where
12+ -- | Bar
13+ bar
14+ :: String
15+ -> String
16+ -> a
17+ -- Pointless comment
18+ default bar
19+ :: ( Read a
20+ , Semigroup a
21+ )
22+ => a
23+ -> a
24+ -> a
25+ -- Even more pointless comment
26+ bar
27+ a
28+ b = read a <> read b
data/examples/declaration/class/default-signatures.hsnew file+31
@@ -0,0 +1,31 @@
1+{-# LANGUAGE DefaultSignatures #-}
2+
3+-- | Something.
4+class Foo a where
5+ -- | Foo
6+ foo :: a -> String
7+ default foo :: Show a => a -> String
8+ foo = show
9+
10+-- | Something else.
11+class Bar a
12+ where
13+ -- | Bar
14+ bar ::
15+ String
16+ -> String
17+ -> a
18+
19+ -- Pointless comment
20+ default bar :: (
21+ Read a,
22+ Semigroup a
23+ ) =>
24+ a -> a -> a
25+
26+ -- Even more pointless comment
27+ bar
28+ a
29+ b
30+ =
31+ read a <> read b
data/examples/declaration/class/dependency-super-classes-out.hsnew file+20
@@ -0,0 +1,20 @@
1+{-# LANGUAGE FunctionalDependencies #-}
2+
3+-- | Something.
4+class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where
5+ get :: m s
6+ put :: s -> m ()
7+
8+-- | 'MonadParsec'
9+class ( Stream s -- Token streams
10+ , MonadPlus m -- Potential for failure
11+ )
12+ => MonadParsec e s m
13+ | m -> e s where
14+ -- | 'getState' returns state
15+ getState
16+ :: m s
17+ -- | 'putState' sets state
18+ putState
19+ :: s
20+ -> m ()
data/examples/declaration/class/dependency-super-classes.hsnew file+22
@@ -0,0 +1,22 @@
1+{-# LANGUAGE FunctionalDependencies #-}
2+
3+-- | Something.
4+class ( MonadReader r s,MonadWriter w m ) => MonadState s m| m -> s where
5+ get :: m s
6+ put :: s -> m ()
7+
8+-- | 'MonadParsec'
9+
10+class (
11+ Stream s, -- Token streams
12+ MonadPlus m -- Potential for failure
13+ ) => MonadParsec e s m | m -> e s
14+ where
15+ -- | 'getState' returns state
16+ getState
17+ ::
18+ m s
19+ -- | 'putState' sets state
20+ putState ::
21+ s
22+ -> m ()
data/examples/declaration/class/empty-classes-out.hsnew file+5
@@ -0,0 +1,5 @@
1+-- | Foo!
2+class Foo a
3+
4+-- | Bar!
5+class Bar a
data/examples/declaration/class/empty-classes.hsnew file+4
@@ -0,0 +1,4 @@
1+-- | Foo!
2+class Foo a where
3+-- | Bar!
4+class Bar a
data/examples/declaration/class/functional-dependencies-out.hsnew file+16
@@ -0,0 +1,16 @@
1+{-# LANGUAGE FunctionalDependencies #-}
2+
3+-- | Something.
4+class Foo a b | a -> b
5+
6+class Bar a b | a -> b, b -> a where
7+ bar :: a
8+
9+-- | Something else.
10+class Baz a b c d
11+ | a b -> c d -- Foo
12+ , b c -> a d -- Bar
13+ , a c -> b d -- Baz
14+ , a c d -> b
15+ , a b d -> a b c d where
16+ baz :: a -> b
data/examples/declaration/class/functional-dependencies.hsnew file+16
@@ -0,0 +1,16 @@
1+{-# LANGUAGE FunctionalDependencies #-}
2+
3+-- | Something.
4+class Foo a b | a -> b
5+
6+class Bar a b | a -> b, b -> a where bar :: a
7+
8+-- | Something else.
9+class Baz a b c d
10+ | a b -> c d -- Foo
11+ , b c -> a d -- Bar
12+ , a c -> b d-- Baz
13+ , a c d -> b
14+ , a b d -> a b c d
15+ where
16+ baz :: a -> b
data/examples/declaration/class/multi-parameters-out.hsnew file+22
@@ -0,0 +1,22 @@
1+{-# LANGUAGE MultiParamTypeClasses #-}
2+class Foo a b where
3+ foo :: a -> b
4+
5+-- | Something.
6+class Bar a b c d where
7+ bar
8+ :: a
9+ -> b
10+ -> c
11+ -> d
12+
13+class Baz where
14+ baz :: Int
15+
16+-- | Something else.
17+class BarBaz a b c d e f where
18+ barbaz
19+ :: a -> f
20+ bazbar
21+ :: e
22+ -> f
data/examples/declaration/class/multi-parameters.hsnew file+32
@@ -0,0 +1,32 @@
1+{-# LANGUAGE MultiParamTypeClasses #-}
2+
3+class Foo a b where foo :: a -> b
4+
5+-- | Something.
6+class Bar
7+ a b c d
8+ where
9+ bar ::
10+ a
11+ -> b
12+ -> c
13+ -> d
14+
15+class Baz
16+ where
17+ baz :: Int
18+
19+-- | Something else.
20+class
21+ BarBaz
22+ a
23+ b
24+ c
25+ d
26+ e
27+ f where
28+ barbaz ::
29+ a -> f
30+ bazbar ::
31+ e ->
32+ f
data/examples/declaration/class/poly-kinded-classes-out.hsnew file+6
@@ -0,0 +1,6 @@
1+{-# LANGUAGE PolyKinds #-}
2+class Foo (a :: k)
3+
4+class Bar ( a
5+ :: *
6+ )
data/examples/declaration/class/poly-kinded-classes.hsnew file+7
@@ -0,0 +1,7 @@
1+{-# LANGUAGE PolyKinds #-}
2+
3+class Foo (a::k)
4+
5+class Bar
6+ (a
7+ :: *)
data/examples/declaration/class/single-parameters-out.hsnew file+22
@@ -0,0 +1,22 @@
1+-- | Something.
2+class Foo a where
3+ foo :: a
4+
5+-- | Something more.
6+class Bar a where
7+ -- | Bar
8+ bar :: a -> a -> a
9+
10+class Baz a where
11+ -- | Baz
12+ baz
13+ :: ( a
14+ , a -- ^ First argument
15+ )
16+ -> a -- ^ Second argument
17+ -> a -- ^ Return value
18+
19+class BarBaz a where
20+ barbaz
21+ :: a -> b
22+ bazbar :: b -> a
data/examples/declaration/class/single-parameters.hsnew file+20
@@ -0,0 +1,20 @@
1+-- | Something.
2+class Foo a where foo :: a
3+
4+-- | Something more.
5+class Bar a where
6+ -- | Bar
7+ bar :: a -> a -> a
8+
9+class Baz a where
10+ -- | Baz
11+ baz ::
12+ (a,
13+ a) -- ^ First argument
14+ -> a -- ^ Second argument
15+ -> a -- ^ Return value
16+
17+class BarBaz a where
18+ barbaz ::
19+ a -> b
20+ bazbar :: b -> a
data/examples/declaration/class/super-classes-out.hsnew file+12
@@ -0,0 +1,12 @@
1+class Foo a
2+
3+class Foo a => Bar a
4+
5+class (Foo a, Bar a)
6+ => Baz a
7+
8+class ( Foo a -- Foo?
9+ , Bar a -- Bar?
10+ , Baz a -- Baz
11+ )
12+ => BarBar a
data/examples/declaration/class/super-classes.hsnew file+9
@@ -0,0 +1,9 @@
1+class () => Foo a
2+class Foo a => Bar a
3+class (Foo a,Bar a) =>
4+ Baz a
5+class (
6+ Foo a, -- Foo?
7+ Bar a, -- Bar?
8+ Baz a -- Baz
9+ ) => BarBar a
ormolu.cabal+1
@@ -60,6 +60,7 @@ library
60 , Ormolu.Printer.Internal
60 , Ormolu.Printer.Internal
61 , Ormolu.Printer.Meat.Common
61 , Ormolu.Printer.Meat.Common
62 , Ormolu.Printer.Meat.Declaration
62 , Ormolu.Printer.Meat.Declaration
63+ , Ormolu.Printer.Meat.Declaration.Class
63 , Ormolu.Printer.Meat.Declaration.Instance
64 , Ormolu.Printer.Meat.Declaration.Instance
64 , Ormolu.Printer.Meat.Declaration.Data
65 , Ormolu.Printer.Meat.Declaration.Data
65 , Ormolu.Printer.Meat.Declaration.Signature
66 , Ormolu.Printer.Meat.Declaration.Signature
src/Ormolu/Printer/Meat/Declaration.hs+15−20
@@ -10,6 +10,7 @@ where
10
10
11import GHC
11import GHC
12import Ormolu.Printer.Combinators
12import Ormolu.Printer.Combinators
13+import Ormolu.Printer.Meat.Declaration.Class
13import Ormolu.Printer.Meat.Common
14import Ormolu.Printer.Meat.Common
14import Ormolu.Printer.Meat.Declaration.Data
15import Ormolu.Printer.Meat.Declaration.Data
15import Ormolu.Printer.Meat.Declaration.Instance
16import Ormolu.Printer.Meat.Declaration.Instance
@@ -17,6 +18,7 @@ import Ormolu.Printer.Meat.Declaration.Signature
17import Ormolu.Printer.Meat.Declaration.Type
18import Ormolu.Printer.Meat.Declaration.Type
18import Ormolu.Printer.Meat.Declaration.TypeFamily
19import Ormolu.Printer.Meat.Declaration.TypeFamily
19import Ormolu.Printer.Meat.Declaration.Value
20import Ormolu.Printer.Meat.Declaration.Value
21+import Ormolu.Printer.Meat.Type
20import Ormolu.Utils
22import Ormolu.Utils
21
23
22p_hsDecl :: HsDecl GhcPs -> R ()
24p_hsDecl :: HsDecl GhcPs -> R ()
@@ -38,32 +40,25 @@ p_hsDecl = \case
38
40
39p_tyClDecl :: TyClDecl GhcPs -> R ()
41p_tyClDecl :: TyClDecl GhcPs -> R ()
40p_tyClDecl = \case
42p_tyClDecl = \case
41− FamDecl NoExt x -> p_famDecl x
43+ FamDecl NoExt x -> p_famDecl Free x
42 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs
44 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs
43 DataDecl {..} ->
45 DataDecl {..} ->
44 p_dataDecl Associated tcdLName (tyVarsToTypes tcdTyVars) tcdDataDefn
46 p_dataDecl Associated tcdLName (tyVarsToTypes tcdTyVars) tcdDataDefn
45− ClassDecl {..} -> notImplemented "ClassDecl"
47+ ClassDecl {..} ->
48+ p_classDecl
49+ tcdCtxt
50+ tcdLName
51+ tcdTyVars
52+ tcdFDs
53+ tcdSigs
54+ tcdMeths
55+ tcdATs
56+ tcdATDefs
46− XTyClDecl _ -> notImplemented "XTyClDecl"
57+ XTyClDecl {} -> notImplemented "XTyClDecl"
47
58
48p_instDecl :: InstDecl GhcPs -> R ()
59p_instDecl :: InstDecl GhcPs -> R ()
49p_instDecl = \case
60p_instDecl = \case
50 ClsInstD NoExt x -> p_clsInstDecl x
61 ClsInstD NoExt x -> p_clsInstDecl x
51 TyFamInstD NoExt x -> p_tyFamInstDecl Free x
62 TyFamInstD NoExt x -> p_tyFamInstDecl Free x
52 DataFamInstD NoExt x -> p_dataFamInstDecl Free x
63 DataFamInstD NoExt x -> p_dataFamInstDecl Free x
53− XInstDecl _ -> notImplemented "XInstDecl"
64+ _ -> notImplemented "certain kinds of declarations"
54−
55−----------------------------------------------------------------------------
56−-- Helpers
57−
58−tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]
59−tyVarsToTypes = \case
60− HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit
61− XLHsQTyVars {} -> notImplemented "XLHsQTyVars"
62−
63−tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs
64−tyVarToType = \case
65− UserTyVar NoExt tvar -> HsTyVar NoExt NotPromoted tvar
66− KindedTyVar NoExt tvar kind ->
67− HsParTy NoExt $ noLoc $
68− HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted tvar)) kind
69− XTyVarBndr {} -> notImplemented "XTyVarBndr"
src/Ormolu/Printer/Meat/Declaration/Class.hsnew file+94
@@ -0,0 +1,94 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+-- | Rendering of type class declarations.
6+
7+module Ormolu.Printer.Meat.Declaration.Class
8+ ( p_classDecl
9+ )
10+where
11+
12+import Class
13+import Control.Arrow
14+import Control.Monad
15+import Data.Foldable
16+import Data.Function
17+import Data.List (sortBy)
18+import Ormolu.Printer.Combinators
19+import Ormolu.Printer.Meat.Declaration.Signature
20+import Ormolu.Printer.Meat.Declaration.Value
21+import Ormolu.Printer.Meat.Declaration.TypeFamily
22+import Ormolu.Printer.Meat.Common
23+import Ormolu.Printer.Meat.Type
24+import Ormolu.Utils
25+import GHC
26+import RdrName (RdrName (..))
27+import SrcLoc (Located, combineSrcSpans)
28+
29+p_classDecl
30+ :: LHsContext GhcPs
31+ -> Located RdrName
32+ -> LHsQTyVars GhcPs
33+ -> [Located (FunDep (Located RdrName))]
34+ -> [LSig GhcPs]
35+ -> LHsBinds GhcPs
36+ -> [LFamilyDecl GhcPs]
37+ -> [LTyFamDefltEqn GhcPs]
38+ -> R ()
39+p_classDecl ctx name tvars fdeps csigs cdefs cats catdefs = do
40+ let HsQTvs {..} = tvars
41+ combinedSpans =
42+ getLoc ctx `combineSrcSpans`
43+ getLoc name `combineSrcSpans`
44+ foldr (combineSrcSpans . getLoc) noSrcSpan hsq_explicit `combineSrcSpans`
45+ foldr (combineSrcSpans . getLoc) noSrcSpan fdeps
46+ txt "class "
47+ sitcc $ do
48+ switchLayout combinedSpans $ do
49+ unless (null (unLoc ctx)) $ do
50+ located ctx p_hsContext
51+ breakpoint
52+ txt "=> "
53+ p_rdrName name
54+ unless (null hsq_explicit) space
55+ spaceSep (located' p_hsTyVarBndr) hsq_explicit
56+ unless (null fdeps) $ do
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
61+ -- location order. This happens because different declarations are stored in
62+ -- different lists. Consequently, to get all the declarations in proper order,
63+ -- they need to be manually sorted.
64+ let sigs = (getLoc &&& located' p_sigDecl) <$> csigs
65+ defs = (getLoc &&& located' p_valDecl) <$> cdefs
66+ tyfam_decls = (getLoc &&& located' (p_famDecl Associated)) <$> cats
67+ tyfam_defs = (getLoc &&& located' p_famDefDecl) <$> catdefs
68+ decls =
69+ snd <$>
70+ sortBy
71+ (compare `on` fst)
72+ (sigs <> toList defs <> tyfam_decls <> tyfam_defs)
73+ if not (null decls)
74+ then do
75+ txt " where"
76+ newline
77+ inci (sequence_ decls)
78+ else newline
79+
80+p_famDefDecl :: TyFamDefltEqn GhcPs -> R ()
81+p_famDefDecl FamEqn {..} = do
82+ txt "type"
83+ breakpoint
84+ let eqn = FamEqn { feqn_pats = tyVarsToTypes feqn_pats, .. }
85+ hsib = HsIB { hsib_ext = NoExt, hsib_body = eqn }
86+ inci (p_tyFamInstEqn hsib)
87+ newline
88+p_famDefDecl XFamEqn {} = notImplemented "XFamEqn"
89+
90+p_funDep :: FunDep (Located RdrName) -> R ()
91+p_funDep (before, after) = do
92+ spaceSep p_rdrName before
93+ txt " -> "
94+ spaceSep p_rdrName after
src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+16−12
@@ -21,22 +21,26 @@ import Ormolu.Printer.Meat.Type
21import Ormolu.Utils
21import Ormolu.Utils
22import SrcLoc (Located, GenLocated (..))
22import SrcLoc (Located, GenLocated (..))
23
23
24−p_famDecl :: FamilyDecl GhcPs -> R ()
24+p_famDecl :: FamilyStyle -> FamilyDecl GhcPs -> R ()
25−p_famDecl FamilyDecl {..} = do
25+p_famDecl style FamilyDecl {..} = do
26 mmeqs <- case fdInfo of
26 mmeqs <- case fdInfo of
27− DataFamily -> Nothing <$ txt "data family"
27+ DataFamily -> Nothing <$ txt "data"
28− OpenTypeFamily -> Nothing <$ txt "type family"
28+ OpenTypeFamily -> Nothing <$ txt "type"
29− ClosedTypeFamily eqs -> Just eqs <$ txt "type family"
29+ ClosedTypeFamily eqs -> Just eqs <$ txt "type"
30− breakpoint
30+ txt $ case style of
31+ Associated -> mempty
32+ Free -> " family"
31 let HsQTvs {..} = fdTyVars
33 let HsQTvs {..} = fdTyVars
32 combinedSpans = combineSrcSpans' $
34 combinedSpans = combineSrcSpans' $
33 getSpan fdLName :| fmap getSpan hsq_explicit
35 getSpan fdLName :| fmap getSpan hsq_explicit
36+ breakpoint
34 inci $ do
37 inci $ do
35− switchLayout combinedSpans $ p_infixDefHelper
38+ switchLayout combinedSpans $ do
39+ p_infixDefHelper
36− (isInfix fdFixity)
40+ (isInfix fdFixity)
37− inci
41+ inci
38− (p_rdrName fdLName)
42+ (p_rdrName fdLName)
39− (located' p_hsTyVarBndr <$> hsq_explicit)
43+ (located' p_hsTyVarBndr <$> hsq_explicit)
40 let rsig = p_familyResultSigL (isJust fdInjectivityAnn) fdResultSig
44 let rsig = p_familyResultSigL (isJust fdInjectivityAnn) fdResultSig
41 unless (isNothing rsig && isNothing fdInjectivityAnn) $
45 unless (isNothing rsig && isNothing fdInjectivityAnn) $
42 breakpoint
46 breakpoint
@@ -53,7 +57,7 @@ p_famDecl FamilyDecl {..} = do
53 Just eqs -> do
57 Just eqs -> do
54 newline
58 newline
55 forM_ eqs (located' (line . inci . p_tyFamInstEqn))
59 forM_ eqs (located' (line . inci . p_tyFamInstEqn))
56−p_famDecl (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"
60+p_famDecl _ (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"
57
61
58p_familyResultSigL
62p_familyResultSigL
59 :: Bool
63 :: Bool
src/Ormolu/Printer/Meat/Type.hs+17
@@ -9,6 +9,7 @@ module Ormolu.Printer.Meat.Type
9 , p_hsContext
9 , p_hsContext
10 , p_hsTyVarBndr
10 , p_hsTyVarBndr
11 , p_conDeclFields
11 , p_conDeclFields
12+ , tyVarsToTypes
12 )
13 )
13where
14where
14
15
@@ -136,3 +137,19 @@ p_conDeclField ConDeclField {..} = do
136 txt ":: "
137 txt ":: "
137 locatedVia Nothing cd_fld_type p_hsType
138 locatedVia Nothing cd_fld_type p_hsType
138p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"
139p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"
140+
141+----------------------------------------------------------------------------
142+-- Convertion functions
143+
144+tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]
145+tyVarsToTypes = \case
146+ HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit
147+ XLHsQTyVars {} -> notImplemented "XLHsQTyVars"
148+
149+tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs
150+tyVarToType = \case
151+ UserTyVar NoExt tvar -> HsTyVar NoExt NotPromoted tvar
152+ KindedTyVar NoExt tvar kind ->
153+ HsParTy NoExt $ noLoc $
154+ HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted tvar)) kind
155+ XTyVarBndr {} -> notImplemented "XTyVarBndr"