mirror of
https://github.com/google/ormolu.git
synced 2024-12-02 23:43:34 +03:00
Support data types with infix & multi-line declarations
Fix the bug where data types with infix names & names layed out over multiple lines get incorrectly formatted. Specifically, reuse `p_infixDefHelper` to easily take care of this behavior.
This commit is contained in:
parent
c2dd159c9c
commit
069ae69a5b
29
data/examples/declaration/data/multiline-names-out.hs
Normal file
29
data/examples/declaration/data/multiline-names-out.hs
Normal file
@ -0,0 +1,29 @@
|
||||
data
|
||||
Foo
|
||||
a
|
||||
b
|
||||
= Foo a b
|
||||
|
||||
data a :-> b = Arrow (a -> b)
|
||||
|
||||
data (f :* g) a = f a :* g a
|
||||
|
||||
data
|
||||
( f :+
|
||||
g
|
||||
)
|
||||
a
|
||||
= L (f a)
|
||||
| R (g a)
|
||||
|
||||
data a `Arrow` b = Arrow' (a -> b)
|
||||
|
||||
data (f `Product` g) a = f a `Product` g a
|
||||
|
||||
data
|
||||
( f `Sum`
|
||||
g
|
||||
)
|
||||
a
|
||||
= L' (f a)
|
||||
| R' (g a)
|
23
data/examples/declaration/data/multiline-names.hs
Normal file
23
data/examples/declaration/data/multiline-names.hs
Normal file
@ -0,0 +1,23 @@
|
||||
data Foo a
|
||||
b
|
||||
= Foo a b
|
||||
|
||||
data a :-> b = Arrow (a -> b)
|
||||
|
||||
data (f :* g) a = f a :* g a
|
||||
|
||||
data (f
|
||||
:+
|
||||
g)
|
||||
a = L (f a)
|
||||
| R (g a)
|
||||
|
||||
data a `Arrow` b = Arrow' (a -> b)
|
||||
|
||||
data (f `Product` g) a = f a `Product` g a
|
||||
|
||||
data (f
|
||||
`Sum`
|
||||
g)
|
||||
a = L' (f a)
|
||||
| R' (g a)
|
@ -6,7 +6,9 @@ instance Foo Int where
|
||||
|
||||
instance Foo Double where
|
||||
|
||||
newtype Bar Double
|
||||
newtype
|
||||
Bar
|
||||
Double
|
||||
= DoubleBar
|
||||
Double
|
||||
Double
|
||||
|
@ -3,7 +3,9 @@
|
||||
|
||||
data instance Foo Int = FooInt Int
|
||||
|
||||
data instance Foo [Int]
|
||||
data instance
|
||||
Foo
|
||||
[Int]
|
||||
= IntListFoo
|
||||
( Int
|
||||
, Int
|
||||
|
@ -66,7 +66,12 @@ p_tyClDecl style = \case
|
||||
FamDecl NoExt x -> p_famDecl style x
|
||||
SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs
|
||||
DataDecl {..} ->
|
||||
p_dataDecl Associated tcdLName (tyVarsToTypes tcdTyVars) tcdDataDefn
|
||||
p_dataDecl
|
||||
Associated
|
||||
tcdLName
|
||||
(tyVarsToTypes tcdTyVars)
|
||||
tcdFixity
|
||||
tcdDataDefn
|
||||
ClassDecl {..} ->
|
||||
p_classDecl
|
||||
tcdCtxt
|
||||
|
@ -24,18 +24,24 @@ p_dataDecl
|
||||
:: FamilyStyle -- ^ Whether to format as data family
|
||||
-> Located RdrName -- ^ Type constructor
|
||||
-> [LHsType GhcPs] -- ^ Type patterns
|
||||
-> LexicalFixity -- ^ Lexical fixity
|
||||
-> HsDataDefn GhcPs -- ^ Data definition
|
||||
-> R ()
|
||||
p_dataDecl style name tpats HsDataDefn {..} = do
|
||||
p_dataDecl style name tpats fixity HsDataDefn {..} = do
|
||||
let combinedSpans = combineSrcSpans' (getLoc name :| (getLoc <$> tpats))
|
||||
txt $ case dd_ND of
|
||||
NewType -> "newtype "
|
||||
DataType -> "data "
|
||||
NewType -> "newtype"
|
||||
DataType -> "data"
|
||||
txt $ case style of
|
||||
Associated -> mempty
|
||||
Free -> "instance "
|
||||
p_rdrName name
|
||||
unless (null tpats) space
|
||||
spaceSep (located' p_hsType) tpats
|
||||
Free -> " instance"
|
||||
switchLayout combinedSpans $ do
|
||||
breakpoint
|
||||
inci $ p_infixDefHelper
|
||||
(isInfix fixity)
|
||||
inci
|
||||
(p_rdrName name)
|
||||
(located' p_hsType <$> tpats)
|
||||
case dd_kindSig of
|
||||
Nothing -> return ()
|
||||
Just k -> do
|
||||
@ -58,7 +64,7 @@ p_dataDecl style name tpats HsDataDefn {..} = do
|
||||
newline
|
||||
inci . located dd_derivs $ \xs ->
|
||||
forM_ xs (line . located' p_hsDerivingClause)
|
||||
p_dataDecl _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"
|
||||
p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"
|
||||
|
||||
p_conDecl :: ConDecl GhcPs -> R ()
|
||||
p_conDecl = \case
|
||||
@ -165,3 +171,11 @@ p_hsDerivingClause HsDerivingClause {..} = do
|
||||
ViaStrategy (XHsImplicitBndrs NoExt) ->
|
||||
notImplemented "XHsImplicitBndrs"
|
||||
p_hsDerivingClause (XHsDerivingClause NoExt) = notImplemented "XHsDerivingClause"
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Helpers
|
||||
|
||||
isInfix :: LexicalFixity -> Bool
|
||||
isInfix = \case
|
||||
Infix -> True
|
||||
Prefix -> False
|
||||
|
@ -112,7 +112,7 @@ p_dataFamInstDecl style = \case
|
||||
DataFamInstDecl {..} -> do
|
||||
let HsIB {..} = dfid_eqn
|
||||
FamEqn {..} = hsib_body
|
||||
p_dataDecl style feqn_tycon feqn_pats feqn_rhs
|
||||
p_dataDecl style feqn_tycon feqn_pats feqn_fixity feqn_rhs
|
||||
|
||||
match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R ()
|
||||
match_overlap_mode overlap_mode layoutStrategy =
|
||||
|
Loading…
Reference in New Issue
Block a user