Fix two minor data-decl layouting issues

src-literatetests/10-tests.blt

@@ -583,6 +583,30 @@ data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
 data GrantsForCompanyResp = GrantsForCompanyResp Types.Company
                                                  [EnterpriseGrantResponse]
 
+#test large record with a comment
+data XIILqcacwiuNiu = XIILqcacwiuNiu
+  { oyyFtvbepgbOge_pebzVmuftEijwuj     :: Jgtoyuh HessJvNlo
+  , wloQsiskdoxJop_xatiKrwedOxtu       :: Jgtoyuh [Inotg]
+  , mmmJjcqtemyIyo_ovosDoreKeeoyamvove :: Jgtoyuh Eujo
+  , mbiIatelofxOzr_uluxNngiiMjah       :: Jgtoyuh HessJvNlo
+  , obxIskfcxpkIkb_uuviTuevcSkrgo      :: Jgtoyuh Int
+  , wqrAtuvuecoHwr_ilotNxbuPleo        :: Jgtoyuh Ufaxdeq
+  , lofAfuebdhpLuv_cnekPoyFxmg         :: Jgtoyuh Ufaxdeq
+  , ouoFugtawzvUpk_oupiLzptugy         :: Jgtoyuh Eujo
+  , iqiXjtziwogNsa_uiyvSunaTtgUsf3     :: Jgtoyuh Oaivn
+  , odbIriaqnojUlz_onotoWuunehIpuy     :: Jgtoyuh Eujo
+  , opjUxtkxzkiKse_luqjuZazt
+      :: Jgtoyuh [(Eujo, Int, Int, Int, Int, Int, NELUxro)]
+  -- , jcqRaqznxfhIpa_ywevMezmoYkutuwa        :: Jgtoyuh ()
+  , vayOmuasyphOfd_bcsVljmvt               :: Jgtoyuh Eujo
+  , rifArahilooRax_ufikecqdImsv            :: Jgtoyuh Oaivn
+  , raqKtopcpszDwb_oqocubasZuqjcryoDojGkw  :: Jgtoyuh Oaivn
+  , mluJiilpcijUtt_gaisklifVekfeyagRmfbyzz :: Jgtoyuh Oaivn
+  , oqhPaahjupaSmi_gamwwoovKyxznecvEayluc  :: Jgtoyuh Oaivn
+  , mazFubimwebZpa_itidehDodiDlboz         :: Jgtoyuh Vrep
+  , jeyOcuesexaYoy_vpqn                    :: Jgtoyuh ()
+  }
+
 ###############################################################################
 ###############################################################################
 ###############################################################################

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

@@ -287,7 +287,7 @@ layoutBriDocM = \case
       Just (ExactPrint.Types.DP (y, x)) ->
         layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0)
     layoutBriDocM bd
-  BDNonBottomSpacing bd -> layoutBriDocM bd
+  BDNonBottomSpacing _ bd -> layoutBriDocM bd
   BDSetParSpacing    bd -> layoutBriDocM bd
   BDForceParSpacing  bd -> layoutBriDocM bd
   BDDebug s bd -> do
@@ -321,14 +321,14 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
     BDAnnotationKW _ _ bd   -> rec bd
     BDAnnotationRest _ bd   -> rec bd
     BDMoveToKWDP _ _ _ bd   -> rec bd
-    BDLines ls@(_:_)        -> do
+    BDLines ls@(_ : _)      -> do
       x <- StateS.get
       return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
     BDLines []              -> error "briDocLineLength BDLines []"
     BDEnsureIndent _ bd     -> rec bd
     BDSetParSpacing   bd    -> rec bd
     BDForceParSpacing bd    -> rec bd
-    BDNonBottomSpacing bd -> rec bd
+    BDNonBottomSpacing _ bd -> rec bd
     BDDebug            _ bd -> rec bd
 
 briDocIsMultiLine :: BriDoc -> Bool
@@ -365,7 +365,7 @@ briDocIsMultiLine briDoc = rec briDoc
     BDEnsureIndent _ bd                      -> rec bd
     BDSetParSpacing   bd                     -> rec bd
     BDForceParSpacing bd                     -> rec bd
-    BDNonBottomSpacing bd                    -> rec bd
+    BDNonBottomSpacing _ bd                  -> rec bd
     BDDebug _ bd                             -> rec bd
 
 -- In theory

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

@@ -40,6 +40,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , docAnnotationRest
   , docMoveToKWDP
   , docNonBottomSpacing
+  , docNonBottomSpacingS
   , docSetParSpacing
   , docForceParSpacing
   , docDebug
@@ -576,7 +577,10 @@ docAnnotationRest
 docAnnotationRest annKey bdm = allocateNode . BDFAnnotationRest annKey =<< bdm
 
 docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
-docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing =<< bdm
+docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing False =<< bdm
+
+docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+docNonBottomSpacingS bdm = allocateNode . BDFNonBottomSpacing True =<< bdm
 
 docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
 docSetParSpacing bdm = allocateNode . BDFSetParSpacing =<< bdm

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

@@ -153,7 +153,8 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
                 ]
               , docLitS "="
               , docSeparator
-              , case forallDocMay of
+              , docSetIndentLevel $ docSeq
+                [ case forallDocMay of
                   Nothing -> docEmpty
                   Just forallDoc -> docSeq
                     [ docForceSingleline forallDoc
@@ -164,6 +165,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
                 , maybe docEmpty docForceSingleline rhsContextDocMay
                 , rhsDoc
                 ]
+              ]
             , -- data D
               --   = forall a . Show a => D a
               docAddBaseY BrIndentRegular $ docPar
@@ -178,7 +180,8 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
               ( docSeq
                 [ docLitS "="
                 , docSeparator
-                , case forallDocMay of
+                , docSetIndentLevel $ docSeq
+                  [ case forallDocMay of
                     Nothing -> docEmpty
                     Just forallDoc -> docSeq
                       [ docForceSingleline forallDoc
@@ -189,6 +192,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
                   , maybe docEmpty docForceSingleline rhsContextDocMay
                   , rhsDoc
                   ]
+                ]
               )
             , -- data D
               --   = forall a
@@ -412,7 +416,6 @@ createDetailsDoc consNameStr details = case details of
     -- allowSingleline <- mAsk <&> _conf_layout .> _lconfig_allowSinglelineRecord .> confUnpack
     let allowSingleline = False
     docAddBaseY BrIndentRegular
-      $ docSetIndentLevel
       $ runFilteredAlternative
       $ do
         -- single-line: { i :: Int, b :: Bool }
@@ -441,7 +444,7 @@ createDetailsDoc consNameStr details = case details of
           ]
         addAlternative $ docPar
           (docLit consNameStr)
-          (docWrapNodePrior lRec $ docLines
+          (docWrapNodePrior lRec $ docNonBottomSpacingS $ docLines
             [ docAlt
               [ docCols ColRecDecl
                 [ appSep (docLitS "{")

src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs

@@ -331,7 +331,7 @@ transformAlts =
             BrIndentNone -> r
             BrIndentRegular ->   reWrap $ BDFEnsureIndent (BrIndentSpecial indAdd) r
             BrIndentSpecial i -> reWrap $ BDFEnsureIndent (BrIndentSpecial i) r
-        BDFNonBottomSpacing bd -> rec bd
+        BDFNonBottomSpacing _ bd -> rec bd
         BDFSetParSpacing bd -> rec bd
         BDFForceParSpacing bd -> rec bd
         BDFDebug s bd -> do
@@ -488,13 +488,18 @@ getSpacing !bridoc = rec bridoc
               BrIndentSpecial i -> i
         return $ mVs <&> \(VerticalSpacing lsp psp pf) ->
           VerticalSpacing (lsp + addInd) psp pf
-      BDFNonBottomSpacing bd -> do
+      BDFNonBottomSpacing b bd -> do
         mVs <- rec bd
         return
           $   mVs
-          <|> LineModeValid (VerticalSpacing 0
+          <|> LineModeValid
-                                             (VerticalSpacingParAlways colMax)
+                (VerticalSpacing
-                                             False)
+                  0
+                  (if b then VerticalSpacingParSome 0
+                        else VerticalSpacingParAlways colMax
+                  )
+                  False
+                )
       BDFSetParSpacing bd -> do
         mVs <- rec bd
         return $ mVs <&> \vs -> vs { _vs_parFlag = True }
@@ -799,16 +804,30 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
                 BrIndentSpecial i -> i
           return $ mVs <&> \(VerticalSpacing lsp psp parFlag) ->
             VerticalSpacing (lsp + addInd) psp parFlag
-        BDFNonBottomSpacing bd -> do
+        BDFNonBottomSpacing b bd -> do
+          -- TODO: the `b` flag is an ugly hack, but I was not able to make
+          -- all tests work without it. It should be possible to have
+          -- `spMakePar` map VSPAlways{} to VSPSome x1, which fixes this
+          -- problem but breaks certain other cases.
           mVs <- rec bd
           return $ if null mVs
-            then [VerticalSpacing 0 (VerticalSpacingParAlways colMax) False]
+            then [VerticalSpacing
+                    0
+                    (if b then VerticalSpacingParSome 0
+                          else VerticalSpacingParAlways colMax
+                    )
+                    False
+                 ]
             else mVs <&> \vs -> vs
               { _vs_sameLine = min colMax (_vs_sameLine vs)
               , _vs_paragraph = case _vs_paragraph vs of
                   VerticalSpacingParNone -> VerticalSpacingParNone
-                  VerticalSpacingParAlways i -> VerticalSpacingParAlways i
+                  VerticalSpacingParAlways i
-                  VerticalSpacingParSome i -> VerticalSpacingParAlways i
+                    | b         -> VerticalSpacingParSome 0
+                    | otherwise -> VerticalSpacingParAlways i
+                  VerticalSpacingParSome i
+                    | b         -> VerticalSpacingParSome 0
+                    | otherwise -> VerticalSpacingParAlways i
               }
             -- the version below is an alternative idea: fold the input
             -- spacings into a single spacing. This was hoped to improve in

src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs

@@ -135,4 +135,4 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
   BDSetParSpacing{}   -> Nothing
   BDForceParSpacing{} -> Nothing
   BDDebug{}           -> Nothing
-  BDNonBottomSpacing x -> Just x
+  BDNonBottomSpacing _ x -> Just x

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

@@ -258,7 +258,7 @@ data BriDoc
   -- after the alt transformation.
   | BDForceMultiline BriDoc
   | BDForceSingleline BriDoc
-  | BDNonBottomSpacing BriDoc
+  | BDNonBottomSpacing Bool BriDoc
   | BDSetParSpacing BriDoc
   | BDForceParSpacing BriDoc
   -- pseudo-deprecated
@@ -303,7 +303,7 @@ data BriDocF f
   | BDFEnsureIndent BrIndent (f (BriDocF f))
   | BDFForceMultiline (f (BriDocF f))
   | BDFForceSingleline (f (BriDocF f))
-  | BDFNonBottomSpacing (f (BriDocF f))
+  | BDFNonBottomSpacing Bool (f (BriDocF f))
   | BDFSetParSpacing (f (BriDocF f))
   | BDFForceParSpacing (f (BriDocF f))
   | BDFDebug String (f (BriDocF f))
@@ -317,31 +317,35 @@ type BriDocNumbered = (Int, BriDocFInt)
 instance Uniplate.Uniplate BriDoc where
   uniplate x@BDEmpty{}               = plate x
   uniplate x@BDLit{}                 = plate x
-  uniplate (BDSeq list)                  = plate BDSeq ||* list
+  uniplate (BDSeq list     )         = plate BDSeq ||* list
   uniplate (BDCols sig list)         = plate BDCols |- sig ||* list
   uniplate x@BDSeparator             = plate x
-  uniplate (BDAddBaseY ind bd)           = plate BDAddBaseY |- ind |* bd
+  uniplate (BDAddBaseY ind bd      ) = plate BDAddBaseY |- ind |* bd
   uniplate (BDBaseYPushCur       bd) = plate BDBaseYPushCur |* bd
   uniplate (BDBaseYPop           bd) = plate BDBaseYPop |* bd
   uniplate (BDIndentLevelPushCur bd) = plate BDIndentLevelPushCur |* bd
   uniplate (BDIndentLevelPop     bd) = plate BDIndentLevelPop |* bd
   uniplate (BDPar ind line indented) = plate BDPar |- ind |* line |* indented
-  uniplate (BDAlt             alts)      = plate BDAlt ||* alts
+  uniplate (BDAlt             alts ) = plate BDAlt ||* alts
   uniplate (BDForwardLineMode bd   ) = plate BDForwardLineMode |* bd
   uniplate x@BDExternal{}            = plate x
   uniplate x@BDPlain{}               = plate x
-  uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd
+  uniplate (BDAnnotationPrior annKey bd) =
-  uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd
+    plate BDAnnotationPrior |- annKey |* bd
-  uniplate (BDAnnotationRest annKey bd)  = plate BDAnnotationRest |- annKey |* bd
+  uniplate (BDAnnotationKW annKey kw bd) =
-  uniplate (BDMoveToKWDP annKey kw b bd) = plate BDMoveToKWDP |- annKey |- kw |- b |* bd
+    plate BDAnnotationKW |- annKey |- kw |* bd
-  uniplate (BDLines lines)               = plate BDLines ||* lines
+  uniplate (BDAnnotationRest annKey bd) =
-  uniplate (BDEnsureIndent ind bd)       = plate BDEnsureIndent |- ind |* bd
+    plate BDAnnotationRest |- annKey |* bd
-  uniplate (BDForceMultiline   bd)       = plate BDForceMultiline |* bd
+  uniplate (BDMoveToKWDP annKey kw b bd) =
-  uniplate (BDForceSingleline  bd)       = plate BDForceSingleline |* bd
+    plate BDMoveToKWDP |- annKey |- kw |- b |* bd
-  uniplate (BDNonBottomSpacing bd)       = plate BDNonBottomSpacing |* bd
+  uniplate (BDLines lines          ) = plate BDLines ||* lines
-  uniplate (BDSetParSpacing    bd)       = plate BDSetParSpacing |* bd
+  uniplate (BDEnsureIndent ind bd  ) = plate BDEnsureIndent |- ind |* bd
-  uniplate (BDForceParSpacing  bd)       = plate BDForceParSpacing |* bd
+  uniplate (BDForceMultiline  bd   ) = plate BDForceMultiline |* bd
-  uniplate (BDDebug s bd)                = plate BDDebug |- s |* bd
+  uniplate (BDForceSingleline bd   ) = plate BDForceSingleline |* bd
+  uniplate (BDNonBottomSpacing b bd) = plate BDNonBottomSpacing |- b |* bd
+  uniplate (BDSetParSpacing   bd   ) = plate BDSetParSpacing |* bd
+  uniplate (BDForceParSpacing bd   ) = plate BDForceParSpacing |* bd
+  uniplate (BDDebug s bd           ) = plate BDDebug |- s |* bd
 
 newtype NodeAllocIndex = NodeAllocIndex Int
 
@@ -371,12 +375,11 @@ unwrapBriDocNumbered tpl = case snd tpl of
   BDFEnsureIndent ind bd       -> BDEnsureIndent ind $ rec bd
   BDFForceMultiline  bd        -> BDForceMultiline $ rec bd
   BDFForceSingleline bd        -> BDForceSingleline $ rec bd
-  BDFNonBottomSpacing bd       -> BDNonBottomSpacing $ rec bd
+  BDFNonBottomSpacing b bd     -> BDNonBottomSpacing b $ rec bd
   BDFSetParSpacing   bd        -> BDSetParSpacing $ rec bd
   BDFForceParSpacing bd        -> BDForceParSpacing $ rec bd
   BDFDebug s bd                -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd
- where
+  where rec = unwrapBriDocNumbered
-  rec = unwrapBriDocNumbered
 
 isNotEmpty :: BriDoc -> Bool
 isNotEmpty BDEmpty = False
@@ -408,7 +411,7 @@ briDocSeqSpine = \case
   BDEnsureIndent _ind bd         -> briDocSeqSpine bd
   BDForceMultiline  bd           -> briDocSeqSpine bd
   BDForceSingleline bd           -> briDocSeqSpine bd
-  BDNonBottomSpacing bd          -> briDocSeqSpine bd
+  BDNonBottomSpacing _ bd        -> briDocSeqSpine bd
   BDSetParSpacing   bd           -> briDocSeqSpine bd
   BDForceParSpacing bd           -> briDocSeqSpine bd
   BDDebug _s bd                  -> briDocSeqSpine bd