.hlint.yaml

@@ -0,0 +1,24 @@
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
+##########################
+
+# This file contains a template configuration file, which is typically
+# placed as .hlint.yaml in the root of your project
+
+# Specify additional command line arguments
+
+- arguments:
+    [ "--cpp-include=srcinc"
+    , "--language=GADTs"
+    , "--language=LambdaCase"
+    , "--language=MultiWayIf"
+    , "--language=KindSignatures"
+    , "--cross"
+    , "--threads=0"
+    ]
+
+- ignore: {name: "Use camelCase"}
+- ignore: {name: "Redundant as"}
+- ignore: {name: "Redundant do"}
+- ignore: {name: "Redundant return"}
+- ignore: {name: "Redundant guard", whithin: "lrdrNameToTextAnn"}

brittany.cabal

@@ -244,7 +244,6 @@ test-suite unittests
     , ghc-boot-th
     , hspec >=2.4.1 && <2.5
     }
-  ghc-options:      -Wall
   main-is:          TestMain.hs
   other-modules:    TestUtils
                     AsymptoticPerfTests
@@ -314,7 +313,6 @@ test-suite littests
     , filepath
     , parsec >=3.1.11 && <3.2
     }
-  ghc-options:      -Wall
   main-is:          Main.hs
   other-modules:
   hs-source-dirs:   src-literatetests
@@ -355,7 +353,6 @@ test-suite libinterfacetests
     , transformers
     , hspec >=2.4.1 && <2.5
     }
-  ghc-options:      -Wall
   main-is:          Main.hs
   other-modules:
   hs-source-dirs:   src-libinterfacetests

src-brittany/Main.hs

@@ -11,6 +11,7 @@ import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
 import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
 import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
 import qualified Data.Map as Map
+import qualified Data.Monoid
 
 import           Text.Read (Read(..))
 import qualified Text.ParserCombinators.ReadP as ReadP
@@ -148,7 +149,7 @@ mainCmdParser helpDesc = do
           , PP.text "inplace: override respective input file (without backup!)"
           ]
         )
-    <> flagDefault Display
+    Data.Monoid.<> flagDefault Display
     )
   inputParams <- addParamNoFlagStrings "PATH" (paramHelpStr "paths to input/inout haskell source files")
   reorderStop

src/Language/Haskell/Brittany/Internal.hs

@@ -93,8 +93,8 @@ parsePrintModule configRaw inputText = runExceptT $ do
       cppCheckFunc
       (hackTransform $ Text.unpack inputText)
     case parseResult of
-      Left  err -> throwE $ [ErrorInput err]
-      Right x   -> pure $ x
+      Left  err -> throwE [ErrorInput err]
+      Right x   -> pure x
   (errsWarns, outputTextL) <- do
     let omitCheck =
           config

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

@@ -1,3 +1,5 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Language.Haskell.Brittany.Internal.LayouterBasics
   ( processDefault
   , rdrNameToText
@@ -11,7 +13,10 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , docEmpty
   , docLit
   , docAlt
-  , docAltFilter
+  , CollectAltM
+  , addAlternativeCond
+  , addAlternative
+  , runFilteredAlternative
   , docLines
   , docCols
   , docSeq
@@ -60,6 +65,8 @@ where
 
 #include "prelude.inc"
 
+import qualified Control.Monad.Writer.Strict as Writer
+
 import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
 import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
 import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
@@ -111,7 +118,7 @@ processDefault x = do
   --       the module (header). This would remove the need for this hack!
   case str of
     "\n" -> return ()
-    _    -> mTell $ Text.Builder.fromString $ str
+    _    -> mTell $ Text.Builder.fromString str
 
 -- | Use ExactPrint's output for this node; add a newly generated inline comment
 -- at insertion position (meant to point out to the user that this node is
@@ -166,7 +173,7 @@ briDocByExactInlineOnly infoStr ast = do
         False
         t
   let errorAction = do
-        mTell $ [ErrorUnknownNode infoStr ast]
+        mTell [ErrorUnknownNode infoStr ast]
         docLit
           $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
   case (fallbackMode, Text.lines exactPrinted) of
@@ -256,8 +263,8 @@ extractAllComments ann =
        )
 
 filterAnns :: Data.Data.Data ast => ast -> ExactPrint.Anns -> ExactPrint.Anns
-filterAnns ast anns =
-  Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) anns
+filterAnns ast =
+  Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast)
 
 hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool
 hasAnyCommentsBelow ast@(L l _) = do
@@ -297,10 +304,10 @@ allocNodeIndex = do
 
 -- docEmpty :: MonadMultiState NodeAllocIndex m => m BriDocNumbered
 -- docEmpty = allocateNode BDFEmpty
--- 
+--
 -- docLit :: MonadMultiState NodeAllocIndex m => Text -> m BriDocNumbered
 -- docLit t = allocateNode $ BDFLit t
--- 
+--
 -- docExt :: (ExactPrint.Annotate.Annotate ast, MonadMultiState NodeAllocIndex m)
 --        => Located ast -> ExactPrint.Types.Anns -> Bool -> m BriDocNumbered
 -- docExt x anns shouldAddComment = allocateNode $ BDFExternal
@@ -308,51 +315,51 @@ allocNodeIndex = do
 --                   (foldedAnnKeys x)
 --                   shouldAddComment
 --                   (Text.pack $ ExactPrint.exactPrint x anns)
--- 
+--
 -- docAlt :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered
 -- docAlt l = allocateNode . BDFAlt =<< sequence l
--- 
--- 
+--
+--
 -- docSeq :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered
 -- docSeq l = allocateNode . BDFSeq =<< sequence l
--- 
+--
 -- docLines :: MonadMultiState NodeAllocIndex m => [m BriDocNumbered] -> m BriDocNumbered
 -- docLines l = allocateNode . BDFLines =<< sequence l
--- 
+--
 -- docCols :: MonadMultiState NodeAllocIndex m => ColSig -> [m BriDocNumbered] -> m BriDocNumbered
 -- docCols sig l = allocateNode . BDFCols sig =<< sequence l
--- 
+--
 -- docAddBaseY :: MonadMultiState NodeAllocIndex m => BrIndent -> m BriDocNumbered -> m BriDocNumbered
 -- docAddBaseY ind bdm = allocateNode . BDFAddBaseY ind =<< bdm
--- 
+--
 -- docSetBaseY :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
 -- docSetBaseY bdm = allocateNode . BDFSetBaseY =<< bdm
--- 
+--
 -- docSetIndentLevel :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
 -- docSetIndentLevel bdm = allocateNode . BDFSetIndentLevel =<< bdm
--- 
+--
 -- docSeparator :: MonadMultiState NodeAllocIndex m => m BriDocNumbered
 -- docSeparator = allocateNode BDFSeparator
--- 
+--
 -- docAnnotationPrior :: MonadMultiState NodeAllocIndex m => AnnKey -> m BriDocNumbered -> m BriDocNumbered
 -- docAnnotationPrior annKey bdm = allocateNode . BDFAnnotationPrior annKey =<< bdm
--- 
+--
 -- docAnnotationPost :: MonadMultiState NodeAllocIndex m => AnnKey -> m BriDocNumbered -> m BriDocNumbered
 -- docAnnotationPost  annKey bdm = allocateNode . BDFAnnotationPost annKey =<< bdm
--- 
+--
 -- docNonBottomSpacing :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
 -- docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing =<< bdm
--- 
+--
 -- appSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
 -- appSep x = docSeq [x, docSeparator]
--- 
+--
 -- docCommaSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered
 -- docCommaSep = appSep $ docLit $ Text.pack ","
--- 
+--
 -- docParenLSep :: MonadMultiState NodeAllocIndex m => m BriDocNumbered
 -- docParenLSep = appSep $ docLit $ Text.pack "("
--- 
--- 
+--
+--
 -- docPostComment :: (Data.Data.Data ast, MonadMultiState NodeAllocIndex m)
 --                => Located ast
 --                -> m BriDocNumbered
@@ -360,7 +367,7 @@ allocNodeIndex = do
 -- docPostComment ast bdm = do
 --   bd <- bdm
 --   allocateNode $ BDFAnnotationPost (ExactPrint.Types.mkAnnKey ast) bd
--- 
+--
 -- docWrapNode :: ( Data.Data.Data ast, MonadMultiState NodeAllocIndex m)
 --             => Located ast
 --             -> m BriDocNumbered
@@ -375,7 +382,7 @@ allocNodeIndex = do
 --     $ (,) i2
 --     $ BDFAnnotationPost (ExactPrint.Types.mkAnnKey ast)
 --     $ bd
--- 
+--
 -- docPar :: MonadMultiState NodeAllocIndex m
 --        => m BriDocNumbered
 --        -> m BriDocNumbered
@@ -384,13 +391,13 @@ allocNodeIndex = do
 --   line <- lineM
 --   indented <- indentedM
 --   allocateNode $ BDFPar BrIndentNone line indented
--- 
+--
 -- docForceSingleline :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
 -- docForceSingleline bdm = allocateNode . BDFForceSingleline =<< bdm
--- 
+--
 -- docForceMultiline :: MonadMultiState NodeAllocIndex m => m BriDocNumbered -> m BriDocNumbered
 -- docForceMultiline bdm = allocateNode . BDFForceMultiline =<< bdm
--- 
+--
 -- docEnsureIndent :: MonadMultiState NodeAllocIndex m => BrIndent -> m BriDocNumbered -> m BriDocNumbered
 -- docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd
 
@@ -415,8 +422,20 @@ docExt x anns shouldAddComment = allocateNode $ BDFExternal
 docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
 docAlt l = allocateNode . BDFAlt =<< sequence l
 
-docAltFilter :: [(Bool, ToBriDocM BriDocNumbered)] -> ToBriDocM BriDocNumbered
-docAltFilter = docAlt . map snd . filter fst
+newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a)
+  deriving (Functor, Applicative, Monad)
+
+addAlternativeCond :: Bool -> ToBriDocM BriDocNumbered -> CollectAltM ()
+addAlternativeCond cond doc =
+  when cond (addAlternative doc)
+
+addAlternative :: ToBriDocM BriDocNumbered -> CollectAltM ()
+addAlternative =
+  CollectAltM . Writer.tell . (: [])
+
+runFilteredAlternative :: CollectAltM () -> ToBriDocM BriDocNumbered
+runFilteredAlternative (CollectAltM action) =
+  docAlt $ Writer.execWriter action
 
 
 docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
@@ -565,7 +584,7 @@ instance DocWrapable a => DocWrapable [a] where
   docWrapNode ast bdsm = do
     bds <- bdsm
     case bds of
-      [] -> return $ [] -- TODO: this might be bad. maybe. then again, not really. well.
+      [] -> return [] -- TODO: this might be bad. maybe. then again, not really. well.
       [bd] -> do
         bd' <- docWrapNode ast (return bd)
         return [bd']
@@ -577,23 +596,23 @@ instance DocWrapable a => DocWrapable [a] where
   docWrapNodePrior ast bdsm = do
     bds <- bdsm
     case bds of
-      [] -> return $ []
+      [] -> return []
       (bd1:bdR) -> do
         bd1' <- docWrapNodePrior ast (return bd1)
-        return $ (bd1':bdR)
+        return (bd1':bdR)
   docWrapNodeRest ast bdsm = do
     bds <- bdsm
     case reverse bds of
-      [] -> return $ []
+      [] -> return []
       (bdN:bdR) -> do
         bdN' <- docWrapNodeRest ast (return bdN)
-        return $ reverse $ (bdN':bdR)
+        return $ reverse (bdN':bdR)
 
 instance DocWrapable a => DocWrapable (Seq a) where
   docWrapNode ast bdsm = do
     bds <- bdsm
     case Seq.viewl bds of
-      Seq.EmptyL -> return $ Seq.empty -- TODO: this might be bad. maybe. then again, not really. well.
+      Seq.EmptyL -> return Seq.empty -- TODO: this might be bad. maybe. then again, not really. well.
       bd1 Seq.:< rest -> case Seq.viewr rest of
         Seq.EmptyR -> do
           bd1' <- docWrapNode ast (return bd1)
@@ -605,14 +624,14 @@ instance DocWrapable a => DocWrapable (Seq a) where
   docWrapNodePrior ast bdsm = do
     bds <- bdsm
     case Seq.viewl bds of
-      Seq.EmptyL -> return $ Seq.empty
+      Seq.EmptyL -> return Seq.empty
       bd1 Seq.:< bdR -> do
         bd1' <- docWrapNodePrior ast (return bd1)
         return $ bd1' Seq.<| bdR
   docWrapNodeRest ast bdsm = do
     bds <- bdsm
     case Seq.viewr bds of
-      Seq.EmptyR -> return $ Seq.empty
+      Seq.EmptyR -> return Seq.empty
       bdR Seq.:> bdN -> do
         bdN' <- docWrapNodeRest ast (return bdN)
         return $ bdR Seq.|> bdN'
@@ -623,19 +642,19 @@ instance DocWrapable ([BriDocNumbered], BriDocNumbered, a) where
     if null bds
       then do
         bd' <- docWrapNode ast (return bd)
-        return $ (bds, bd', x)
+        return (bds, bd', x)
       else do
         bds' <- docWrapNodePrior ast (return bds)
         bd' <- docWrapNodeRest ast (return bd)
-        return $ (bds', bd', x)
+        return (bds', bd', x)
   docWrapNodePrior ast stuffM = do
     (bds, bd, x) <- stuffM
     bds' <- docWrapNodePrior ast (return bds)
-    return $ (bds', bd, x)
+    return (bds', bd, x)
   docWrapNodeRest ast stuffM = do
     (bds, bd, x) <- stuffM
     bd' <- docWrapNodeRest ast (return bd)
-    return $ (bds, bd', x)
+    return (bds, bd', x)
 
 
 
@@ -661,7 +680,7 @@ docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd
 unknownNodeError
   :: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered
 unknownNodeError infoStr ast = do
-  mTell $ [ErrorUnknownNode infoStr ast]
+  mTell [ErrorUnknownNode infoStr ast]
   docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
 
 spacifyDocs :: [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]

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

@@ -308,258 +308,237 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
             ++ (List.intersperse docCommaSep
                                  (docForceSingleline . return <$> gs)
                )
+      wherePart = case mWhereDocs of
+        Nothing  -> Just docEmpty
+        Just [w] -> Just $ docSeq
+          [ docSeparator
+          , appSep $ docLit $ Text.pack "where"
+          , docSetIndentLevel $ docForceSingleline $ return w
+          ]
+        _        -> Nothing
 
   indentPolicy <- mAsk
     <&> _conf_layout
     .>  _lconfig_indentPolicy
     .>  confUnpack
-  docAltFilter
-    $  -- one-line solution
-       [ ( True
-         , docCols
-         (ColBindingLine alignmentToken)
-         [ docSeq (patPartInline ++ [guardPart])
-         , docSeq
-           [ appSep $ return binderDoc
-           , docForceSingleline $ return body
-           , wherePart
-           ]
-         ]
-         )
-       | not hasComments
-       , [(guards, body, _bodyRaw)] <- [clauseDocs]
-       , let guardPart = singleLineGuardsDoc guards
-       , wherePart <- case mWhereDocs of
-         Nothing  -> return @[] $ docEmpty
-         Just [w] -> return @[] $ docSeq
-           [ docSeparator
-           , appSep $ docLit $ Text.pack "where"
-           , docSetIndentLevel $ docForceSingleline $ return w
-           ]
-         _        -> []
-       ]
-    ++ -- one-line solution + where in next line(s)
-       [ ( True
-         , docLines
-         $  [ docCols
-              (ColBindingLine alignmentToken)
-              [ docSeq (patPartInline ++ [guardPart])
-              , docSeq
-                [appSep $ return binderDoc, docForceParSpacing $ return body]
+
+  runFilteredAlternative $ do
+
+    case clauseDocs of
+      [(guards, body, _bodyRaw)] -> do
+        let guardPart = singleLineGuardsDoc guards
+        forM_ wherePart $ \wherePart' ->
+          -- one-line solution
+          addAlternativeCond (not hasComments) $ docCols
+            (ColBindingLine alignmentToken)
+            [ docSeq (patPartInline ++ [guardPart])
+            , docSeq
+              [ appSep $ return binderDoc
+              , docForceSingleline $ return body
+              , wherePart'
               ]
             ]
-         ++ wherePartMultiLine
-         )
-       | [(guards, body, _bodyRaw)] <- [clauseDocs]
-       , let guardPart = singleLineGuardsDoc guards
-       , Data.Maybe.isJust mWhereDocs
-       ]
-    ++ -- two-line solution + where in next line(s)
-       [ ( True 
-         , docLines
-         $  [ docForceSingleline
-            $ docSeq (patPartInline ++ [guardPart, return binderDoc])
-            , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body
-            ]
-         ++ wherePartMultiLine
-         )
-       | [(guards, body, _bodyRaw)] <- [clauseDocs]
-       , let guardPart = singleLineGuardsDoc guards
-       ]
-    ++ -- pattern and exactly one clause in single line, body as par;
-       -- where in following lines
-       [ ( True
-         , docLines
-         $  [ docCols
-              (ColBindingLine alignmentToken)
-              [ docSeq (patPartInline ++ [guardPart])
-              , docSeq
-                [ appSep $ return binderDoc
-                , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body
-                ]
-              ]
-            ]
-          -- , lineMod $ docAlt
-          --   [ docSetBaseY $ return body
-          --   , docAddBaseY BrIndentRegular $ return body
-          --   ]
-         ++ wherePartMultiLine
-         )
-       | [(guards, body, _bodyRaw)] <- [clauseDocs]
-       , let guardPart = singleLineGuardsDoc guards
-       ]
-    ++ -- pattern and exactly one clause in single line, body in new line.
-       [ ( True
-         , docLines
-         $  [ docSeq (patPartInline ++ [guardPart, return binderDoc])
-            , docEnsureIndent BrIndentRegular
-            $ docNonBottomSpacing
-            $ (docAddBaseY BrIndentRegular $ return body)
-            ]
-         ++ wherePartMultiLine
-         )
-       | [(guards, body, _)] <- [clauseDocs]
-       , let guardPart = singleLineGuardsDoc guards
-       ]
-    ++ -- multiple clauses added in-paragraph, each in a single line
-       -- example: foo | bar = baz
-       --              | lll = asd
-       [ ( indentPolicy /= IndentPolicyLeft
-         , docLines
-         $  [ docSeq
-              [ appSep $ docForceSingleline $ return patDoc
-              , docSetBaseY
-              $   docLines
-              $   clauseDocs
-              <&> \(guardDocs, bodyDoc, _) -> do
-                    let guardPart = singleLineGuardsDoc guardDocs
-                    -- the docForceSingleline might seems superflous, but it
-                    -- helps the alternative resolving impl.
-                    docForceSingleline $ docCols
-                      ColGuardedBody
-                      [ guardPart
-                      , docSeq
-                        [ appSep $ return binderDoc
-                        , docForceSingleline $ return bodyDoc
-                        -- i am not sure if there is a benefit to using
-                        -- docForceParSpacing additionally here:
-                        -- , docAddBaseY BrIndentRegular $ return bodyDoc
-                        ]
-                      ]
-              ]
-            ]
-         ++ wherePartMultiLine
-         )
-       | Just patDoc <- [mPatDoc]
-       ]
-    ++ -- multiple clauses, each in a separate, single line
-       [ ( True
-         , docLines
-         $  [ docAddBaseY BrIndentRegular
-              $   patPartParWrap
-              $   docLines
-              $   map docSetBaseY
-              $   clauseDocs
-              <&> \(guardDocs, bodyDoc, _) -> do
-                    let guardPart = singleLineGuardsDoc guardDocs
-                    -- the docForceSingleline might seems superflous, but it
-                    -- helps the alternative resolving impl.
-                    docForceSingleline $ docCols
-                      ColGuardedBody
-                      [ guardPart
-                      , docSeq
-                        [ appSep $ return binderDoc
-                        , docForceSingleline $ return bodyDoc
-                        -- i am not sure if there is a benefit to using
-                        -- docForceParSpacing additionally here:
-                        -- , docAddBaseY BrIndentRegular $ return bodyDoc
-                        ]
-                      ]
-            ]
-         ++ wherePartMultiLine
-         )
-       ]
-    ++ -- multiple clauses, each with the guard(s) in a single line, body
-       -- as a paragraph
-       [ ( True
-         , docLines
-         $  [ docAddBaseY BrIndentRegular
-              $   patPartParWrap
-              $   docLines
-              $   map docSetBaseY
-              $   clauseDocs
-              <&> \(guardDocs, bodyDoc, _) ->
-                    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
-                           ]
-                         ]
-            ]
-         ++ wherePartMultiLine
-         )
-       ]
-    ++ -- multiple clauses, each with the guard(s) in a single line, body
-       -- in a new line as a paragraph
-       [ ( True
-         , docLines
-         $  [ docAddBaseY BrIndentRegular
-              $   patPartParWrap
-              $   docLines
-              $   map docSetBaseY
-              $   clauseDocs
-              >>= \(guardDocs, bodyDoc, _) ->
-                    ( case guardDocs of
-                      [] -> []
-                      [g] ->
-                        [ docForceSingleline
-                        $ docSeq [appSep $ docLit $ Text.pack "|", return g]
-                        ]
-                      gs ->
-                        [  docForceSingleline
-                        $  docSeq
-                        $  [appSep $ docLit $ Text.pack "|"]
-                        ++ List.intersperse docCommaSep (return <$> gs)
-                        ]
-                    )
-                    ++ [ docCols
-                         ColOpPrefix
+        -- one-line solution + where in next line(s)
+        addAlternativeCond (Data.Maybe.isJust mWhereDocs)
+          $ docLines
+          $  [ docCols
+               (ColBindingLine alignmentToken)
+               [ docSeq (patPartInline ++ [guardPart])
+               , docSeq
+                 [appSep $ return binderDoc, docForceParSpacing $ return body]
+               ]
+             ]
+          ++ wherePartMultiLine
+        -- two-line solution + where in next line(s)
+        addAlternative
+          $ docLines
+          $  [ docForceSingleline
+             $ docSeq (patPartInline ++ [guardPart, return binderDoc])
+             , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body
+             ]
+          ++ wherePartMultiLine
+        -- pattern and exactly one clause in single line, body as par;
+        -- where in following lines
+        addAlternative
+          $ docLines
+          $  [ docCols
+               (ColBindingLine alignmentToken)
+               [ docSeq (patPartInline ++ [guardPart])
+               , docSeq
+                 [ appSep $ return binderDoc
+                 , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body
+                 ]
+               ]
+             ]
+           -- , lineMod $ docAlt
+           --   [ docSetBaseY $ return body
+           --   , docAddBaseY BrIndentRegular $ return body
+           --   ]
+          ++ wherePartMultiLine
+        -- pattern and exactly one clause in single line, body in new line.
+        addAlternative
+          $ docLines
+          $  [ docSeq (patPartInline ++ [guardPart, return binderDoc])
+             , docEnsureIndent BrIndentRegular
+             $ docNonBottomSpacing
+             $ docAddBaseY BrIndentRegular
+             $ return body
+             ]
+          ++ wherePartMultiLine
+
+      _ -> return () -- no alternatives exclusively when `length clauseDocs /= 1`
+
+    case mPatDoc of
+      Nothing     -> return ()
+      Just patDoc ->
+        -- multiple clauses added in-paragraph, each in a single line
+        -- example: foo | bar = baz
+        --              | lll = asd
+        addAlternativeCond (indentPolicy /= IndentPolicyLeft)
+          $ docLines
+          $  [ docSeq
+               [ appSep $ docForceSingleline $ return patDoc
+               , docSetBaseY
+               $   docLines
+               $   clauseDocs
+               <&> \(guardDocs, bodyDoc, _) -> do
+                     let guardPart = singleLineGuardsDoc guardDocs
+                     -- the docForceSingleline might seems superflous, but it
+                     -- helps the alternative resolving impl.
+                     docForceSingleline $ docCols
+                       ColGuardedBody
+                       [ guardPart
+                       , docSeq
                          [ appSep $ return binderDoc
-                         , docAddBaseY BrIndentRegular
-                         $ docForceParSpacing
-                         $ return bodyDoc
+                         , docForceSingleline $ return bodyDoc
+                         -- i am not sure if there is a benefit to using
+                         -- docForceParSpacing additionally here:
+                         -- , docAddBaseY BrIndentRegular $ return bodyDoc
                          ]
                        ]
-            ]
-         ++ wherePartMultiLine
-         )
-       ]
-    ++ -- conservative approach: everything starts on the left.
-       [ ( True
-         , docLines
-         $  [ docAddBaseY BrIndentRegular
-              $   patPartParWrap
-              $   docLines
-              $   map docSetBaseY
-              $   clauseDocs
-              >>= \(guardDocs, bodyDoc, _) ->
-                    ( case guardDocs of
-                        [] -> []
-                        [g] ->
-                          [docSeq [appSep $ docLit $ Text.pack "|", return g]]
-                        (g1:gr) ->
-                          ( docSeq [appSep $ docLit $ Text.pack "|", return g1]
-                          : (   gr
-                            <&> \g ->
-                                  docSeq
-                                    [appSep $ docLit $ Text.pack ",", return g]
-                            )
-                          )
-                      )
-                      ++ [ docCols
-                           ColOpPrefix
-                           [ appSep $ return binderDoc
-                           , docAddBaseY BrIndentRegular $ return bodyDoc
-                           ]
-                         ]
-            ]
-         ++ wherePartMultiLine
-         )
-       ]
+               ]
+             ]
+          ++ wherePartMultiLine
+    -- multiple clauses, each in a separate, single line
+    addAlternative
+      $ docLines
+      $  [ docAddBaseY BrIndentRegular
+           $   patPartParWrap
+           $   docLines
+           $   map docSetBaseY
+           $   clauseDocs
+           <&> \(guardDocs, bodyDoc, _) -> do
+                 let guardPart = singleLineGuardsDoc guardDocs
+                 -- the docForceSingleline might seems superflous, but it
+                 -- helps the alternative resolving impl.
+                 docForceSingleline $ docCols
+                   ColGuardedBody
+                   [ guardPart
+                   , docSeq
+                     [ appSep $ return binderDoc
+                     , docForceSingleline $ return bodyDoc
+                     -- i am not sure if there is a benefit to using
+                     -- docForceParSpacing additionally here:
+                     -- , docAddBaseY BrIndentRegular $ return bodyDoc
+                     ]
+                   ]
+         ]
+      ++ wherePartMultiLine
+    -- multiple clauses, each with the guard(s) in a single line, body
+    -- as a paragraph
+    addAlternative
+      $ docLines
+      $  [ docAddBaseY BrIndentRegular
+           $   patPartParWrap
+           $   docLines
+           $   map docSetBaseY
+           $   clauseDocs
+           <&> \(guardDocs, bodyDoc, _) ->
+                 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
+                        ]
+                      ]
+         ]
+      ++ wherePartMultiLine
+    -- multiple clauses, each with the guard(s) in a single line, body
+    -- in a new line as a paragraph
+    addAlternative
+      $ docLines
+      $  [ docAddBaseY BrIndentRegular
+           $   patPartParWrap
+           $   docLines
+           $   map docSetBaseY
+           $   clauseDocs
+           >>= \(guardDocs, bodyDoc, _) ->
+                 ( case guardDocs of
+                   [] -> []
+                   [g] ->
+                     [ docForceSingleline
+                     $ docSeq [appSep $ docLit $ Text.pack "|", return g]
+                     ]
+                   gs ->
+                     [  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
+           >>= \(guardDocs, bodyDoc, _) ->
+                 ( case guardDocs of
+                     [] -> []
+                     [g] ->
+                       [docSeq [appSep $ docLit $ Text.pack "|", return g]]
+                     (g1:gr) ->
+                       ( docSeq [appSep $ docLit $ Text.pack "|", return g1]
+                       : (   gr
+                         <&> \g ->
+                               docSeq
+                                 [appSep $ docLit $ Text.pack ",", return g]
+                         )
+                       )
+                   )
+                   ++ [ docCols
+                        ColOpPrefix
+                        [ appSep $ return binderDoc
+                        , docAddBaseY BrIndentRegular $ return bodyDoc
+                        ]
+                      ]
+         ]
+      ++ wherePartMultiLine

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

@@ -61,7 +61,7 @@ layoutExpr lexpr@(L _ expr) = do
       bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body
       let funcPatternPartLine =
             docCols ColCasePattern
-              $ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
+              (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
       docAlt
         [ -- single line
           docSeq
@@ -106,7 +106,7 @@ layoutExpr lexpr@(L _ expr) = do
 #else /* ghc-8.0 */
     HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do
 #endif
-      binderDoc <- docLit $ Text.pack "->"
+      binderDoc   <- docLit $ Text.pack "->"
       funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches
       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
         (docLit $ Text.pack "\\case")
@@ -114,8 +114,8 @@ layoutExpr lexpr@(L _ expr) = do
     HsApp exp1@(L _ HsApp{}) exp2 -> do
       let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName])
           gather list = \case
-            (L _ (HsApp l r)) -> gather (r:list) l
-            x -> (x, list)
+            L _ (HsApp l r) -> gather (r:list) l
+            x               -> (x, list)
       let (headE, paramEs) = gather [exp2] exp1
       let colsOrSequence = case headE of
             L _ (HsVar (L _ (Unqual occname))) ->
@@ -123,51 +123,46 @@ layoutExpr lexpr@(L _ expr) = do
             _ -> docSeq
       headDoc <- docSharedWrapper layoutExpr headE
       paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
-      docAltFilter
-        [ -- foo x y
-          ( True
-          , colsOrSequence
+      runFilteredAlternative $ do
+        -- foo x y
+        addAlternative
+          $ colsOrSequence
           $ appSep (docForceSingleline headDoc)
           : spacifyDocs (docForceSingleline <$> paramDocs)
-          )
-        , -- foo x
-          --     y
-          ( allowFreeIndent
-          , docSeq
-            [ appSep (docForceSingleline headDoc)
-            , docSetBaseY
-            $ docAddBaseY BrIndentRegular
-            $ docLines
-            $ (docForceSingleline <$> paramDocs)
-            ]
-          )
-        , -- foo
-          --   x
-          --   y
-          ( True
-          , docSetParSpacing
+        -- foo x
+        --     y
+        addAlternativeCond allowFreeIndent
+          $ docSeq
+          [ appSep (docForceSingleline headDoc)
+          , docSetBaseY
+          $ docAddBaseY BrIndentRegular
+          $ docLines
+          $ docForceSingleline <$> paramDocs
+          ]
+        -- foo
+        --   x
+        --   y
+        addAlternative
+          $ docSetParSpacing
           $ docAddBaseY BrIndentRegular
           $ docPar
             (docForceSingleline headDoc)
             ( docNonBottomSpacing
             $ docLines paramDocs
             )
-          )
-        , -- ( multi
-          --   line
-          --   function
-          -- )
-          --   x
-          --   y
-          ( True
-          , docAddBaseY BrIndentRegular
+        -- ( multi
+        --   line
+        --   function
+        -- )
+        --   x
+        --   y
+        addAlternative
+          $ docAddBaseY BrIndentRegular
           $ docPar
             headDoc
             ( docNonBottomSpacing
             $ docLines paramDocs
             )
-          )
-        ]
     HsApp exp1 exp2 -> do
       -- TODO: if expDoc1 is some literal, we may want to create a docCols here.
       expDoc1 <- docSharedWrapper layoutExpr exp1
@@ -235,47 +230,44 @@ layoutExpr lexpr@(L _ expr) = do
                                               | xD <- docSharedWrapper layoutExpr x
                                               , yD <- docSharedWrapper layoutExpr y
                                               ]
-      opLastDoc <- docSharedWrapper layoutExpr expOp
-      expLastDoc <- docSharedWrapper layoutExpr expRight
+      opLastDoc   <- docSharedWrapper layoutExpr expOp
+      expLastDoc  <- docSharedWrapper layoutExpr expRight
       hasComments <- hasAnyCommentsBelow lexpr
       let allowPar = case (expOp, expRight) of
             (L _ (HsVar (L _ (Unqual occname))), _)
               | occNameString occname == "$" -> True
             (_, L _ (HsApp _ (L _ HsVar{}))) -> False
             _ -> True
-      docAltFilter
-        [ ( not hasComments
+      runFilteredAlternative $ do
+        addAlternativeCond (not hasComments)
+          $ docSeq
+          [ appSep $ docForceSingleline leftOperandDoc
           , docSeq
-            [ appSep $ docForceSingleline leftOperandDoc
-            , docSeq
-            $ (appListDocs <&> \(od, ed) -> docSeq
-                [ appSep $ docForceSingleline od
-                , appSep $ docForceSingleline ed
-                ]
-              )
-            , appSep $ docForceSingleline opLastDoc
-            , (if allowPar then docForceParSpacing else docForceSingleline)
-                expLastDoc
-            ]
-          )
+          $ appListDocs <&> \(od, ed) -> docSeq
+              [ appSep $ docForceSingleline od
+              , appSep $ docForceSingleline ed
+              ]
+          , appSep $ docForceSingleline opLastDoc
+          , (if allowPar then docForceParSpacing else docForceSingleline)
+              expLastDoc
+          ]
         -- this case rather leads to some unfortunate layouting than to anything
         -- useful; disabling for now. (it interfers with cols stuff.)
-        -- , docSetBaseY
-        -- - $ docPar
+        -- addAlternative
+        --   $ docSetBaseY
+        --   $ docPar
         --     leftOperandDoc
         --     ( docLines
-        -- -    $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
+        --      $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
         --       ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
         --     )
-        , (otherwise
-          , docPar
+        addAlternative $
+          docPar
             leftOperandDoc
             ( docLines
             $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
               ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
             )
-          )
-        ]
     OpApp expLeft expOp _ expRight -> do
       expDocLeft  <- docSharedWrapper layoutExpr expLeft
       expDocOp    <- docSharedWrapper layoutExpr expOp
@@ -285,47 +277,47 @@ layoutExpr lexpr@(L _ expr) = do
               | occNameString occname == "$" -> True
             (_, L _ (HsApp _ (L _ HsVar{}))) -> False
             _ -> True
-      docAltFilter
-        $   [ -- one-line
-              (,) True
-            $ docSeq
-              [ appSep $ docForceSingleline expDocLeft
-              , appSep $ docForceSingleline expDocOp
-              , docForceSingleline expDocRight
-              ]
-            -- , -- line + freely indented block for right expression
-            --   docSeq
-            --   [ appSep $ docForceSingleline expDocLeft
-            --   , appSep $ docForceSingleline expDocOp
-            --   , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight
-            --   ]
-            , -- two-line
-              (,) True
-            $ docAddBaseY BrIndentRegular
-            $ docPar
-                expDocLeft
-                ( docForceSingleline
-                $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]
-                )
-            , -- one-line + par
-              (,) allowPar
-            $ docSeq
-              [ appSep $ docForceSingleline expDocLeft
-              , appSep $ docForceSingleline expDocOp
-              , docForceParSpacing expDocRight
-              ]
-            , -- more lines
-              (,) True
-            $ docAddBaseY BrIndentRegular
-            $ docPar
-                expDocLeft
-                (docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight])
-            ]
+      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
+          $ docAddBaseY BrIndentRegular
+          $ docPar
+              expDocLeft
+              ( docForceSingleline
+              $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]
+              )
+        -- one-line + par
+        addAlternativeCond allowPar
+          $ docSeq
+          [ appSep $ docForceSingleline expDocLeft
+          , appSep $ docForceSingleline expDocOp
+          , docForceParSpacing expDocRight
+          ]
+        -- more lines
+        addAlternative
+          $ docAddBaseY BrIndentRegular
+          $ docPar
+              expDocLeft
+              (docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight])
     NegApp op _ -> do
       opDoc <- docSharedWrapper layoutExpr op
-      docSeq $ [ docLit $ Text.pack "-"
-               , opDoc
-               ]
+      docSeq [ docLit $ Text.pack "-"
+             , opDoc
+             ]
     HsPar innerExp -> do
       innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp
       docAlt
@@ -364,7 +356,7 @@ layoutExpr lexpr@(L _ expr) = do
       case splitFirstLast argDocs of
         FirstLastEmpty -> docSeq
           [ openLit
-          , docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit
+          , docNodeAnnKW lexpr (Just AnnOpenP) closeLit
           ]
         FirstLastSingleton e -> docAlt
           [ docCols ColTuple
@@ -380,24 +372,21 @@ layoutExpr lexpr@(L _ expr) = do
             , closeLit
             ]
           ]
-        FirstLast e1 ems eN ->
-          docAltFilter
-            [ (,) (not hasComments)
-            $ docCols ColTuple
-              (  [docSeq [openLit, docForceSingleline e1]]
-              ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e])
-              ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]]
-              )
-            , (,) True
-            $ let
-                start = docCols ColTuples
-                          [appSep $ openLit, e1]
-                linesM = ems <&> \d ->
-                        docCols ColTuples [docCommaSep, d]
-                lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
-                end   = closeLit
-              in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
-            ]
+        FirstLast e1 ems eN -> runFilteredAlternative $ do
+          addAlternativeCond (not hasComments)
+            $  docCols ColTuple
+            $  [docSeq [openLit, docForceSingleline e1]]
+            ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e])
+            ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]]
+          addAlternative $
+            let
+              start = docCols ColTuples
+                        [appSep openLit, e1]
+              linesM = ems <&> \d ->
+                      docCols ColTuples [docCommaSep, d]
+              lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
+              end   = closeLit
+            in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]
     HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
       cExpDoc <- docSharedWrapper layoutExpr cExp
       binderDoc <- docLit $ Text.pack "->"
@@ -432,10 +421,10 @@ layoutExpr lexpr@(L _ expr) = do
               _ -> BrIndentSpecial 3
       -- TODO: some of the alternatives (especially last and last-but-one)
       -- overlap.
-      docAltFilter
-        [ -- if _ then _ else _
-          (,) (not hasComments)
-        $ docSeq
+      runFilteredAlternative $ do
+        -- if _ then _ else _
+        addAlternativeCond (not hasComments)
+          $ docSeq
           [ appSep $ docLit $ Text.pack "if"
           , appSep $ docForceSingleline ifExprDoc
           , appSep $ docLit $ Text.pack "then"
@@ -443,106 +432,105 @@ layoutExpr lexpr@(L _ expr) = do
           , appSep $ docLit $ Text.pack "else"
           , docForceSingleline elseExprDoc
           ]
-        , -- either
-          --   if expr
-          --   then foo
-          --     bar
-          --   else foo
-          --     bar
-          -- or
-          --   if expr
-          --   then
-          --     stuff
-          --   else
-          --     stuff
-          -- note that this has par-spacing
-          (,) True
-        $ docSetParSpacing
-        $ docAddBaseY BrIndentRegular
-        $ docPar
-            ( docSeq
-              [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
-              , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc
-              ])
-            (docLines
-              [ docAddBaseY BrIndentRegular
-              $ docNodeAnnKW lexpr (Just AnnThen)
-              $ docAlt
-                [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]
+        -- either
+        --   if expr
+        --   then foo
+        --     bar
+        --   else foo
+        --     bar
+        -- or
+        --   if expr
+        --   then
+        --     stuff
+        --   else
+        --     stuff
+        -- note that this has par-spacing
+        addAlternative
+          $ docSetParSpacing
+          $ docAddBaseY BrIndentRegular
+          $ docPar
+              ( docSeq
+                [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
+                , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc
+                ])
+              (docLines
+                [ docAddBaseY BrIndentRegular
+                $ docNodeAnnKW lexpr (Just AnnThen)
+                $ docAlt
+                  [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]
+                  , docAddBaseY BrIndentRegular
+                  $ docPar (docLit $ Text.pack "then") thenExprDoc
+                  ]
                 , docAddBaseY BrIndentRegular
-                $ docPar (docLit $ Text.pack "then") thenExprDoc
-                ]
-              , docAddBaseY BrIndentRegular
-              $ docAlt
-                [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]
+                $ docAlt
+                  [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]
+                  , docAddBaseY BrIndentRegular
+                  $ docPar (docLit $ Text.pack "else") elseExprDoc
+                  ]
+                ])
+        -- either
+        --   if multi
+        --      line
+        --      condition
+        --   then foo
+        --     bar
+        --   else foo
+        --     bar
+        -- or
+        --   if multi
+        --      line
+        --      condition
+        --   then
+        --     stuff
+        --   else
+        --     stuff
+        -- note that this does _not_ have par-spacing
+        addAlternative
+          $ docAddBaseY BrIndentRegular
+          $ docPar
+              ( docAddBaseY maySpecialIndent
+              $ docSeq
+                [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
+                , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
+                ])
+              (docLines
+                [ docAddBaseY BrIndentRegular
+                $ docNodeAnnKW lexpr (Just AnnThen)
+                $ docAlt
+                  [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]
+                  , docAddBaseY BrIndentRegular
+                  $ docPar (docLit $ Text.pack "then") thenExprDoc
+                  ]
                 , docAddBaseY BrIndentRegular
-                $ docPar (docLit $ Text.pack "else") elseExprDoc
-                ]
-              ])
-        , -- either
-          --   if multi
-          --      line
-          --      condition
-          --   then foo
-          --     bar
-          --   else foo
-          --     bar
-          -- or
-          --   if multi
-          --      line
-          --      condition
-          --   then
-          --     stuff
-          --   else
-          --     stuff
-          -- note that this does _not_ have par-spacing
-          (,) True
-        $ docAddBaseY BrIndentRegular
-        $ docPar
-            ( docAddBaseY maySpecialIndent
+                $ docAlt
+                  [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]
+                  , docAddBaseY BrIndentRegular
+                  $ docPar (docLit $ Text.pack "else") elseExprDoc
+                  ]
+                ])
+        addAlternative
+          $ docSetBaseY
+          $ docLines
+            [ docAddBaseY maySpecialIndent
             $ docSeq
               [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
               , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
-              ])
-            (docLines
-              [ docAddBaseY BrIndentRegular
-              $ docNodeAnnKW lexpr (Just AnnThen)
-              $ docAlt
-                [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc]
-                , docAddBaseY BrIndentRegular
-                $ docPar (docLit $ Text.pack "then") thenExprDoc
-                ]
-              , docAddBaseY BrIndentRegular
-              $ docAlt
-                [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc]
-                , docAddBaseY BrIndentRegular
-                $ docPar (docLit $ Text.pack "else") elseExprDoc
-                ]
-              ])
-        , (,) True
-        $ docSetBaseY
-        $ docLines
-          [ docAddBaseY maySpecialIndent
-          $ docSeq
-            [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if"
-            , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc
+              ]
+            , docNodeAnnKW lexpr (Just AnnThen)
+            $ docAddBaseY BrIndentRegular
+            $ docPar (docLit $ Text.pack "then") thenExprDoc
+            , docAddBaseY BrIndentRegular
+            $ docPar (docLit $ Text.pack "else") elseExprDoc
             ]
-          , docNodeAnnKW lexpr (Just AnnThen)
-          $ docAddBaseY BrIndentRegular
-          $ docPar (docLit $ Text.pack "then") thenExprDoc
-          , docAddBaseY BrIndentRegular
-          $ docPar (docLit $ Text.pack "else") elseExprDoc
-          ]
-        ]
     HsMultiIf _ cases -> do
-      clauseDocs <- cases `forM` layoutGrhs
-      binderDoc <- docLit $ Text.pack "->"
+      clauseDocs  <- cases `forM` layoutGrhs
+      binderDoc   <- docLit $ Text.pack "->"
       hasComments <- hasAnyCommentsBelow lexpr
       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
         (docLit $ Text.pack "if")
         (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)
     HsLet binds exp1 -> do
-      expDoc1 <- docSharedWrapper layoutExpr exp1
+      expDoc1   <- docSharedWrapper layoutExpr exp1
       -- We jump through some ugly hoops here to ensure proper sharing.
       mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return)
                =<< layoutLocalBinds binds
@@ -562,9 +550,9 @@ layoutExpr lexpr@(L _ expr) = do
         Just [bindDoc] -> docAlt
           [ docSeq
               [ appSep $ docLit $ Text.pack "let"
-              , appSep $ docForceSingleline $ bindDoc
+              , appSep $ docForceSingleline bindDoc
               , appSep $ docLit $ Text.pack "in"
-              , docForceSingleline $ expDoc1
+              , docForceSingleline expDoc1
               ]
           , docLines
               [ docAlt
@@ -576,7 +564,7 @@ layoutExpr lexpr@(L _ expr) = do
                   , docAddBaseY BrIndentRegular
                   $ docPar
                     (docLit $ Text.pack "let")
-                    (docSetBaseAndIndent $ bindDoc)
+                    (docSetBaseAndIndent bindDoc)
                   ]
               , docAlt
                   [ docSeq
@@ -586,11 +574,11 @@ layoutExpr lexpr@(L _ expr) = do
                   , docAddBaseY BrIndentRegular
                   $ docPar
                     (docLit $ Text.pack "in")
-                    (docSetBaseY $ expDoc1)
+                    (docSetBaseY expDoc1)
                   ]
               ]
           ]
-        Just bindDocs@(_:_) -> docAltFilter
+        Just bindDocs@(_:_) -> runFilteredAlternative $ do
           --either
           --  let
           --    a = b
@@ -604,43 +592,39 @@ layoutExpr lexpr@(L _ expr) = do
           --    c = d
           --  in
           --    fooooooooooooooooooo
-          [ ( indentPolicy == IndentPolicyLeft
-            , docLines
-              [ docAddBaseY BrIndentRegular
-              $ docPar
-                (docLit $ Text.pack "let")
-                (docSetBaseAndIndent $ docLines $ bindDocs)
-              , docSeq
-                [ docLit $ Text.pack "in "
-                , docAddBaseY BrIndentRegular $ expDoc1
-                ]
+          addAlternativeCond (indentPolicy == IndentPolicyLeft)
+            $ docLines
+            [ docAddBaseY BrIndentRegular
+            $ docPar
+              (docLit $ Text.pack "let")
+              (docSetBaseAndIndent $ docLines bindDocs)
+            , docSeq
+              [ docLit $ Text.pack "in "
+              , docAddBaseY BrIndentRegular expDoc1
               ]
-            )
-          , ( indentPolicy /= IndentPolicyLeft
-            , docLines
-              [ docSeq
-                [ appSep $ docLit $ Text.pack "let"
-                , docSetBaseAndIndent $ docLines $ bindDocs
-                ]
-              , docSeq
-                [ appSep $ docLit $ Text.pack "in "
-                , docSetBaseY $ expDoc1
-                ]
+            ]
+          addAlternativeCond (indentPolicy /= IndentPolicyLeft)
+            $ docLines
+            [ docSeq
+              [ appSep $ docLit $ Text.pack "let"
+              , docSetBaseAndIndent $ docLines bindDocs
               ]
-            )
-          , ( True
-            , docLines
-              [ docAddBaseY BrIndentRegular
-              $ docPar
-                (docLit $ Text.pack "let")
-                (docSetBaseAndIndent $ docLines $ bindDocs)
-              , docAddBaseY BrIndentRegular
-              $ docPar
-                (docLit $ Text.pack "in")
-                (docSetBaseY $ expDoc1)
+            , docSeq
+              [ appSep $ docLit $ Text.pack "in "
+              , docSetBaseY expDoc1
               ]
-            )
-          ]
+            ]
+          addAlternative
+            $ docLines
+            [ docAddBaseY BrIndentRegular
+            $ docPar
+              (docLit $ Text.pack "let")
+              (docSetBaseAndIndent $ docLines $ bindDocs)
+            , docAddBaseY BrIndentRegular
+            $ docPar
+              (docLit $ Text.pack "in")
+              (docSetBaseY $ expDoc1)
+            ]
         _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
       -- docSeq [appSep $ docLit "let in", expDoc1]
     HsDo DoExpr (L _ stmts) _ -> do
@@ -660,11 +644,11 @@ layoutExpr lexpr@(L _ expr) = do
     HsDo x  (L _ stmts) _ | case x of { ListComp -> True
                                       ; MonadComp -> True
                                       ; _ -> False } -> do
-      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
+      stmtDocs    <- docSharedWrapper layoutStmt `mapM` stmts
       hasComments <- hasAnyCommentsBelow lexpr
-      docAltFilter
-        [ (,) (not hasComments)
-        $ docSeq
+      runFilteredAlternative $ do
+        addAlternativeCond (not hasComments)
+          $ docSeq
           [ docNodeAnnKW lexpr Nothing
           $ appSep
           $ docLit
@@ -675,11 +659,11 @@ layoutExpr lexpr@(L _ expr) = do
           $ List.last stmtDocs
           , appSep $ docLit $ Text.pack "|"
           , docSeq $ List.intersperse docCommaSep
-                  $ fmap docForceSingleline $ List.init stmtDocs
+          $ docForceSingleline <$> List.init stmtDocs
           , docLit $ Text.pack " ]"
           ]
-        , (,) True
-        $ let
+        addAlternative $
+          let
             start = docCols ColListComp
                       [ docNodeAnnKW lexpr Nothing
                       $ appSep $ docLit $ Text.pack "["
@@ -694,12 +678,11 @@ layoutExpr lexpr@(L _ expr) = do
                     docCols ColListComp [docCommaSep, d]
             end   = docLit $ Text.pack "]"
           in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
-        ]
     HsDo{} -> do
       -- TODO
       unknownNodeError "HsDo{} no comp" lexpr
     ExplicitList _ _ elems@(_:_) -> do
-      elemDocs <- elems `forM` docSharedWrapper layoutExpr
+      elemDocs    <- elems `forM` docSharedWrapper layoutExpr
       hasComments <- hasAnyCommentsBelow lexpr
       case splitFirstLast elemDocs of
         FirstLastEmpty -> docSeq
@@ -716,28 +699,26 @@ layoutExpr lexpr@(L _ expr) = do
             [ docSeq
               [ docLit $ Text.pack "["
               , docSeparator
-              , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e
+              , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) e
               ]
             , docLit $ Text.pack "]"
             ]
           ]
-        FirstLast e1 ems eN ->
-          docAltFilter
-            [  (,) (not hasComments)
+        FirstLast e1 ems eN -> runFilteredAlternative $ do
+          addAlternativeCond (not hasComments)
             $  docSeq
             $  [docLit $ Text.pack "["]
             ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN]))
             ++ [docLit $ Text.pack "]"]
-            , (,) True
-            $ let
-                start = docCols ColList
-                          [appSep $ docLit $ Text.pack "[", e1]
-                linesM = ems <&> \d ->
-                        docCols ColList [docCommaSep, d]
-                lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN]
-                end   = docLit $ Text.pack "]"
-              in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
-            ]
+          addAlternative $
+            let
+              start = docCols ColList
+                        [appSep $ docLit $ Text.pack "[", e1]
+              linesM = ems <&> \d ->
+                      docCols ColList [docCommaSep, d]
+              lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN]
+              end   = docLit $ Text.pack "]"
+            in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
     ExplicitList _ _ [] ->
       docLit $ Text.pack "[]"
     ExplicitPArr{} -> do
@@ -757,20 +738,20 @@ layoutExpr lexpr@(L _ expr) = do
         fExpDoc <- if pun
           then return Nothing
           else Just <$> docSharedWrapper layoutExpr fExpr
-        return $ (fieldl, lrdrNameToText lnameF, fExpDoc)
+        return (fieldl, lrdrNameToText lnameF, fExpDoc)
       let line1 appender wrapper =
             [ appender $ docLit $ Text.pack "{"
-            , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n
+            , docWrapNodePrior fd1l $ appSep $ docLit fd1n
             , case fd1e of
                 Just x -> docSeq
                   [ appSep $ docLit $ Text.pack "="
-                  , docWrapNodeRest fd1l $ wrapper $ x
+                  , docWrapNodeRest fd1l $ wrapper x
                   ]
                 Nothing -> docEmpty
             ]
       let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
             [ docCommaSep
-            , appSep $ docLit $ fText
+            , appSep $ docLit fText
             , case fDoc of
                 Just x -> docWrapNode lfield $ docSeq
                   [ appSep $ docLit $ Text.pack "="
@@ -784,14 +765,14 @@ layoutExpr lexpr@(L _ expr) = do
             ]
       docAlt
         [  docSeq
-        $  [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator]
+        $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
         ++ line1 id docForceSingleline
         ++ join (lineR docForceSingleline)
         ++ lineN
         , docSetParSpacing
         $ docAddBaseY BrIndentRegular
         $ docPar
-            (docNodeAnnKW lexpr Nothing $ nameDoc)
+            (docNodeAnnKW lexpr Nothing nameDoc)
             ( docNonBottomSpacing
             $ docLines
             $  [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]
@@ -808,20 +789,20 @@ layoutExpr lexpr@(L _ expr) = do
         fExpDoc <- if pun
           then return Nothing
           else Just <$> docSharedWrapper layoutExpr fExpr
-        return $ (fieldl, lrdrNameToText lnameF, fExpDoc)
+        return (fieldl, lrdrNameToText lnameF, fExpDoc)
       let line1 appender wrapper =
             [ appender $ docLit $ Text.pack "{"
-            , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n
+            , docWrapNodePrior fd1l $ appSep $ docLit fd1n
             , case fd1e of
                 Just x -> docSeq
                   [ appSep $ docLit $ Text.pack "="
-                  , docWrapNodeRest fd1l $ wrapper $ x
+                  , docWrapNodeRest fd1l $ wrapper x
                   ]
                 Nothing -> docEmpty
             ]
       let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
             [ docCommaSep
-            , appSep $ docLit $ fText
+            , appSep $ docLit fText
             , case fDoc of
                 Just x -> docWrapNode lfield $ docSeq
                   [ appSep $ docLit $ Text.pack "="
@@ -839,7 +820,7 @@ layoutExpr lexpr@(L _ expr) = do
             ]
       docAlt
         [  docSeq
-        $  [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator]
+        $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
         ++ line1 id docForceSingleline
         ++ join (lineR docForceSingleline)
         ++ lineDot
@@ -847,7 +828,7 @@ layoutExpr lexpr@(L _ expr) = do
         , docSetParSpacing
         $ docAddBaseY BrIndentRegular
         $ docPar
-            (docNodeAnnKW lexpr Nothing $ nameDoc)
+            (docNodeAnnKW lexpr Nothing nameDoc)
             ( docNonBottomSpacing
             $ docLines
             $  [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)]
@@ -870,77 +851,75 @@ layoutExpr lexpr@(L _ expr) = do
           return $ case ambName of
             Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
             Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)
-      docAltFilter
+      runFilteredAlternative $ do
         -- container { fieldA = blub, fieldB = blub }
-        [ ( True
-          , docSeq
-            [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc
-            , appSep $ docLit $ Text.pack "{"
-            , appSep $ docSeq $ List.intersperse docCommaSep
-                    $ rFs <&> \case
-                      (lfield, fieldStr, Just fieldDoc) ->
-                        docWrapNode lfield $ docSeq
-                              [ appSep $ docLit fieldStr
-                              , appSep $ docLit $ Text.pack "="
-                              , docForceSingleline fieldDoc
-                              ]
-                      (lfield, fieldStr, Nothing) ->
-                        docWrapNode lfield $ docLit fieldStr
-            , docLit $ Text.pack "}"
-            ]
-          )
+        addAlternative
+          $ docSeq
+          [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc
+          , appSep $ docLit $ Text.pack "{"
+          , appSep $ docSeq $ List.intersperse docCommaSep
+                  $ rFs <&> \case
+                    (lfield, fieldStr, Just fieldDoc) ->
+                      docWrapNode lfield $ docSeq
+                            [ appSep $ docLit fieldStr
+                            , appSep $ docLit $ Text.pack "="
+                            , docForceSingleline fieldDoc
+                            ]
+                    (lfield, fieldStr, Nothing) ->
+                      docWrapNode lfield $ docLit fieldStr
+          , docLit $ Text.pack "}"
+          ]
         -- hanging single-line fields
         -- container { fieldA = blub
         --           , fieldB = blub
         --           }
-        , ( indentPolicy /= IndentPolicyLeft
-          , docSeq
-            [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
-            , docSetBaseY $ docLines $ let
-                line1 = docCols ColRecUpdate
-                  [ appSep $ docLit $ Text.pack "{"
-                  , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n
-                  , case rF1e of
-                      Just x -> docWrapNodeRest rF1f $ docSeq
-                                      [ appSep $ docLit $ Text.pack "="
+        addAlternativeCond (indentPolicy /= IndentPolicyLeft)
+          $ docSeq
+          [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc
+          , docSetBaseY $ docLines $ let
+              line1 = docCols ColRecUpdate
+                [ appSep $ docLit $ Text.pack "{"
+                , docWrapNodePrior rF1f $ appSep $ docLit rF1n
+                , case rF1e of
+                    Just x -> docWrapNodeRest rF1f $ docSeq
+                                    [ appSep $ docLit $ Text.pack "="
+                                    , docForceSingleline x
+                                    ]
+                    Nothing -> docEmpty
+                ]
+              lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
+                [ docCommaSep
+                , appSep $ docLit fText
+                , case fDoc of
+                    Just x ->  docSeq [ appSep $ docLit $ Text.pack "="
                                       , docForceSingleline x
                                       ]
-                      Nothing -> docEmpty
-                  ]
-                lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate
-                  [ docCommaSep
-                  , appSep $ docLit $ fText
-                  , case fDoc of
-                      Just x ->  docSeq [ appSep $ docLit $ Text.pack "="
-                                        , docForceSingleline x
-                                        ]
-                      Nothing -> docEmpty
-                  ]
-                lineN = docSeq
-                  [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
-                  , docLit $ Text.pack "}"
-                  ]
-                in [line1] ++ lineR ++ [lineN]
-            ]
-          )
-          -- non-hanging with expressions placed to the right of the names
-          -- container
-          -- { fieldA = blub
-          -- , fieldB = potentially
-          --     multiline
-          -- }
-        , ( True
-          , docSetParSpacing
+                    Nothing -> docEmpty
+                ]
+              lineN = docSeq
+                [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
+                , docLit $ Text.pack "}"
+                ]
+              in [line1] ++ lineR ++ [lineN]
+          ]
+        -- non-hanging with expressions placed to the right of the names
+        -- container
+        -- { fieldA = blub
+        -- , fieldB = potentially
+        --     multiline
+        -- }
+        addAlternative
+          $ docSetParSpacing
           $ docAddBaseY BrIndentRegular
           $ docPar
-              (docNodeAnnKW lexpr Nothing $ rExprDoc)
+              (docNodeAnnKW lexpr Nothing rExprDoc)
               (docNonBottomSpacing $ docLines $ let
                 expressionWrapper = if indentPolicy == IndentPolicyLeft
                   then docForceParSpacing
                   else docSetBaseY
                 line1 = docCols ColRecUpdate
                   [ appSep $ docLit $ Text.pack "{"
-                  , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n
+                  , docWrapNodePrior rF1f $ appSep $ docLit rF1n
                   , docWrapNodeRest rF1f $ case rF1e of
                       Just x -> docAlt
                         [ docSeq [ appSep $ docLit $ Text.pack "="
@@ -954,7 +933,7 @@ layoutExpr lexpr@(L _ expr) = do
                 lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield
                   $ docCols ColRecUpdate
                   [ docCommaSep
-                  , appSep $ docLit $ fText
+                  , appSep $ docLit fText
                   , case fDoc of
                       Just x -> docAlt
                         [ docSeq [ appSep $ docLit $ Text.pack "="
@@ -971,8 +950,6 @@ layoutExpr lexpr@(L _ expr) = do
                   ]
                 in [line1] ++ lineR ++ [lineN]
               )
-          )
-        ]
 #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
     ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
 #else /* ghc-8.0 */
@@ -1078,7 +1055,7 @@ layoutExpr lexpr@(L _ expr) = do
       docLit $ Text.pack "_"
     EAsPat asName asExpr -> do
       docSeq
-        [ docLit $ (lrdrNameToText asName) <> Text.pack "@"
+        [ docLit $ lrdrNameToText asName <> Text.pack "@"
         , layoutExpr asExpr
         ]
     EViewPat{} -> do
@@ -1112,10 +1089,10 @@ litBriDoc = \case
   HsWordPrim   (SourceText t) _i          -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
   HsInt64Prim  (SourceText t) _i          -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
   HsWord64Prim (SourceText t) _i          -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
-  HsInteger (SourceText t) _i _type       -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
-  HsRat (FL t _) _type       -> BDFLit $ Text.pack t
-  HsFloatPrim  (FL t _)      -> BDFLit $ Text.pack t
-  HsDoublePrim (FL t _)      -> BDFLit $ Text.pack t
+  HsInteger    (SourceText t) _i _type    -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
+  HsRat        (FL t _) _type             -> BDFLit $ Text.pack t
+  HsFloatPrim  (FL t _)                   -> BDFLit $ Text.pack t
+  HsDoublePrim (FL t _)                   -> BDFLit $ Text.pack t
   _ -> error "litBriDoc: literal with no SourceText"
 
 overLitValBriDoc :: OverLitVal -> BriDocFInt

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

@@ -46,18 +46,15 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
   IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"]
   IEThingWith _ _ ns _ -> do
     hasComments <- hasAnyCommentsBelow lie
-    docAltFilter
-      [ ( not hasComments
-        , docSeq
+    runFilteredAlternative $ do
+      addAlternativeCond (not hasComments)
+        $  docSeq
         $  [ien, docLit $ Text.pack "("]
         ++ intersperse docCommaSep (map nameDoc ns)
         ++ [docParenR]
-        )
-      , (otherwise
-        , docAddBaseY BrIndentRegular
+      addAlternative
+        $ docAddBaseY BrIndentRegular
         $ docPar ien (layoutItems (splitFirstLast ns))
-        )
-      ]
    where
     nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
     layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
@@ -121,25 +118,22 @@ layoutLLIEs :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered
 layoutLLIEs enableSingleline llies = do
   ieDs        <- layoutAnnAndSepLLIEs llies
   hasComments <- hasAnyCommentsBelow llies
-  case ieDs of
-    [] -> docAltFilter
-      [ (not hasComments, docLit $ Text.pack "()")
-      , ( hasComments
-        , docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
+  runFilteredAlternative $
+    case ieDs of
+      [] -> do
+        addAlternativeCond (not hasComments) $
+          docLit $ Text.pack "()"
+        addAlternativeCond hasComments $
+          docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
                  docParenR
-        )
-      ]
-    (ieDsH:ieDsT) -> docAltFilter
-      [ ( not hasComments && enableSingleline
-        , docSeq
-        $  [docLit (Text.pack "(")]
-        ++ (docForceSingleline <$> ieDs)
-        ++ [docParenR]
-        )
-      , ( otherwise
-        , docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
-        $  docLines
-        $  ieDsT
-        ++ [docParenR]
-        )
-      ]
+      (ieDsH:ieDsT) -> do
+        addAlternativeCond (not hasComments && enableSingleline)
+          $  docSeq
+          $  [docLit (Text.pack "(")]
+          ++ (docForceSingleline <$> ieDs)
+          ++ [docParenR]
+        addAlternative
+          $  docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
+          $  docLines
+          $  ieDsT
+          ++ [docParenR]

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

@@ -98,25 +98,21 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
                 [] -> if hasComments
                   then docPar
                     (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])
-                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) $ docParenR)
+                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
                   else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]
                   -- ..[hiding].( b )
-                [ieD] -> docAltFilter
-                  [ ( not hasComments
-                    , docSeq
-                      [ hidDoc
-                      , docParenLSep
-                      , docForceSingleline $ ieD
-                      , docSeparator
-                      , docParenR
-                      ]
-                    )
-                  , ( otherwise
-                    , docPar
-                      (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
-                      (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
-                    )
-                  ]
+                [ieD] -> runFilteredAlternative $ do
+                  addAlternativeCond (not hasComments)
+                    $ docSeq
+                    [ hidDoc
+                    , docParenLSep
+                    , docForceSingleline ieD
+                    , docSeparator
+                    , docParenR
+                    ]
+                  addAlternative $ docPar
+                    (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
+                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
                   -- ..[hiding].( b
                   --            , b'
                   --            )

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

@@ -38,25 +38,27 @@ layoutModule lmod@(L _ mod') = case mod' of
           [ docNodeAnnKW lmod Nothing docEmpty
              -- A pseudo node that serves merely to force documentation
              -- before the node
-          , docNodeMoveToKWDP lmod AnnModule $ docAltFilter
-            [ (,) allowSingleLineExportList $ docForceSingleline $ docSeq
-                   [ appSep $ docLit $ Text.pack "module"
-                   , appSep $ docLit tn
-                   , docWrapNode lmod $ appSep $ case les of
-                     Nothing -> docEmpty
-                     Just x  -> layoutLLIEs True x
-                   , docLit $ Text.pack "where"
-                   ]
-            , (,) otherwise $ docLines
-                   [ docAddBaseY BrIndentRegular $ docPar
-                     (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
-                     )
-                     (docWrapNode lmod $ case les of
-                       Nothing -> docEmpty
-                       Just x  -> layoutLLIEs False x
-                     )
-                   , docLit $ Text.pack "where"
-                   ]
-            ]
+          , docNodeMoveToKWDP lmod AnnModule $ runFilteredAlternative $ do
+            addAlternativeCond allowSingleLineExportList $
+              docForceSingleline
+                $ docSeq
+                [ appSep $ docLit $ Text.pack "module"
+                , appSep $ docLit tn
+                , docWrapNode lmod $ appSep $ case les of
+                  Nothing -> docEmpty
+                  Just x  -> layoutLLIEs True x
+                , docLit $ Text.pack "where"
+                ]
+            addAlternative
+              $ docLines
+              [ docAddBaseY BrIndentRegular $ docPar
+                (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
+                )
+                (docWrapNode lmod $ case les of
+                  Nothing -> docEmpty
+                  Just x  -> layoutLLIEs False x
+                )
+              , docLit $ Text.pack "where"
+              ]
           ]
       : map layoutImport imports

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

@@ -94,14 +94,14 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
       fExpDoc <- if pun
         then return Nothing
         else Just <$> docSharedWrapper layoutPat fPat
-      return $ (lrdrNameToText lnameF, fExpDoc)
-    fmap Seq.singleton $ docSeq
+      return (lrdrNameToText lnameF, fExpDoc)
+    Seq.singleton <$> docSeq
       [ appSep $ docLit t
       , appSep $ docLit $ Text.pack "{"
       , docSeq $ List.intersperse docCommaSep
                $ fds <&> \case
           (fieldName, Just fieldDoc) -> docSeq
-            [ appSep $ docLit $ fieldName
+            [ appSep $ docLit fieldName
             , appSep $ docLit $ Text.pack "="
             , fieldDoc >>= colsWrapPat
             ]
@@ -112,7 +112,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
   ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do
     -- Abc { .. } -> expr
     let t = lrdrNameToText lname
-    fmap Seq.singleton $ docSeq
+    Seq.singleton <$> docSeq
       [ appSep $ docLit t
       , docLit $ Text.pack "{..}"
       ]
@@ -123,13 +123,13 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
       fExpDoc <- if pun
         then return Nothing
         else Just <$> docSharedWrapper layoutPat fPat
-      return $ (lrdrNameToText lnameF, fExpDoc)
-    fmap Seq.singleton $ docSeq
+      return (lrdrNameToText lnameF, fExpDoc)
+    Seq.singleton <$> docSeq
       [ appSep $ docLit t
       , appSep $ docLit $ Text.pack "{"
       , docSeq $ fds >>= \case
           (fieldName, Just fieldDoc) ->
-            [ appSep $ docLit $ fieldName
+            [ appSep $ docLit fieldName
             , appSep $ docLit $ Text.pack "="
             , fieldDoc >>= colsWrapPat
             , docCommaSep
@@ -167,7 +167,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
                docAddBaseY BrIndentRegular $ docSeq
           [ appSep $ return xN
           , appSep $ docLit $ Text.pack "::"
-          , docForceSingleline $ tyDoc
+          , docForceSingleline tyDoc
           ]
         return $ xR Seq.|> xN'
   ListPat elems _ _ ->
@@ -193,7 +193,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
 -- else
 --   VarPat n -> return $ stringLayouter lpat $ rdrNameToText n
 -- endif
-  _ -> fmap return $ briDocByExactInlineOnly "some unknown pattern" lpat
+  _ -> return <$> briDocByExactInlineOnly "some unknown pattern" lpat
 
 colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
 colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList
@@ -205,7 +205,7 @@ wrapPatPrepend
 wrapPatPrepend pat prepElem = do
   patDocs <- layoutPat pat
   case Seq.viewl patDocs of
-    Seq.EmptyL -> return $ Seq.empty
+    Seq.EmptyL -> return Seq.empty
     x1 Seq.:< xR -> do
       x1' <- docSeq [prepElem, return x1]
       return $ x1' Seq.<| xR
@@ -216,7 +216,7 @@ wrapPatListy
   -> String
   -> ToBriDocM (Seq BriDocNumbered)
 wrapPatListy elems start end = do
-  elemDocs <- Seq.fromList elems `forM` \e -> layoutPat e >>= colsWrapPat
+  elemDocs <- Seq.fromList elems `forM` (layoutPat >=> colsWrapPat)
   sDoc <- docLit $ Text.pack start
   eDoc <- docLit $ Text.pack end
   case Seq.viewl elemDocs of

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

@@ -71,46 +71,40 @@ layoutStmt lstmt@(L _ stmt) = do
           (docLit $ Text.pack "let")
           (docSetBaseAndIndent $ return bindDoc)
         ]
-      Just bindDocs -> docAltFilter
-        [ -- let aaa = expra
-          --     bbb = exprb
-          --     ccc = exprc
-          ( indentPolicy /= IndentPolicyLeft
-          , docSeq
-            [ appSep $ docLit $ Text.pack "let"
-            , docSetBaseAndIndent $ docLines $ return <$> bindDocs
-            ]
-          )
-        , -- let
-          --   aaa = expra
-          --   bbb = exprb
-          --   ccc = exprc
-          ( True
-          , docAddBaseY BrIndentRegular $ docPar
+      Just bindDocs -> runFilteredAlternative $ do
+        -- let aaa = expra
+        --     bbb = exprb
+        --     ccc = exprc
+        addAlternativeCond (indentPolicy /= IndentPolicyLeft)
+          $ docSeq
+          [ appSep $ docLit $ Text.pack "let"
+          , docSetBaseAndIndent $ docLines $ return <$> bindDocs
+          ]
+        -- let
+        --   aaa = expra
+        --   bbb = exprb
+        --   ccc = exprc
+        addAlternative $
+          docAddBaseY BrIndentRegular $ docPar
             (docLit $ Text.pack "let")
             (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
-          )
+    RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do
+      -- rec stmt1
+      --     stmt2
+      --     stmt3
+      addAlternativeCond (indentPolicy /= IndentPolicyLeft)
+        $ docSeq
+        [ docLit (Text.pack "rec")
+        , docSeparator
+        , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
         ]
-    RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter
-      [ -- rec stmt1
-        --     stmt2
-        --     stmt3
-        ( indentPolicy /= IndentPolicyLeft
-        , docSeq
-          [ docLit (Text.pack "rec")
-          , docSeparator
-          , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts
-          ]
-        )
-      , -- rec
-        --   stmt1
-        --   stmt2
-        --   stmt3
-        ( True
-        , docAddBaseY BrIndentRegular
-          $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)
-        )
-      ]
+      -- rec
+      --   stmt1
+      --   stmt2
+      --   stmt3
+      addAlternative
+        $ docAddBaseY BrIndentRegular
+        $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts)
     BodyStmt expr _ _ _ -> do
       expDoc <- docSharedWrapper layoutExpr expr
       docAddBaseY BrIndentRegular $ expDoc

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

@@ -255,14 +255,16 @@ import Debug.Trace                   as E ( trace
 import Foreign.ForeignPtr            as E ( ForeignPtr
                                           )
 
-import Data.Monoid                   as E ( (<>)
-                                          , mconcat
+import Data.Monoid                   as E ( mconcat
                                           , Monoid (..)
                                           )
 
 import Data.Bifunctor                as E ( bimap )
 import Data.Functor                  as E ( (<$), ($>) )
 import Data.Function                 as E ( (&) )
+import Data.Semigroup                as E ( (<>)
+                                          , Semigroup(..)
+                                          )
 import System.IO                     as E ( hFlush
                                           , stdout
                                           )
@@ -306,7 +308,7 @@ import Data.Tree                     as E ( Tree(..)
 import Control.Monad.Trans.MultiRWS  as E ( -- MultiRWST (..)
                                           -- , MultiRWSTNull
                                           -- , MultiRWS
-                                          -- , 
+                                          -- ,
                                             MonadMultiReader(..)
                                           , MonadMultiWriter(..)
                                           , MonadMultiState(..)

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

@@ -84,9 +84,12 @@ fromOptionIdentity x y =
 newtype Max a = Max { getMax :: a }
   deriving (Eq, Ord, Show, Bounded, Num)
 
+instance (Num a, Ord a) => Semigroup (Max a) where
+  (<>) = Data.Coerce.coerce (max :: a -> a -> a)
+
 instance (Num a, Ord a) => Monoid (Max a) where
   mempty  = Max 0
-  mappend = Data.Coerce.coerce (max :: a -> a -> a)
+  mappend = (<>)
 
 newtype ShowIsId = ShowIsId String deriving Data
 
@@ -222,7 +225,7 @@ tellDebugMess :: MonadMultiWriter
 tellDebugMess s = mTell $ Seq.singleton s
 
 tellDebugMessShow :: forall a m . (MonadMultiWriter
-  (Seq String) m, Show a) => a -> m () 
+  (Seq String) m, Show a) => a -> m ()
 tellDebugMessShow = tellDebugMess . show
 
 -- i should really put that into multistate..

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-11.0
+resolver: lts-11.1
 
 packages:
   - .