data/10-structured/expression-special.blt

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

data/10-structured/op-precedence.blt

@@ -164,14 +164,12 @@ 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,8 +237,7 @@ showPackageDetailedInfo pkginfo =
           , entry "Cached"        haveTarball  alwaysShow      dispYesNo
           , if not (hasLib pkginfo)
             then empty
-            else
+            else text "Modules:"
-              text "Modules:"
               $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
@@ -304,24 +303,25 @@ func _                   = 3
 #test listcomprehension-case-of
 parserCompactLocation =
   [ try
-    $ [ ParseRelAbs (Text.Read.read digits) _ _
+      $ [ ParseRelAbs (Text.Read.read digits) _ _
-      | digits <- many1 digit
+        | digits <- many1 digit
-      , rel1 :: Maybe (Either Int (Ratio Int)) <-
+        , rel1 :: Maybe (Either Int (Ratio Int)) <-
-        optionMaybe
+          optionMaybe
-          [ case divPart of
+            [ case divPart of
-              Nothing -> Left $ Text.Read.read digits
+                Nothing -> Left $ Text.Read.read digits
-              Just ddigits ->
+                Just ddigits ->
-                Right $ Text.Read.read digits % Text.Read.read ddigits
+                  Right $ Text.Read.read digits % Text.Read.read ddigits
-          | digits  <- many1 digit
+            | digits  <- many1 digit
-          , divPart <- optionMaybe (string "/" *> many1 digit)
+            , divPart <- optionMaybe (string "/" *> many1 digit)
-          ]
+            ]
-      ]
+        ]
   ]
 
 #test opapp-specialcasing-1
-func = fooooooooooooooooooooooooooooooooo
+func =
-  $ foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
+  fooooooooooooooooooooooooooooooooo
-                                      foooooooooooooooooooooooooooooooo
+    $ 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
+         $  [ docForceSingleline
-              (patPartInline ++ [guardPart, return binderDoc])
+              $ docSeq (patPartInline ++ [guardPart, return binderDoc])
             , docEnsureIndent BrIndentRegular
             $ docForceSingleline
             $ return body
@@ -872,7 +872,6 @@ instance HasDependencies SomeDataModel where
     = (SomeOtherDataModelId, SomeOtherOtherDataModelId)
 
 #test stupid-do-operator-combination
-#pending
 
 func =
   do
@@ -896,45 +895,3 @@ 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,8 +1176,7 @@ showPackageDetailedInfo pkginfo =
           , entry "Cached" haveTarball alwaysShow dispYesNo
           , if not (hasLib pkginfo)
             then empty
-            else
+            else text "Modules:"
-              text "Modules:"
               $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
@@ -1250,18 +1249,18 @@ func _ = 3
 #test listcomprehension-case-of
 parserCompactLocation =
   [ try
-    $ [ ParseRelAbs (Text.Read.read digits) _ _
+      $ [ ParseRelAbs (Text.Read.read digits) _ _
-      | digits <- many1 digit
+        | digits <- many1 digit
-      , rel1 :: Maybe (Either Int (Ratio Int)) <-
+        , rel1 :: Maybe (Either Int (Ratio Int)) <-
-        optionMaybe
+          optionMaybe
-          [ case divPart of
+            [ case divPart of
-              Nothing -> Left $ Text.Read.read digits
+                Nothing -> Left $ Text.Read.read digits
-              Just ddigits ->
+                Just ddigits ->
-                Right $ Text.Read.read digits % Text.Read.read ddigits
+                  Right $ Text.Read.read digits % Text.Read.read ddigits
-          | digits <- many1 digit
+            | digits <- many1 digit
-          , divPart <- optionMaybe (string "/" *> many1 digit)
+            , divPart <- optionMaybe (string "/" *> many1 digit)
-          ]
+            ]
-      ]
+        ]
   ]
 
 #test opapp-specialcasing-1
@@ -1371,8 +1370,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
        ]
     ++ -- two-line solution + where in next line(s)
        [ docLines
-         $ [ docForceSingleline $ docSeq
+         $ [ docForceSingleline
-             (patPartInline ++ [guardPart, return binderDoc])
+             $ docSeq (patPartInline ++ [guardPart, return binderDoc])
            , docEnsureIndent BrIndentRegular
            $ docForceSingleline
            $ return body

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

@@ -223,9 +223,7 @@ 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
@@ -247,7 +245,6 @@ 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
@@ -268,8 +265,6 @@ 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,19 +242,6 @@ 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
@@ -536,10 +523,6 @@ 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 (m, ExactPrint.pos2delta p1 p2) $ pure ()
+          -- traceShow (ExactPrint.pos2delta p1 p2) $ pure ()
           case ExactPrint.pos2delta p1 p2 of
             SameLine{} -> pure ()
             DifferentLine n _ | newlinePlanned -> layoutWriteNewlines n
@@ -326,14 +326,10 @@ printComments comms = do
           Anchor span UnchangedAnchor -> do
             let dp = ExactPrint.ss2deltaEnd prior span
             layoutWriteComment True isBlock dp 1 (Text.pack s)
-            if isBlock
+            layoutUpdateMarker $ realSrcSpanEnd span
-              then layoutSetMarker $ Just $ realSrcSpanEnd span
-              else layoutUpdateMarker $ realSrcSpanEnd span
           Anchor span (MovedAnchor dp) -> do
             layoutWriteComment False isBlock dp 1 (Text.pack s)
-            if isBlock
+            layoutUpdateMarker $ realSrcSpanEnd span
-              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)
-      (id, Nothing)
+      Nothing
       hasComments
 
 
@@ -196,8 +196,7 @@ bindOrSigtoSrcSpan (BagSig (L (SrcSpanAnn _ l) _)) = l
 layoutLocalBinds
   :: HsLocalBindsLR GhcPs GhcPs
   -> ToBriDocM
-       ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+       ( Maybe
-       , Maybe
            ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
            , [BriDocNumbered]
            )
@@ -208,28 +207,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 locWhere = obtainAnnPos epAnn AnnWhere
-    let unordered =
+      let unordered =
-          [ BagBind b | b <- Data.Foldable.toList bindlrs ]
+            [ BagBind b | b <- Data.Foldable.toList bindlrs ]
-            ++ [ BagSig s | s <- sigs ]
+              ++ [ BagSig s | s <- sigs ]
-        ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered
+          ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered
-    ds <- join <$> ordered `forM` \case
+      ds <- docHandleComms epAnn $ join <$> ordered `forM` \case
-      BagBind b -> either id return <$> layoutBind b
+        BagBind b -> either id return <$> layoutBind b
-      BagSig  s@(L _ sig) -> do
+        BagSig  s@(L _ sig) -> do
-        doc <- layoutSig s sig
+          doc <- layoutSig s sig
-        pure [doc]
+          pure [doc]
-    pure $ (docHandleComms epAnn, Just (docHandleComms locWhere, ds))
+      pure $ Just (docHandleComms locWhere, ds)
 --  x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
   HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR"
   HsIPBinds epAnn (IPBinds _ bb) -> do
-    ds <- mapM layoutIPBind bb
+    ds <- docHandleComms epAnn $ mapM layoutIPBind bb
-    pure $ (docHandleComms epAnn, Just (id, ds)) -- TODO92 do we need to replace id?
+    pure $ Just (id, ds) -- TODO92 do we need to replace id?
-  EmptyLocalBinds NoExtField -> return $ (id, Nothing)
+  EmptyLocalBinds NoExtField -> return $ Nothing
 
 layoutGrhs
   :: LGRHS GhcPs (LHsExpr GhcPs)
   -> ToBriDocM
-       ( Maybe (EpAnn GrhsAnn)
+       ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
        , [BriDocNumbered]
        , BriDocNumbered
        )
@@ -239,7 +238,7 @@ layoutGrhs (L _ (GRHS epAnn guards body)) = do
     [] -> pure []
     _  -> docFlushCommsPost False posArrow $ callLayouter layout_stmt `mapM` guards
   bodyDoc <- callLayouter layout_expr body
-  return (Just epAnn, guardDocs, bodyDoc)
+  return (docHandleComms epAnn, guardDocs, bodyDoc)
 
 layoutPatternBind
   :: Maybe Text
@@ -260,7 +259,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
       let t' = fixPatternBindIdentifier match t
       docLit t'
     _ -> pure Nothing
-  patDoc <- docHandleComms lmatch $ case (mIdDoc, patDocs) of -- TODO92 we use lmatch twice here!
+  patDoc <- docHandleComms lmatch $ case (mIdDoc, patDocs) of
     (Just idDoc, p1 : p2 : pr) | isInfix -> if null pr
       then docCols
         ColPatternsFuncInfix
@@ -324,15 +323,14 @@ layoutPatternBindFinal
   -> BriDocNumbered
   -> Maybe BriDocNumbered
   -> Either (LHsExpr GhcPs) [LGRHS GhcPs (LHsExpr GhcPs)]
-  -> ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+  -> ( Maybe
-     , Maybe
          ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
          , [BriDocNumbered]
          )
      )
   -> Bool
   -> ToBriDocM BriDocNumbered
-layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhereDocs) hasComments
+layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasComments
   = do
     let
       patPartInline = case mPatDoc of
@@ -356,13 +354,14 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
       Just (wrapWhere, [w]) -> pure . pure <$> docAlt
         [ docEnsureIndent BrIndentRegular
           $ docSeq
-              [ wrapBinds $ wrapWhere $ docLit $ Text.pack "where"
+              [ wrapWhere $ docLit $ Text.pack "where"
               , docSeparator
               , docForceSingleline $ return w
               ]
-        , docEnsureIndent whereIndent
+        , -- docMoveToKWDP annKeyWhere AnnWhere False -- TODO92
+          docEnsureIndent whereIndent
         $ docLines
-            [ wrapBinds $ wrapWhere $ docLit $ Text.pack "where"
+            [ docLit $ Text.pack "where"
             , docEnsureIndent whereIndent
             $ docSetIndentLevel
             $ docNonBottomSpacing
@@ -371,9 +370,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
         ]
       Just (wrapWhere, ws) ->
         fmap (pure . pure)
+          -- $ docMoveToKWDP annKeyWhere AnnWhere False -- TODO92
           $ docEnsureIndent whereIndent
           $ docLines
-              [ wrapBinds $ wrapWhere $ docLit $ Text.pack "where"
+              [ wrapWhere $ docLit $ Text.pack "where"
               , docEnsureIndent whereIndent
               $ docSetIndentLevel
               $ docNonBottomSpacing
@@ -397,7 +397,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
         Nothing -> Just docEmpty
         Just (wrapWhere, [w]) -> Just $ docSeq
           [ docSeparator
-          , wrapBinds $ wrapWhere $ appSep $ docLit $ Text.pack "where"
+          , wrapWhere $ appSep $ docLit $ Text.pack "where"
           , docSetIndentLevel $ docForceSingleline $ return w
           ]
         _ -> Nothing
@@ -407,24 +407,17 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
     clauseDocs <- case clauses of
       Left expr -> do
         e <- callLayouter layout_expr expr
-        pure [(Nothing, [], e)]
+        pure [(id, [], e)]
       Right grhss -> layoutGrhs `mapM` grhss
 
-    let multipleClauses = not $ null clauseDocs
-
     runFilteredAlternative $ do
 
       case clauseDocs of
-        [(grhsEpAnn, guards, body)] -> do
+        [(wrapClause, guards, body)] -> do
-          let grhsHasComms = hasAnyCommentsBelow grhsEpAnn
+          let guardPart = wrapClause $ singleLineGuardsDoc guards
-          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' ->
-            addAlternativeCond (not hasComments && not grhsHasComms) $ docCols
+            -- one-line solution
+            addAlternativeCond (not hasComments) $ docCols
               (ColBindingLine alignmentToken)
               [ docSeq (patPartInline ++ [guardPart])
               , docSeq
@@ -433,29 +426,14 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
                 , wherePart'
                 ]
               ]
-
+          -- one-line solution + where in next line(s)
-          -- any below have this pattern:
+          addAlternativeCond (Data.Maybe.isJust mWhereDocs)
-          -- …
-          --   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
@@ -463,8 +441,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
                   ]
               ]
             ++ wherePartMultiLine
-          -- func x | null x =
+          -- two-line solution + where in next line(s)
-          --   x + a + 2
           addAlternative
             $ docLines
             $ [ docForceSingleline
@@ -474,10 +451,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
               $ return body
               ]
             ++ wherePartMultiLine
-          -- func x | null x
+          -- pattern and exactly one clause in single line, body as par;
-          --   = do
+          -- where in following lines
-          --       stmt x
-          --       log "abc"
           addAlternative
             $ docLines
             $ [ docCols
@@ -496,10 +471,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
              --   , docAddBaseY BrIndentRegular $ return body
              --   ]
             ++ wherePartMultiLine
-          -- func x | null x =
+          -- pattern and exactly one clause in single line, body in new line.
-          --   do
-          --     stmt1
-          --     stmt2 x
           addAlternative
             $ docLines
             $ [ docSeq (patPartInline ++ [guardPart, return binderDoc])
@@ -513,18 +485,19 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
         _ -> return () -- no alternatives exclusively when `length clauseDocs /= 1`
 
       case mPatDoc of
-        Just patDoc | multipleClauses, indentPolicy == IndentPolicyFree ->
+        Nothing -> return ()
+        Just patDoc ->
           -- multiple clauses added in-paragraph, each in a single line
-          -- func x | null x    = baz
+          -- example: foo | bar = baz
-          --        | otherwise = asd
+          --              | lll = asd
-          addAlternative
+          addAlternativeCond (indentPolicy == IndentPolicyFree)
             $ docLines
             $ [ docSeq
                   [ appSep $ docForceSingleline $ return patDoc
                   , docSetBaseY
                   $ docLines
                   $ clauseDocs
-                  <&> \(epAnn, guardDocs, bodyDoc) -> docHandleComms epAnn $ do
+                  <&> \(wrapClause, guardDocs, bodyDoc) -> wrapClause $ do -- TODO92
                         let guardPart = singleLineGuardsDoc guardDocs
                         -- the docForceSingleline might seems superflous, but it
                         -- helps the alternative resolving impl.
@@ -542,10 +515,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
                   ]
               ]
             ++ wherePartMultiLine
-        _ -> return ()
+      -- multiple clauses, each in a separate, single line
-      -- func x y
-      --   | null x, null y = a + b
-      --   | otherwise = a - b
       addAlternative
         $ docLines
         $ [ docAddBaseY BrIndentRegular
@@ -553,7 +523,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
             $ docLines
             $ map docSetBaseY
             $ clauseDocs
-            <&> \(epAnn, guardDocs, bodyDoc) -> docHandleComms epAnn $ do
+            <&> \(wrapClause, guardDocs, bodyDoc) -> wrapClause $ do -- TODO92
                   let guardPart = singleLineGuardsDoc guardDocs
                   -- the docForceSingleline might seems superflous, but it
                   -- helps the alternative resolving impl.
@@ -571,12 +541,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
                     ]
           ]
         ++ wherePartMultiLine
-      -- func x y
+      -- multiple clauses, each with the guard(s) in a single line, body
-      --   | null x, null y = do
+      -- as a paragraph
-      --       stmt x
-      --       stmt y
-      --   | otherwise -> do
-      --       abort
       addAlternativeCond (not hasComments)
         $ docLines
         $ [ docAddBaseY BrIndentRegular
@@ -584,26 +550,34 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
             $ docLines
             $ map docSetBaseY
             $ clauseDocs
-            <&> \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
+            <&> \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
-              docHandleComms grhsEpAnn $ docSeq
+                  wrapClause $ docSeq
-                [ singleLineGuardsDoc guardDocs
+                    $ (case guardDocs of
-                , docCols
+                        [] -> []
-                  ColOpPrefix
+                        [g] ->
-                  [ appSep $ return binderDoc
+                          [ docForceSingleline $ docSeq
-                  , docAddBaseY BrIndentRegular
+                              [appSep $ docLit $ Text.pack "|", return g]
-                  $ docForceParSpacing
+                          ]
-                  $ return bodyDoc
+                        gs ->
-                  ]
+                          [ docForceSingleline
-                ]
+                              $ docSeq
+                              $ [appSep $ docLit $ Text.pack "|"]
+                              ++ List.intersperse docCommaSep (return <$> gs)
+                          ]
+                      )
+                    ++ [ docSeparator
+                       , docCols
+                         ColOpPrefix
+                         [ appSep $ return binderDoc
+                         , docAddBaseY BrIndentRegular
+                         $ docForceParSpacing
+                         $ return bodyDoc
+                         ]
+                       ]
           ]
         ++ wherePartMultiLine
-      -- func x y
+      -- multiple clauses, each with the guard(s) in a single line, body
-      --   | null x, null y
+      -- in a new line as a paragraph
-      --   = do
-      --     stmt x
-      --     stmt y
-      --   | otherwise
-      --   = abort
       addAlternative
         $ docLines
         $ [ docAddBaseY BrIndentRegular
@@ -611,45 +585,46 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
             $ docLines
             $ map docSetBaseY
             $ clauseDocs
-            >>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
+            >>= \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
-              [ docHandleComms grhsEpAnn $ singleLineGuardsDoc guardDocs
-              , docCols
-                ColOpPrefix
-                [ appSep $ return binderDoc
-                , docAddBaseY BrIndentRegular
-                $ docForceParSpacing
-                $ return bodyDoc
-                ]
-              ]
-          ]
-        ++ wherePartMultiLine
-      -- func x y
-      --   | null x
-      --   , null y
-      --   = do
-      --       stmt x
-      --       stmt y
-      --   | otherwise
-      --   = abort
-      addAlternative
-        $ docLines
-        $ [ docAddBaseY BrIndentRegular
-            $ patPartParWrap
-            $ docLines
-            $ map docSetBaseY
-            $ clauseDocs
-            >>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
                   (case guardDocs of
-                      [] -> [docHandleComms grhsEpAnn docEmpty]
+                      [] -> [wrapClause docEmpty]
                       [g] ->
-                        [ docHandleComms grhsEpAnn
+                        [ wrapClause $ docForceSingleline
-                        $ docSeq [appSep
+                            $ docSeq [appSep $ docLit $ Text.pack "|", return g]
-                        $ 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
+                           ]
+                       ]
+          ]
+        ++ wherePartMultiLine
+      -- conservative approach: everything starts on the left.
+      addAlternative
+        $ docLines
+        $ [ docAddBaseY BrIndentRegular
+            $ patPartParWrap
+            $ docLines
+            $ map docSetBaseY
+            $ clauseDocs
+            >>= \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
+                  (case guardDocs of
+                      [] -> [wrapClause docEmpty]
+                      [g] ->
+                        [ wrapClause $ docSeq [appSep $ docLit $ Text.pack "|", return g]
                         ]
                       (g1 : gr) ->
-                        ( ( docHandleComms grhsEpAnn
+                        ( (wrapClause $ docSeq [appSep $ docLit $ Text.pack "|", return g1])
-                          $ 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 _expOp _expRight -> do
+    OpApp _topEpAnn _expLeft@(L _ OpApp{}) _expOp _expRight -> do
       -- let
       --   allowPar = case (expOp, expRight) of
       --     (L _ (HsVar _ (L _ (Unqual occname))), _)
@@ -235,6 +235,60 @@ 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]
@@ -531,7 +585,7 @@ layoutExpr lexpr@(L _ expr) = do
                                  binderDoc
                                  Nothing
                                  (Right cases)
-                                 (id, Nothing)
+                                 Nothing
                                  hasComments
         )
     HsLet epAnn binds exp1 -> docHandleComms epAnn $ do
@@ -539,7 +593,7 @@ layoutExpr lexpr@(L _ expr) = do
       let hasComments            = hasAnyCommentsBelow lexpr
       let wrapLet                = docHandleComms spanLet
       let wrapIn                 = docHandleComms spanIn
-      (wrapBinds, mBindDocs) <- callLayouter layout_localBinds binds
+      mBindDocs <- callLayouter layout_localBinds binds
       let ifIndentFreeElse :: a -> a -> a
           ifIndentFreeElse x y = case indentPolicy of
             IndentPolicyLeft     -> y
@@ -560,7 +614,7 @@ layoutExpr lexpr@(L _ expr) = do
         Just [bindDoc] -> runFilteredAlternative $ do
           addAlternativeCond (not hasComments) $ docSeq
             [ appSep $ letDoc
-            , wrapBinds $ appSep $ docForceSingleline (pure bindDoc)
+            , appSep $ docForceSingleline (pure bindDoc)
             , appSep $ inDoc
             , docForceSingleline expDoc1
             ]
@@ -568,13 +622,11 @@ layoutExpr lexpr@(L _ expr) = do
             [ docAlt
               [ docSeq
                 [ appSep $ letDoc
-                , wrapBinds
+                , ifIndentFreeElse docSetBaseAndIndent docForceSingleline
-                  $ ifIndentFreeElse docSetBaseAndIndent docForceSingleline
                   $ pure bindDoc
                 ]
-              , docAddBaseY BrIndentRegular $ docPar
+              , docAddBaseY BrIndentRegular
-                  (letDoc)
+                $ docPar (letDoc) (docSetBaseAndIndent $ pure bindDoc)
-                  (wrapBinds $ docSetBaseAndIndent $ pure bindDoc)
               ]
             , docAlt
               [ docSeq
@@ -606,9 +658,7 @@ layoutExpr lexpr@(L _ expr) = do
           let noHangingBinds =
                 [ docNonBottomSpacing $ docAddBaseY BrIndentRegular $ docPar
                   (letDoc)
-                  ( wrapBinds
+                  (docSetBaseAndIndent $ docLines $ pure <$> bindDocs)
-                  $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs
-                  )
                 , docSeq
                   [ wrapIn $ docLit $ Text.pack "in "
                   , docAddBaseY BrIndentRegular $ docForceParSpacing expDoc1
@@ -618,9 +668,10 @@ layoutExpr lexpr@(L _ expr) = do
             IndentPolicyLeft     -> docLines noHangingBinds
             IndentPolicyMultiple -> docLines noHangingBinds
             IndentPolicyFree     -> docLines
-              [ docSeq
+              [ -- TODO92 docNodeAnnKW lexpr (Just AnnLet) $
+                docSeq
                 [ appSep $ letDoc
-                , wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs
+                , docSetBaseAndIndent $ docLines $ pure <$> bindDocs
                 ]
               , docSeq
                 [ appSep $ wrapIn $ docLit $ Text.pack "in "
@@ -628,15 +679,15 @@ layoutExpr lexpr@(L _ expr) = do
                 ]
               ]
           addAlternative $ docLines
-            [ docAddBaseY BrIndentRegular $ docPar
+            [ -- TODO92 docNodeAnnKW lexpr (Just AnnLet) $
+              docAddBaseY BrIndentRegular $ docPar
               (letDoc)
-              (wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs)
+              (docSetBaseAndIndent $ docLines $ pure <$> bindDocs)
             , docAddBaseY BrIndentRegular
               $ docPar (inDoc) (docSetBaseY $ expDoc1)
             ]
         _ -> docSeq
-          [ docForceSingleline $ docSeq
+          [ docForceSingleline $ docSeq [letDoc, docSeparator, inDoc]
-            [letDoc, docSeparator, wrapBinds $ inDoc]
           , docSeparator
           , expDoc1
           ]
@@ -645,11 +696,10 @@ 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
-              (docHandleComms locDo $ docLit $ Text.pack "do")
+              (docLit $ Text.pack "do")
               ( docSetBaseAndIndent
               $ docNonBottomSpacing
               $ docLines

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

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

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

@@ -49,8 +49,7 @@ layoutStmt lstmt@(L _ stmt) = do
     LetStmt epAnn binds -> docHandleComms epAnn $ do
       let isFree = indentPolicy == IndentPolicyFree
       let indentFourPlus = indentAmount >= 4
-      (wrapBinds, bindrDocsMay) <- callLayouter layout_localBinds binds
+      callLayouter layout_localBinds binds >>= \case
-      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
@@ -66,13 +65,13 @@ layoutStmt lstmt@(L _ stmt) = do
                   IndentPolicyMultiple
                     | indentFourPlus -> docSetBaseAndIndent
                     | otherwise -> docForceSingleline
-              in wrapBinds $ f $ return bindDoc
+              in f $ return bindDoc
             ]
           , -- let
-            --   bind = expr
+              --   bind = expr
             docAddBaseY BrIndentRegular $ docPar
             (docLit $ Text.pack "let")
-            (wrapBinds $ docSetBaseAndIndent $ return bindDoc)
+            (docSetBaseAndIndent $ return bindDoc)
           ]
         Just (_, bindDocs) -> runFilteredAlternative $ do
           -- let aaa = expra
@@ -84,7 +83,7 @@ layoutStmt lstmt@(L _ stmt) = do
                 f = if indentFourPlus
                   then docEnsureIndent BrIndentRegular
                   else docSetBaseAndIndent
-              in wrapBinds $ f $ docLines $ return <$> bindDocs
+              in f $ docLines $ return <$> bindDocs
             ]
           -- let
           --   aaa = expra
@@ -94,7 +93,7 @@ layoutStmt lstmt@(L _ stmt) = do
             $ docAddBaseY BrIndentRegular
             $ docPar
                 (docLit $ Text.pack "let")
-                (wrapBinds $ docSetBaseAndIndent $ docLines $ return <$> bindDocs)
+                (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
     RecStmt epAnn (L _ stmts) _ _ _ _ _ ->
       docHandleComms epAnn $ runFilteredAlternative $ do
         -- rec stmt1

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

@@ -37,18 +37,12 @@ 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
-      $ ( wrapCtx $ case cntxtDocs of
+      $ ( do
+          cntxtDocs <- case ctxMay of
+            Nothing         -> pure []
+            Just (L _ ctxs) -> ctxs `forM` (shareDoc . layoutType)
+          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
-         ( Maybe (GHC.EpAnn GHC.GrhsAnn)
+         ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
          , [BriDocNumbered]
          , BriDocNumbered
          )
@@ -218,8 +218,7 @@ data Layouters = Layouters
     -> BriDocNumbered
     -> Maybe BriDocNumbered
     -> Either (GHC.LHsExpr GhcPs) [GHC.LGRHS GhcPs (GHC.LHsExpr GhcPs)]
-    -> ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+    -> ( Maybe
-       , Maybe
            ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
            , [BriDocNumbered]
            )
@@ -229,8 +228,7 @@ data Layouters = Layouters
   , layout_localBinds
     :: GHC.HsLocalBindsLR GhcPs GhcPs
     -> ToBriDocM
-         ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+         ( Maybe
-         , 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 $ go briDoc
+briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
                           -- the state encodes whether a separator was already
                           -- appended at the current position.
  where
-  go = \case
+  rec = \case
     BDEmpty -> return $ 0
     BDLit t -> StateS.put False $> Text.length t
-    BDSeq bds -> sum <$> go `mapM` bds
+    BDSeq bds -> sum <$> rec `mapM` bds
-    BDCols _ bds -> sum <$> go `mapM` bds
+    BDCols _ bds -> sum <$> rec `mapM` bds
     BDSeparator -> StateS.get >>= \b -> StateS.put True $> if b then 0 else 1
-    BDAddBaseY _ bd -> go bd
+    BDAddBaseY _ bd -> rec bd
-    BDBaseYPushCur bd -> go bd
+    BDBaseYPushCur bd -> rec bd
-    BDIndentLevelPushCur bd -> go bd
+    BDIndentLevelPushCur bd -> rec bd
-    BDIndentLevelPop bd -> go bd
+    BDIndentLevelPop bd -> rec bd
-    BDPar _ line _ -> go line
+    BDPar _ line _ -> rec line
     BDAlt{} -> error "briDocLineLength BDAlt"
-    BDForceAlt _ bd -> go bd
+    BDForceAlt _ bd -> rec bd
-    BDForwardLineMode bd -> go bd
+    BDForwardLineMode bd -> rec bd
     BDExternal _ t -> return $ Text.length t
     BDPlain t -> return $ Text.length t
-    BDQueueComments _ bd -> go bd
+    BDQueueComments _ bd -> rec bd
-    BDFlushCommentsPrior _ bd -> go bd
+    BDFlushCommentsPrior _ bd -> rec bd
-    BDFlushCommentsPost _ _ bd -> go bd
+    BDFlushCommentsPost _ _ bd -> rec bd
     BDLines ls@(_ : _) -> do
       x <- StateS.get
-      return $ maximum $ ls <&> \l -> StateS.evalState (go l) x
+      return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
-    BDEntryDelta _dp bd -> go bd
+    BDEntryDelta _dp bd -> rec bd
     BDLines [] -> error "briDocLineLength BDLines []"
-    BDEnsureIndent _ bd -> go bd
+    BDEnsureIndent _ bd -> rec bd
-    BDDebug _ bd -> go bd
+    BDDebug _ bd -> rec bd
 
 briDocIsMultiLine :: BriDoc -> Bool
-briDocIsMultiLine briDoc = go briDoc
+briDocIsMultiLine briDoc = rec briDoc
  where
-  go :: BriDoc -> Bool
+  rec :: BriDoc -> Bool
-  go = \case
+  rec = \case
     BDEmpty -> False
     BDLit _ -> False
-    BDSeq bds -> any go bds
+    BDSeq bds -> any rec bds
-    BDCols _ bds -> any go bds
+    BDCols _ bds -> any rec bds
     BDSeparator -> False
-    BDAddBaseY _ bd -> go bd
+    BDAddBaseY _ bd -> rec bd
-    BDBaseYPushCur bd -> go bd
+    BDBaseYPushCur bd -> rec bd
-    BDIndentLevelPushCur bd -> go bd
+    BDIndentLevelPushCur bd -> rec bd
-    BDIndentLevelPop bd -> go bd
+    BDIndentLevelPop bd -> rec bd
     BDPar{} -> True
     BDAlt{} -> error "briDocIsMultiLine BDAlt"
-    BDForceAlt _ bd -> go bd
+    BDForceAlt _ bd -> rec bd
-    BDForwardLineMode bd -> go bd
+    BDForwardLineMode bd -> rec bd
     BDExternal _ t | [_] <- Text.lines t -> False
     BDExternal{} -> True
     BDPlain t | [_] <- Text.lines t -> False
     BDPlain _ -> True
-    BDQueueComments _ bd -> go bd
+    BDQueueComments _ bd -> rec bd
-    BDFlushCommentsPrior _ bd -> go bd
+    BDFlushCommentsPrior _ bd -> rec bd
-    BDFlushCommentsPost _ _ bd -> go bd
+    BDFlushCommentsPost _ _ bd -> rec bd
-    BDEntryDelta _dp bd -> go bd
+    BDEntryDelta _dp bd -> rec bd
     BDLines (_ : _ : _) -> True
     BDLines [_] -> False
     BDLines [] -> error "briDocIsMultiLine BDLines []"
-    BDEnsureIndent _ bd -> go bd
+    BDEnsureIndent _ bd -> rec bd
-    BDDebug _ bd -> go bd
+    BDDebug _ bd -> rec bd
 
 briDocToColInfo :: Bool -> BriDoc -> StateS.State ColBuildState ColInfo
 briDocToColInfo lastFlag = \case