Consolidate record expression layouter

Both record construction and record layouting have very similar
constructions. These each had their own layouter with slightly different
variations. Variations here lead to subtley different bugs in layout for
nearly identicle syntactic forms.

The record update logic is more advanced and respects `IndentPolicyLeft`.
Instead of keeping these layouters distinct we can consolidate
construction logic into the update logic. This results in a smaller
volume of code and more uniform layouting of syntax for these simlilar
forms.

Record constructors with fields and wildcards are not included in this
consolidation. A TODO has been left to handle this consolidation later.

src-literatetests/15-regressions.blt

@@ -53,10 +53,9 @@ func = Foo
 
 #test record construction 3
 func = do
-  Foo
+  Foo { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-    { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+      , _lstate_foo    = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-    , _lstate_foo    = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
+      }
-    }
 
 #test post-indent comment
 func = do

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

@@ -1378,6 +1378,22 @@ foo =
     cccc = ()
   in foo
 
+#test issue 176
+
+record :: Record
+record = Record
+  { rProperties =
+    [ "foo" .= "bar"
+    , "foo" .= "bar"
+    , "foo" .= "bar"
+    , "foo" .= "bar"
+    , "foo" .= "bar"
+    , "foo" .= "bar"
+    , "foo" .= "bar"
+    , "foo" .= "bar"
+    ]
+  }
+
 
 ###############################################################################
 ###############################################################################

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

@@ -527,7 +527,7 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
           (BDCols ColGuardedBody        _) -> True
           (BDCols ColBindStmt           _) -> True
           (BDCols ColDoLet              _) -> True
-          (BDCols ColRecUpdate          _) -> False
+          (BDCols ColRec                _) -> False
           (BDCols ColListComp           _) -> False
           (BDCols ColList               _) -> False
           (BDCols ColApp{}              _) -> True

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

@@ -15,7 +15,7 @@ import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.LayouterBasics
 import           Language.Haskell.Brittany.Internal.Config.Types
 
-import           GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..), RdrName(..) )
+import           GHC ( runGhc, GenLocated(L), SrcSpan, moduleNameString, AnnKeywordId(..), RdrName(..) )
 import           HsSyn
 import           Name
 import qualified FastString
@@ -750,67 +750,21 @@ layoutExpr lexpr@(L _ expr) = do
     ExplicitPArr{} -> do
       -- TODO
       briDocByExactInlineOnly "ExplicitPArr{}" lexpr
-    RecordCon lname _ _ (HsRecFields [] Nothing) -> do
+    RecordCon lname _ _ (HsRecFields fields Nothing) -> do
-      let t = lrdrNameToText lname
-      docWrapNode lname $ docSeq
-        [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{"
-        , docLit $ Text.pack "}"
-        ]
-    RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do
-      -- TODO: the layouter for RecordUpd is slightly more clever. Should
-      -- probably copy the approach from there.
       let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
-      ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do
+      rFs <- fields
-        fExpDoc <- if pun
+        `forM` \lfield@(L _ (HsRecField (L _ (FieldOcc lnameF _)) rFExpr pun)) -> do
-          then return Nothing
+          rFExpDoc <- if pun
-          else Just <$> docSharedWrapper layoutExpr fExpr
+            then return Nothing
-        return (fieldl, lrdrNameToText lnameF, fExpDoc)
+            else Just <$> docSharedWrapper layoutExpr rFExpr
-      let line1 wrapper =
+          return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
-            [ appSep $ docLit $ Text.pack "{"
+      recordExpression indentPolicy lexpr nameDoc rFs
-            , docWrapNodePrior fd1l $ appSep $ docLit fd1n
+
-            , case fd1e of
-                Just x -> docSeq
-                  [ appSep $ docLit $ Text.pack "="
-                  , docWrapNodeRest fd1l $ wrapper x
-                  ]
-                Nothing -> docEmpty
-            ]
-      let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
-            [ docCommaSep
-            , appSep $ docLit fText
-            , case fDoc of
-                Just x -> docWrapNode lfield $ docSeq
-                  [ appSep $ docLit $ Text.pack "="
-                  , wrapper x
-                  ]
-                Nothing -> docEmpty
-            ]
-      let lineN =
-            [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
-            , docLit $ Text.pack "}"
-            ]
-      docAlt -- TODO: make this addFilteredAlternative and a hanging layout when Free
-        [  docSeq
-        $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
-        ++ line1 docForceSingleline
-        ++ join (lineR docForceSingleline)
-        ++ [docSeparator]
-        ++ lineN
-        , docSetParSpacing
-        $ docAddBaseY BrIndentRegular
-        $ docPar
-            (docNodeAnnKW lexpr Nothing nameDoc)
-            ( docNonBottomSpacing
-            $ docLines
-            $  [docCols ColRecUpdate $ line1 (docAddBaseY BrIndentRegular)]
-            ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular))
-            ++ [docSeq lineN]
-            )
-        ]
     RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do
       let t = lrdrNameToText lname
       docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
     RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do
+      -- TODO this should be consolidated into `recordExpression`
       let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
       ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do
         fExpDoc <- if pun
@@ -859,19 +813,16 @@ layoutExpr lexpr@(L _ expr) = do
             (docNodeAnnKW lexpr Nothing nameDoc)
             ( docNonBottomSpacing
             $ docLines
-            $  [docCols ColRecUpdate $ line1 (docAddBaseY BrIndentRegular)]
+            $  [docCols ColRec $ line1 (docAddBaseY BrIndentRegular)]
-            ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular))
+            ++ (docCols ColRec <$> lineR (docAddBaseY BrIndentRegular))
             ++ [docSeq lineDot, docSeq lineN]
             )
         ]
     RecordCon{} ->
       unknownNodeError "RecordCon with puns" lexpr
-    RecordUpd rExpr [] _ _ _ _ -> do
+    RecordUpd rExpr fields _ _ _ _ -> do
       rExprDoc <- docSharedWrapper layoutExpr rExpr
-      docSeq [rExprDoc, docLit $ Text.pack "{}"]
+      rFs <- fields
-    RecordUpd rExpr fields@(_:_) _ _ _ _ -> do
-      rExprDoc <- docSharedWrapper layoutExpr rExpr
-      rFs@((rF1f, rF1n, rF1e):rFr) <- fields
         `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do
           rFExpDoc <- if pun
             then return Nothing
@@ -879,106 +830,7 @@ layoutExpr lexpr@(L _ expr) = do
           return $ case ambName of
             Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
             Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)
-      runFilteredAlternative $ do
+      recordExpression indentPolicy lexpr rExprDoc rFs
-        -- container { fieldA = blub, fieldB = blub }
-        addAlternative
-          $ docSeq
-          [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc
-          , appSep $ docLit $ Text.pack "{"
-          , appSep $ docSeq $ List.intersperse docCommaSep
-                  $ rFs <&> \case
-                    (lfield, fieldStr, Just fieldDoc) ->
-                      docWrapNode lfield $ docSeq
-                            [ appSep $ docLit fieldStr
-                            , appSep $ docLit $ Text.pack "="
-                            , docForceSingleline fieldDoc
-                            ]
-                    (lfield, fieldStr, Nothing) ->
-                      docWrapNode lfield $ docLit fieldStr
-          , docLit $ Text.pack "}"
-          ]
-        -- hanging single-line fields
-        -- container { fieldA = blub
-        --           , fieldB = blub
-        --           }
-        addAlternativeCond (indentPolicy == IndentPolicyFree)
-          $ docSeq
-          [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
-          , docSetBaseY $ docLines $ let
-              line1 = docCols ColRecUpdate
-                [ appSep $ docLit $ Text.pack "{"
-                , docWrapNodePrior rF1f $ appSep $ docLit rF1n
-                , case rF1e of
-                    Just x -> docWrapNodeRest rF1f $ docSeq
-                                    [ appSep $ docLit $ Text.pack "="
-                                    , docForceSingleline x
-                                    ]
-                    Nothing -> docEmpty
-                ]
-              lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
-                [ docCommaSep
-                , appSep $ docLit fText
-                , case fDoc of
-                    Just x ->  docSeq [ appSep $ docLit $ Text.pack "="
-                                      , docForceSingleline x
-                                      ]
-                    Nothing -> docEmpty
-                ]
-              lineN = docSeq
-                [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
-                , docLit $ Text.pack "}"
-                ]
-              in [line1] ++ lineR ++ [lineN]
-          ]
-        -- non-hanging with expressions placed to the right of the names
-        -- container
-        -- { fieldA = blub
-        -- , fieldB = potentially
-        --     multiline
-        -- }
-        addAlternative
-          $ docSetParSpacing
-          $ docAddBaseY BrIndentRegular
-          $ docPar
-              (docNodeAnnKW lexpr Nothing rExprDoc)
-              (docNonBottomSpacing $ docLines $ let
-                expressionWrapper = case indentPolicy of
-                  IndentPolicyLeft -> docForceParSpacing
-                  IndentPolicyMultiple -> docForceParSpacing
-                  IndentPolicyFree -> docSetBaseY
-                line1 = docCols ColRecUpdate
-                  [ appSep $ docLit $ Text.pack "{"
-                  , docWrapNodePrior rF1f $ appSep $ docLit rF1n
-                  , docWrapNodeRest rF1f $ case rF1e of
-                      Just x -> docAlt
-                        [ docSeq [ appSep $ docLit $ Text.pack "="
-                                 , expressionWrapper x
-                                 ]
-                        , docAddBaseY BrIndentRegular
-                        $ docPar (docLit $ Text.pack "=") x
-                        ]
-                      Nothing -> docEmpty
-                  ]
-                lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield
-                  $ docCols ColRecUpdate
-                  [ docCommaSep
-                  , appSep $ docLit fText
-                  , case fDoc of
-                      Just x -> docAlt
-                        [ docSeq [ appSep $ docLit $ Text.pack "="
-                                 , expressionWrapper x
-                                 ]
-                        , docAddBaseY BrIndentRegular
-                        $ docPar (docLit $ Text.pack "=") x
-                        ]
-                      Nothing -> docEmpty
-                  ]
-                lineN = docSeq
-                  [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
-                  , docLit $ Text.pack "}"
-                  ]
-                in [line1] ++ lineR ++ [lineN]
-              )
 #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
     ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
 #else /* ghc-8.0 */
@@ -1105,6 +957,120 @@ layoutExpr lexpr@(L _ expr) = do
       briDocByExactInlineOnly "ExplicitSum{}" lexpr
 #endif
 
+recordExpression
+  :: (Data.Data.Data lExpr, Data.Data.Data name)
+  => IndentPolicy
+  -> GenLocated SrcSpan lExpr
+  -> ToBriDocM BriDocNumbered
+  -> [(GenLocated SrcSpan name, Text, Maybe (ToBriDocM BriDocNumbered))]
+  -> ToBriDocM BriDocNumbered
+recordExpression _ lexpr nameDoc [] =
+  docSeq
+    [ docNodeAnnKW lexpr (Just AnnOpenC) $ docSeq [nameDoc, docLit $ Text.pack "{"]
+    , docLit $ Text.pack "}"
+    ]
+recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) =
+  runFilteredAlternative $ do
+    -- container { fieldA = blub, fieldB = blub }
+    addAlternative
+      $ docSeq
+      [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline nameDoc
+      , appSep $ docLit $ Text.pack "{"
+      , appSep $ docSeq $ List.intersperse docCommaSep
+              $ rFs <&> \case
+                (lfield, fieldStr, Just fieldDoc) ->
+                  docWrapNode lfield $ docSeq
+                        [ appSep $ docLit fieldStr
+                        , appSep $ docLit $ Text.pack "="
+                        , docForceSingleline fieldDoc
+                        ]
+                (lfield, fieldStr, Nothing) ->
+                  docWrapNode lfield $ docLit fieldStr
+      , docLit $ Text.pack "}"
+      ]
+    -- hanging single-line fields
+    -- container { fieldA = blub
+    --           , fieldB = blub
+    --           }
+    addAlternativeCond (indentPolicy == IndentPolicyFree)
+      $ docSeq
+      [ docNodeAnnKW lexpr Nothing $ appSep nameDoc
+      , docSetBaseY $ docLines $ let
+          line1 = docCols ColRec
+            [ appSep $ docLit $ Text.pack "{"
+            , docWrapNodePrior rF1f $ appSep $ docLit rF1n
+            , case rF1e of
+                Just x -> docWrapNodeRest rF1f $ docSeq
+                                [ appSep $ docLit $ Text.pack "="
+                                , docForceSingleline x
+                                ]
+                Nothing -> docEmpty
+            ]
+          lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRec
+            [ docCommaSep
+            , appSep $ docLit fText
+            , case fDoc of
+                Just x ->  docSeq [ appSep $ docLit $ Text.pack "="
+                                  , docForceSingleline x
+                                  ]
+                Nothing -> docEmpty
+            ]
+          lineN = docSeq
+            [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
+            , docLit $ Text.pack "}"
+            ]
+          in [line1] ++ lineR ++ [lineN]
+      ]
+    -- non-hanging with expressions placed to the right of the names
+    -- container
+    -- { fieldA = blub
+    -- , fieldB = potentially
+    --     multiline
+    -- }
+    addAlternative
+      $ docSetParSpacing
+      $ docAddBaseY BrIndentRegular
+      $ docPar
+          (docNodeAnnKW lexpr Nothing nameDoc)
+          (docNonBottomSpacing $ docLines $ let
+            expressionWrapper = case indentPolicy of
+              IndentPolicyLeft -> docForceParSpacing
+              IndentPolicyMultiple -> docForceParSpacing
+              IndentPolicyFree -> docSetBaseY
+            line1 = docCols ColRec
+              [ appSep $ docLit $ Text.pack "{"
+              , docWrapNodePrior rF1f $ appSep $ docLit rF1n
+              , docWrapNodeRest rF1f $ case rF1e of
+                  Just x -> docAlt
+                    [ docSeq [ appSep $ docLit $ Text.pack "="
+                             , expressionWrapper x
+                             ]
+                    , docAddBaseY BrIndentRegular
+                    $ docPar (docLit $ Text.pack "=") x
+                    ]
+                  Nothing -> docEmpty
+              ]
+            lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield
+              $ docCols ColRec
+              [ docCommaSep
+              , appSep $ docLit fText
+              , case fDoc of
+                  Just x -> docAlt
+                    [ docSeq [ appSep $ docLit $ Text.pack "="
+                             , expressionWrapper x
+                             ]
+                    , docAddBaseY BrIndentRegular
+                    $ docPar (docLit $ Text.pack "=") x
+                    ]
+                  Nothing -> docEmpty
+              ]
+            lineN = docSeq
+              [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
+              , docLit $ Text.pack "}"
+              ]
+            in [line1] ++ lineR ++ [lineN]
+          )
+
 
 #if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
 litBriDoc :: HsLit GhcPs -> BriDocFInt

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

@@ -184,7 +184,7 @@ data ColSig
     -- expected to have exactly two columns
   | ColBindStmt
   | ColDoLet -- the non-indented variant
-  | ColRecUpdate -- used for both RecCon and RecUpd. TODO: refactor to reflect?
+  | ColRec
   | ColListComp
   | ColList
   | ColApp Text
@@ -410,7 +410,7 @@ briDocForceSpine bd = briDocSeqSpine bd `seq` bd
 
 data VerticalSpacingPar
   = VerticalSpacingParNone -- no indented lines
-  | VerticalSpacingParSome   Int -- indented lines, requiring this much 
+  | VerticalSpacingParSome   Int -- indented lines, requiring this much
                                  -- vertical space at most
   | VerticalSpacingParAlways Int -- indented lines, requiring this much
                                  -- vertical space at most, but should