Support infix operator & multi-line class names

data/examples/declaration/class/associated-data-out.hs

@@ -14,7 +14,11 @@ class Bar a where
 -- | Something more.
 class Baz a where
   -- | Baz bar
-  data BazBar a b c
+  data
+    BazBar
+      a
+      b
+      c
   -- | Baz baz
   data
     BazBaz

data/examples/declaration/class/associated-data.hs

@@ -14,7 +14,10 @@ class Bar a
 -- | Something more.
 class Baz a where
     -- | Baz bar
-    data BazBar a b c
+    data BazBar
+        a
+        b
+        c
 
     -- | Baz baz
     data family BazBaz

data/examples/declaration/class/associated-types-out.hs

@@ -14,9 +14,14 @@ class Bar a where
 -- | Something more.
 class Baz a where
   -- | Baz bar
-  type BazBar a b c
+  type
+    BazBar
+      a -- Foo
+      b -- Bar
+      c
   -- | Baz baz
   type
+    -- After type
     BazBaz
       b
       a

data/examples/declaration/class/associated-types.hs

@@ -14,10 +14,14 @@ class Bar a
 -- | Something more.
 class Baz a where
     -- | Baz bar
-    type BazBar a b c
+    type BazBar
+        a      -- Foo
+        b      -- Bar
+        c
 
     -- | Baz baz
-    type BazBaz
+    type -- After type
+         BazBaz
         b
         a
         c

data/examples/declaration/class/multi-parameters-out.hs

@@ -10,11 +10,18 @@ class Bar a b c d where
     -> c
     -> d
 
-class Baz where
+class -- Before name
+      Baz where
   baz :: Int
 
 -- | Something else.
-class BarBaz a b c d e f where
+class BarBaz
+        a -- Foo
+        b -- Bar
+        c -- Baz bar
+        d -- Baz baz
+        e -- Rest
+        f where
   barbaz
     :: a -> f
   bazbar

data/examples/declaration/class/multi-parameters.hs

@@ -3,8 +3,7 @@
 class Foo a b where foo :: a -> b
 
 -- | Something.
-class Bar
-        a b c d
+class Bar a b c d
   where
     bar ::
            a
@@ -12,18 +11,19 @@ class Bar
         -> c
         -> d
 
-class Baz
+class -- Before name
+    Baz
   where
     baz :: Int
 
 -- | Something else.
 class
       BarBaz
-        a
-        b
-        c
-        d
-        e
+        a              -- Foo
+        b              -- Bar
+        c              -- Baz bar
+        d              -- Baz baz
+        e              -- Rest
         f where
     barbaz ::
         a -> f

data/examples/declaration/class/poly-kinded-classes-out.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE PolyKinds #-}
 class Foo (a :: k)
 
-class Bar ( a
-            :: *
-          )
+class Bar
+        ( a -- Variable
+          :: * -- Star
+        )

data/examples/declaration/class/poly-kinded-classes.hs

@@ -3,5 +3,6 @@
 class Foo (a::k)
 
 class Bar
-    (a
-       :: *)
+    (a -- Variable
+       :: * -- Star
+    )

data/examples/declaration/class/type-operators-out.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+class (:$) a b
+
+class (:&)
+        a
+        b
+
+class a :* b
+
+class a :+ -- Before operator
+        b -- After operator
+
+class ( f :.
+        g
+      )
+        a
+
+class a `Pair` b
+
+class a `Sum`
+        b
+
+class (f `Product` g) a
+
+class ( f `Sum`
+        g
+      )
+        a

data/examples/declaration/class/type-operators.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+
+class (:$) a b
+
+class (:&)
+    a
+        b
+
+class    a:*b
+
+class
+    a -- Before operator
+    :+
+    b -- After operator
+
+class (
+    f :. g
+  ) a
+
+class
+    a`Pair`b
+
+class
+          a
+    `Sum` b
+
+class (f`Product`g)a
+
+class (
+    f `Sum` g
+  ) a

src/Ormolu/Printer/Meat/Declaration.hs

@@ -52,6 +52,7 @@ p_tyClDecl = \case
       tcdCtxt
       tcdLName
       tcdTyVars
+      tcdFixity
       tcdFDs
       tcdSigs
       tcdMeths
@@ -70,6 +71,3 @@ p_derivDecl :: DerivDecl GhcPs -> R ()
 p_derivDecl = \case
   d@DerivDecl {..} -> p_standaloneDerivDecl d
   XDerivDecl _ -> notImplemented "XDerivDecl standalone deriving"
-
-----------------------------------------------------------------------------
--- Helpers

src/Ormolu/Printer/Meat/Declaration/Class.hs

@@ -30,33 +30,32 @@ p_classDecl
   :: LHsContext GhcPs
   -> Located RdrName
   -> LHsQTyVars GhcPs
+  -> LexicalFixity
   -> [Located (FunDep (Located RdrName))]
   -> [LSig GhcPs]
   -> LHsBinds GhcPs
   -> [LFamilyDecl GhcPs]
   -> [LTyFamDefltEqn GhcPs]
   -> R ()
-p_classDecl ctx name tvars fdeps csigs cdefs cats catdefs = do
+p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do
   let HsQTvs {..} = tvars
+      variableSpans = foldr (combineSrcSpans . getLoc) noSrcSpan hsq_explicit
+      signatureSpans = getLoc name `combineSrcSpans` variableSpans
+      dependencySpans = foldr (combineSrcSpans . getLoc) noSrcSpan fdeps
       combinedSpans =
         getLoc ctx `combineSrcSpans`
-        getLoc name `combineSrcSpans`
-        foldr (combineSrcSpans . getLoc) noSrcSpan hsq_explicit `combineSrcSpans`
-        foldr (combineSrcSpans . getLoc) noSrcSpan fdeps
+        signatureSpans `combineSrcSpans`
+        dependencySpans
   txt "class "
   sitcc $ do
-    switchLayout combinedSpans $ do
-      unless (null (unLoc ctx)) $ do
-        located ctx p_hsContext
-        breakpoint
-        txt "=> "
-      p_rdrName name
-      unless (null hsq_explicit) space
-      spaceSep (located' p_hsTyVarBndr) hsq_explicit
-      unless (null fdeps) $ do
-        breakpoint
-        txt "| "
-        velt (withSep comma (located' p_funDep) fdeps)
+    switchLayout combinedSpans $ p_classContext ctx
+    switchLayout signatureSpans $ do
+      p_infixDefHelper
+        (isInfix fixity)
+        inci
+        (p_rdrName name)
+        (located' p_hsTyVarBndr <$> hsq_explicit)
+    switchLayout combinedSpans $ p_classFundeps fdeps
   -- GHC's AST does not necessarily store each kind of element in source
   -- location order. This happens because different declarations are stored in
   -- different lists. Consequently, to get all the declarations in proper order,
@@ -77,6 +76,18 @@ p_classDecl ctx name tvars fdeps csigs cdefs cats catdefs = do
       inci (sequence_ decls)
     else newline
 
+p_classContext :: LHsContext GhcPs -> R ()
+p_classContext ctx = unless (null (unLoc ctx)) $ do
+  located ctx p_hsContext
+  breakpoint
+  txt "=> "
+
+p_classFundeps :: [Located (FunDep (Located RdrName))] -> R ()
+p_classFundeps fdeps = unless (null fdeps) $ do
+  breakpoint
+  txt "| "
+  velt $ withSep comma (located' p_funDep) fdeps
+
 p_famDefDecl :: TyFamDefltEqn GhcPs -> R ()
 p_famDefDecl FamEqn {..} = do
   txt "type"
@@ -92,3 +103,11 @@ p_funDep (before, after) = do
   spaceSep p_rdrName before
   txt " -> "
   spaceSep p_rdrName after
+
+----------------------------------------------------------------------------
+-- Helpers
+
+isInfix :: LexicalFixity -> Bool
+isInfix = \case
+  Infix -> True
+  Prefix -> False