content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MonadComprehensions #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  module Language.Haskell.Brittany.Internal.Layouters.Expr where
  
  import qualified Data.Data
  import qualified Data.Semigroup as Semigroup
  import qualified Data.Sequence as Seq
  import qualified Data.Text as Text
  import GHC (AnnKeywordId(..), GenLocated(L), RdrName(..), SrcSpan)
  import qualified GHC.Data.FastString as FastString
  import GHC.Hs
  import qualified GHC.OldList as List
  import GHC.Types.Basic
  import GHC.Types.Name
  import Language.Haskell.Brittany.Internal.Config.Types
  import Language.Haskell.Brittany.Internal.LayouterBasics
  import Language.Haskell.Brittany.Internal.Layouters.Decl
  import Language.Haskell.Brittany.Internal.Layouters.Pattern
  import Language.Haskell.Brittany.Internal.Layouters.Stmt
  import Language.Haskell.Brittany.Internal.Layouters.Type
  import Language.Haskell.Brittany.Internal.Prelude
  import Language.Haskell.Brittany.Internal.PreludeUtils
  import Language.Haskell.Brittany.Internal.Types
  import Language.Haskell.Brittany.Internal.Utils
  
  
  
  layoutExpr :: ToBriDoc HsExpr
  layoutExpr lexpr@(L _ expr) = do
    indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
    let allowFreeIndent = indentPolicy == IndentPolicyFree
    docWrapNode lexpr $ case expr of
      HsVar _ vname -> do
        docLit =<< lrdrNameToTextAnn vname
      HsUnboundVar _ oname -> docLit $ Text.pack $ occNameString oname
      HsRecFld{} -> do
        -- TODO
        briDocByExactInlineOnly "HsRecFld" lexpr
      HsOverLabel _ext _reboundFromLabel name ->
        let label = FastString.unpackFS name in docLit . Text.pack $ '#' : label
      HsIPVar _ext (HsIPName name) ->
        let label = FastString.unpackFS name in docLit . Text.pack $ '?' : label
      HsOverLit _ olit -> do
        allocateNode $ overLitValBriDoc $ ol_val olit
      HsLit _ lit -> do
        allocateNode $ litBriDoc lit
      HsLam _ (MG _ (L _ [lmatch@(L _ match)]) _)
        | pats <- m_pats match
        , GRHSs _ [lgrhs] llocals <- m_grhss match
        , L _ EmptyLocalBinds{} <- llocals
        , L _ (GRHS _ [] body) <- lgrhs
        -> do
          patDocs <- zip (True : repeat False) pats `forM` \(isFirst, p) ->
            fmap return $ do
              -- this code could be as simple as `colsWrapPat =<< layoutPat p`
              -- if it was not for the following two cases:
              -- \ !x -> x
              -- \ ~x -> x
              -- These make it necessary to special-case an additional separator.
              -- (TODO: we create a BDCols here, but then make it ineffective
              -- by wrapping it in docSeq below. We _could_ add alignments for
              -- stuff like lists-of-lambdas. Nothing terribly important..)
              let
                shouldPrefixSeparator = case p of
                  L _ LazyPat{} -> isFirst
                  L _ BangPat{} -> isFirst
                  _ -> False
              patDocSeq <- layoutPat p
              fixed <- case Seq.viewl patDocSeq of
                p1 Seq.:< pr | shouldPrefixSeparator -> do
                  p1' <- docSeq [docSeparator, pure p1]
                  pure (p1' Seq.<| pr)
                _ -> pure patDocSeq
              colsWrapPat fixed
          bodyDoc <-
            docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body
          let
            funcPatternPartLine = docCols
              ColCasePattern
              (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
          docAlt
            [ -- single line
              docSeq
              [ docLit $ Text.pack "\\"
              , docWrapNode lmatch $ docForceSingleline funcPatternPartLine
              , appSep $ docLit $ Text.pack "->"
              , docWrapNode lgrhs $ docForceSingleline bodyDoc
              ]
              -- double line
            , docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
              (docSeq
                [ docLit $ Text.pack "\\"
                , docWrapNode lmatch $ appSep $ docForceSingleline
                  funcPatternPartLine
                , docLit $ Text.pack "->"
                ]
              )
              (docWrapNode lgrhs $ docForceSingleline bodyDoc)
              -- wrapped par spacing
            , docSetParSpacing $ docSeq
              [ docLit $ Text.pack "\\"
              , docWrapNode lmatch $ docForceSingleline funcPatternPartLine
              , appSep $ docLit $ Text.pack "->"
              , docWrapNode lgrhs $ docForceParSpacing bodyDoc
              ]
              -- conservative
            , docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
              (docSeq
                [ docLit $ Text.pack "\\"
                , docWrapNode lmatch $ appSep $ docForceSingleline
                  funcPatternPartLine
                , docLit $ Text.pack "->"
                ]
              )
              (docWrapNode lgrhs $ docNonBottomSpacing bodyDoc)
            ]
      HsLam{} -> unknownNodeError "HsLam too complex" lexpr
      HsLamCase _ (MG _ (L _ []) _) -> do
        docSetParSpacing
          $ docAddBaseY BrIndentRegular
          $ (docLit $ Text.pack "\\case {}")
      HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do
        binderDoc <- docLit $ Text.pack "->"
        funcPatDocs <-
          docWrapNode lmatches
          $ layoutPatternBind Nothing binderDoc
          `mapM` matches
        docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
          (docLit $ Text.pack "\\case")
          (docSetBaseAndIndent
          $ docNonBottomSpacing
          $ docLines
          $ return
          <$> funcPatDocs
          )
      HsApp _ exp1@(L _ HsApp{}) exp2 -> do
        let
          gather
            :: [LHsExpr GhcPs]
            -> LHsExpr GhcPs
            -> (LHsExpr GhcPs, [LHsExpr GhcPs])
          gather list = \case
            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))) ->
              docCols (ColApp $ Text.pack $ occNameString occname)
            _ -> docSeq
        headDoc <- docSharedWrapper layoutExpr headE
        paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
        hasComments <- hasAnyCommentsConnected exp2
        runFilteredAlternative $ do
          -- foo x y
          addAlternativeCond (not hasComments)
            $ colsOrSequence
            $ appSep (docForceSingleline headDoc)
            : spacifyDocs (docForceSingleline <$> paramDocs)
          -- 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
          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
        expDoc2 <- docSharedWrapper layoutExpr exp2
        docAlt
          [ -- func arg
            docSeq
            [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2]
          , -- func argline1
            --   arglines
            -- e.g.
            -- func Abc
            --   { member1 = True
            --   , member2 = 13
            --   }
            docSetParSpacing -- this is most likely superfluous because
                             -- this is a sequence of a one-line and a par-space
                             -- anyways, so it is _always_ par-spaced.
          $ docAddBaseY BrIndentRegular
          $ docSeq
              [appSep $ docForceSingleline expDoc1, docForceParSpacing expDoc2]
          , -- func
            --   arg
            docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
            (docForceSingleline expDoc1)
            (docNonBottomSpacing expDoc2)
          , -- fu
            --   nc
            --   ar
            --     gument
            docAddBaseY BrIndentRegular $ docPar expDoc1 expDoc2
          ]
      HsAppType _ exp1 (HsWC _ ty1) -> do
        t <- docSharedWrapper layoutType ty1
        e <- docSharedWrapper layoutExpr exp1
        docAlt
          [ docSeq
            [ docForceSingleline e
            , docSeparator
            , docLit $ Text.pack "@"
            , docForceSingleline t
            ]
          , docPar e (docSeq [docLit $ Text.pack "@", t])
          ]
      OpApp _ expLeft@(L _ OpApp{}) expOp expRight -> do
        let
          gather
            :: [(LHsExpr GhcPs, LHsExpr GhcPs)]
            -> LHsExpr GhcPs
            -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)])
          gather opExprList = \case
            (L _ (OpApp _ l1 op1 r1)) -> gather ((op1, r1) : opExprList) l1
            final -> (final, opExprList)
          (leftOperand, appList) = gather [] expLeft
        leftOperandDoc <- docSharedWrapper layoutExpr leftOperand
        appListDocs <- appList `forM` \(x, y) ->
          [ (xD, yD)
          | xD <- docSharedWrapper layoutExpr x
          , yD <- docSharedWrapper layoutExpr y
          ]
        opLastDoc <- docSharedWrapper layoutExpr expOp
        expLastDoc <- docSharedWrapper layoutExpr expRight
        allowSinglelinePar <- do
          hasComLeft <- hasAnyCommentsConnected expLeft
          hasComOp <- hasAnyCommentsConnected expOp
          pure $ not hasComLeft && not hasComOp
        let
          allowPar = case (expOp, expRight) of
            (L _ (HsVar _ (L _ (Unqual occname))), _)
              | occNameString occname == "$" -> True
            (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False
            _ -> True
        runFilteredAlternative $ do
          -- > one + two + three
          -- or
          -- > one + two + case x of
          -- >   _ -> three
          addAlternativeCond allowSinglelinePar $ 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
            ]
          -- this case rather leads to some unfortunate layouting than to anything
          -- useful; disabling for now. (it interfers with cols stuff.)
          -- addAlternative
          --   $ docSetBaseY
          --   $ docPar
          --     leftOperandDoc
          --     ( docLines
          --      $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
          --       ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
          --     )
          -- > one
          -- >   + two
          -- >   + three
          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
        expDocRight <- docSharedWrapper 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 <- docSharedWrapper layoutExpr op
        docSeq [docLit $ Text.pack "-", opDoc]
      HsPar _ innerExp -> do
        innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp
        docAlt
          [ docSeq
            [ docLit $ Text.pack "("
            , docForceSingleline innerExpDoc
            , docLit $ Text.pack ")"
            ]
          , docSetBaseY $ docLines
            [ docCols
              ColOpPrefix
              [ docLit $ Text.pack "("
              , docAddBaseY (BrIndentSpecial 2) innerExpDoc
              ]
            , docLit $ Text.pack ")"
            ]
          ]
      SectionL _ left op -> do -- TODO: add to testsuite
        leftDoc <- docSharedWrapper layoutExpr left
        opDoc <- docSharedWrapper layoutExpr op
        docSeq [leftDoc, docSeparator, opDoc]
      SectionR _ op right -> do -- TODO: add to testsuite
        opDoc <- docSharedWrapper layoutExpr op
        rightDoc <- docSharedWrapper layoutExpr right
        docSeq [opDoc, docSeparator, rightDoc]
      ExplicitTuple _ args boxity -> do
        let
          argExprs = args <&> \arg -> case arg of
            (L _ (Present _ e)) -> (arg, Just e)
            (L _ (Missing NoExtField)) -> (arg, Nothing)
        argDocs <- forM argExprs $ docSharedWrapper $ \(arg, exprM) ->
          docWrapNode arg $ maybe docEmpty layoutExpr exprM
        hasComments <-
          orM
            (hasCommentsBetween lexpr AnnOpenP AnnCloseP
            : map hasAnyCommentsBelow args
            )
        let
          (openLit, closeLit) = case boxity of
            Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")")
            Unboxed -> (docParenHashLSep, docParenHashRSep)
        case splitFirstLast argDocs of
          FirstLastEmpty ->
            docSeq [openLit, docNodeAnnKW lexpr (Just AnnOpenP) closeLit]
          FirstLastSingleton e -> docAlt
            [ docCols
              ColTuple
              [ openLit
              , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e
              , closeLit
              ]
            , docSetBaseY $ docLines
              [ docSeq
                [ openLit
                , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e
                ]
              , closeLit
              ]
            ]
          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 _ (L _ []) _) -> do
        cExpDoc <- docSharedWrapper layoutExpr cExp
        docAlt
          [ docAddBaseY BrIndentRegular $ docSeq
            [ appSep $ docLit $ Text.pack "case"
            , appSep $ docForceSingleline cExpDoc
            , docLit $ Text.pack "of {}"
            ]
          , docPar
            (docAddBaseY BrIndentRegular
            $ docPar (docLit $ Text.pack "case") cExpDoc
            )
            (docLit $ Text.pack "of {}")
          ]
      HsCase _ cExp (MG _ lmatches@(L _ matches) _) -> do
        cExpDoc <- docSharedWrapper layoutExpr cExp
        binderDoc <- docLit $ Text.pack "->"
        funcPatDocs <-
          docWrapNode lmatches
          $ layoutPatternBind Nothing binderDoc
          `mapM` matches
        docAlt
          [ docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
            (docSeq
              [ appSep $ docLit $ Text.pack "case"
              , appSep $ docForceSingleline cExpDoc
              , docLit $ Text.pack "of"
              ]
            )
            (docSetBaseAndIndent
            $ docNonBottomSpacing
            $ docLines
            $ return
            <$> funcPatDocs
            )
          , docPar
            (docAddBaseY BrIndentRegular
            $ docPar (docLit $ Text.pack "case") cExpDoc
            )
            (docAddBaseY BrIndentRegular $ docPar
              (docLit $ Text.pack "of")
              (docSetBaseAndIndent
              $ docNonBottomSpacing
              $ docLines
              $ return
              <$> funcPatDocs
              )
            )
          ]
      HsIf _ ifExpr thenExpr elseExpr -> do
        ifExprDoc <- docSharedWrapper layoutExpr ifExpr
        thenExprDoc <- docSharedWrapper layoutExpr thenExpr
        elseExprDoc <- docSharedWrapper layoutExpr elseExpr
        hasComments <- hasAnyCommentsBelow lexpr
        let
          maySpecialIndent = case indentPolicy of
            IndentPolicyLeft -> BrIndentRegular
            IndentPolicyMultiple -> BrIndentRegular
            IndentPolicyFree -> BrIndentSpecial 3
        -- TODO: some of the alternatives (especially last and last-but-one)
        -- overlap.
        docSetIndentLevel $ runFilteredAlternative $ do
          -- if _ then _ else _
          addAlternativeCond (not hasComments) $ docSeq
            [ appSep $ docLit $ Text.pack "if"
            , appSep $ docForceSingleline ifExprDoc
            , appSep $ docLit $ Text.pack "then"
            , appSep $ docForceSingleline thenExprDoc
            , 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
          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)
              $ docNonBottomSpacing
              $ docAlt
                  [ docSeq
                    [ appSep $ docLit $ Text.pack "then"
                    , docForceParSpacing thenExprDoc
                    ]
                  , docAddBaseY BrIndentRegular
                    $ docPar (docLit $ Text.pack "then") thenExprDoc
                  ]
              , docAddBaseY BrIndentRegular $ docNonBottomSpacing $ 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 $ 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
              ]
            , 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 "->"
        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
        -- We jump through some ugly hoops here to ensure proper sharing.
        hasComments <- hasAnyCommentsBelow lexpr
        mBindDocs <- fmap (fmap pure) <$> layoutLocalBinds binds
        let
          ifIndentFreeElse :: a -> a -> a
          ifIndentFreeElse x y = case indentPolicy of
            IndentPolicyLeft -> y
            IndentPolicyMultiple -> y
            IndentPolicyFree -> x
        -- this `docSetBaseAndIndent` might seem out of place (especially the
        -- Indent part; setBase is necessary due to the use of docLines below),
        -- but is here due to ghc-exactprint's DP handling of "let" in
        -- particular.
        -- Just pushing another indentation level is a straightforward approach
        -- to making brittany idempotent, even though the result is non-optimal
        -- if "let" is moved horizontally as part of the transformation, as the
        -- comments before the first let item are moved horizontally with it.
        docSetBaseAndIndent $ case mBindDocs of
          Just [bindDoc] -> runFilteredAlternative $ do
            addAlternativeCond (not hasComments) $ docSeq
              [ appSep $ docLit $ Text.pack "let"
              , docNodeAnnKW lexpr (Just AnnLet) $ appSep $ docForceSingleline
                bindDoc
              , appSep $ docLit $ Text.pack "in"
              , docForceSingleline expDoc1
              ]
            addAlternative $ docLines
              [ docNodeAnnKW lexpr (Just AnnLet) $ docAlt
                [ docSeq
                  [ appSep $ docLit $ Text.pack "let"
                  , ifIndentFreeElse docSetBaseAndIndent docForceSingleline
                    $ bindDoc
                  ]
                , docAddBaseY BrIndentRegular $ docPar
                  (docLit $ Text.pack "let")
                  (docSetBaseAndIndent bindDoc)
                ]
              , docAlt
                [ docSeq
                  [ appSep $ docLit $ Text.pack $ ifIndentFreeElse "in " "in"
                  , ifIndentFreeElse
                    docSetBaseAndIndent
                    docForceSingleline
                    expDoc1
                  ]
                , docAddBaseY BrIndentRegular
                  $ docPar (docLit $ Text.pack "in") (docSetBaseY expDoc1)
                ]
              ]
          Just bindDocs@(_ : _) -> runFilteredAlternative $ do
            --either
            --  let
            --    a = b
            --    c = d
            --  in foo
            --    bar
            --    baz
            --or
            --  let
            --    a = b
            --    c = d
            --  in
            --    fooooooooooooooooooo
            let
              noHangingBinds =
                [ docNonBottomSpacing $ docAddBaseY BrIndentRegular $ docPar
                  (docLit $ Text.pack "let")
                  (docSetBaseAndIndent $ docLines bindDocs)
                , docSeq
                  [ docLit $ Text.pack "in "
                  , docAddBaseY BrIndentRegular $ docForceParSpacing expDoc1
                  ]
                ]
            addAlternative $ case indentPolicy of
              IndentPolicyLeft -> docLines noHangingBinds
              IndentPolicyMultiple -> docLines noHangingBinds
              IndentPolicyFree -> docLines
                [ docNodeAnnKW lexpr (Just AnnLet) $ docSeq
                  [ appSep $ docLit $ Text.pack "let"
                  , docSetBaseAndIndent $ docLines bindDocs
                  ]
                , docSeq [appSep $ docLit $ Text.pack "in ", docSetBaseY expDoc1]
                ]
            addAlternative $ docLines
              [ docNodeAnnKW lexpr (Just AnnLet)
              $ 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 _ stmtCtx (L _ stmts) -> case stmtCtx of
        DoExpr _ -> do
          stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
          docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
            (docLit $ Text.pack "do")
            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
        MDoExpr _ -> do
          stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
          docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
            (docLit $ Text.pack "mdo")
            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
        x
          | case x of
            ListComp -> True
            MonadComp -> True
            _ -> False
          -> do
            stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
            hasComments <- hasAnyCommentsBelow lexpr
            runFilteredAlternative $ do
              addAlternativeCond (not hasComments) $ docSeq
                [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "["
                , docNodeAnnKW lexpr (Just AnnOpenS)
                $ appSep
                $ docForceSingleline
                $ List.last stmtDocs
                , appSep $ docLit $ Text.pack "|"
                , docSeq
                $ List.intersperse docCommaSep
                $ docForceSingleline
                <$> List.init stmtDocs
                , docLit $ Text.pack " ]"
                ]
              addAlternative
                $ let
                    start = docCols
                      ColListComp
                      [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack
                        "["
                      , docSetBaseY
                      $ docNodeAnnKW lexpr (Just AnnOpenS)
                      $ List.last stmtDocs
                      ]
                    (s1 : sM) = List.init stmtDocs
                    line1 =
                      docCols ColListComp [appSep $ docLit $ Text.pack "|", s1]
                    lineM = sM <&> \d -> docCols ColListComp [docCommaSep, d]
                    end = docLit $ Text.pack "]"
                  in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
        _ -> do
          -- TODO
          unknownNodeError "HsDo{} unknown stmtCtx" lexpr
      ExplicitList _ _ elems@(_ : _) -> do
        elemDocs <- elems `forM` docSharedWrapper layoutExpr
        hasComments <- hasAnyCommentsBelow lexpr
        case splitFirstLast elemDocs of
          FirstLastEmpty -> docSeq
            [ docLit $ Text.pack "["
            , docNodeAnnKW lexpr (Just AnnOpenS) $ docLit $ Text.pack "]"
            ]
          FirstLastSingleton e -> docAlt
            [ docSeq
              [ docLit $ Text.pack "["
              , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e
              , docLit $ Text.pack "]"
              ]
            , docSetBaseY $ docLines
              [ docSeq
                [ docLit $ Text.pack "["
                , docSeparator
                , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) e
                ]
              , docLit $ Text.pack "]"
              ]
            ]
          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 "]"]
            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 "[]"
      RecordCon _ lname fields -> case fields of
        HsRecFields fs Nothing -> do
          let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
          rFs <-
            fs `forM` \lfield@(L _ (HsRecField (L _ fieldOcc) rFExpr pun)) -> do
              let FieldOcc _ lnameF = fieldOcc
              rFExpDoc <- if pun
                then return Nothing
                else Just <$> docSharedWrapper layoutExpr rFExpr
              return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
          recordExpression False indentPolicy lexpr nameDoc rFs
        HsRecFields [] (Just (L _ 0)) -> do
          let t = lrdrNameToText lname
          docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
        HsRecFields fs@(_ : _) (Just (L _ dotdoti)) | dotdoti == length fs -> do
          let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
          fieldDocs <-
            fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do
              let FieldOcc _ lnameF = fieldOcc
              fExpDoc <- if pun
                then return Nothing
                else Just <$> docSharedWrapper layoutExpr fExpr
              return (fieldl, lrdrNameToText lnameF, fExpDoc)
          recordExpression True indentPolicy lexpr nameDoc fieldDocs
        _ -> unknownNodeError "RecordCon with puns" lexpr
      RecordUpd _ rExpr fields -> do
        rExprDoc <- docSharedWrapper layoutExpr rExpr
        rFs <-
          fields `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do
            rFExpDoc <- if pun
              then return Nothing
              else Just <$> docSharedWrapper layoutExpr rFExpr
            return $ case ambName of
              Unambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc)
              Ambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc)
        recordExpression False indentPolicy lexpr rExprDoc rFs
      ExprWithTySig _ exp1 (HsWC _ (HsIB _ typ1)) -> do
        expDoc <- docSharedWrapper layoutExpr exp1
        typDoc <- docSharedWrapper layoutType typ1
        docSeq [appSep expDoc, appSep $ docLit $ Text.pack "::", typDoc]
      ArithSeq _ Nothing info -> case info of
        From e1 -> do
          e1Doc <- docSharedWrapper layoutExpr e1
          docSeq
            [ docLit $ Text.pack "["
            , appSep $ docForceSingleline e1Doc
            , docLit $ Text.pack "..]"
            ]
        FromThen e1 e2 -> do
          e1Doc <- docSharedWrapper layoutExpr e1
          e2Doc <- docSharedWrapper layoutExpr e2
          docSeq
            [ docLit $ Text.pack "["
            , docForceSingleline e1Doc
            , appSep $ docLit $ Text.pack ","
            , appSep $ docForceSingleline e2Doc
            , docLit $ Text.pack "..]"
            ]
        FromTo e1 eN -> do
          e1Doc <- docSharedWrapper layoutExpr e1
          eNDoc <- docSharedWrapper layoutExpr eN
          docSeq
            [ docLit $ Text.pack "["
            , appSep $ docForceSingleline e1Doc
            , appSep $ docLit $ Text.pack ".."
            , docForceSingleline eNDoc
            , docLit $ Text.pack "]"
            ]
        FromThenTo e1 e2 eN -> do
          e1Doc <- docSharedWrapper layoutExpr e1
          e2Doc <- docSharedWrapper layoutExpr e2
          eNDoc <- docSharedWrapper layoutExpr eN
          docSeq
            [ docLit $ Text.pack "["
            , docForceSingleline e1Doc
            , appSep $ docLit $ Text.pack ","
            , appSep $ docForceSingleline e2Doc
            , appSep $ docLit $ Text.pack ".."
            , docForceSingleline eNDoc
            , docLit $ Text.pack "]"
            ]
      ArithSeq{} -> briDocByExactInlineOnly "ArithSeq" lexpr
      HsBracket{} -> do
        -- TODO
        briDocByExactInlineOnly "HsBracket{}" lexpr
      HsRnBracketOut{} -> do
        -- TODO
        briDocByExactInlineOnly "HsRnBracketOut{}" lexpr
      HsTcBracketOut{} -> do
        -- TODO
        briDocByExactInlineOnly "HsTcBracketOut{}" lexpr
      HsSpliceE _ (HsQuasiQuote _ _ quoter _loc content) -> do
        allocateNode $ BDFPlain
          (Text.pack
          $ "["
          ++ showOutputable quoter
          ++ "|"
          ++ showOutputable content
          ++ "|]"
          )
      HsSpliceE{} -> do
        -- TODO
        briDocByExactInlineOnly "HsSpliceE{}" lexpr
      HsProc{} -> do
        -- TODO
        briDocByExactInlineOnly "HsProc{}" lexpr
      HsStatic{} -> do
        -- TODO
        briDocByExactInlineOnly "HsStatic{}" lexpr
      HsTick{} -> do
        -- TODO
        briDocByExactInlineOnly "HsTick{}" lexpr
      HsBinTick{} -> do
        -- TODO
        briDocByExactInlineOnly "HsBinTick{}" lexpr
      HsConLikeOut{} -> do
        -- TODO
        briDocByExactInlineOnly "HsWrap{}" lexpr
      ExplicitSum{} -> do
        -- TODO
        briDocByExactInlineOnly "ExplicitSum{}" lexpr
      HsPragE{} -> do
        -- TODO
        briDocByExactInlineOnly "HsPragE{}" lexpr
  
  recordExpression
    :: (Data.Data.Data lExpr, Data.Data.Data name)
    => Bool
    -> IndentPolicy
    -> GenLocated SrcSpan lExpr
    -> ToBriDocM BriDocNumbered
    -> [ ( GenLocated SrcSpan name
         , Text
         , Maybe (ToBriDocM BriDocNumbered)
         )
       ]
    -> ToBriDocM BriDocNumbered
  recordExpression False _ lexpr nameDoc [] = docSeq
    [ docNodeAnnKW lexpr (Just AnnOpenC)
      $ docSeq [nameDoc, docLit $ Text.pack "{"]
    , docLit $ Text.pack "}"
    ]
  recordExpression True _ lexpr nameDoc [] = docSeq -- this case might still be incomplete, and is probably not used
           -- atm anyway.
    [ docNodeAnnKW lexpr (Just AnnOpenC)
      $ docSeq [nameDoc, docLit $ Text.pack "{"]
    , docLit $ Text.pack " .. }"
    ]
  recordExpression dotdot indentPolicy lexpr nameDoc rFs@(rF1 : rFr) = do
    let (rF1f, rF1n, rF1e) = rF1
    runFilteredAlternative $ do
      -- container { fieldA = blub, fieldB = blub }
      addAlternative $ docSeq
        [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline nameDoc
        , appSep $ docLit $ Text.pack "{"
        , 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
        , if dotdot
          then docSeq [docCommaSep, docLit $ Text.pack "..", docSeparator]
          else docSeparator
        , docLit $ Text.pack "}"
        ]
      -- hanging single-line fields
      -- container { fieldA = blub
      --           , fieldB = blub
      --           }
      addAlternativeCond (indentPolicy == IndentPolicyFree) $ docSeq
        [ docNodeAnnKW lexpr Nothing $ docForceSingleline $ appSep nameDoc
        , docSetBaseY
        $ docLines
        $ let
            line1 = docCols
              ColRec
              [ appSep $ docLit $ Text.pack "{"
              , docWrapNodePrior rF1f $ appSep $ docLit rF1n
              , case rF1e of
                Just x -> docWrapNodeRest rF1f $ docSeq
                  [appSep $ docLit $ Text.pack "=", docForceSingleline x]
                Nothing -> docEmpty
              ]
            lineR = rFr <&> \(lfield, fText, fDoc) ->
              docWrapNode lfield $ docCols
                ColRec
                [ docCommaSep
                , appSep $ docLit fText
                , case fDoc of
                  Just x ->
                    docSeq [appSep $ docLit $ Text.pack "=", docForceSingleline x]
                  Nothing -> docEmpty
                ]
            dotdotLine = if dotdot
              then docCols
                ColRec
                [ docNodeAnnKW lexpr (Just AnnOpenC) docCommaSep
                , docNodeAnnKW lexpr (Just AnnDotdot) $ docLit $ Text.pack ".."
                ]
              else docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
            lineN = docLit $ Text.pack "}"
          in [line1] ++ lineR ++ [dotdotLine, lineN]
        ]
      -- non-hanging with expressions placed to the right of the names
      -- container
      -- { fieldA = blub
      -- , fieldB = potentially
      --     multiline
      -- }
      addAlternative $ docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
        (docNodeAnnKW lexpr Nothing nameDoc)
        (docNonBottomSpacing
        $ docLines
        $ let
            line1 = docCols
              ColRec
              [ appSep $ docLit $ Text.pack "{"
              , docWrapNodePrior rF1f $ appSep $ docLit rF1n
              , docWrapNodeRest rF1f $ case rF1e of
                Just x -> runFilteredAlternative $ do
                  addAlternativeCond (indentPolicy == IndentPolicyFree) $ do
                    docSeq [appSep $ docLit $ Text.pack "=", docSetBaseY x]
                  addAlternative $ do
                    docSeq
                      [appSep $ docLit $ Text.pack "=", docForceParSpacing x]
                  addAlternative $ do
                    docAddBaseY BrIndentRegular
                      $ docPar (docLit $ Text.pack "=") x
                Nothing -> docEmpty
              ]
            lineR = rFr <&> \(lfield, fText, fDoc) ->
              docWrapNode lfield $ docCols
                ColRec
                [ docCommaSep
                , appSep $ docLit fText
                , case fDoc of
                  Just x -> runFilteredAlternative $ do
                    addAlternativeCond (indentPolicy == IndentPolicyFree) $ do
                      docSeq [appSep $ docLit $ Text.pack "=", docSetBaseY x]
                    addAlternative $ do
                      docSeq
                        [appSep $ docLit $ Text.pack "=", docForceParSpacing x]
                    addAlternative $ do
                      docAddBaseY BrIndentRegular
                        $ docPar (docLit $ Text.pack "=") x
                  Nothing -> docEmpty
                ]
            dotdotLine = if dotdot
              then docCols
                ColRec
                [ docNodeAnnKW lexpr (Just AnnOpenC) docCommaSep
                , docNodeAnnKW lexpr (Just AnnDotdot) $ docLit $ Text.pack ".."
                ]
              else docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
            lineN = docLit $ Text.pack "}"
          in [line1] ++ lineR ++ [dotdotLine, lineN]
        )
  
  litBriDoc :: HsLit GhcPs -> BriDocFInt
  litBriDoc = \case
    HsChar (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
    HsCharPrim (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
    HsString (SourceText t) _fastString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ FastString.unpackFS fastString
    HsStringPrim (SourceText t) _byteString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ Data.ByteString.Char8.unpack byteString
    HsInt _ (IL (SourceText t) _ _) -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
    HsIntPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
    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 (SourceText t) _ _) _type -> BDFLit $ Text.pack t
    HsFloatPrim _ (FL (SourceText t) _ _) -> BDFLit $ Text.pack t
    HsDoublePrim _ (FL (SourceText t) _ _) -> BDFLit $ Text.pack t
    _ -> error "litBriDoc: literal with no SourceText"
  
  overLitValBriDoc :: OverLitVal -> BriDocFInt
  overLitValBriDoc = \case
    HsIntegral (IL (SourceText t) _ _) -> BDFLit $ Text.pack t
    HsFractional (FL (SourceText t) _ _) -> BDFLit $ Text.pack t
    HsIsString (SourceText t) _ -> BDFLit $ Text.pack t
    _ -> error "overLitValBriDoc: literal with no SourceText"
  