{-# 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"