Implement rendering of data type declarations

data/examples/declaration/data/deriving-strategies-out.hs

@@ -0,0 +1,8 @@
+-- | Something.
+newtype Foo = Foo Int
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass
+    ( ToJSON
+    , FromJSON
+    )
+  deriving newtype (Num)

data/examples/declaration/data/deriving-strategies.hs

@@ -0,0 +1,9 @@
+-- | Something.
+
+newtype Foo = Foo Int
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass
+    ( ToJSON
+    , FromJSON
+    )
+  deriving newtype (Num)

data/examples/declaration/data/existential-multiline-out.hs

@@ -0,0 +1,4 @@
+{-# LANGUAGE ExistentialQuantification #-}
+data Foo
+  = forall a. MkFoo a (a -> Bool)
+  | forall a. Eq a => MkBar a

data/examples/declaration/data/existential-multiline.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE ExistentialQuantification #-}
+
+data Foo
+  = forall a. MkFoo a (a -> Bool)
+  | forall a. Eq a => MkBar a

data/examples/declaration/data/existential-out.hs

@@ -0,0 +1,2 @@
+{-# LANGUAGE ExistentialQuantification #-}
+data Foo = forall a. MkFoo a (a -> Bool)

data/examples/declaration/data/existential.hs

@@ -0,0 +1,3 @@
+{-# LANGUAGE ExistentialQuantification #-}
+
+data Foo = forall a. MkFoo a (a -> Bool)

data/examples/declaration/data/fat-multiline-out.hs

@@ -0,0 +1,11 @@
+-- | Something.
+
+data Foo
+  = Foo
+      Int
+      Int
+    -- ^ Foo
+  | Bar
+      Bool
+      Bool
+    -- ^ Bar

data/examples/declaration/data/fat-multiline.hs

@@ -0,0 +1,9 @@
+-- | Something.
+
+data Foo
+  = Foo Int
+        Int
+    -- ^ Foo
+  | Bar Bool
+        Bool
+    -- ^ Bar

data/examples/declaration/data/gadt-syntax-out.hs

@@ -0,0 +1,3 @@
+{-# LANUGAGE GADTSyntax #-}
+data Foo where
+  MKFoo :: a -> (a -> Bool) -> Foo

data/examples/declaration/data/gadt-syntax.hs

@@ -0,0 +1,3 @@
+{-# LANUGAGE GADTSyntax #-}
+
+data Foo where { MKFoo :: a -> (a->Bool) -> Foo }

data/examples/declaration/data/gadt/multiline-out.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE ExplicitForAll #-}
+
+-- | Here goes a comment.
+data Foo a where
+  -- | 'Foo' is wonderful.
+  Foo
+    :: forall a b. ( Show a
+                   , Eq b
+                   ) -- foo
+    -- bar
+    => a
+    -> b
+    -> Foo 'Int
+  -- | But 'Bar' is also not too bad.
+  Bar
+    :: Int
+    -> Maybe Text
+    -> Foo 'Bool
+  -- | So is 'Baz'.
+  Baz
+    :: forall a. a
+    -> Foo 'String

data/examples/declaration/data/gadt/multiline.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE ExplicitForAll #-}
+
+-- | Here goes a comment.
+
+data Foo a where
+  -- | 'Foo' is wonderful.
+  Foo :: forall a b. (Show a, Eq b) -- foo
+    -- bar
+    => a -> b -> Foo 'Int
+  -- | But 'Bar' is also not too bad.
+  Bar
+    :: Int -> Maybe Text -> Foo 'Bool
+  -- | So is 'Baz'.
+  Baz
+    :: forall a. a -> Foo 'String

data/examples/declaration/data/gadt/record-out.hs

@@ -0,0 +1,11 @@
+-- | Something.
+data Foo where
+  Foo :: {fooX :: Int} -> Foo
+  Bar
+    :: { fooY :: Int
+       , fooBar, fooBaz :: Bool
+       , fooFoo
+         , barBar
+           :: Int
+       }
+    -> Foo

data/examples/declaration/data/gadt/record.hs

@@ -0,0 +1,9 @@
+-- | Something.
+
+data Foo where
+  Foo :: { fooX :: Int } -> Foo
+  Bar :: { fooY :: Int
+         , fooBar, fooBaz :: Bool
+         , fooFoo
+             , barBar :: Int
+         } -> Foo

data/examples/declaration/data/gadt/simple-out.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE ExplicitForAll #-}
+
+-- | Here goes a comment.
+data Foo a where
+  -- | 'Foo' is wonderful.
+  Foo :: forall a b. (Show a, Eq b) => a -> b -> Foo 'Int
+  Bar :: Int -> Text -> Foo 'Bool -- ^ But 'Bar' is also not too bad.
+  Baz :: forall a. a -> Foo 'String -- ^ So is 'Baz'.

data/examples/declaration/data/gadt/simple.hs

@@ -0,0 +1,9 @@
+{-# LANGUAGE ExplicitForAll #-}
+
+-- | Here goes a comment.
+
+data Foo a where
+  -- | 'Foo' is wonderful.
+  Foo :: forall a b. (Show a, Eq b) => a -> b -> Foo 'Int
+  Bar :: Int -> Text -> Foo 'Bool -- ^ But 'Bar' is also not too bad.
+  Baz :: forall a. a -> Foo 'String -- ^ So is 'Baz'.

data/examples/declaration/data/gadt/strictness-out.hs

@@ -0,0 +1,2 @@
+data Foo a where
+  Foo :: !Int -> {-# UNPACK #-} !Bool -> Foo Int

data/examples/declaration/data/gadt/strictness.hs

@@ -0,0 +1,2 @@
+data Foo a where
+  Foo :: !Int -> {-# UNPACK #-} !Bool -> Foo Int

data/examples/declaration/data/infix-out.hs

@@ -0,0 +1 @@
+data Foo a b = a `Foo` b

data/examples/declaration/data/infix.hs

@@ -0,0 +1 @@
+data Foo a b = a `Foo` b

data/examples/declaration/data/multiline-out.hs

@@ -0,0 +1,6 @@
+-- | Here we have 'Foo'.
+data Foo
+  = Foo -- ^ One
+  | Bar Int -- ^ Two
+  | Baz -- ^ Three
+  deriving (Eq, Show)

data/examples/declaration/data/multiline.hs

@@ -0,0 +1,7 @@
+-- | Here we have 'Foo'.
+
+data Foo
+  = Foo -- ^ One
+  | Bar Int -- ^ Two
+  | Baz -- ^ Three
+  deriving (Eq, Show)

data/examples/declaration/data/newline-out.hs

@@ -0,0 +1,3 @@
+-- | Something.
+newtype Foo = Foo Int
+  deriving (Eq, Show)

data/examples/declaration/data/newline.hs

@@ -0,0 +1,4 @@
+-- | Something.
+
+newtype Foo = Foo Int
+  deriving (Eq, Show)

data/examples/declaration/data/record-out.hs

@@ -0,0 +1,11 @@
+-- | Something.
+data Foo
+  = Foo
+      { fooX :: Int -- ^ X
+      , fooY :: Int -- ^ Y
+      , fooBar, fooBaz :: Bool -- ^ BarBaz
+      , fooFoo
+        , barBar
+          :: Int -- ^ Huh!
+      }
+  deriving (Eq, Show)

data/examples/declaration/data/record-singleline-out.hs

@@ -0,0 +1,3 @@
+-- | Something.
+data Foo = Foo {fooX :: Int, fooY :: Int}
+  deriving (Eq, Show)

data/examples/declaration/data/record-singleline.hs

@@ -0,0 +1,4 @@
+-- | Something.
+
+data Foo = Foo { fooX :: Int , fooY :: Int }
+  deriving (Eq, Show)

data/examples/declaration/data/record.hs

@@ -0,0 +1,9 @@
+-- | Something.
+
+data Foo = Foo
+  { fooX :: Int -- ^ X
+  , fooY :: Int -- ^ Y
+  , fooBar, fooBaz :: Bool -- ^ BarBaz
+  , fooFoo
+      , barBar :: Int -- ^ Huh!
+  } deriving (Eq, Show)

data/examples/declaration/data/simple-out.hs

@@ -0,0 +1,3 @@
+-- | And here we have 'Foo'.
+data Foo = Foo | Bar Int | Baz
+  deriving (Eq, Show)

data/examples/declaration/data/simple.hs

@@ -0,0 +1,4 @@
+-- | And here we have 'Foo'.
+
+data Foo = Foo | Bar Int | Baz
+  deriving (Eq, Show)

data/examples/declaration/data/strictness-out.hs

@@ -0,0 +1,2 @@
+-- | Something.
+data Foo = Foo !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String

data/examples/declaration/data/strictness.hs

@@ -0,0 +1,3 @@
+-- | Something.
+
+data Foo = Foo !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String

ormolu.cabal

@@ -50,6 +50,7 @@ library
                     , Ormolu.Printer.Internal
                     , Ormolu.Printer.Meat.Common
                     , Ormolu.Printer.Meat.Declaration
+                    , Ormolu.Printer.Meat.Declaration.Data
                     , Ormolu.Printer.Meat.Declaration.Type
                     , Ormolu.Printer.Meat.Declaration.TypeFamily
                     , Ormolu.Printer.Meat.ImportExport

src/Ormolu/Printer/Combinators.hs

@@ -14,17 +14,21 @@ module Ormolu.Printer.Combinators
   , atom
   , newline
   , inci
+  , relaxComments
   , located
   , locatedVia
   , located'
+  , switchLayout
   , velt
   , velt'
   , vlayout
+  , breakpoint
   , withSep
   , spaceSep
   , newlineSep
     -- ** Wrapping
   , line
+  , backticks
   , braces
   , brackets
   , bracketsPar
@@ -32,14 +36,11 @@ module Ormolu.Printer.Combinators
   , parensHash
     -- ** Literals
   , comma
-  , ofType
-  , larrow
-  , rarrow
-  , darrow
   , space
   )
 where
 
+import Data.Bool (bool)
 import Data.Data (Data)
 import Data.List (intersperse)
 import Data.Text (Text)
@@ -86,47 +87,41 @@ locatedVia
   -> R ()
 locatedVia ml loc@(L l a) f = do
   mann <- lookupAnn loc
-  layout <- currentLayout
-  let m = enterLayout
-        (case ml of
-           Nothing -> layout
-           Just l' ->
-             if isOneLineSpan l'
-               then SingleLine
-               else MultiLine)
-        (f a)
+  relaxed <- relaxedComments
+  let m = case ml of
+       Nothing -> f a
+       Just l' -> switchLayout l' (f a)
   case mann of
     Nothing -> m
-    Just Ann {..} ->
-      sitcc $ do
-        -- There are three things in 'Ann' which contain comments:
+    Just Ann {..} -> bool sitcc id relaxed $ do
+      -- There are three things in 'Ann' which contain comments:
 
-        let cmode =
-              if annGetConstr a == CN "HsModule"
-                then Module
-                else Other
-            (before, after) = partitionDPs cmode l annsDP
+      let cmode =
+            if annGetConstr a == CN "HsModule"
+              then Module
+              else Other
+          (before, after) = partitionDPs cmode l annsDP
 
-        -- 'annPriorComments' contains comments that were directly placed
-        -- before entities such as comments (in both styles) before function
-        -- definitions and inline comments before smaller things like types
-        -- and literals.
+      -- 'annPriorComments' contains comments that were directly placed
+      -- before entities such as comments (in both styles) before function
+      -- definitions and inline comments before smaller things like types
+      -- and literals.
 
-        spitComments (addDecoration cmode Before l <$> annPriorComments)
+      spitComments (addDecoration cmode Before l <$> annPriorComments)
 
-        -- Comments inside 'annsDP' marked with 'AnnComment' are trickier,
-        -- they seem to contain everything that goes after the thing they
-        -- are attached to and in some cases (e.g. for modules) they contain
-        -- comments that go before things. Exact location can only be
-        -- deduced by analyzing the associated span.
+      -- Comments inside 'annsDP' marked with 'AnnComment' are trickier,
+      -- they seem to contain everything that goes after the thing they
+      -- are attached to and in some cases (e.g. for modules) they contain
+      -- comments that go before things. Exact location can only be
+      -- deduced by analyzing the associated span.
 
-        spitComments before
-        m
-        spitComments after
+      spitComments before
+      m
+      spitComments after
 
-        -- I wasn't able to find any case when 'annFollowingComments' is
-        -- populated, so we'll ignore that one for now and fix it when we
-        -- have an example of source code where it matters.
+      -- I wasn't able to find any case when 'annFollowingComments' is
+      -- populated, so we'll ignore that one for now and fix it when we
+      -- have an example of source code where it matters.
 
 -- | A version of 'located' with arguments flipped.
 
@@ -137,6 +132,20 @@ located'
   -> R ()
 located' = flip located
 
+-- | Set layout according to given 'SrcSpan' for a given computation. Use
+-- this only when you need to set layout based on e.g. combined span of
+-- several elements when there is no corresponding 'Located' wrapper
+-- provided by GHC AST.
+
+switchLayout
+  :: SrcSpan                    -- ^ Span that controls layout
+  -> R ()                       -- ^ Computation to run with changed layout
+  -> R ()
+switchLayout spn = enterLayout
+  (if isOneLineSpan spn
+    then SingleLine
+    else MultiLine)
+
 -- | Element of variable layout. This means that the sub-components may be
 -- rendered either on single line or each on its own line depending on
 -- current layout.
@@ -159,6 +168,12 @@ velt' xs = sitcc $ sequence_ (intersperse sep (sitcc <$> xs))
   where
     sep = vlayout (spit " ") newline
 
+-- | Insert a space if enclosing layout is single-line, or newline if it's
+-- multiline.
+
+breakpoint :: R ()
+breakpoint = vlayout space newline
+
 -- | Put separator between renderings of items of a list.
 
 withSep
@@ -198,6 +213,11 @@ line m = do
   m
   newline
 
+-- | Surround given entity by backticks.
+
+backticks :: R () -> R ()
+backticks m = txt "`" >> m >> txt "`"
+
 -- | Surround given entity by curly braces.
 
 braces :: R () -> R ()
@@ -252,26 +272,6 @@ ospaces m = vlayout m (txt " " >> m >> newline)
 comma :: R ()
 comma = txt ", "
 
--- | Print @::@ followed by a space.
-
-ofType :: R ()
-ofType = txt ":: "
-
--- | Print @<-@ followed by a space.
-
-larrow :: R ()
-larrow = txt "<- "
-
--- | Print @->@ followed by a space.
-
-rarrow :: R ()
-rarrow = txt "-> "
-
--- | Print @=>@ followed by a space.
-
-darrow :: R ()
-darrow = txt "=> "
-
 -- | Print single space.
 
 space :: R ()

src/Ormolu/Printer/Internal.hs

@@ -16,10 +16,11 @@ module Ormolu.Printer.Internal
   , ensureIndent
   , inci
   , sitcc
+  , relaxComments
   , Layout (..)
   , enterLayout
   , vlayout
-  , currentLayout
+  , relaxedComments
   , lookupAnn
   )
 where
@@ -53,6 +54,8 @@ data RC = RC
     -- newline if we break lines
   , rcLayout :: Layout
     -- ^ Current layout
+  , rcRelaxedComments :: Bool
+    -- ^ Whether to relax aligning rules for comments
   , rcAnns :: Anns
     -- ^ The collection of annotations obtained after parsing
   , rcDebug :: Bool
@@ -88,6 +91,7 @@ runR debug (R m) anns =
     rc = RC
       { rcIndent = 0
       , rcLayout = MultiLine
+      , rcRelaxedComments = False
       , rcAnns = anns
       , rcDebug = debug
       }
@@ -168,6 +172,19 @@ sitcc m' = do
   vlayout m' (R (local modRC m))
   traceR "sitcc_ended" Nothing
 
+-- | Relax alignment rules for comments inside this block. This is usually
+-- done to avoid bumping indentation level too aggressively. Important for
+-- beautiful rendering of e.g. type signatures.
+
+relaxComments :: R () -> R ()
+relaxComments (R m) = do
+  traceR "relax_start" Nothing
+  let modRC x = x
+        { rcRelaxedComments = True
+        }
+  R (local modRC m)
+  traceR "relax_end" Nothing
+
 -- | Set 'Layout' for internal computation.
 
 enterLayout :: Layout -> R () -> R ()
@@ -200,6 +217,11 @@ vlayout sline mline = do
 currentLayout :: R Layout
 currentLayout = R (asks rcLayout)
 
+-- | Check whether we're in a region with relaxed comments placement.
+
+relaxedComments :: R Bool
+relaxedComments = R (asks rcRelaxedComments)
+
 -- | Lookup an annotation.
 
 lookupAnn :: Data a => Located a -> R (Maybe Annotation)

src/Ormolu/Printer/Meat/Common.hs

@@ -10,17 +10,23 @@ module Ormolu.Printer.Meat.Common
   , p_rdrName'
   , p_qualName
   , p_ieWildcard
+    -- * Helpers
   , opParens
+  , combineSrcSpans'
+  , getSpan
+  , unL
   )
 where
 
 import Data.Char (isAlphaNum)
+import Data.List.NonEmpty (NonEmpty (..))
 import GHC hiding (GhcPs, IE)
 import Module (Module (..))
 import OccName (OccName (..))
 import Ormolu.Printer.Combinators
 import Outputable (Outputable (..), showSDocUnsafe)
 import RdrName (RdrName (..), rdrNameOcc)
+import SrcLoc (combineSrcSpans)
 
 p_hsmodName :: ModuleName -> R ()
 p_hsmodName mname = do
@@ -69,3 +75,18 @@ opParens x m =
   if all (not . isAlphaNum) (showSDocUnsafe (ppr x))
     then txt "(" >> m >> txt ")"
     else m
+
+-- | Combine all source spans from the given list.
+
+combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan
+combineSrcSpans' (x:|xs) = foldr combineSrcSpans x xs
+
+-- | Get source span from a 'Located' thing.
+
+getSpan :: Located e -> SrcSpan
+getSpan (L spn _) = spn
+
+-- | Exact inner value from 'Located'.
+
+unL :: Located e -> e
+unL (L _ e) = e

src/Ormolu/Printer/Meat/Declaration.hs

@@ -11,6 +11,7 @@ where
 import HsDecls
 import Language.Haskell.GHC.ExactPrint.Types
 import Ormolu.Printer.Combinators
+import Ormolu.Printer.Meat.Declaration.Data
 import Ormolu.Printer.Meat.Declaration.Type
 import Ormolu.Printer.Meat.Declaration.TypeFamily
 
@@ -23,4 +24,5 @@ p_tyClDecl :: TyClDecl GhcPs -> R ()
 p_tyClDecl = \case
   FamDecl x -> p_famDecl x
   SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs
+  DataDecl {..} -> p_dataDecl tcdLName tcdTyVars tcdDataDefn
   _ -> error "this is not yet supported"

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

@@ -0,0 +1,122 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+module Ormolu.Printer.Meat.Declaration.Data
+  ( p_dataDecl
+  )
+where
+
+import BasicTypes (DerivStrategy (..))
+import Control.Monad
+import Data.List.NonEmpty (nonEmpty)
+import Data.Maybe (isJust)
+import GHC hiding (GhcPs, IE)
+import Language.Haskell.GHC.ExactPrint.Types
+import Ormolu.Printer.Combinators
+import Ormolu.Printer.Meat.Common
+import Ormolu.Printer.Meat.Type
+import RdrName (RdrName (..))
+import SrcLoc (Located)
+
+p_dataDecl
+  :: Located RdrName            -- ^ Type constructor
+  -> LHsQTyVars GhcPs           -- ^ Type variables
+  -> HsDataDefn GhcPs           -- ^ Data definition
+  -> R ()
+p_dataDecl name tvars HsDataDefn {..} = do
+  let HsQTvs {..} = tvars
+  txt $ case dd_ND of
+    NewType -> "newtype "
+    DataType -> "data "
+  located name p_rdrName'
+  unless (null hsq_explicit) space
+  spaceSep (located' p_hsTyVarBndr) hsq_explicit
+  case dd_kindSig of
+    Nothing -> return ()
+    Just k -> do
+      space
+      txt ":: "
+      relaxComments (located k p_hsType)
+  let gadt = isJust dd_kindSig || any (isGadt . unL) dd_cons
+  case nonEmpty dd_cons of
+    Nothing -> pure ()
+    Just dd_cons_ne ->
+      if gadt
+        then do
+          txt " where"
+          newline
+          inci $ newlineSep (located' p_conDecl) dd_cons
+        else switchLayout (combineSrcSpans' (getSpan <$> dd_cons_ne)) $ do
+          breakpoint
+          inci $ do
+            txt "= "
+            let sep = vlayout (txt " | ") (txt "| ")
+            velt $ withSep sep (located' p_conDecl) dd_cons
+  newline
+  inci . located dd_derivs $ \xs ->
+    forM_ xs (line . located' p_hsDerivingClause)
+
+p_conDecl :: ConDecl GhcPs -> R ()
+p_conDecl = \case
+  ConDeclGADT {..} -> velt'
+    [ spaceSep (located' p_rdrName') con_names
+    , inci $ do
+        txt ":: "
+        relaxComments (locatedVia Nothing (hsib_body con_type) p_hsType)
+    ]
+  ConDeclH98 {..} -> do
+    case hsq_explicit <$> con_qvars of
+      Nothing -> return ()
+      Just bndrs -> do
+        txt "forall "
+        spaceSep (located' p_hsTyVarBndr) bndrs
+        txt "."
+        breakpoint
+    case con_cxt of
+      Nothing -> return ()
+      Just ctx -> located ctx $ \case
+        [] -> pure ()
+        xs -> do
+          p_hsContext xs
+          breakpoint
+          txt "=> "
+    case con_details of
+      PrefixCon xs -> do
+        located con_name p_rdrName'
+        unless (null xs) breakpoint
+        inci $ velt' (located' p_hsType <$> xs)
+      RecCon l -> do
+        located con_name p_rdrName'
+        breakpoint
+        inci $ located l p_conDeclFields
+      InfixCon x y -> velt'
+        [ located x p_hsType
+        , inci $ velt'
+          [ backticks (located con_name p_rdrName')
+          , inci $ located y p_hsType
+          ]
+        ]
+
+isGadt :: ConDecl GhcPs -> Bool
+isGadt = \case
+  ConDeclGADT {} -> True
+  ConDeclH98 {} -> False
+
+p_hsDerivingClause
+  :: HsDerivingClause GhcPs
+  -> R ()
+p_hsDerivingClause HsDerivingClause {..} = do
+  txt "deriving"
+  case deriv_clause_strategy of
+    Nothing -> return ()
+    Just l -> do
+      space
+      located l $ \case
+        StockStrategy -> txt "stock"
+        AnyclassStrategy -> txt "anyclass"
+        NewtypeStrategy -> txt "newtype"
+  breakpoint
+  inci . located deriv_clause_tys $ \case
+    [] -> txt "()"
+    xs -> parens . velt $ withSep comma (located' p_hsType . hsib_body) xs

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

@@ -28,5 +28,5 @@ p_synDecl name tvars t = line $ do
   let HsQTvs {..} = tvars
   unless (null hsq_explicit) space
   spaceSep (located' p_hsTyVarBndr) hsq_explicit
-  vlayout space newline
-  inci (txt "= " >> located t p_hsType)
+  breakpoint
+  inci (txt "= " >> relaxComments (located t p_hsType))

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

@@ -33,7 +33,7 @@ p_famDecl FamilyDecl {..} = do
           ++ (located' p_injectivityAnn <$> maybeToList fdInjectivityAnn)
   spaceSep (located' p_hsTyVarBndr) hsq_explicit
   unless (null items) $
-    vlayout space newline
+    breakpoint
   inci . inci $ spaceSep id items
   case mmeqs of
     Nothing -> newline
@@ -51,18 +51,18 @@ p_familyResultSigL injAnn l =
     L _ a -> case a of
       NoSig -> Nothing
       KindSig k -> Just $ do
-        if injAnn then txt "= " else ofType
-        located k p_hsType
+        if injAnn then txt "= " else txt ":: "
+        relaxComments (located k p_hsType)
       TyVarSig bndr -> Just $ do
-        if injAnn then txt "= " else ofType
-        located bndr p_hsTyVarBndr
+        if injAnn then txt "= " else txt ":: "
+        relaxComments (located bndr p_hsTyVarBndr)
 
 p_injectivityAnn :: InjectivityAnn GhcPs -> R ()
 p_injectivityAnn (InjectivityAnn a bs) = do
   txt "| "
   located a p_rdrName
   space
-  rarrow
+  txt "-> "
   spaceSep (located' p_rdrName) bs
 
 p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

src/Ormolu/Printer/Meat/ImportExport.hs

@@ -22,36 +22,36 @@ p_hsmodExports xs = do
   parens . velt $ withSep comma (located' p_lie) xs
 
 p_hsmodImport :: ImportDecl GhcPs -> R ()
-p_hsmodImport ImportDecl {..} = line . velt' $
-  [ do txt "import "
-       when ideclSource $
-         txt "{-# SOURCE #-} "
-       when ideclSafe $
-         txt "safe "
-       when ideclQualified $
-         txt "qualified "
-       case ideclPkgQual of
-         Nothing -> return ()
-         Just slit -> do
-           atom slit
-           space
-       located ideclName atom
-       case ideclAs of
-         Nothing -> return ()
-         Just l -> do
-           txt " as "
-           located l atom
-       case ideclHiding of
-         Nothing -> return ()
-         Just (hiding, _) ->
-           when hiding $
-             txt " hiding"
-  ] ++ (case ideclHiding of
-          Nothing -> []
-          Just (_, l) ->
-            [ inci . locatedVia Nothing l $
-                parens . velt . withSep comma (located' p_lie)
-            ])
+p_hsmodImport ImportDecl {..} = line $ do
+  txt "import "
+  when ideclSource $
+    txt "{-# SOURCE #-} "
+  when ideclSafe $
+    txt "safe "
+  when ideclQualified $
+    txt "qualified "
+  case ideclPkgQual of
+    Nothing -> return ()
+    Just slit -> do
+      atom slit
+      space
+  located ideclName atom
+  case ideclAs of
+    Nothing -> return ()
+    Just l -> do
+      txt " as "
+      located l atom
+  case ideclHiding of
+    Nothing -> return ()
+    Just (hiding, _) ->
+      when hiding $
+        txt " hiding"
+  case ideclHiding of
+    Nothing -> return ()
+    Just (_, l) -> do
+      breakpoint
+      inci . locatedVia Nothing l $
+        parens . velt . withSep comma (located' p_lie)
 
 p_lie :: IE GhcPs -> R ()
 p_lie = \case

src/Ormolu/Printer/Meat/Module.hs

@@ -29,16 +29,15 @@ p_hsModule loc@(L moduleSpan hsModule) = do
   locatedVia (Just spn) loc $ \HsModule {..} -> do
     case hsmodName of
       Nothing -> pure ()
-      Just hsmodName' -> do
-        line . velt' $
-          [ located hsmodName' p_hsmodName ] ++
-          (case hsmodExports of
-             Nothing -> []
-             Just hsmodExports' ->
-               [ inci (locatedVia Nothing hsmodExports' p_hsmodExports)
-               ])
-          ++ [ txt "where"
-             ]
+      Just hsmodName' -> line $ do
+        located hsmodName' p_hsmodName
+        case hsmodExports of
+          Nothing -> return ()
+          Just hsmodExports' -> do
+            breakpoint
+            inci (locatedVia Nothing hsmodExports' p_hsmodExports)
+        breakpoint
+        txt "where"
         unless (null hsmodImports) newline
     forM_ (sortImports hsmodImports) (located' p_hsmodImport)
     when (not (null hsmodImports) && not (null hsmodDecls)) newline

src/Ormolu/Printer/Meat/Type.hs

@@ -1,11 +1,14 @@
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
 
 -- | Rendering of types.
 
 module Ormolu.Printer.Meat.Type
   ( p_hsType
+  , p_hsContext
   , p_hsTyVarBndr
+  , p_conDeclFields
   )
 where
 
@@ -16,25 +19,22 @@ import Ormolu.Printer.Meat.Common
 
 p_hsType :: HsType GhcPs -> R ()
 p_hsType = \case
-  HsForAllTy bndrs t -> velt'
-    [ do txt "forall"
-         velt' (located' p_hsTyVarBndr <$> bndrs)
-         txt "."
-    , located t p_hsType
-    ]
-  HsQualTy qs t -> velt'
-    [ locatedVia Nothing qs $ \case
-        [] -> txt "()"
-        [x] -> located x p_hsType
-        xs -> parens . velt $ withSep comma (located' p_hsType) xs
-    , inci $ darrow >> located t p_hsType
-    ]
+  HsForAllTy bndrs t -> do
+    txt "forall "
+    spaceSep (located' p_hsTyVarBndr) bndrs
+    txt ". "
+    locatedVia Nothing t p_hsType
+  HsQualTy qs t -> do
+    locatedVia Nothing qs p_hsContext
+    breakpoint
+    txt "=> "
+    locatedVia Nothing t p_hsType
   HsTyVar p n -> do
     case p of
       Promoted -> txt "'"
       NotPromoted -> return ()
     located n p_rdrName
-  HsAppsTy apps -> do
+  HsAppsTy apps ->
     velt' $ case apps of
       [] -> []
       (x:xs) -> located' p_hsAppType x : (located' (inci . p_hsAppType) <$> xs)
@@ -42,10 +42,14 @@ p_hsType = \case
     [ located f p_hsType
     , inci $ located x p_hsType
     ]
-  HsFunTy f x -> velt'
-    [ located f p_hsType
-    , inci $ rarrow >> located x p_hsType
-    ]
+  HsFunTy f x@(L _ x') -> do
+    located f p_hsType
+    breakpoint
+    txt "-> "
+    let located_ = case x' of
+          HsFunTy{} -> locatedVia Nothing
+          _ -> located
+    located_ x p_hsType
   HsListTy t -> located t (brackets . p_hsType)
   HsPArrTy t -> located t (bracketsPar . p_hsType)
   HsTupleTy tsort xs ->
@@ -66,7 +70,7 @@ p_hsType = \case
     parens (located t p_hsType)
   HsIParamTy n t -> velt'
     [ located n atom
-    , inci $ ofType >> located t p_hsType
+    , inci $ txt ":: " >> located t p_hsType
     ]
   HsEqTy x y -> velt'
     [ located x p_hsType
@@ -74,7 +78,7 @@ p_hsType = \case
     ]
   HsKindSig t k -> velt'
     [ located t p_hsType
-    , inci $ ofType >> located k p_hsType
+    , inci $ txt ":: " >> located k p_hsType
     ]
   HsSpliceTy _ _ -> error "HsSpliceTy"
   HsDocTy _ _ -> error "HsDocTy"
@@ -88,7 +92,8 @@ p_hsType = \case
       SrcStrict -> txt "!"
       NoSrcStrict -> return ()
     located t p_hsType
-  HsRecTy _ -> error "HsRecTy"
+  HsRecTy fields ->
+    p_conDeclFields fields
   HsCoreTy t -> atom t
   HsExplicitListTy p _ xs -> do
     case p of -- XXX not sure about this one
@@ -101,13 +106,19 @@ p_hsType = \case
   HsTyLit t -> atom t
   HsWildCardTy (AnonWildCard PlaceHolder) -> txt "_"
 
+p_hsContext :: HsContext GhcPs -> R ()
+p_hsContext = \case
+  [] -> txt "()"
+  [x] -> located x p_hsType
+  xs -> parens . velt $ withSep comma (located' p_hsType) xs
+
 p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
 p_hsTyVarBndr = \case
   UserTyVar l ->
     located l p_rdrName
   KindedTyVar l k -> parens $ velt'
     [ located l atom
-    , inci $ ofType >> located k p_hsType
+    , inci $ txt ":: " >> located k p_hsType
     ]
 
 p_hsAppType :: HsAppType GhcPs -> R ()
@@ -116,3 +127,18 @@ p_hsAppType = \case
     located l p_rdrName'
   HsAppPrefix l ->
     located l p_hsType
+
+p_conDeclFields :: [LConDeclField GhcPs] -> R ()
+p_conDeclFields =
+  braces . velt . withSep comma (located' p_conDeclField)
+
+p_conDeclField :: ConDeclField GhcPs -> R ()
+p_conDeclField ConDeclField {..} = velt'
+  [ velt $ withSep
+      comma
+      (located' (located' p_rdrName . rdrNameFieldOcc))
+      cd_fld_names
+  , inci $ do
+      txt ":: "
+      relaxComments (locatedVia Nothing cd_fld_type p_hsType)
+  ]

tests/Ormolu/Printer/CombinatorsSpec.hs

@@ -66,12 +66,12 @@ rFn :: R ()
 rFn = velt'
   [ txt "foo"
   , inci $ velt'
-    [ do ofType
+    [ do txt ":: "
          parens $ velt'
            [ txt "Int"
-           , rarrow >> txt "Int"
+           , txt "-> " >> txt "Int"
            ]
-    , rarrow >> txt "Bool"
+    , txt "-> " >> txt "Bool"
     ]
   ]