Format records with a single data constructor more compactly

CHANGELOG.md

@@ -24,6 +24,9 @@
   cause the data constructor be unconditionally rendered in multiline layout
   [Issue 427](https://github.com/tweag/ormolu/issues/427).
 
+* Records with a single data constructor are now formatted more compactly.
+  [Issue 425](https://github.com/tweag/ormolu/issues/425).
+
 * Implemented support for the new language extension `ImportQualifiedPost`.
 
 * Implemented support for the new language extension

app/Main.hs

@@ -81,15 +81,14 @@ formatOne mode config = \case
 ----------------------------------------------------------------------------
 -- Command line options parsing.
 
-data Opts
-  = Opts
-      { -- | Mode of operation
-        optMode :: !Mode,
-        -- | Ormolu 'Config'
-        optConfig :: !Config,
-        -- | Haskell source files to format or stdin (when the list is empty)
-        optInputFiles :: ![FilePath]
-      }
+data Opts = Opts
+  { -- | Mode of operation
+    optMode :: !Mode,
+    -- | Ormolu 'Config'
+    optConfig :: !Config,
+    -- | Haskell source files to format or stdin (when the list is empty)
+    optInputFiles :: ![FilePath]
+  }
 
 -- | Mode of operation.
 data Mode

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

@@ -1,13 +1,12 @@
 module Main where
 
 -- | Foo.
-data Foo
-  = Foo
-      { -- | Something
-        foo :: Foo Int Int,
-        -- | Something else
-        bar ::
-          Bar
-            Char
-            Char
-      }
+data Foo = Foo
+  { -- | Something
+    foo :: Foo Int Int,
+    -- | Something else
+    bar ::
+      Bar
+        Char
+        Char
+  }

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

@@ -0,0 +1,17 @@
+module Main where
+
+-- | Something.
+data Foo
+  = Foo
+      { -- | X
+        fooX :: Int,
+        -- | Y
+        fooY :: Int
+      }
+  | Bar
+      { -- | X
+        barX :: Int,
+        -- | Y
+        barY :: Int
+      }
+  deriving (Eq, Show)

data/examples/declaration/data/record-multi-const.hs

@@ -0,0 +1,13 @@
+module Main where
+
+-- | Something.
+
+data Foo = Foo
+  { fooX :: Int -- ^ X
+  , fooY :: Int -- ^ Y
+  } |
+  Bar
+  { barX :: Int -- ^ X
+  , barY :: Int -- ^ Y
+  }
+  deriving (Eq, Show)

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

@@ -1,24 +1,23 @@
 module Main where
 
 -- | Something.
-data Foo
-  = Foo
-      { -- | X
-        fooX :: Int,
-        -- | Y
-        fooY :: Int,
-        -- | BarBaz
-        fooBar, fooBaz :: NonEmpty (Identity Bool),
-        -- | GagGog
-        fooGag,
-        fooGog ::
-          NonEmpty
-            ( Indentity
-                Bool
-            ),
-        -- | Huh!
-        fooFoo,
-        barBar ::
-          Int
-      }
+data Foo = Foo
+  { -- | X
+    fooX :: Int,
+    -- | Y
+    fooY :: Int,
+    -- | BarBaz
+    fooBar, fooBaz :: NonEmpty (Identity Bool),
+    -- | GagGog
+    fooGag,
+    fooGog ::
+      NonEmpty
+        ( Indentity
+            Bool
+        ),
+    -- | Huh!
+    fooFoo,
+    barBar ::
+      Int
+  }
   deriving (Eq, Show)

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

@@ -1,8 +1,7 @@
 module Main where
 
 -- | Here we go.
-data Foo
-  = Foo {unFoo :: Int}
+data Foo = Foo {unFoo :: Int}
   deriving (Eq)
 
 -- | And once again.

data/examples/declaration/instance/data-family-instances-newtype-out.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE GADTSyntax #-}
 {-# LANGUAGE TypeFamilies #-}
 
-newtype instance Foo [Double]
-  = DoubleListFoo
-      { unDoubleListFoo :: Double
-      }
+newtype instance Foo [Double] = DoubleListFoo
+  { unDoubleListFoo :: Double
+  }

src/Ormolu/Config.hs

@@ -10,21 +10,20 @@ where
 import qualified SrcLoc as GHC
 
 -- | Ormolu configuration.
-data Config
-  = Config
-      { -- | Dynamic options to pass to GHC parser
-        cfgDynOptions :: ![DynOption],
-        -- | Do formatting faster but without automatic detection of defects
-        cfgUnsafe :: !Bool,
-        -- | Output information useful for debugging
-        cfgDebug :: !Bool,
-        -- | Do not fail if CPP pragma is present (still doesn't handle CPP but
-        -- useful for formatting of files that enable the extension without
-        -- actually containing CPP macros)
-        cfgTolerateCpp :: !Bool,
-        -- | Checks if re-formatting the result is idempotent.
-        cfgCheckIdempotency :: !Bool
-      }
+data Config = Config
+  { -- | Dynamic options to pass to GHC parser
+    cfgDynOptions :: ![DynOption],
+    -- | Do formatting faster but without automatic detection of defects
+    cfgUnsafe :: !Bool,
+    -- | Output information useful for debugging
+    cfgDebug :: !Bool,
+    -- | Do not fail if CPP pragma is present (still doesn't handle CPP but
+    -- useful for formatting of files that enable the extension without
+    -- actually containing CPP macros)
+    cfgTolerateCpp :: !Bool,
+    -- | Checks if re-formatting the result is idempotent.
+    cfgCheckIdempotency :: !Bool
+  }
   deriving (Eq, Show)
 
 -- | Default 'Config'.
@@ -39,10 +38,9 @@ defaultConfig =
     }
 
 -- | A wrapper for dynamic options.
-newtype DynOption
-  = DynOption
-      { unDynOption :: String
-      }
+newtype DynOption = DynOption
+  { unDynOption :: String
+  }
   deriving (Eq, Ord, Show)
 
 -- | Convert 'DynOption' to @'GHC.Located' 'String'@.

src/Ormolu/Parser/Result.hs

@@ -13,23 +13,22 @@ import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Pragma (Pragma)
 
 -- | A collection of data that represents a parsed module in Ormolu.
-data ParseResult
-  = ParseResult
-      { -- | 'ParsedSource' from GHC
-        prParsedSource :: ParsedSource,
-        -- | Ormolu-specfic representation of annotations
-        prAnns :: Anns,
-        -- | Comment stream
-        prCommentStream :: CommentStream,
-        -- | Extensions enabled in that module
-        prExtensions :: [Pragma],
-        -- | Shebangs found in the input
-        prShebangs :: [Located String],
-        -- | Whether or not record dot syntax is enabled
-        prUseRecordDot :: Bool,
-        -- | Whether or not ImportQualifiedPost is enabled
-        prImportQualifiedPost :: Bool
-      }
+data ParseResult = ParseResult
+  { -- | 'ParsedSource' from GHC
+    prParsedSource :: ParsedSource,
+    -- | Ormolu-specfic representation of annotations
+    prAnns :: Anns,
+    -- | Comment stream
+    prCommentStream :: CommentStream,
+    -- | Extensions enabled in that module
+    prExtensions :: [Pragma],
+    -- | Shebangs found in the input
+    prShebangs :: [Located String],
+    -- | Whether or not record dot syntax is enabled
+    prUseRecordDot :: Bool,
+    -- | Whether or not ImportQualifiedPost is enabled
+    prImportQualifiedPost :: Bool
+  }
 
 -- | Pretty-print a 'ParseResult'.
 prettyPrintParseResult :: ParseResult -> String

src/Ormolu/Printer/Internal.hs

@@ -73,45 +73,43 @@ newtype R a = R (ReaderT RC (State SC) a)
 
 -- | Reader context of 'R'. This should be used when we control rendering by
 -- enclosing certain expressions with wrappers.
-data RC
-  = RC
-      { -- | Indentation level, as the column index we need to start from after
-        -- a newline if we break lines
-        rcIndent :: !Int,
-        -- | Current layout
-        rcLayout :: Layout,
-        -- | Spans of enclosing elements of AST
-        rcEnclosingSpans :: [RealSrcSpan],
-        -- | Collection of annotations
-        rcAnns :: Anns,
-        -- | Whether the last expression in the layout can use braces
-        rcCanUseBraces :: Bool,
-        -- | Whether the source could have used the record dot preprocessor
-        rcUseRecDot :: Bool
-      }
+data RC = RC
+  { -- | Indentation level, as the column index we need to start from after
+    -- a newline if we break lines
+    rcIndent :: !Int,
+    -- | Current layout
+    rcLayout :: Layout,
+    -- | Spans of enclosing elements of AST
+    rcEnclosingSpans :: [RealSrcSpan],
+    -- | Collection of annotations
+    rcAnns :: Anns,
+    -- | Whether the last expression in the layout can use braces
+    rcCanUseBraces :: Bool,
+    -- | Whether the source could have used the record dot preprocessor
+    rcUseRecDot :: Bool
+  }
 
 -- | State context of 'R'.
-data SC
-  = SC
-      { -- | Index of the next column to render
-        scColumn :: !Int,
-        -- | Rendered source code so far
-        scBuilder :: Builder,
-        -- | Span stream
-        scSpanStream :: SpanStream,
-        -- | Comment stream
-        scCommentStream :: CommentStream,
-        -- | Pending comment lines (in reverse order) to be inserted before next
-        -- newline, 'Int' is the indentation level
-        scPendingComments :: ![(CommentPosition, Int, Text)],
-        -- | Whether the current line is “dirty”, that is, already contains
-        -- atoms that can have comments attached to them
-        scDirtyLine :: !Bool,
-        -- | Whether to output a space before the next output
-        scRequestedDelimiter :: !RequestedDelimiter,
-        -- | Span of last output comment
-        scLastCommentSpan :: !(Maybe (Maybe HaddockStyle, RealSrcSpan))
-      }
+data SC = SC
+  { -- | Index of the next column to render
+    scColumn :: !Int,
+    -- | Rendered source code so far
+    scBuilder :: Builder,
+    -- | Span stream
+    scSpanStream :: SpanStream,
+    -- | Comment stream
+    scCommentStream :: CommentStream,
+    -- | Pending comment lines (in reverse order) to be inserted before next
+    -- newline, 'Int' is the indentation level
+    scPendingComments :: ![(CommentPosition, Int, Text)],
+    -- | Whether the current line is “dirty”, that is, already contains
+    -- atoms that can have comments attached to them
+    scDirtyLine :: !Bool,
+    -- | Whether to output a space before the next output
+    scRequestedDelimiter :: !RequestedDelimiter,
+    -- | Span of last output comment
+    scLastCommentSpan :: !(Maybe (Maybe HaddockStyle, RealSrcSpan))
+  }
 
 -- | Make sure next output is delimited by one of the following.
 data RequestedDelimiter

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

@@ -59,25 +59,35 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do
           breakpoint
           txt "where"
         breakpoint
-        sepSemi (located' p_conDecl) dd_cons
+        sepSemi (located' (p_conDecl False)) dd_cons
       else switchLayout (getLoc name : (getLoc <$> dd_cons))
         $ inci
         $ do
-          breakpoint
+          let singleConstRec = isSingleConstRec dd_cons
+          if singleConstRec
+            then space
+            else breakpoint
           txt "="
           space
           let s =
                 vlayout
                   (space >> txt "|" >> space)
                   (newline >> txt "|" >> space)
-          sep s (sitcc . located' p_conDecl) dd_cons
+              sitcc' =
+                if singleConstRec
+                  then id
+                  else sitcc
+          sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons
   unless (null $ unLoc dd_derivs) breakpoint
   inci . located dd_derivs $ \xs ->
     sep newline (located' p_hsDerivingClause) xs
 p_dataDecl _ _ _ _ (XHsDataDefn x) = noExtCon x
 
-p_conDecl :: ConDecl GhcPs -> R ()
-p_conDecl = \case
+p_conDecl ::
+  Bool ->
+  ConDecl GhcPs ->
+  R ()
+p_conDecl singleConstRec = \case
   ConDeclGADT {..} -> do
     mapM_ (p_hsDocString Pipe True) con_doc
     let conDeclSpn =
@@ -144,7 +154,11 @@ p_conDecl = \case
         RecCon l -> do
           p_rdrName con_name
           breakpoint
-          inci $ located l p_conDeclFields
+          let inci' =
+                if singleConstRec
+                  then id
+                  else inci
+          inci' (located l p_conDeclFields)
         InfixCon x y -> do
           located x p_hsType
           breakpoint
@@ -235,3 +249,10 @@ isInfix :: LexicalFixity -> Bool
 isInfix = \case
   Infix -> True
   Prefix -> False
+
+isSingleConstRec :: [LConDecl GhcPs] -> Bool
+isSingleConstRec [(L _ ConDeclH98 {..})] =
+  case con_args of
+    RecCon _ -> True
+    _ -> False
+isSingleConstRec _ = False