Improve data decl layouting

- Fix bug in BackendUtil/lowest level of brittany about
  alignment being ignored after a comment,
- Properly layout large (more than single-line) types in
  record fields and in data decl rhs arguments,
- Properly layout data decl constructors with large "heads"
  (forall, constraints),
- Add a config flag to control single-line layout of record
  definition,

src-literatetests/10-tests.blt

@@ -324,10 +324,14 @@ data Foo = Bar {}
 data Biz = Baz
 
 #test single record
-data Foo = Bar { foo :: Baz }
+data Foo = Bar
+  { foo :: Baz
+  }
 
 #test record multiple names
-data Foo = Bar { foo, bar :: Baz }
+data Foo = Bar
+  { foo, bar :: Baz
+  }
 
 #test record multiple types
 data Foo = Bar
@@ -348,6 +352,91 @@ data Foo = Bar
   }
   deriving Show
 
+#test record long field names
+data MyRecord = MyConstructor
+  { bar1, bar2
+      :: Loooooooooooooooooooooooooooooooong
+      -> Loooooooooooooooooooooooooooooooong
+  , foo1, foo2
+      :: Loooooooooooooooooooooooooooooooonger
+      -> Loooooooooooooooooooooooooooooooonger
+  }
+
+#test record with DataTypeContexts
+{-# LANGUAGE DatatypeContexts #-}
+data
+  ( LooooooooooooooooooooongConstraint a
+  , LooooooooooooooooooooongConstraint b
+  ) =>
+  MyRecord a b
+  = MyConstructor
+    { foo1, foo2
+        :: loooooooooooooooooooooooooooooooong
+        -> loooooooooooooooooooooooooooooooong
+    , bar  :: a
+    , bazz :: b
+    }
+
+#test record single line layout
+{-# LANGUAGE ScopedTypeVariables #-}
+-- brittany { lconfig_allowSinglelineRecord: true }
+data MyRecord = forall a . Show a => MyCons { foo :: a -> a, i :: Int }
+
+#test record no matching single line layout
+{-# LANGUAGE ScopedTypeVariables #-}
+-- brittany { lconfig_allowSinglelineRecord: true }
+data MyRecord = forall a . Show a => Bar
+  { foo :: abittoolongbutnotvery -> abittoolongbutnotvery
+  }
+
+#test record forall constraint multiline
+{-# LANGUAGE ScopedTypeVariables #-}
+data MyRecord
+  = forall a
+  . LooooooooooooooooooooongConstraint a =>
+    LoooooooooooongConstructor
+      { foo :: abittoolongbutnotvery -> abittoolongbutnotvery
+      }
+
+#test record forall constraint multiline more
+{-# LANGUAGE ScopedTypeVariables #-}
+data MyRecord
+  = forall a b
+  . ( Loooooooooooooooooooooooooooooooong a
+    , Loooooooooooooooooooooooooooooooong b
+    ) =>
+    MyConstructor
+      { a :: a
+      , b :: b
+      }
+
+#test plain with forall and constraint
+{-# LANGUAGE ScopedTypeVariables #-}
+data MyStruct
+  = forall a b
+  . ( Loooooooooooooooooooooooooooooooong a
+    , Loooooooooooooooooooooooooooooooong b
+    ) =>
+    MyConstructor (ToBriDocM BriDocNumbered)
+                  (ToBriDocM BriDocNumbered)
+                  (ToBriDocM BriDocNumbered)
+
+#test record with many features
+{-# LANGUAGE ScopedTypeVariables #-}
+data MyRecord
+  = forall a b
+  . ( Loooooooooooooooooooooooooooooooong a
+    , Loooooooooooooooooooooooooooooooong b
+    ) =>
+    MyConstructor
+      { foo, foo2
+          :: loooooooooooooooooooooooooooooooong
+          -> loooooooooooooooooooooooooooooooong
+      , bar  :: a
+      , bazz :: b
+      }
+  deriving Show
+
 #test record multiple types deriving
 data Foo = Bar
   { foo  :: Baz
@@ -382,7 +471,9 @@ data Foo = Bar
 #test single record existential
 {-# LANGUAGE ExistentialQuantification #-}
 
-data Foo = forall a . Show a => Bar { foo :: a }
+data Foo = forall a . Show a => Bar
+  { foo :: a
+  }
 
 #test record multiple types existential
 {-# LANGUAGE ExistentialQuantification #-}
@@ -415,8 +506,8 @@ data Foo = Bar -- a
 data Foo = Bar
   {  -- a
     foo  -- b
-        :: -- c
+         :: -- c
-           Baz -- d
+            Baz -- d
   , -- e
     bars :: Bizzz
   }
@@ -467,16 +558,19 @@ data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
 
 #test normal records on multi line indent policy free
 -- brittany {lconfig_indentPolicy: IndentPolicyFree }
+data GrantsForCompanyResp = GrantsForCompanyResp Types.Company
+                                                 [EnterpriseGrantResponse]
+
+#test normal records on multi line indent policy free 2
+-- brittany {lconfig_indentPolicy: IndentPolicyFree }
 data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
-                                          Types.Company
+                                            Types.Company
-                                          [EnterpriseGrantResponse]
+                                            [EnterpriseGrantResponse]
 
 #test normal records on multi line indent policy multiple
 -- brittany {lconfig_indentPolicy: IndentPolicyMultiple }
-data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
+data GrantsForCompanyResp = GrantsForCompanyResp Types.Company
-                                          Types.Company
+                                                 [EnterpriseGrantResponse]
-                                          [EnterpriseGrantResponse]
-
 
 ###############################################################################
 ###############################################################################

src-literatetests/30-tests-context-free.blt

@@ -321,10 +321,14 @@ func = f
 ###############################################################################
 
 #test single record
-data Foo = Bar { foo :: Baz }
+data Foo = Bar
+  { foo :: Baz
+  }
 
 #test record multiple names
-data Foo = Bar { foo, bar :: Baz }
+data Foo = Bar
+  { foo, bar :: Baz
+  }
 
 #test record multiple types
 data Foo = Bar

src-literatetests/Main.hs

@@ -214,6 +214,7 @@ defaultTestConfig = Config
     , _lconfig_allowSingleLineExportList = coerce True
     , _lconfig_allowHangingQuasiQuotes   = coerce True
     , _lconfig_experimentalSemicolonNewlines = coerce False
+    , _lconfig_allowSinglelineRecord     = coerce False
     }
   , _conf_errorHandling             = (_conf_errorHandling staticDefaultConfig) { _econf_omit_output_valid_check = coerce True }
   , _conf_preprocessor              = _conf_preprocessor staticDefaultConfig

src-unittests/TestUtils.hs

@@ -61,6 +61,7 @@ defaultTestConfig = Config
     , _lconfig_allowSingleLineExportList = coerce True
     , _lconfig_allowHangingQuasiQuotes   = coerce True
     , _lconfig_experimentalSemicolonNewlines = coerce False
+    , _lconfig_allowSinglelineRecord     = coerce False
     }
   , _conf_errorHandling             = (_conf_errorHandling staticDefaultConfig)
     { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever

src/Language/Haskell/Brittany/Internal/BackendUtils.hs

@@ -245,9 +245,10 @@ layoutWriteEnsureAbsoluteN
   -> m ()
 layoutWriteEnsureAbsoluteN n = do
   state <- mGet
-  let diff = case _lstate_curYOrAddNewline state of
+  let diff = case (_lstate_commentCol state, _lstate_curYOrAddNewline state) of
-        Left i  -> n - i
+        (Just c , _      ) -> n - c
-        Right{} -> n
+        (Nothing, Left i ) -> n - i
+        (Nothing, Right{}) -> n
   traceLocal ("layoutWriteEnsureAbsoluteN", n, diff)
   when (diff > 0) $ do
     mSet $ state { _lstate_addSepSpace = Just diff -- this always sets to
@@ -557,6 +558,7 @@ layoutWritePostComments ast = do
                       ) -> do
         replicateM_ x layoutWriteNewline
         layoutWriteAppend $ Text.pack $ replicate y ' '
+        mModify $ \s -> s { _lstate_addSepSpace = Nothing }
         layoutWriteAppendMultiline $ Text.pack $ comment
 
 layoutIndentRestorePostComment

src/Language/Haskell/Brittany/Internal/Config.hs

@@ -77,6 +77,7 @@ staticDefaultConfig = Config
     , _lconfig_allowSingleLineExportList = coerce False
     , _lconfig_allowHangingQuasiQuotes   = coerce True
     , _lconfig_experimentalSemicolonNewlines = coerce False
+    , _lconfig_allowSinglelineRecord     = coerce False
     }
   , _conf_errorHandling = ErrorHandlingConfig
     { _econf_produceOutputOnErrors   = coerce False
@@ -181,6 +182,7 @@ cmdlineConfigParser = do
       , _lconfig_allowSingleLineExportList = mempty
       , _lconfig_allowHangingQuasiQuotes   = mempty
       , _lconfig_experimentalSemicolonNewlines = mempty
+      , _lconfig_allowSinglelineRecord     = mempty
       }
     , _conf_errorHandling = ErrorHandlingConfig
       { _econf_produceOutputOnErrors   = wrapLast $ falseToNothing outputOnErrors

src/Language/Haskell/Brittany/Internal/Config/Types.hs

@@ -142,6 +142,14 @@ data CLayoutConfig f = LayoutConfig
     -- The implementation for this is a bit hacky and not tested; it might
     -- break output syntax or not work properly for every kind of brace. So
     -- far I have considered `do` and `case-of`.
+  , _lconfig_allowSinglelineRecord :: f (Last Bool)
+    -- if true, layouts record data decls as a single line when possible, e.g.
+    -- > MyPoint { x :: Double, y :: Double }
+    -- if false, always use the multi-line layout
+    -- > MyPoint
+    -- >   { x :: Double
+    -- >   , y :: Double
+    -- >   }
   }
   deriving (Generic)
 

src/Language/Haskell/Brittany/Internal/LayouterBasics.hs

@@ -13,6 +13,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , filterAnns
   , docEmpty
   , docLit
+  , docLitS
   , docAlt
   , CollectAltM
   , addAlternativeCond
@@ -481,6 +482,9 @@ docEmpty = allocateNode BDFEmpty
 docLit :: Text -> ToBriDocM BriDocNumbered
 docLit t = allocateNode $ BDFLit t
 
+docLitS :: String -> ToBriDocM BriDocNumbered
+docLitS s = allocateNode $ BDFLit $ Text.pack s
+
 docExt
   :: (ExactPrint.Annotate.Annotate ast)
   => Located ast

src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs

@@ -59,17 +59,17 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
         consNameStr <- lrdrNameToTextAnn consName
         tyVarLine   <- fmap return $ createBndrDoc bndrs
         -- headDoc     <- fmap return $ docSeq
-        --   [ appSep $ docLit (Text.pack "newtype")
+        --   [ appSep $ docLitS "newtype")
         --   , appSep $ docLit nameStr
         --   , appSep tyVarLine
         --   ]
         rhsDoc      <- fmap return $ createDetailsDoc consNameStr details
         createDerivingPar mDerivs $ docSeq
-          [ appSep $ docLit (Text.pack "newtype")
+          [ appSep $ docLitS "newtype"
           , appSep $ docLit nameStr
           , appSep tyVarLine
           , docSeparator
-          , docLit (Text.pack "=")
+          , docLitS "="
           , docSeparator
           , rhsDoc
           ]
@@ -88,7 +88,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
       nameStr       <- lrdrNameToTextAnn name
       tyVarLine     <- fmap return $ createBndrDoc bndrs
       createDerivingPar mDerivs $ docSeq
-        [ appSep $ docLit (Text.pack "data")
+        [ appSep $ docLitS "data"
         , lhsContextDoc
         , appSep $ docLit nameStr
         , appSep tyVarLine
@@ -112,22 +112,115 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
           nameStr       <- lrdrNameToTextAnn name
           consNameStr   <- lrdrNameToTextAnn consName
           tyVarLine     <- fmap return $ createBndrDoc bndrs
-          forallDoc     <- docSharedWrapper createForallDoc qvars
+          forallDocMay  <- case createForallDoc qvars of
-          rhsContextDoc <- case mRhsContext of
+            Nothing -> pure Nothing
-            Nothing         -> return docEmpty
+            Just x -> Just . pure <$> x
-            Just (L _ ctxt) -> docSharedWrapper createContextDoc ctxt
+          rhsContextDocMay <- case mRhsContext of
+            Nothing         -> pure Nothing
+            Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt
           rhsDoc        <- fmap return $ createDetailsDoc consNameStr details
-          createDerivingPar mDerivs $ docSeq
+          consDoc <- fmap pure
-            [ appSep $ docLit (Text.pack "data")
+            $ docNonBottomSpacing
-            , lhsContextDoc
+            $ case (forallDocMay, rhsContextDocMay) of
-            , appSep $ docLit nameStr
+                (Just forallDoc, Just rhsContextDoc) -> docLines
-            , appSep tyVarLine
+                  [ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc]
-            , docSeparator
+                  , docSeq
-            , docLit (Text.pack "=")
+                    [ docLitS "."
-            , docSeparator
+                    , docSeparator
-            , forallDoc
+                    , docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
-            , rhsContextDoc
+                    ]
-            , rhsDoc
+                  ]
+                (Just forallDoc, Nothing) -> docLines
+                  [ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc]
+                  , docSeq [docLitS ".", docSeparator, rhsDoc]
+                  ]
+                (Nothing, Just rhsContextDoc) -> docSeq
+                  [ docLitS "="
+                  , docSeparator
+                  , docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
+                  ]
+                (Nothing, Nothing) -> docSeq [docLitS "=", docSeparator, rhsDoc]
+          createDerivingPar mDerivs $ docAlt
+            [ -- data D = forall a . Show a => D a
+              docSeq
+              [ appSep $ docLitS "data"
+              , docForceSingleline $ lhsContextDoc
+              , appSep $ docLit nameStr
+              , appSep tyVarLine
+              , docSeparator
+              , docLitS "="
+              , docSeparator
+              , case forallDocMay of
+                Nothing -> docEmpty
+                Just forallDoc -> docSeq
+                  [ docForceSingleline forallDoc
+                  , docSeparator
+                  , docLitS "."
+                  , docSeparator
+                  ]
+              , maybe docEmpty docForceSingleline rhsContextDocMay
+              , rhsDoc
+              ]
+            , -- data D
+              --   = forall a . Show a => D a
+              docAddBaseY BrIndentRegular $ docPar
+              ( docSeq
+                [ appSep $ docLitS "data"
+                , docForceSingleline lhsContextDoc
+                , appSep $ docLit nameStr
+                , tyVarLine
+                ]
+              )
+              ( docSeq
+                [ docLitS "="
+                , docSeparator
+                , case forallDocMay of
+                  Nothing -> docEmpty
+                  Just forallDoc -> docSeq
+                    [ docForceSingleline forallDoc
+                    , docSeparator
+                    , docLitS "."
+                    , docSeparator
+                    ]
+                , maybe docEmpty docForceSingleline rhsContextDocMay
+                , rhsDoc
+                ]
+              )
+            , -- data D
+              --   = forall a
+              --   . Show a =>
+              --     D a
+              docAddBaseY BrIndentRegular $ docPar
+              ( docSeq
+                [ appSep $ docLitS "data"
+                , docForceSingleline lhsContextDoc
+                , appSep $ docLit nameStr
+                , tyVarLine
+                ]
+              )
+              consDoc
+            , -- data
+              --   Show a =>
+              --   D
+              --   = forall a
+              --   . Show a =>
+              --     D a
+              -- This alternative is only for -XDatatypeContexts.
+              -- But I think it is rather unlikely this will trigger without
+              -- -XDataTypeContexts, especially with the `docNonBottomSpacing`
+              -- above, so while not strictly necessary, this should not
+              -- hurt.
+              docAddBaseY BrIndentRegular $ docPar
+              (docLitS "data")
+              ( docLines
+                [ lhsContextDoc
+                , docSeq
+                  [ appSep $ docLit nameStr
+                  , tyVarLine
+                  ]
+                , consDoc
+                ]
+              )
             ]
       _ -> briDocByExactNoComment ltycl
 
@@ -136,13 +229,25 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
 createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered
 createContextDoc [] = docEmpty
 createContextDoc [t] =
-  docSeq [layoutType t, docSeparator, docLit (Text.pack "=>"), docSeparator]
+  docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator]
-createContextDoc ts = docSeq
+createContextDoc (t1 : tR) = do
-  [ docLit (Text.pack "(")
+  t1Doc  <- docSharedWrapper layoutType t1
-  , docSeq $ List.intersperse docCommaSep (layoutType <$> ts)
+  tRDocs <- tR `forM` docSharedWrapper layoutType
-  , docLit (Text.pack ") =>")
+  docAlt
-  , docSeparator
+    [ docSeq
-  ]
+      [ docLitS "("
+      , docForceSingleline $ docSeq $ List.intersperse docCommaSep
+                                                       (t1Doc : tRDocs)
+      , docLitS ") =>"
+      , docSeparator
+      ]
+    , docLines $ join
+      [ [docSeq [docLitS "(", docSeparator, t1Doc]]
+      , tRDocs
+        <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc]
+      , [docLitS ") =>", docSeparator]
+      ]
+    ]
 
 createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
 createBndrDoc bs = do
@@ -165,13 +270,13 @@ createBndrDoc bs = do
     <&> \(vname, mKind) -> case mKind of
           Nothing   -> docLit vname
           Just kind -> docSeq
-            [ docLit (Text.pack "(")
+            [ docLitS "("
             , docLit vname
             , docSeparator
-            , docLit (Text.pack "::")
+            , docLitS "::"
             , docSeparator
             , kind
-            , docLit (Text.pack ")")
+            , docLitS ")"
             ]
 
 createDerivingPar
@@ -179,7 +284,7 @@ createDerivingPar
 createDerivingPar derivs mainDoc = do
   case derivs of
 #if MIN_VERSION_ghc(8,2,0)   /* ghc-8.2 */
-    (L _ []) -> docLines [mainDoc]
+    (L _ []) -> mainDoc
     (L _ types) ->
       docPar mainDoc
         $   docEnsureIndent BrIndentRegular
@@ -188,7 +293,7 @@ createDerivingPar derivs mainDoc = do
         $   derivingClauseDoc
         <$> types
 #else
-    Nothing -> docLines [mainDoc]
+    Nothing -> mainDoc
     Just types ->
       docPar mainDoc
         $ docEnsureIndent BrIndentRegular
@@ -213,7 +318,7 @@ derivingClauseDoc types = case types of
     let
       tsLength = length ts
       whenMoreThan1Type val =
-        if tsLength > 1 then docLit (Text.pack val) else docLit (Text.pack "")
+        if tsLength > 1 then docLitS val else docLitS ""
 #if MIN_VERSION_ghc(8,2,0)   /* ghc-8.2 */
       (lhsStrategy, rhsStrategy) = maybe (docEmpty, docEmpty) strategyLeftRight mStrategy
 #else
@@ -243,15 +348,15 @@ derivingClauseDoc types = case types of
 #if MIN_VERSION_ghc(8,2,0)   /* ghc-8.6 */
  where
   strategyLeftRight = \case
-    (L _ StockStrategy          ) -> (docLit $ Text.pack " stock", docEmpty)
+    (L _ StockStrategy          ) -> (docLitS " stock", docEmpty)
-    (L _ AnyclassStrategy       ) -> (docLit $ Text.pack " anyclass", docEmpty)
+    (L _ AnyclassStrategy       ) -> (docLitS " anyclass", docEmpty)
-    (L _ NewtypeStrategy        ) -> (docLit $ Text.pack " newtype", docEmpty)
+    (L _ NewtypeStrategy        ) -> (docLitS " newtype", docEmpty)
 #if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
     lVia@(L _ (ViaStrategy viaTypes) ) ->
       ( docEmpty
       , case viaTypes of
           HsIB _ext t -> docSeq
-            [ docWrapNode lVia $ docLit $ Text.pack " via"
+            [ docWrapNode lVia $ docLitS " via"
             , docSeparator
             , layoutType t
             ]
@@ -261,62 +366,109 @@ derivingClauseDoc types = case types of
 #endif
 
 docDeriving :: ToBriDocM BriDocNumbered
-docDeriving = docLit $ Text.pack "deriving"
+docDeriving = docLitS "deriving"
 
 createDetailsDoc
   :: Text -> HsConDeclDetails GhcPs -> (ToBriDocM BriDocNumbered)
 createDetailsDoc consNameStr details = case details of
   PrefixCon args -> do
-    indentPolicy <- mAsk <&> _conf_layout .>  _lconfig_indentPolicy .>  confUnpack
+    indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .>  confUnpack
     let
       singleLine = docSeq
         [ docLit consNameStr
         , docSeparator
-        , docSeq $ List.intersperse docSeparator $ args <&> layoutType
+        , docForceSingleline
+          $ docSeq
+          $ List.intersperse docSeparator
+          $ args <&> layoutType
         ]
       leftIndented = docSetParSpacing
         . docAddBaseY BrIndentRegular
         . docPar (docLit consNameStr)
         . docLines
         $ layoutType <$> args
-      multiIndented = docSetParSpacing
+      multiAppended = docSeq
-        . docSetBaseAndIndent
+        [ docLit consNameStr
-        . docPar (docLit consNameStr)
+        , docSeparator
-        . docLines
+        , docSetBaseY $ docLines $ layoutType <$> args
-        $ layoutType
+        ]
-        <$> args
+      multiIndented = docSetBaseY $ docAddBaseY BrIndentRegular $ docPar
+        (docLit consNameStr)
+        (docLines $ layoutType <$> args)
     case indentPolicy of
       IndentPolicyLeft     -> docAlt [singleLine, leftIndented]
-      IndentPolicyMultiple -> docAlt [singleLine, multiIndented]
+      IndentPolicyMultiple -> docAlt [singleLine, multiAppended, leftIndented]
-      IndentPolicyFree     -> docAlt [singleLine, multiIndented]
+      IndentPolicyFree ->
+        docAlt [singleLine, multiAppended, multiIndented, leftIndented]
   RecCon (L _ []) -> docSeq [docLit consNameStr, docSeparator, docLit $ Text.pack "{}"]
-#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-  RecCon lRec@(L _ [lField@(L _ (ConDeclField _ext names t _))]) ->
-#else
-  RecCon lRec@(L _ [lField@(L _ (ConDeclField names t _))]) ->
-#endif
-    docSetIndentLevel $ docSeq
-      [ docLit consNameStr
-      , docSeparator
-      , docWrapNodePrior lRec $ docLit $ Text.pack "{"
-      , docSeparator
-      , docWrapNodeRest lRec $ docSeq $ fmap docForceSingleline $ createNamesAndTypeDoc lField names t
-      , docSeparator
-      , docLit $ Text.pack "}"
-      ]
   RecCon lRec@(L _ fields@(_:_)) -> do
-    let (fDoc1 : fDocR) = mkFieldDocs fields
+    let ((fName1, fType1) : fDocR) = mkFieldDocs fields
-    docAddBaseY BrIndentRegular $ docSetIndentLevel $ docPar
+    allowSingleline <- mAsk <&> _conf_layout .> _lconfig_allowSinglelineRecord .> confUnpack
-      (docLit consNameStr)
+    docAddBaseY BrIndentRegular
-      (docWrapNodePrior lRec $ docLines
+      $ docSetIndentLevel
-        [ docCols ColRecDecl
+      $ runFilteredAlternative
-          $ appSep (docLit (Text.pack "{"))
+      $ do
-          : fDoc1
+        -- single-line: { i :: Int, b :: Bool }
-        , docWrapNodeRest lRec $ docLines $ fDocR <&> \f ->
+        addAlternativeCond allowSingleline $ docSeq
-            docCols ColRecDecl $ docCommaSep : f
+          [ docLit consNameStr
-        , docLit $ Text.pack "}"
+          , docSeparator
-        ]
+          , docWrapNodePrior lRec $ docLitS "{"
-      )
+          , docSeparator
+          , docWrapNodeRest lRec
+            $ docForceSingleline
+            $ docSeq
+            $ join
+            $ [fName1, docSeparator, docLitS "::", docSeparator, fType1]
+              : [ [ docLitS ","
+                  , docSeparator
+                  , fName
+                  , docSeparator
+                  , docLitS "::"
+                  , docSeparator
+                  , fType
+                  ]
+                | (fName, fType) <- fDocR
+                ]
+          , docSeparator
+          , docLitS "}"
+          ]
+        addAlternative $ docPar
+          (docLit consNameStr)
+          (docWrapNodePrior lRec $ docLines
+            [ docAlt
+              [ docCols ColRecDecl
+                [ appSep (docLitS "{")
+                , appSep $ docForceSingleline fName1
+                , docSeq [docLitS "::", docSeparator]
+                , docForceSingleline $ fType1
+                ]
+              , docSeq
+                [ docLitS "{"
+                , docSeparator
+                , docSetBaseY $ docAddBaseY BrIndentRegular $ docPar
+                    fName1
+                    (docSeq [docLitS "::", docSeparator, fType1])
+                ]
+              ]
+            , docWrapNodeRest lRec $ docLines $ fDocR <&> \(fName, fType) ->
+                docAlt
+                [ docCols ColRecDecl
+                  [ docCommaSep
+                  , appSep $ docForceSingleline fName
+                  , docSeq [docLitS "::", docSeparator]
+                  , docForceSingleline fType
+                  ]
+                , docSeq
+                  [ docLitS ","
+                  , docSeparator
+                  , docSetBaseY $ docAddBaseY BrIndentRegular $ docPar
+                      fName
+                      (docSeq [docLitS "::", docSeparator, fType])
+                  ]
+                ]
+            , docLitS "}"
+            ]
+          )
   InfixCon arg1 arg2 -> docSeq
     [ layoutType arg1
     , docSeparator
@@ -325,7 +477,9 @@ createDetailsDoc consNameStr details = case details of
     , layoutType arg2
     ]
  where
-  mkFieldDocs :: [LConDeclField GhcPs] -> [[ToBriDocM BriDocNumbered]]
+  mkFieldDocs
+    :: [LConDeclField GhcPs]
+    -> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
   mkFieldDocs = fmap $ \lField -> case lField of
 #if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
     L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t
@@ -334,23 +488,19 @@ createDetailsDoc consNameStr details = case details of
     L _ (ConDeclField names t _) -> createNamesAndTypeDoc lField names t
 #endif
 
-createForallDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
+createForallDoc :: [LHsTyVarBndr GhcPs] -> Maybe (ToBriDocM BriDocNumbered)
-createForallDoc []            = docEmpty
+createForallDoc []            = Nothing
-createForallDoc lhsTyVarBndrs =  docSeq
+createForallDoc lhsTyVarBndrs = Just $ docSeq
-  [ docLit (Text.pack "forall ")
+  [docLitS "forall ", createBndrDoc lhsTyVarBndrs]
-  , createBndrDoc lhsTyVarBndrs
-  , docLit (Text.pack " .")
-  , docSeparator
-  ]
 
 createNamesAndTypeDoc
   :: Data.Data.Data ast
   => Located ast
   -> [GenLocated t (FieldOcc GhcPs)]
   -> Located (HsType GhcPs)
-  -> [ToBriDocM BriDocNumbered]
+  -> (ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)
 createNamesAndTypeDoc lField names t =
-  [ docNodeAnnKW lField Nothing $ docWrapNodePrior lField $ docSeq
+  ( docNodeAnnKW lField Nothing $ docWrapNodePrior lField $ docSeq
     [ docSeq
       $   List.intersperse docCommaSep
       $   names
@@ -362,11 +512,6 @@ createNamesAndTypeDoc lField names t =
         L _ (FieldOcc fieldName _) ->
 #endif
             docLit =<< lrdrNameToTextAnn fieldName
-    , docSeparator
     ]
-  , docWrapNodeRest lField $ docSeq
+  , docWrapNodeRest lField $ layoutType t
-    [ docLit $ Text.pack "::"
+  )
-    , docSeparator
-    , layoutType t
-    ]
-  ]