Allow par-spacing for single-operator 1+n-line layout plus Tweak of OpApp

- Allow parSpacing for single-clause layout
- Allow par/sl layout when no where-clause was present
  (not sure why this was disabled in the first place)

data/10-structured/expression-special.blt

@@ -2,13 +2,10 @@
 
 
 #test monad-comprehension-case-of
-func =
-  foooooo
-    $ [ case
-          foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-        of
-          _ -> True
-      ]
+func = foooooo
+  $ [ case foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo of
+        _ -> True
+    ]
 
 #test operatorprefixalignment-even-with-multiline-alignbreak
 func =

data/10-structured/op-precedence.blt

@@ -164,12 +164,14 @@ doop =
 #expected
 -- brittany { lconfig_fixityBasedAddAlignParens: True }
 doop =
-  (  some long invocation == loooooooooongman + (third nested expression) - 4
+  (  (  some long invocation == loooooooooongman + (third nested expression) - 4
      && {- meow -} 5 - 6 > 7 `mod` loooooooooongwoman
+     )
   || ill just invoke a function with these args
   || (  foo
-     && dooasdoiaosdoi ** oaisdoioasido
+     && (  dooasdoiaosdoi ** oaisdoioasido
         <= asduiuaisduiasdu + asdahjsd + ahsjdhjhasd
+        )
      )
   )
 

data/15-regressions.blt

@@ -237,7 +237,8 @@ showPackageDetailedInfo pkginfo =
           , entry "Cached"        haveTarball  alwaysShow      dispYesNo
           , if not (hasLib pkginfo)
             then empty
-            else text "Modules:"
+            else
+              text "Modules:"
               $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
@@ -303,25 +304,24 @@ func _                   = 3
 #test listcomprehension-case-of
 parserCompactLocation =
   [ try
-      $ [ ParseRelAbs (Text.Read.read digits) _ _
-        | digits <- many1 digit
-        , rel1 :: Maybe (Either Int (Ratio Int)) <-
-          optionMaybe
-            [ case divPart of
-                Nothing -> Left $ Text.Read.read digits
-                Just ddigits ->
-                  Right $ Text.Read.read digits % Text.Read.read ddigits
-            | digits  <- many1 digit
-            , divPart <- optionMaybe (string "/" *> many1 digit)
-            ]
-        ]
+    $ [ ParseRelAbs (Text.Read.read digits) _ _
+      | digits <- many1 digit
+      , rel1 :: Maybe (Either Int (Ratio Int)) <-
+        optionMaybe
+          [ case divPart of
+              Nothing -> Left $ Text.Read.read digits
+              Just ddigits ->
+                Right $ Text.Read.read digits % Text.Read.read ddigits
+          | digits  <- many1 digit
+          , divPart <- optionMaybe (string "/" *> many1 digit)
+          ]
+      ]
   ]
 
 #test opapp-specialcasing-1
-func =
-  fooooooooooooooooooooooooooooooooo
-    $ foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
-                                        foooooooooooooooooooooooooooooooo
+func = fooooooooooooooooooooooooooooooooo
+  $ foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
+                                      foooooooooooooooooooooooooooooooo
 
 #test opapp-specialcasing-2
 func =
@@ -445,8 +445,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
        ]
     ++ -- two-line solution + where in next line(s)
        [ docLines
-         $  [ docForceSingleline
-              $ docSeq (patPartInline ++ [guardPart, return binderDoc])
+         $  [ docForceSingleline $ docSeq
+              (patPartInline ++ [guardPart, return binderDoc])
             , docEnsureIndent BrIndentRegular
             $ docForceSingleline
             $ return body
@@ -872,6 +872,7 @@ instance HasDependencies SomeDataModel where
     = (SomeOtherDataModelId, SomeOtherOtherDataModelId)
 
 #test stupid-do-operator-combination
+#pending
 
 func =
   do
@@ -895,3 +896,45 @@ fieldWith
      -> ToBriDocM BriDocNumbered
      )
   -> [ToBriDocM BriDocNumbered]
+
+#test comment-before-where
+briDocLineLength briDoc = flip StateS.evalState False $ go briDoc
+                          -- the state encodes whether a separator was already
+                          -- appended at the current position.
+ where
+  go = \case
+    BDEmpty   -> return $ 0
+    BDLit t   -> StateS.put False $> Text.length t
+    BDSeq bds -> sum <$> go `mapM` bds
+
+#test where-funbind-no-empty-lines
+alignColsLines layoutBriDocM bridocs = do -- colInfos `forM_` \colInfo -> do
+  -- tellDebugMess ("alignColsLines: at " ++ take 100 (show $ briDocToDoc $ head bridocs))
+  case () of
+    _ -> do
+      -- tellDebugMess ("colInfos:\n" ++ List.unlines [ "> " ++ prettyColInfos "> " x | x <- colInfos])
+      -- tellDebugMess ("processedMap: " ++ show processedMap)
+      sequence_
+        $ List.intersperse layoutWriteEnsureNewlineBlock
+        $ colInfos <&> processInfo layoutBriDocM colMax processedMap
+     where
+      (colInfos, finalState) = StateS.runState
+        (mergeBriDocs bridocs)
+        (ColBuildState IntMapS.empty 0)
+      -- maxZipper :: [Int] -> [Int] -> [Int]
+      -- maxZipper [] ys = ys
+      -- maxZipper xs [] = xs
+      -- maxZipper (x:xr) (y:yr) = max x y : maxZipper xr yr
+      colAggregation :: [Int] -> Int
+      colAggregation [] = 0 -- this probably cannot happen the way we call
+                            -- this function, because _cbs_map only ever
+                            -- contains nonempty Seqs.
+      colAggregation xs = maximum [ x | x <- xs, x <= minimum xs + alignMax' ]
+        where alignMax' = max 0 alignMax
+
+#test type-signature comment-after-context
+tzejubuVxairoy
+  :: (VwzuyApikd.VwzuyApikd zub, ZxtbaKospaKwqnuw Defg.Xeqpgko.Xeqpgko m)
+  -- foo bar
+  => CUR.Ozuzcak zub
+  -> m ()

data/30-tests-context-free.blt

@@ -1176,7 +1176,8 @@ showPackageDetailedInfo pkginfo =
           , entry "Cached" haveTarball alwaysShow dispYesNo
           , if not (hasLib pkginfo)
             then empty
-            else text "Modules:"
+            else
+              text "Modules:"
               $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
@@ -1249,18 +1250,18 @@ func _ = 3
 #test listcomprehension-case-of
 parserCompactLocation =
   [ try
-      $ [ ParseRelAbs (Text.Read.read digits) _ _
-        | digits <- many1 digit
-        , rel1 :: Maybe (Either Int (Ratio Int)) <-
-          optionMaybe
-            [ case divPart of
-                Nothing -> Left $ Text.Read.read digits
-                Just ddigits ->
-                  Right $ Text.Read.read digits % Text.Read.read ddigits
-            | digits <- many1 digit
-            , divPart <- optionMaybe (string "/" *> many1 digit)
-            ]
-        ]
+    $ [ ParseRelAbs (Text.Read.read digits) _ _
+      | digits <- many1 digit
+      , rel1 :: Maybe (Either Int (Ratio Int)) <-
+        optionMaybe
+          [ case divPart of
+              Nothing -> Left $ Text.Read.read digits
+              Just ddigits ->
+                Right $ Text.Read.read digits % Text.Read.read ddigits
+          | digits <- many1 digit
+          , divPart <- optionMaybe (string "/" *> many1 digit)
+          ]
+      ]
   ]
 
 #test opapp-specialcasing-1
@@ -1370,8 +1371,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
        ]
     ++ -- two-line solution + where in next line(s)
        [ docLines
-         $ [ docForceSingleline
-             $ docSeq (patPartInline ++ [guardPart, return binderDoc])
+         $ [ docForceSingleline $ docSeq
+             (patPartInline ++ [guardPart, return binderDoc])
            , docEnsureIndent BrIndentRegular
            $ docForceSingleline
            $ return body

source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs

@@ -223,7 +223,9 @@ hardcodedFixity allowUnqualify = \case
   "!"         -> Just $ Fixity NoSourceText 9 InfixL
   "//"        -> Just $ Fixity NoSourceText 9 InfixL
   "<>"        -> Just $ Fixity NoSourceText 6 InfixR
+  "<+>"       -> Just $ Fixity NoSourceText 5 InfixR
   "<$"        -> Just $ Fixity NoSourceText 4 InfixL
+  "$>"        -> Just $ Fixity NoSourceText 4 InfixL
   "<$>"       -> Just $ Fixity NoSourceText 4 InfixL
   "<&>"       -> Just $ Fixity NoSourceText 1 InfixL
   "&"         -> Just $ Fixity NoSourceText 1 InfixL
@@ -245,6 +247,7 @@ hardcodedFixity allowUnqualify = \case
   "`shiftR`"  -> Just $ Fixity NoSourceText 8 InfixL
   "`rotateL`" -> Just $ Fixity NoSourceText 8 InfixL
   "`rotateR`" -> Just $ Fixity NoSourceText 8 InfixL
+  "+#"        -> Just $ Fixity NoSourceText 6 InfixL
   ".^."       -> Just $ Fixity NoSourceText 6 InfixL
   ".>>."      -> Just $ Fixity NoSourceText 8 InfixL
   ".<<."      -> Just $ Fixity NoSourceText 8 InfixL
@@ -265,6 +268,8 @@ hardcodedFixity allowUnqualify = \case
   ".>"        -> Just $ Fixity NoSourceText 9 InfixL
   ":?"        -> Just $ Fixity NoSourceText 7 InfixN
   ":-"        -> Just $ Fixity NoSourceText 9 InfixR
+  ".:"        -> Just $ Fixity NoSourceText 9 InfixR
+  ".="        -> Just $ Fixity NoSourceText 8 InfixR
 
   str         -> case (Safe.headMay str, Safe.lastMay str) of
     (Just '\'', _) -> hardcodedFixity False (drop 1 str)

source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs

@@ -242,6 +242,19 @@ hasCommentsBetween ast left right = do
     )
     ast
 
+startsWithComments :: EpAnn a -> Bool
+startsWithComments = \case
+  EpAnnNotUsed                         -> False
+  EpAnn (GHC.Anchor srcSpan _) _ comms -> case comms of
+    EpaComments cs                 -> anyCheck cs
+    EpaCommentsBalanced comms1 comms2 -> anyCheck comms1 || anyCheck comms2
+   where
+    anyCheck cs =
+      any
+        (\(L _ (GHC.EpaComment _ commSpan)) ->
+          GHC.realSrcSpanStart srcSpan == GHC.realSrcSpanStart commSpan
+        )
+        cs
 
 
   -- mAnn <- astAnn ast
@@ -523,6 +536,10 @@ instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
         )
     EpAnnNotUsed -> bdm
 
+instance DocHandleComms (Maybe (EpAnn a)) (ToBriDocM BriDocNumbered) where
+  docHandleComms Nothing = id
+  docHandleComms (Just epAnn) = docHandleComms epAnn
+
 instance DocHandleComms (GHC.RealSrcSpan) (ToBriDocM BriDocNumbered) where
   docHandleComms loc = docHandleComms (GHC.realSrcSpanStart loc)
 

source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs

@@ -289,7 +289,7 @@ layoutBriDocM = \case
                 PlannedSameline{} -> False
                 PlannedNewline{}  -> True
                 PlannedDelta{}    -> True
-          -- traceShow (ExactPrint.pos2delta p1 p2) $ pure ()
+          -- traceShow (m, ExactPrint.pos2delta p1 p2) $ pure ()
           case ExactPrint.pos2delta p1 p2 of
             SameLine{} -> pure ()
             DifferentLine n _ | newlinePlanned -> layoutWriteNewlines n
@@ -326,10 +326,14 @@ printComments comms = do
           Anchor span UnchangedAnchor -> do
             let dp = ExactPrint.ss2deltaEnd prior span
             layoutWriteComment True isBlock dp 1 (Text.pack s)
-            layoutUpdateMarker $ realSrcSpanEnd span
+            if isBlock
+              then layoutSetMarker $ Just $ realSrcSpanEnd span
+              else layoutUpdateMarker $ realSrcSpanEnd span
           Anchor span (MovedAnchor dp) -> do
             layoutWriteComment False isBlock dp 1 (Text.pack s)
-            layoutUpdateMarker $ realSrcSpanEnd span
+            if isBlock
+              then layoutSetMarker $ Just $ realSrcSpanEnd span
+              else layoutUpdateMarker $ realSrcSpanEnd span
   comms `forM_` \(L anch (EpaComment tok prior)) -> case tok of
     EpaDocCommentNext  s -> addComment False s anch prior
     EpaDocCommentPrev  s -> addComment False s anch prior

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs

@@ -182,7 +182,7 @@ layoutIPBind lipbind@(L _ bind) = case bind of
       binderDoc
       (Just ipName)
       (Left expr)
-      Nothing
+      (id, Nothing)
       hasComments
 
 
@@ -196,7 +196,8 @@ bindOrSigtoSrcSpan (BagSig (L (SrcSpanAnn _ l) _)) = l
 layoutLocalBinds
   :: HsLocalBindsLR GhcPs GhcPs
   -> ToBriDocM
-       ( Maybe
+       ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+       , Maybe
            ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
            , [BriDocNumbered]
            )
@@ -207,28 +208,28 @@ layoutLocalBinds binds = case binds of
   -- x@(HsValBinds (ValBindsIn{})) ->
   --   Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x
   HsValBinds epAnn (ValBinds _ bindlrs sigs) -> do
-      let locWhere = obtainAnnPos epAnn AnnWhere
-      let unordered =
-            [ BagBind b | b <- Data.Foldable.toList bindlrs ]
-              ++ [ BagSig s | s <- sigs ]
-          ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered
-      ds <- docHandleComms epAnn $ join <$> ordered `forM` \case
-        BagBind b -> either id return <$> layoutBind b
-        BagSig  s@(L _ sig) -> do
-          doc <- layoutSig s sig
-          pure [doc]
-      pure $ Just (docHandleComms locWhere, ds)
+    let locWhere = obtainAnnPos epAnn AnnWhere
+    let unordered =
+          [ BagBind b | b <- Data.Foldable.toList bindlrs ]
+            ++ [ BagSig s | s <- sigs ]
+        ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered
+    ds <- join <$> ordered `forM` \case
+      BagBind b -> either id return <$> layoutBind b
+      BagSig  s@(L _ sig) -> do
+        doc <- layoutSig s sig
+        pure [doc]
+    pure $ (docHandleComms epAnn, Just (docHandleComms locWhere, ds))
 --  x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
   HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR"
   HsIPBinds epAnn (IPBinds _ bb) -> do
-    ds <- docHandleComms epAnn $ mapM layoutIPBind bb
-    pure $ Just (id, ds) -- TODO92 do we need to replace id?
-  EmptyLocalBinds NoExtField -> return $ Nothing
+    ds <- mapM layoutIPBind bb
+    pure $ (docHandleComms epAnn, Just (id, ds)) -- TODO92 do we need to replace id?
+  EmptyLocalBinds NoExtField -> return $ (id, Nothing)
 
 layoutGrhs
   :: LGRHS GhcPs (LHsExpr GhcPs)
   -> ToBriDocM
-       ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+       ( Maybe (EpAnn GrhsAnn)
        , [BriDocNumbered]
        , BriDocNumbered
        )
@@ -238,7 +239,7 @@ layoutGrhs (L _ (GRHS epAnn guards body)) = do
     [] -> pure []
     _  -> docFlushCommsPost False posArrow $ callLayouter layout_stmt `mapM` guards
   bodyDoc <- callLayouter layout_expr body
-  return (docHandleComms epAnn, guardDocs, bodyDoc)
+  return (Just epAnn, guardDocs, bodyDoc)
 
 layoutPatternBind
   :: Maybe Text
@@ -259,7 +260,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
       let t' = fixPatternBindIdentifier match t
       docLit t'
     _ -> pure Nothing
-  patDoc <- docHandleComms lmatch $ case (mIdDoc, patDocs) of
+  patDoc <- docHandleComms lmatch $ case (mIdDoc, patDocs) of -- TODO92 we use lmatch twice here!
     (Just idDoc, p1 : p2 : pr) | isInfix -> if null pr
       then docCols
         ColPatternsFuncInfix
@@ -323,14 +324,15 @@ layoutPatternBindFinal
   -> BriDocNumbered
   -> Maybe BriDocNumbered
   -> Either (LHsExpr GhcPs) [LGRHS GhcPs (LHsExpr GhcPs)]
-  -> ( Maybe
+  -> ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+     , Maybe
          ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
          , [BriDocNumbered]
          )
      )
   -> Bool
   -> ToBriDocM BriDocNumbered
-layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasComments
+layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhereDocs) hasComments
   = do
     let
       patPartInline = case mPatDoc of
@@ -354,14 +356,13 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
       Just (wrapWhere, [w]) -> pure . pure <$> docAlt
         [ docEnsureIndent BrIndentRegular
           $ docSeq
-              [ wrapWhere $ docLit $ Text.pack "where"
+              [ wrapBinds $ wrapWhere $ docLit $ Text.pack "where"
               , docSeparator
               , docForceSingleline $ return w
               ]
-        , -- docMoveToKWDP annKeyWhere AnnWhere False -- TODO92
-          docEnsureIndent whereIndent
+        , docEnsureIndent whereIndent
         $ docLines
-            [ docLit $ Text.pack "where"
+            [ wrapBinds $ wrapWhere $ docLit $ Text.pack "where"
             , docEnsureIndent whereIndent
             $ docSetIndentLevel
             $ docNonBottomSpacing
@@ -370,10 +371,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
         ]
       Just (wrapWhere, ws) ->
         fmap (pure . pure)
-          -- $ docMoveToKWDP annKeyWhere AnnWhere False -- TODO92
           $ docEnsureIndent whereIndent
           $ docLines
-              [ wrapWhere $ docLit $ Text.pack "where"
+              [ wrapBinds $ wrapWhere $ docLit $ Text.pack "where"
               , docEnsureIndent whereIndent
               $ docSetIndentLevel
               $ docNonBottomSpacing
@@ -397,7 +397,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
         Nothing -> Just docEmpty
         Just (wrapWhere, [w]) -> Just $ docSeq
           [ docSeparator
-          , wrapWhere $ appSep $ docLit $ Text.pack "where"
+          , wrapBinds $ wrapWhere $ appSep $ docLit $ Text.pack "where"
           , docSetIndentLevel $ docForceSingleline $ return w
           ]
         _ -> Nothing
@@ -407,17 +407,24 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
     clauseDocs <- case clauses of
       Left expr -> do
         e <- callLayouter layout_expr expr
-        pure [(id, [], e)]
+        pure [(Nothing, [], e)]
       Right grhss -> layoutGrhs `mapM` grhss
 
+    let multipleClauses = not $ null clauseDocs
+
     runFilteredAlternative $ do
 
       case clauseDocs of
-        [(wrapClause, guards, body)] -> do
-          let guardPart = wrapClause $ singleLineGuardsDoc guards
+        [(grhsEpAnn, guards, body)] -> do
+          let grhsHasComms = hasAnyCommentsBelow grhsEpAnn
+          let guardPart = docHandleComms grhsEpAnn $ singleLineGuardsDoc guards
+          -- func x | null x = x + a + 2 where a = 1
+          -- or
+          -- func x | null x = x + a + b where
+          --   a = 1
+          --   b = 2
           forM_ wherePart $ \wherePart' ->
-            -- one-line solution
-            addAlternativeCond (not hasComments) $ docCols
+            addAlternativeCond (not hasComments && not grhsHasComms) $ docCols
               (ColBindingLine alignmentToken)
               [ docSeq (patPartInline ++ [guardPart])
               , docSeq
@@ -426,14 +433,29 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
                 , wherePart'
                 ]
               ]
-          -- one-line solution + where in next line(s)
-          addAlternativeCond (Data.Maybe.isJust mWhereDocs)
+
+          -- any below have this pattern:
+          -- …
+          --   where a = 1
+          -- or
+          -- …
+          --  where
+          --   a = 1
+          --   b = 1
+
+          -- func x | null x = do
+          --   stmt x
+          addAlternativeCond (not $ maybe False startsWithComments grhsEpAnn)
             $ docLines
             $ [ docCols
                   (ColBindingLine alignmentToken)
                   [ docSeq (patPartInline ++ [guardPart])
                   , docSeq
                     [ appSep $ return binderDoc
+                      -- TODO I did it this way just to reduce test breakage,
+                      --      but arguably we should modify tests instead.
+                      --      I _think_ we really want to drop this alternative
+                      --      when grhsHasComms
                     , docForceParSpacing
                     $ docAddBaseY BrIndentRegular
                     $ return body
@@ -441,7 +463,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
                   ]
               ]
             ++ wherePartMultiLine
-          -- two-line solution + where in next line(s)
+          -- func x | null x =
+          --   x + a + 2
           addAlternative
             $ docLines
             $ [ docForceSingleline
@@ -451,8 +474,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
               $ return body
               ]
             ++ wherePartMultiLine
-          -- pattern and exactly one clause in single line, body as par;
-          -- where in following lines
+          -- func x | null x
+          --   = do
+          --       stmt x
+          --       log "abc"
           addAlternative
             $ docLines
             $ [ docCols
@@ -471,7 +496,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
              --   , docAddBaseY BrIndentRegular $ return body
              --   ]
             ++ wherePartMultiLine
-          -- pattern and exactly one clause in single line, body in new line.
+          -- func x | null x =
+          --   do
+          --     stmt1
+          --     stmt2 x
           addAlternative
             $ docLines
             $ [ docSeq (patPartInline ++ [guardPart, return binderDoc])
@@ -485,19 +513,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
         _ -> return () -- no alternatives exclusively when `length clauseDocs /= 1`
 
       case mPatDoc of
-        Nothing -> return ()
-        Just patDoc ->
+        Just patDoc | multipleClauses, indentPolicy == IndentPolicyFree ->
           -- multiple clauses added in-paragraph, each in a single line
-          -- example: foo | bar = baz
-          --              | lll = asd
-          addAlternativeCond (indentPolicy == IndentPolicyFree)
+          -- func x | null x    = baz
+          --        | otherwise = asd
+          addAlternative
             $ docLines
             $ [ docSeq
                   [ appSep $ docForceSingleline $ return patDoc
                   , docSetBaseY
                   $ docLines
                   $ clauseDocs
-                  <&> \(wrapClause, guardDocs, bodyDoc) -> wrapClause $ do -- TODO92
+                  <&> \(epAnn, guardDocs, bodyDoc) -> docHandleComms epAnn $ do
                         let guardPart = singleLineGuardsDoc guardDocs
                         -- the docForceSingleline might seems superflous, but it
                         -- helps the alternative resolving impl.
@@ -515,7 +542,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
                   ]
               ]
             ++ wherePartMultiLine
-      -- multiple clauses, each in a separate, single line
+        _ -> return ()
+      -- func x y
+      --   | null x, null y = a + b
+      --   | otherwise = a - b
       addAlternative
         $ docLines
         $ [ docAddBaseY BrIndentRegular
@@ -523,7 +553,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
             $ docLines
             $ map docSetBaseY
             $ clauseDocs
-            <&> \(wrapClause, guardDocs, bodyDoc) -> wrapClause $ do -- TODO92
+            <&> \(epAnn, guardDocs, bodyDoc) -> docHandleComms epAnn $ do
                   let guardPart = singleLineGuardsDoc guardDocs
                   -- the docForceSingleline might seems superflous, but it
                   -- helps the alternative resolving impl.
@@ -541,8 +571,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
                     ]
           ]
         ++ wherePartMultiLine
-      -- multiple clauses, each with the guard(s) in a single line, body
-      -- as a paragraph
+      -- func x y
+      --   | null x, null y = do
+      --       stmt x
+      --       stmt y
+      --   | otherwise -> do
+      --       abort
       addAlternativeCond (not hasComments)
         $ docLines
         $ [ docAddBaseY BrIndentRegular
@@ -550,34 +584,26 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
             $ docLines
             $ map docSetBaseY
             $ clauseDocs
-            <&> \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
-                  wrapClause $ docSeq
-                    $ (case guardDocs of
-                        [] -> []
-                        [g] ->
-                          [ docForceSingleline $ docSeq
-                              [appSep $ docLit $ Text.pack "|", return g]
-                          ]
-                        gs ->
-                          [ docForceSingleline
-                              $ docSeq
-                              $ [appSep $ docLit $ Text.pack "|"]
-                              ++ List.intersperse docCommaSep (return <$> gs)
-                          ]
-                      )
-                    ++ [ docSeparator
-                       , docCols
-                         ColOpPrefix
-                         [ appSep $ return binderDoc
-                         , docAddBaseY BrIndentRegular
-                         $ docForceParSpacing
-                         $ return bodyDoc
-                         ]
-                       ]
+            <&> \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
+              docHandleComms grhsEpAnn $ docSeq
+                [ singleLineGuardsDoc guardDocs
+                , docCols
+                  ColOpPrefix
+                  [ appSep $ return binderDoc
+                  , docAddBaseY BrIndentRegular
+                  $ docForceParSpacing
+                  $ return bodyDoc
+                  ]
+                ]
           ]
         ++ wherePartMultiLine
-      -- multiple clauses, each with the guard(s) in a single line, body
-      -- in a new line as a paragraph
+      -- func x y
+      --   | null x, null y
+      --   = do
+      --     stmt x
+      --     stmt y
+      --   | otherwise
+      --   = abort
       addAlternative
         $ docLines
         $ [ docAddBaseY BrIndentRegular
@@ -585,31 +611,26 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
             $ docLines
             $ map docSetBaseY
             $ clauseDocs
-            >>= \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
-                  (case guardDocs of
-                      [] -> [wrapClause docEmpty]
-                      [g] ->
-                        [ wrapClause $ docForceSingleline
-                            $ docSeq [appSep $ docLit $ Text.pack "|", return g]
-                        ]
-                      gs ->
-                        [ wrapClause $ docForceSingleline
-                            $ docSeq
-                            $ [appSep $ docLit $ Text.pack "|"]
-                            ++ List.intersperse docCommaSep (return <$> gs)
-                        ]
-                    )
-                    ++ [ docCols
-                           ColOpPrefix
-                           [ appSep $ return binderDoc
-                           , docAddBaseY BrIndentRegular
-                           $ docForceParSpacing
-                           $ return bodyDoc
-                           ]
-                       ]
+            >>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
+              [ docHandleComms grhsEpAnn $ singleLineGuardsDoc guardDocs
+              , docCols
+                ColOpPrefix
+                [ appSep $ return binderDoc
+                , docAddBaseY BrIndentRegular
+                $ docForceParSpacing
+                $ return bodyDoc
+                ]
+              ]
           ]
         ++ wherePartMultiLine
-      -- conservative approach: everything starts on the left.
+      -- func x y
+      --   | null x
+      --   , null y
+      --   = do
+      --       stmt x
+      --       stmt y
+      --   | otherwise
+      --   = abort
       addAlternative
         $ docLines
         $ [ docAddBaseY BrIndentRegular
@@ -617,14 +638,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
             $ docLines
             $ map docSetBaseY
             $ clauseDocs
-            >>= \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
+            >>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
                   (case guardDocs of
-                      [] -> [wrapClause docEmpty]
+                      [] -> [docHandleComms grhsEpAnn docEmpty]
                       [g] ->
-                        [ wrapClause $ docSeq [appSep $ docLit $ Text.pack "|", return g]
+                        [ docHandleComms grhsEpAnn
+                        $ docSeq [appSep
+                        $ docLit $ Text.pack "|", return g]
                         ]
                       (g1 : gr) ->
-                        ( (wrapClause $ docSeq [appSep $ docLit $ Text.pack "|", return g1])
+                        ( ( docHandleComms grhsEpAnn
+                          $ docSeq [appSep $ docLit $ Text.pack "|", return g1]
+                          )
                         : (gr <&> \g ->
                             docSeq [appSep $ docLit $ Text.pack ",", return g]
                           )

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs

@@ -220,7 +220,7 @@ layoutExpr lexpr@(L _ expr) = do
           ]
         , docPar e (docSeq [docLit $ Text.pack "@", t])
         ]
-    OpApp _topEpAnn _expLeft@(L _ OpApp{}) _expOp _expRight -> do
+    OpApp _topEpAnn _expLeft _expOp _expRight -> do
       -- let
       --   allowPar = case (expOp, expRight) of
       --     (L _ (HsVar _ (L _ (Unqual occname))), _)
@@ -235,60 +235,6 @@ layoutExpr lexpr@(L _ expr) = do
       treeAndHasComms <-
         layout_gatherOpTreeE layouters False False id Nothing Nothing [] lexpr
       layout_opTree layouters treeAndHasComms
-    OpApp epAnn expLeft expOp expRight -> docHandleComms epAnn $ do
-      expDocLeft  <- shareDoc $ layoutExpr expLeft
-      expDocOp    <- shareDoc $ layoutExpr expOp
-      expDocRight <- shareDoc $ layoutExpr expRight
-      let
-        allowPar = case (expOp, expRight) of
-          (L _ (HsVar _ (L _ (Unqual occname))), _)
-            | occNameString occname == "$" -> True
-          (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False
-          _ -> True
-      let leftIsDoBlock = case expLeft of
-            L _ HsDo{} -> True
-            _          -> False
-      runFilteredAlternative $ do
-        -- one-line
-        addAlternative $ docSeq
-          [ appSep $ docForceSingleline expDocLeft
-          , appSep $ docForceSingleline expDocOp
-          , docForceSingleline expDocRight
-          ]
-        -- -- line + freely indented block for right expression
-        -- addAlternative
-        --   $ docSeq
-        --   [ appSep $ docForceSingleline expDocLeft
-        --   , appSep $ docForceSingleline expDocOp
-        --   , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight
-        --   ]
-        -- two-line
-        addAlternative $ do
-          let expDocOpAndRight = docForceSingleline $ docCols
-                ColOpPrefix
-                [appSep $ expDocOp, docSetBaseY expDocRight]
-          if leftIsDoBlock
-            then docLines [expDocLeft, expDocOpAndRight]
-            else docAddBaseY BrIndentRegular
-              $ docPar expDocLeft expDocOpAndRight
-              -- TODO: in both cases, we don't force expDocLeft to be
-              -- single-line, which has certain.. interesting consequences.
-              -- At least, the "two-line" label is not entirely
-              -- accurate.
-        -- one-line + par
-        addAlternativeCond allowPar $ docSeq
-          [ appSep $ docForceSingleline expDocLeft
-          , appSep $ docForceSingleline expDocOp
-          , docForceParSpacing expDocRight
-          ]
-        -- more lines
-        addAlternative $ do
-          let expDocOpAndRight =
-                docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight]
-          if leftIsDoBlock
-            then docLines [expDocLeft, expDocOpAndRight]
-            else docAddBaseY BrIndentRegular
-              $ docPar expDocLeft expDocOpAndRight
     NegApp _ op _ -> do
       opDoc <- shareDoc $ layoutExpr op
       docSeq [docLit $ Text.pack "-", opDoc]
@@ -585,7 +531,7 @@ layoutExpr lexpr@(L _ expr) = do
                                  binderDoc
                                  Nothing
                                  (Right cases)
-                                 Nothing
+                                 (id, Nothing)
                                  hasComments
         )
     HsLet epAnn binds exp1 -> docHandleComms epAnn $ do
@@ -593,7 +539,7 @@ layoutExpr lexpr@(L _ expr) = do
       let hasComments            = hasAnyCommentsBelow lexpr
       let wrapLet                = docHandleComms spanLet
       let wrapIn                 = docHandleComms spanIn
-      mBindDocs <- callLayouter layout_localBinds binds
+      (wrapBinds, mBindDocs) <- callLayouter layout_localBinds binds
       let ifIndentFreeElse :: a -> a -> a
           ifIndentFreeElse x y = case indentPolicy of
             IndentPolicyLeft     -> y
@@ -614,7 +560,7 @@ layoutExpr lexpr@(L _ expr) = do
         Just [bindDoc] -> runFilteredAlternative $ do
           addAlternativeCond (not hasComments) $ docSeq
             [ appSep $ letDoc
-            , appSep $ docForceSingleline (pure bindDoc)
+            , wrapBinds $ appSep $ docForceSingleline (pure bindDoc)
             , appSep $ inDoc
             , docForceSingleline expDoc1
             ]
@@ -622,11 +568,13 @@ layoutExpr lexpr@(L _ expr) = do
             [ docAlt
               [ docSeq
                 [ appSep $ letDoc
-                , ifIndentFreeElse docSetBaseAndIndent docForceSingleline
+                , wrapBinds
+                  $ ifIndentFreeElse docSetBaseAndIndent docForceSingleline
                   $ pure bindDoc
                 ]
-              , docAddBaseY BrIndentRegular
-                $ docPar (letDoc) (docSetBaseAndIndent $ pure bindDoc)
+              , docAddBaseY BrIndentRegular $ docPar
+                  (letDoc)
+                  (wrapBinds $ docSetBaseAndIndent $ pure bindDoc)
               ]
             , docAlt
               [ docSeq
@@ -658,7 +606,9 @@ layoutExpr lexpr@(L _ expr) = do
           let noHangingBinds =
                 [ docNonBottomSpacing $ docAddBaseY BrIndentRegular $ docPar
                   (letDoc)
-                  (docSetBaseAndIndent $ docLines $ pure <$> bindDocs)
+                  ( wrapBinds
+                  $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs
+                  )
                 , docSeq
                   [ wrapIn $ docLit $ Text.pack "in "
                   , docAddBaseY BrIndentRegular $ docForceParSpacing expDoc1
@@ -668,10 +618,9 @@ layoutExpr lexpr@(L _ expr) = do
             IndentPolicyLeft     -> docLines noHangingBinds
             IndentPolicyMultiple -> docLines noHangingBinds
             IndentPolicyFree     -> docLines
-              [ -- TODO92 docNodeAnnKW lexpr (Just AnnLet) $
-                docSeq
+              [ docSeq
                 [ appSep $ letDoc
-                , docSetBaseAndIndent $ docLines $ pure <$> bindDocs
+                , wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs
                 ]
               , docSeq
                 [ appSep $ wrapIn $ docLit $ Text.pack "in "
@@ -679,15 +628,15 @@ layoutExpr lexpr@(L _ expr) = do
                 ]
               ]
           addAlternative $ docLines
-            [ -- TODO92 docNodeAnnKW lexpr (Just AnnLet) $
-              docAddBaseY BrIndentRegular $ docPar
+            [ docAddBaseY BrIndentRegular $ docPar
               (letDoc)
-              (docSetBaseAndIndent $ docLines $ pure <$> bindDocs)
+              (wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs)
             , docAddBaseY BrIndentRegular
               $ docPar (inDoc) (docSetBaseY $ expDoc1)
             ]
         _ -> docSeq
-          [ docForceSingleline $ docSeq [letDoc, docSeparator, inDoc]
+          [ docForceSingleline $ docSeq
+            [letDoc, docSeparator, wrapBinds $ inDoc]
           , docSeparator
           , expDoc1
           ]
@@ -696,10 +645,11 @@ layoutExpr lexpr@(L _ expr) = do
       docHandleComms epAnn $ do
         case stmtCtx of
           DoExpr _ -> do
+            let locDo = obtainAnnPos epAnn AnnDo
             stmtDocs <- docHandleComms stmtEpAnn $ do
               stmts `forM` docHandleListElemComms (callLayouter layout_stmt)
             docSetParSpacing $ docAddBaseY BrIndentRegularForce $ docPar
-              (docLit $ Text.pack "do")
+              (docHandleComms locDo $ docLit $ Text.pack "do")
               ( docSetBaseAndIndent
               $ docNonBottomSpacing
               $ docLines

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs

@@ -96,7 +96,9 @@ gatherOpTreeT hasParen hasComms commWrap locOpen locClose opExprList = \case
       commWrap
       locOpen
       locClose
-      ((docLit $ printRdrNameWithAnns op1, callLayouter layout_type r1) : opExprList)
+      ( (docLit $ printRdrNameWithAnns op1, callLayouter layout_type r1)
+      : opExprList
+      )
       l1
   (L _ (HsParTy epAnn inner)) -> do
     let AnnParen _ spanOpen spanClose = anns epAnn
@@ -220,7 +222,8 @@ layoutOpTree allowSinglelinePar = \case
     -> ToBriDocM BriDocNumbered
   coreAlternative hasParen locO locC fixity docL sharedOps sharedOpsFlat lastWrap
     = do
-      let wrapParenIfSl x inner = if x then wrapParenSl inner else inner
+      indentPolicy <- askLayoutConf _lconfig_indentPolicy
+      let wrapParenIfSl x inner = if x then wrapParenSl inner else docSetParSpacing inner
           wrapParenSl inner = docAlt
             [ docSeq
               [ docLit $ Text.pack "("
@@ -251,13 +254,18 @@ layoutOpTree allowSinglelinePar = \case
             Nothing                -> False
             Just (Fixity _ prec _) -> prec > 0
 
+      let isSingleOp = length sharedOps == 1 && length sharedOpsFlat == 1
+
       runFilteredAlternative $ do
         -- > one + two + three
         -- or
         -- > one + two + case x of
         -- >   _ -> three
-        addAlternativeCond allowSinglelinePar $ wrapParenIfSl hasParen $ docSeq
-          ([docForceSingleline docL] ++ case splitFirstLast sharedOps of
+        addAlternativeCond allowSinglelinePar
+          $ wrapParenIfSl hasParen
+          $ docSetParSpacing
+          $ docSeq
+          ([docForceSingleline docL] ++ case splitFirstLast sharedOpsFlat of
             FirstLastEmpty -> []
             FirstLastSingleton (od, ed) ->
               [docSeparator, docForceSingleline od, docSeparator, lastWrap ed]
@@ -284,11 +292,29 @@ layoutOpTree allowSinglelinePar = \case
           )
         -- this case rather leads to some unfortunate layouting than to anything
         -- useful; disabling for now. (it interfers with cols stuff.)
-        addAlternativeCond (not hasParen) $ docPar
+        -- one
+        -- + two
+        -- + three
+        addAlternativeCond (not hasParen && not isSingleOp) $ docPar
           (docHandleComms locO $ docForceSingleline $ docL)
           (docFlushCommsPost False locC $ docLines $ sharedOps <&> \(od, ed) ->
             docCols ColOpPrefix [appSep od, docForceSingleline ed]
           )
+        let singlelineUnlessFree = case indentPolicy of
+              IndentPolicyLeft     -> docForceSingleline
+              IndentPolicyMultiple -> docForceSingleline
+              IndentPolicyFree     -> id
+        let curIsPrec0 = case fixity of
+              Nothing -> False
+              Just (Fixity _ prec _) -> prec == 0
+        case sharedOps of
+          [(od, ed)] | curIsPrec0 ->
+            addAlternativeCond (not hasParen && isSingleOp)
+              $ docSetParSpacing
+              $ docPar
+                (docHandleComms locO $ docForceSingleline $ docL)
+                (docSeq [od, docSeparator, singlelineUnlessFree ed])
+          _ -> pure ()
         -- > ( one
         -- > + two
         -- > + three
@@ -297,7 +323,7 @@ layoutOpTree allowSinglelinePar = \case
           $ docForceZeroAdd
           $ wrapParenMl
               (docSetBaseY docL)
-              (sharedOpsFlat <&> \(od, ed) ->
+              (sharedOps <&> \(od, ed) ->
                 docCols ColOpPrefix [appSep od, docSetBaseY ed]
               )
         -- > one
@@ -308,6 +334,6 @@ layoutOpTree allowSinglelinePar = \case
               hasParen
           -- ((if not hasParen then docAddBaseY BrIndentRegular else id) docL)
               (if hasParen then docSetBaseY docL else docL)
-              (sharedOpsFlat <&> \(od, ed) ->
+              ((if hasParen then sharedOps else sharedOpsFlat) <&> \(od, ed) ->
                 docCols ColOpPrefix [appSep od, docSetBaseY ed]
               )

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs

@@ -49,7 +49,8 @@ layoutStmt lstmt@(L _ stmt) = do
     LetStmt epAnn binds -> docHandleComms epAnn $ do
       let isFree = indentPolicy == IndentPolicyFree
       let indentFourPlus = indentAmount >= 4
-      callLayouter layout_localBinds binds >>= \case
+      (wrapBinds, bindrDocsMay) <- callLayouter layout_localBinds binds
+      case bindrDocsMay of
         Nothing -> docLit $ Text.pack "let"
           -- i just tested the above, and it is indeed allowed. heh.
         Just (_, []) -> docLit $ Text.pack "let" -- this probably never happens
@@ -65,13 +66,13 @@ layoutStmt lstmt@(L _ stmt) = do
                   IndentPolicyMultiple
                     | indentFourPlus -> docSetBaseAndIndent
                     | otherwise -> docForceSingleline
-              in f $ return bindDoc
+              in wrapBinds $ f $ return bindDoc
             ]
           , -- let
-              --   bind = expr
+            --   bind = expr
             docAddBaseY BrIndentRegular $ docPar
             (docLit $ Text.pack "let")
-            (docSetBaseAndIndent $ return bindDoc)
+            (wrapBinds $ docSetBaseAndIndent $ return bindDoc)
           ]
         Just (_, bindDocs) -> runFilteredAlternative $ do
           -- let aaa = expra
@@ -83,7 +84,7 @@ layoutStmt lstmt@(L _ stmt) = do
                 f = if indentFourPlus
                   then docEnsureIndent BrIndentRegular
                   else docSetBaseAndIndent
-              in f $ docLines $ return <$> bindDocs
+              in wrapBinds $ f $ docLines $ return <$> bindDocs
             ]
           -- let
           --   aaa = expra
@@ -93,7 +94,7 @@ layoutStmt lstmt@(L _ stmt) = do
             $ docAddBaseY BrIndentRegular
             $ docPar
                 (docLit $ Text.pack "let")
-                (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
+                (wrapBinds $ docSetBaseAndIndent $ docLines $ return <$> bindDocs)
     RecStmt epAnn (L _ stmts) _ _ _ _ _ ->
       docHandleComms epAnn $ runFilteredAlternative $ do
         -- rec stmt1

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs

@@ -37,12 +37,18 @@ splitArrowType ltype@(L _ typ) = case typ of
     splitHsForallTypeFromBinders (getBinders hsf) typ1
   HsQualTy NoExtField ctxMay typ1 -> do
     (innerHead, innerBody) <- splitArrowType typ1
+    (wrapCtx, cntxtDocs) <- case ctxMay of
+      Nothing         -> pure (id, [])
+      Just (L (SrcSpanAnn epAnn _) ctxs) -> do
+        let wrap = case epAnn of
+              EpAnn _ (AnnContext (Just (_, loc)) _ _) _ ->
+                docFlushCommsPost False (Just $ epaLocationRealSrcSpanStart loc)
+                  . docHandleComms epAnn
+              _ -> docHandleComms epAnn
+        x <- ctxs `forM` (shareDoc . layoutType)
+        pure (wrap, x)
     pure
-      $ ( do
-          cntxtDocs <- case ctxMay of
-            Nothing         -> pure []
-            Just (L _ ctxs) -> ctxs `forM` (shareDoc . layoutType)
-          case cntxtDocs of
+      $ ( wrapCtx $ case cntxtDocs of
             []   -> docLit $ Text.pack "()"
             [x]  -> x
             docs -> docAlt

source/library/Language/Haskell/Brittany/Internal/Types.hs

@@ -202,7 +202,7 @@ data Layouters = Layouters
   , layout_grhs
     :: GHC.LGRHS GhcPs (GHC.LHsExpr GhcPs)
     -> ToBriDocM
-         ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+         ( Maybe (GHC.EpAnn GHC.GrhsAnn)
          , [BriDocNumbered]
          , BriDocNumbered
          )
@@ -218,7 +218,8 @@ data Layouters = Layouters
     -> BriDocNumbered
     -> Maybe BriDocNumbered
     -> Either (GHC.LHsExpr GhcPs) [GHC.LGRHS GhcPs (GHC.LHsExpr GhcPs)]
-    -> ( Maybe
+    -> ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+       , Maybe
            ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
            , [BriDocNumbered]
            )
@@ -228,7 +229,8 @@ data Layouters = Layouters
   , layout_localBinds
     :: GHC.HsLocalBindsLR GhcPs GhcPs
     -> ToBriDocM
-         ( Maybe
+         ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+         , Maybe
              ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
              , [BriDocNumbered]
              )

source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/AlignmentAlgo.hs

@@ -386,68 +386,68 @@ withAlloc lastFlag f = do
   return info
 
 briDocLineLength :: BriDoc -> Int
-briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
+briDocLineLength briDoc = flip StateS.evalState False $ go briDoc
                           -- the state encodes whether a separator was already
                           -- appended at the current position.
  where
-  rec = \case
+  go = \case
     BDEmpty -> return $ 0
     BDLit t -> StateS.put False $> Text.length t
-    BDSeq bds -> sum <$> rec `mapM` bds
-    BDCols _ bds -> sum <$> rec `mapM` bds
+    BDSeq bds -> sum <$> go `mapM` bds
+    BDCols _ bds -> sum <$> go `mapM` bds
     BDSeparator -> StateS.get >>= \b -> StateS.put True $> if b then 0 else 1
-    BDAddBaseY _ bd -> rec bd
-    BDBaseYPushCur bd -> rec bd
-    BDIndentLevelPushCur bd -> rec bd
-    BDIndentLevelPop bd -> rec bd
-    BDPar _ line _ -> rec line
+    BDAddBaseY _ bd -> go bd
+    BDBaseYPushCur bd -> go bd
+    BDIndentLevelPushCur bd -> go bd
+    BDIndentLevelPop bd -> go bd
+    BDPar _ line _ -> go line
     BDAlt{} -> error "briDocLineLength BDAlt"
-    BDForceAlt _ bd -> rec bd
-    BDForwardLineMode bd -> rec bd
+    BDForceAlt _ bd -> go bd
+    BDForwardLineMode bd -> go bd
     BDExternal _ t -> return $ Text.length t
     BDPlain t -> return $ Text.length t
-    BDQueueComments _ bd -> rec bd
-    BDFlushCommentsPrior _ bd -> rec bd
-    BDFlushCommentsPost _ _ bd -> rec bd
+    BDQueueComments _ bd -> go bd
+    BDFlushCommentsPrior _ bd -> go bd
+    BDFlushCommentsPost _ _ bd -> go bd
     BDLines ls@(_ : _) -> do
       x <- StateS.get
-      return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
-    BDEntryDelta _dp bd -> rec bd
+      return $ maximum $ ls <&> \l -> StateS.evalState (go l) x
+    BDEntryDelta _dp bd -> go bd
     BDLines [] -> error "briDocLineLength BDLines []"
-    BDEnsureIndent _ bd -> rec bd
-    BDDebug _ bd -> rec bd
+    BDEnsureIndent _ bd -> go bd
+    BDDebug _ bd -> go bd
 
 briDocIsMultiLine :: BriDoc -> Bool
-briDocIsMultiLine briDoc = rec briDoc
+briDocIsMultiLine briDoc = go briDoc
  where
-  rec :: BriDoc -> Bool
-  rec = \case
+  go :: BriDoc -> Bool
+  go = \case
     BDEmpty -> False
     BDLit _ -> False
-    BDSeq bds -> any rec bds
-    BDCols _ bds -> any rec bds
+    BDSeq bds -> any go bds
+    BDCols _ bds -> any go bds
     BDSeparator -> False
-    BDAddBaseY _ bd -> rec bd
-    BDBaseYPushCur bd -> rec bd
-    BDIndentLevelPushCur bd -> rec bd
-    BDIndentLevelPop bd -> rec bd
+    BDAddBaseY _ bd -> go bd
+    BDBaseYPushCur bd -> go bd
+    BDIndentLevelPushCur bd -> go bd
+    BDIndentLevelPop bd -> go bd
     BDPar{} -> True
     BDAlt{} -> error "briDocIsMultiLine BDAlt"
-    BDForceAlt _ bd -> rec bd
-    BDForwardLineMode bd -> rec bd
+    BDForceAlt _ bd -> go bd
+    BDForwardLineMode bd -> go bd
     BDExternal _ t | [_] <- Text.lines t -> False
     BDExternal{} -> True
     BDPlain t | [_] <- Text.lines t -> False
     BDPlain _ -> True
-    BDQueueComments _ bd -> rec bd
-    BDFlushCommentsPrior _ bd -> rec bd
-    BDFlushCommentsPost _ _ bd -> rec bd
-    BDEntryDelta _dp bd -> rec bd
+    BDQueueComments _ bd -> go bd
+    BDFlushCommentsPrior _ bd -> go bd
+    BDFlushCommentsPost _ _ bd -> go bd
+    BDEntryDelta _dp bd -> go bd
     BDLines (_ : _ : _) -> True
     BDLines [_] -> False
     BDLines [] -> error "briDocIsMultiLine BDLines []"
-    BDEnsureIndent _ bd -> rec bd
-    BDDebug _ bd -> rec bd
+    BDEnsureIndent _ bd -> go bd
+    BDDebug _ bd -> go bd
 
 briDocToColInfo :: Bool -> BriDoc -> StateS.State ColBuildState ColInfo
 briDocToColInfo lastFlag = \case