on master help sign in
Support data types with infix & multi-line declarations
069ae69yumiova
data/examples/declaration/data/multiline-names-out.hsnew file+29
@@ -0,0 +1,29 @@
1+data
2+ Foo
3+ a
4+ b
5+ = Foo a b
6+
7+data a :-> b = Arrow (a -> b)
8+
9+data (f :* g) a = f a :* g a
10+
11+data
12+ ( f :+
13+ g
14+ )
15+ a
16+ = L (f a)
17+ | R (g a)
18+
19+data a `Arrow` b = Arrow' (a -> b)
20+
21+data (f `Product` g) a = f a `Product` g a
22+
23+data
24+ ( f `Sum`
25+ g
26+ )
27+ a
28+ = L' (f a)
29+ | R' (g a)
data/examples/declaration/data/multiline-names.hsnew file+23
@@ -0,0 +1,23 @@
1+data Foo a
2+ b
3+ = Foo a b
4+
5+data a :-> b = Arrow (a -> b)
6+
7+data (f :* g) a = f a :* g a
8+
9+data (f
10+ :+
11+ g)
12+ a = L (f a)
13+ | R (g a)
14+
15+data a `Arrow` b = Arrow' (a -> b)
16+
17+data (f `Product` g) a = f a `Product` g a
18+
19+data (f
20+ `Sum`
21+ g)
22+ a = L' (f a)
23+ | R' (g a)
data/examples/declaration/instance/associated-data-out.hs+3−1
@@ -6,7 +6,9 @@ instance Foo Int where
6
6
7instance Foo Double where
7instance Foo Double where
8
8
9− newtype Bar Double
9+ newtype
10+ Bar
11+ Double
10 = DoubleBar
12 = DoubleBar
11 Double
13 Double
12 Double
14 Double
data/examples/declaration/instance/data-family-instances-out.hs+3−1
@@ -3,7 +3,9 @@
3
3
4data instance Foo Int = FooInt Int
4data instance Foo Int = FooInt Int
5
5
6−data instance Foo [Int]
6+data instance
7+ Foo
8+ [Int]
7 = IntListFoo
9 = IntListFoo
8 ( Int
10 ( Int
9 , Int
11 , Int
src/Ormolu/Printer/Meat/Declaration.hs+6−1
@@ -66,7 +66,12 @@ p_tyClDecl style = \case
66 FamDecl NoExt x -> p_famDecl style x
66 FamDecl NoExt x -> p_famDecl style x
67 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs
67 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs
68 DataDecl {..} ->
68 DataDecl {..} ->
69+ p_dataDecl
70+ Associated
71+ tcdLName
69− p_dataDecl Associated tcdLName (tyVarsToTypes tcdTyVars) tcdDataDefn
72+ (tyVarsToTypes tcdTyVars)
73+ tcdFixity
74+ tcdDataDefn
70 ClassDecl {..} ->
75 ClassDecl {..} ->
71 p_classDecl
76 p_classDecl
72 tcdCtxt
77 tcdCtxt
src/Ormolu/Printer/Meat/Declaration/Data.hs+22−8
@@ -24,18 +24,24 @@ p_dataDecl
24 :: FamilyStyle -- ^ Whether to format as data family
24 :: FamilyStyle -- ^ Whether to format as data family
25 -> Located RdrName -- ^ Type constructor
25 -> Located RdrName -- ^ Type constructor
26 -> [LHsType GhcPs] -- ^ Type patterns
26 -> [LHsType GhcPs] -- ^ Type patterns
27+ -> LexicalFixity -- ^ Lexical fixity
27 -> HsDataDefn GhcPs -- ^ Data definition
28 -> HsDataDefn GhcPs -- ^ Data definition
28 -> R ()
29 -> R ()
29−p_dataDecl style name tpats HsDataDefn {..} = do
30+p_dataDecl style name tpats fixity HsDataDefn {..} = do
31+ let combinedSpans = combineSrcSpans' (getLoc name :| (getLoc <$> tpats))
30 txt $ case dd_ND of
32 txt $ case dd_ND of
31− NewType -> "newtype "
33+ NewType -> "newtype"
32− DataType -> "data "
34+ DataType -> "data"
33 txt $ case style of
35 txt $ case style of
34 Associated -> mempty
36 Associated -> mempty
35− Free -> "instance "
37+ Free -> " instance"
38+ switchLayout combinedSpans $ do
39+ breakpoint
40+ inci $ p_infixDefHelper
41+ (isInfix fixity)
42+ inci
36− p_rdrName name
43+ (p_rdrName name)
37− unless (null tpats) space
38− spaceSep (located' p_hsType) tpats
44+ (located' p_hsType <$> tpats)
39 case dd_kindSig of
45 case dd_kindSig of
40 Nothing -> return ()
46 Nothing -> return ()
41 Just k -> do
47 Just k -> do
@@ -58,7 +64,7 @@ p_dataDecl style name tpats HsDataDefn {..} = do
58 newline
64 newline
59 inci . located dd_derivs $ \xs ->
65 inci . located dd_derivs $ \xs ->
60 forM_ xs (line . located' p_hsDerivingClause)
66 forM_ xs (line . located' p_hsDerivingClause)
61−p_dataDecl _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"
67+p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"
62
68
63p_conDecl :: ConDecl GhcPs -> R ()
69p_conDecl :: ConDecl GhcPs -> R ()
64p_conDecl = \case
70p_conDecl = \case
@@ -165,3 +171,11 @@ p_hsDerivingClause HsDerivingClause {..} = do
165 ViaStrategy (XHsImplicitBndrs NoExt) ->
171 ViaStrategy (XHsImplicitBndrs NoExt) ->
166 notImplemented "XHsImplicitBndrs"
172 notImplemented "XHsImplicitBndrs"
167p_hsDerivingClause (XHsDerivingClause NoExt) = notImplemented "XHsDerivingClause"
173p_hsDerivingClause (XHsDerivingClause NoExt) = notImplemented "XHsDerivingClause"
174+
175+----------------------------------------------------------------------------
176+-- Helpers
177+
178+isInfix :: LexicalFixity -> Bool
179+isInfix = \case
180+ Infix -> True
181+ Prefix -> False
src/Ormolu/Printer/Meat/Declaration/Instance.hs+1−1
@@ -112,7 +112,7 @@ p_dataFamInstDecl style = \case
112 DataFamInstDecl {..} -> do
112 DataFamInstDecl {..} -> do
113 let HsIB {..} = dfid_eqn
113 let HsIB {..} = dfid_eqn
114 FamEqn {..} = hsib_body
114 FamEqn {..} = hsib_body
115− p_dataDecl style feqn_tycon feqn_pats feqn_rhs
115+ p_dataDecl style feqn_tycon feqn_pats feqn_fixity feqn_rhs
116
116
117match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R ()
117match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R ()
118match_overlap_mode overlap_mode layoutStrategy =
118match_overlap_mode overlap_mode layoutStrategy =