From 069ae69a5bfc7388b846624a1b754e8cd602f671 Mon Sep 17 00:00:00 2001 From: yumiova Date: Mon, 8 Jul 2019 18:17:42 +0200 Subject: [PATCH] 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. --- .../declaration/data/multiline-names-out.hs | 29 ++++++++++++++++++ .../declaration/data/multiline-names.hs | 23 ++++++++++++++ .../instance/associated-data-out.hs | 4 ++- .../instance/data-family-instances-out.hs | 4 ++- src/Ormolu/Printer/Meat/Declaration.hs | 7 ++++- src/Ormolu/Printer/Meat/Declaration/Data.hs | 30 ++++++++++++++----- .../Printer/Meat/Declaration/Instance.hs | 2 +- 7 files changed, 87 insertions(+), 12 deletions(-) create mode 100644 data/examples/declaration/data/multiline-names-out.hs create mode 100644 data/examples/declaration/data/multiline-names.hs diff --git a/data/examples/declaration/data/multiline-names-out.hs b/data/examples/declaration/data/multiline-names-out.hs new file mode 100644 index 0000000..0e16de0 --- /dev/null +++ b/data/examples/declaration/data/multiline-names-out.hs @@ -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) diff --git a/data/examples/declaration/data/multiline-names.hs b/data/examples/declaration/data/multiline-names.hs new file mode 100644 index 0000000..3e49fd2 --- /dev/null +++ b/data/examples/declaration/data/multiline-names.hs @@ -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) diff --git a/data/examples/declaration/instance/associated-data-out.hs b/data/examples/declaration/instance/associated-data-out.hs index d5f1160..46c99c3 100644 --- a/data/examples/declaration/instance/associated-data-out.hs +++ b/data/examples/declaration/instance/associated-data-out.hs @@ -6,7 +6,9 @@ instance Foo Int where instance Foo Double where - newtype Bar Double + newtype + Bar + Double = DoubleBar Double Double diff --git a/data/examples/declaration/instance/data-family-instances-out.hs b/data/examples/declaration/instance/data-family-instances-out.hs index f3cb5bc..31f3e3e 100644 --- a/data/examples/declaration/instance/data-family-instances-out.hs +++ b/data/examples/declaration/instance/data-family-instances-out.hs @@ -3,7 +3,9 @@ data instance Foo Int = FooInt Int -data instance Foo [Int] +data instance + Foo + [Int] = IntListFoo ( Int , Int diff --git a/src/Ormolu/Printer/Meat/Declaration.hs b/src/Ormolu/Printer/Meat/Declaration.hs index 876d08d..11734d8 100644 --- a/src/Ormolu/Printer/Meat/Declaration.hs +++ b/src/Ormolu/Printer/Meat/Declaration.hs @@ -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 diff --git a/src/Ormolu/Printer/Meat/Declaration/Data.hs b/src/Ormolu/Printer/Meat/Declaration/Data.hs index 7bf1428..cb1c3e6 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Data.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Data.hs @@ -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 diff --git a/src/Ormolu/Printer/Meat/Declaration/Instance.hs b/src/Ormolu/Printer/Meat/Declaration/Instance.hs index ddc1017..e8e2819 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Instance.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Instance.hs @@ -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 =