{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Language.Haskell.Brittany.Internal.ToBriDoc.Expr where

import qualified Data.Sequence                 as Seq
import qualified Data.Text                     as Text
import           GHC                            ( GenLocated(L)
                                                , RdrName(..)
                                                )
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           GHC.Types.SourceText           ( FractionalLit(FL)
                                                , IntegralLit(IL)
                                                , SourceText(SourceText)
                                                )
import qualified GHC.Types.SrcLoc              as GHC

import           Language.Haskell.Brittany.Internal.Components.BriDoc
import           Language.Haskell.Brittany.Internal.Config.Types
import           Language.Haskell.Brittany.Internal.Prelude
import           Language.Haskell.Brittany.Internal.ToBriDocTools
import           Language.Haskell.Brittany.Internal.Types
import           Language.Haskell.Brittany.Internal.Utils



layoutExpr :: ToBriDoc HsExpr
layoutExpr lexpr@(L _ expr) = do
  indentPolicy <- askLayoutConf _lconfig_indentPolicy
  let allowFreeIndent = indentPolicy == IndentPolicyFree
  docHandleComms lexpr $ case expr of
    HsVar NoExtField vname -> docHandleComms lexpr $ do
      docLit =<< lrdrNameToTextAnn vname
    HsUnboundVar epAnn oname -> docHandleComms epAnn $ do
      docLit $ Text.pack $ occNameString oname
    HsRecFld{} -> docHandleComms lexpr $ do
      -- TODO
      briDocByExactInlineOnly "HsRecFld" lexpr
    HsOverLabel _ext name -> -- TODO92
      let label = FastString.unpackFS name in docLit . Text.pack $ '#' : label
    HsIPVar _ext (HsIPName name) -> -- TODO92
      let label = FastString.unpackFS name in docLit . Text.pack $ '?' : label
    HsOverLit epAnn olit -> docHandleComms epAnn $ do
      allocateNode $ overLitValBriDoc $ ol_val olit
    HsLit epAnn lit -> docHandleComms epAnn $ do
      allocateNode $ litBriDoc lit
    HsLam _ (MG _ (L _ [(L _ match)]) _)
      | Match epAnn _matchCtx pats (GRHSs _ [lgrhs] llocals) <- match
      , EmptyLocalBinds{} <- llocals
      , L _ (GRHS rhsEpAnn [] body) <- lgrhs
      -> do
        layouters <- mAsk
        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 <- callLayouter layout_pat p
            fixed     <- case Seq.viewl patDocSeq of
              p1 Seq.:< pr | shouldPrefixSeparator -> do
                p1' <- docSeq [docSeparator, pure p1]
                pure (p1' Seq.<| pr)
              _ -> pure patDocSeq
            layout_colsWrapPat layouters fixed
        bodyDoc <-
          shareDoc
          $ docAddBaseY BrIndentRegular
          $ docHandleComms epAnn
          $ docHandleComms rhsEpAnn
          $ layoutExpr body
        let funcPatternPartLine = docCols
              ColCasePattern
              (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
        docAlt
          [ -- single line
            docSeq
            [ docLit $ Text.pack "\\"
            , docForceSingleline funcPatternPartLine
            , appSep $ docLit $ Text.pack "->"
            , docForceSingleline bodyDoc
            ]
            -- double line
          , docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
            (docSeq
              [ docLit $ Text.pack "\\"
              , appSep $ docForceSingleline funcPatternPartLine
              , docLit $ Text.pack "->"
              ]
            )
            (docForceSingleline bodyDoc)
            -- wrapped par spacing
          , docSetParSpacing $ docSeq
            [ docLit $ Text.pack "\\"
            , docForceSingleline funcPatternPartLine
            , appSep $ docLit $ Text.pack "->"
            , docForceParSpacing bodyDoc
            ]
            -- conservative
          , docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
            (docSeq
              [ docLit $ Text.pack "\\"
              , appSep $ docForceSingleline funcPatternPartLine
              , docLit $ Text.pack "->"
              ]
            )
            (docNonBottomSpacing bodyDoc)
          ]
    HsLam{}                       -> unknownNodeError "HsLam too complex" lexpr
    HsLamCase _ (MG _ (L _ []) _) -> do
      docSetParSpacing
        $ docAddBaseY BrIndentRegular
        $ (docLit $ Text.pack "\\case {}")
    HsLamCase epAnn (MG _ lmatches@(L _ matches) _) -> do
      binderDoc   <- docLit $ Text.pack "->"
      layouters <- mAsk
      funcPatDocs <-
        layout_patternBind layouters Nothing binderDoc `mapM` matches
      docSetParSpacing
        $ docAddBaseY BrIndentRegular
        $ docHandleComms epAnn
        $ docPar
          (docLit $ Text.pack "\\case")
          ( docSetBaseAndIndent
          $ docNonBottomSpacing
          $ docHandleComms lmatches
          $ docLines
          $ return <$> funcPatDocs
          )
    HsApp _ exp1 _ -> do
      let gather
            :: [(EpAnnCO, LHsExpr GhcPs)]
            -> LHsExpr GhcPs
            -> (LHsExpr GhcPs, [(EpAnnCO, LHsExpr GhcPs)])
          gather list = \case
            L _ (HsApp epAnn l r) -> gather ((epAnn, r) : list) l
            x                     -> (x, list)
      let (headE, paramEs) = gather [] lexpr
      let colsOrSequence = case headE of
            L _ (HsVar _ (L _ (Unqual occname))) ->
              docCols (ColApp $ Text.pack $ occNameString occname)
            _ -> docSeq
      headDoc   <- shareDoc $ layoutExpr headE
      paramDocs <- forM paramEs $ \(epAnn, e) ->
        shareDoc $ docHandleComms epAnn $ layoutExpr e
      let hasComments = hasAnyCommentsConnected exp1
      runFilteredAlternative $ do
        -- foo x y
        addAlternativeCond (not hasComments)
          $ colsOrSequence
          $ appSep (docForceSingleline headDoc)
          : spacifyDocs (docForceSingleline <$> paramDocs)
        -- foo x do
        --   a
        --   b
        -- foo x \meow -> do
        --   a
        --   b
        addAlternativeCond (not hasComments) $ docSetParSpacing $ docSeq
          [ appSep (docForceSingleline headDoc)
          , case splitFirstLast paramDocs of
            FirstLastEmpty        -> docEmpty
            FirstLastSingleton e1 -> docForceParSpacing e1
            FirstLast e1 ems eN   -> docSeq
              (  spacifyDocs (docForceSingleline <$> (e1 : ems))
              ++ [docSeparator, docForceParSpacing eN]
              )
          ]
        -- foo x
        --     y
        addAlternativeCond allowFreeIndent $ docSeq
          [ appSep (docForceSingleline headDoc)
          , docSetBaseY
          $   docAddBaseY BrIndentRegular
          $   docLines
          $   docForceSingleline
          <$> paramDocs
          ]
        -- foo
        --   x
        --   y
        addAlternative $ do
          let checkAllowPar = \case
                (_, L _ ExplicitTuple{}) -> True
                (_, L _ ExplicitList{}) -> True
                (_, L _ HsPar{}) -> True
                (_, L _ HsDo{}) -> True
                (_, L _ HsSpliceE{}) -> True
                _ -> False
          let wrap = if all checkAllowPar paramEs then docSetParSpacing else id
          wrap $ docAddBaseY BrIndentRegular $ docPar
            (docForceSingleline headDoc)
            (docNonBottomSpacing $ docLines paramDocs)
        -- ( multi
        --   line
        --   function
        -- )
        --   x
        --   y
        addAlternative $ docAddBaseY BrIndentRegular $ docPar
          headDoc
          (docNonBottomSpacing $ docLines paramDocs)
    HsAppType _ exp1 (HsWC _ ty1) -> do
      t <- shareDoc $ callLayouter2 layout_type False ty1
      e <- shareDoc $ callLayouter layout_expr exp1
      docAlt
        [ docSeq
          [ docForceSingleline e
          , docSeparator
          , docLit $ Text.pack "@"
          , docForceSingleline t
          ]
        , docPar e (docSeq [docLit $ Text.pack "@", t])
        ]
    OpApp _topEpAnn _expLeft _expOp _expRight -> do
      -- let
      --   allowPar = case (expOp, expRight) of
      --     (L _ (HsVar _ (L _ (Unqual occname))), _)
      --       | occNameString occname == "$" -> True
      --     (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False
      --     _ -> True
      -- let hasComments =
      --       not
      --         $  hasAnyCommentsConnected expLeft
      --         || hasAnyCommentsConnected expOp
      layouters <- mAsk
      treeAndHasComms <-
        layout_gatherOpTreeE layouters NoParen False id Nothing Nothing [] lexpr
      layout_opTree layouters treeAndHasComms
    NegApp _ op _ -> do
      opDoc <- shareDoc $ layoutExpr op
      docSeq [docLit $ Text.pack "-", opDoc]
    HsPar _epAnn _inner -> do
      layouters <- mAsk
      treeAndHasComms <-
        layout_gatherOpTreeE layouters NoParen False id Nothing Nothing [] lexpr
      layout_opTree layouters treeAndHasComms
    SectionL _ left op -> do -- TODO: add to testsuite
      leftDoc <- shareDoc $ layoutExpr left
      opDoc   <- shareDoc $ layoutExpr op
      docSeq [leftDoc, docSeparator, opDoc]
    SectionR _ op right -> do -- TODO: add to testsuite
      opDoc    <- shareDoc $ layoutExpr op
      rightDoc <- shareDoc $ layoutExpr right
      docSeq [opDoc, docSeparator, rightDoc]
    ExplicitTuple epAnn args boxity -> docHandleComms epAnn $ do
      let (wrapOpen, wrapClose) = case anns epAnn of
            [open, close] -> case boxity of
              Boxed ->
                ( docHandleComms $ obtainAnnPos open AnnOpenP
                , docHandleComms $ obtainAnnPos close AnnCloseP
                )
              Unboxed ->
                ( docHandleComms $ obtainAnnPos open AnnOpenPH
                , docHandleComms $ obtainAnnPos close AnnClosePH
                )
            _ -> (id, id)
      argDocs <- forM args $ \case
        Present _ e          -> shareDoc $ docHandleListElemComms layoutExpr e
        Missing missingEpAnn -> shareDoc $ docHandleComms missingEpAnn docEmpty
      -- let ((c1, argsWithC, c2), cRemain) = case epAnn of
      --       EpAnn _ [open, close] comms ->
      --         enterCommentsSplitC comms $ do
      --           comms1 <- getCommentsBeforeKW open AnnOpenP
      --           elems' <- args `forM` \arg -> case arg of
      --             Present _ e@(L (SrcSpanAnn elEpAnn loc) _) -> do
      --               commsB <- case loc of
      --                 GHC.RealSrcSpan span _ -> getCommentsBeforeSpan span
      --                 _ -> pure []
      --               case elEpAnn of
      --                 EpAnn _ (AnnListItem items) _ -> do
      --                   commsA <- items `forM` \case
      --                     AddCommaAnn span ->
      --                       getCommentsBeforeEpaLocation span
      --                     ann1 ->
      --                       error $ "unexpected TrailingAnn: "
      --                            ++ showSDocUnsafe (ppr ann1)
      --                   pure $ docWrapNode (commsB, join commsA) $ layoutExpr e
      --                 EpAnnNotUsed -> do
      --                   pure $ prependComments commsB $ layoutExpr e
      --             Missing (EpAnn _ epa _) -> do
      --               commsB <- getCommentsBeforeEpaLocation epa
      --               pure $ prependComments commsB docEmpty
      --             Missing EpAnnNotUsed -> pure $ docEmpty
      --           comm2 <- getCommentsBeforeKW close AnnCloseP
      --           pure (comms1, elems', comm2)
      --       EpAnn _ _ _ -> error "unexpected ExplicitTuple ann!"
      --       EpAnnNotUsed ->
      --         let argsDocs = [ case arg of
      --               Present _ e -> layoutExpr e
      --               Missing _ -> docEmpty
      --               | arg <- args ]
      --         in (([], argsDocs, []), [])
      let hasComments = hasAnyCommentsBelow lexpr -- TODO92 this is slightly
              -- overzealous for comments before open & after close
      let
        (openLit, closeLit) = case boxity of
          Boxed ->
            ( wrapOpen $ docLit $ Text.pack "("
            , wrapClose $ docLit $ Text.pack ")"
            )
          Unboxed ->
            (wrapOpen $ docParenHashLSep, wrapClose $ docParenHashRSep)
      case splitFirstLast argDocs of
        FirstLastEmpty       -> docSeq [openLit, closeLit]
        FirstLastSingleton e -> docAlt
          [ docCols ColTuple [openLit, docForceSingleline e, closeLit]
          , docSetBaseY
            $ docLines [docSeq [openLit, 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
                   , -- TODO92 docNodeAnnKW lexpr (Just AnnOpenP) 
                     (docForceSingleline eN)
                   , closeLit
                   ]
               ]
          addAlternative
            $ let start  = docCols ColTuples [appSep openLit, docSetBaseY e1]
                  linesM = ems <&> \d -> docCols ColTuples [docCommaSep, docSetBaseY d]
                  lineN  = docCols
                    ColTuples
                    [ docCommaSep
                    , -- TODO92 docNodeAnnKW lexpr (Just AnnOpenP) 
                      docSetBaseY eN
                    ]
                  end = closeLit
              in  docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]
    HsCase epAnn cExp (MG _ (L _ []) _) -> docHandleComms epAnn $ do
      cExpDoc <- shareDoc $ 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 epAnn cExp (MG _ lmatches@(L _ matches) _) ->
      docHandleComms epAnn $ do
        cExpDoc     <- shareDoc $ layoutExpr cExp
        binderDoc   <- docLit $ Text.pack "->"
        layouters   <- mAsk
        funcPatDocs <-
          -- docWrapNode lmatches
          layout_patternBind layouters Nothing binderDoc `mapM` matches
        docAlt
          [ docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
            (docSeq
              [ appSep $ docLit $ Text.pack "case"
              , appSep $ docForceSingleline cExpDoc
              , docLit $ Text.pack "of"
              ]
            )
            (   docSetBaseAndIndent
            $   docNonBottomSpacing
            $   docHandleComms lmatches
            $   docLines
            $   return
            <$> funcPatDocs
            )
          , docPar
            ( docAddBaseY BrIndentRegular
            $ docPar (docLit $ Text.pack "case") cExpDoc
            )
            (docAddBaseY BrIndentRegular $ docPar
              (docLit $ Text.pack "of")
              (   docSetBaseAndIndent
              $   docNonBottomSpacing
              $   docHandleComms lmatches
              $   docLines
              $   return
              <$> funcPatDocs
              )
            )
          ]
    HsIf epAnn ifExpr thenExpr elseExpr -> docHandleComms epAnn $ do
      let AnnsIf spanIf spanThen spanElse _ _ = anns epAnn
      let ifDoc = docHandleComms spanIf $ docLit $ Text.pack "if"
      let thenDoc = docHandleComms spanThen $ docLit $ Text.pack "then"
      let elseDoc = docHandleComms spanElse $ docLit $ Text.pack "else"
      ifExprDoc   <- shareDoc $ layoutExpr ifExpr
      thenExprDoc <- shareDoc $ layoutExpr thenExpr
      elseExprDoc <- shareDoc $ layoutExpr elseExpr
      let 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 $ ifDoc
          , appSep $ docForceSingleline ifExprDoc
          , appSep $ thenDoc
          , appSep $ docForceSingleline thenExprDoc
          , appSep $ elseDoc
          , 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
            [ -- TODO92 docNodeAnnKW lexpr Nothing $ 
              appSep $ ifDoc
            , -- TODO92 docNodeAnnKW lexpr (Just AnnIf) $ 
              docForceSingleline ifExprDoc
            ]
          )
          (docLines
            [ docAddBaseY BrIndentRegular
            -- TODO92 $ docNodeAnnKW lexpr (Just AnnThen)
            $ docNonBottomSpacing
            $ docAlt
                [ docSeq [appSep $ thenDoc, docForceParSpacing thenExprDoc]
                , docAddBaseY BrIndentRegular $ docPar thenDoc thenExprDoc
                ]
            , docAddBaseY BrIndentRegular $ docNonBottomSpacing $ docAlt
              [ docSeq [appSep $ elseDoc, docForceParSpacing elseExprDoc]
              , docAddBaseY BrIndentRegular $ docPar elseDoc 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 $ docPar
          (docAddBaseY maySpecialIndent $ docSeq [appSep $ ifDoc, ifExprDoc])
          (docLines
            [ docAddBaseY BrIndentRegular $ docAlt
              [ docSeq [appSep $ thenDoc, docForceParSpacing thenExprDoc]
              , docPar thenDoc thenExprDoc
              ]
            , docAddBaseY BrIndentRegular $ docAlt
              [ docSeq [appSep $ elseDoc, docForceParSpacing elseExprDoc]
              , docPar elseDoc elseExprDoc
              ]
            ]
          )
    HsMultiIf epAnn cases -> do
      binderDoc <- docLit $ Text.pack "->"
      let hasComments =
            hasAnyCommentsBelow epAnn
            || any (\(L _ (GRHS gEpAnn _ _)) -> hasAnyCommentsBelow gEpAnn) cases
      let posIf = obtainAnnPos epAnn AnnIf
      layouters <- mAsk
      docHandleComms epAnn
        $ docSetParSpacing
        $ docAddBaseY BrIndentRegular
        $ docPar
          (docHandleComms posIf $ docLit $ Text.pack "if")
          (layout_patternBindFinal layouters
                                   Nothing
                                   binderDoc
                                   Nothing
                                   (Right cases)
                                   (id, Nothing)
                                   hasComments
          )
    HsLet epAnn binds exp1 -> docHandleComms epAnn $ do
      let AnnsLet spanLet spanIn = anns epAnn
      let hasComments            = hasAnyCommentsBelow lexpr
      let wrapLet                = docHandleComms spanLet
      let wrapIn                 = docHandleComms spanIn
      (wrapBinds, mBindDocs) <- callLayouter layout_localBinds binds
      let ifIndentFreeElse :: a -> a -> a
          ifIndentFreeElse x y = case indentPolicy of
            IndentPolicyLeft     -> y
            IndentPolicyMultiple -> y
            IndentPolicyFree     -> x
      expDoc1 <- shareDoc $ layoutExpr exp1
      -- 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.
      letDoc  <- shareDoc
        $ docFlushCommsPost True spanLet
        $ wrapLet
        $ docLitS "let"
      inDoc   <- shareDoc $ wrapIn $ docLit $ Text.pack "in"
      docSetBaseAndIndent $ case fmap snd mBindDocs of
        Just [bindDoc] -> runFilteredAlternative $ do
          addAlternativeCond (not hasComments) $ docSeq
            [ appSep $ letDoc
            , wrapBinds $ appSep $ docForceSingleline (pure bindDoc)
            , appSep $ inDoc
            , docForceSingleline expDoc1
            ]
          addAlternative $ docLines
            [ docAlt
              [ docSeq
                [ appSep $ letDoc
                , wrapBinds
                  $ ifIndentFreeElse docSetBaseAndIndent docForceSingleline
                  $ pure bindDoc
                ]
              , docAddBaseY BrIndentRegular $ docPar
                  (letDoc)
                  (wrapBinds $ docSetBaseAndIndent $ pure bindDoc)
              ]
            , docAlt
              [ docSeq
                [ appSep $ wrapIn $ docLit $ Text.pack $ ifIndentFreeElse
                  "in "
                  "in"
                , ifIndentFreeElse docSetBaseAndIndent
                                   docForceSingleline
                                   expDoc1
                ]
              , docAddBaseY BrIndentRegular
                $ docPar (inDoc) (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
                  (letDoc)
                  ( wrapBinds
                  $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs
                  )
                , docSeq
                  [ wrapIn $ docLit $ Text.pack "in "
                  , docAddBaseY BrIndentRegular $ docForceParSpacing expDoc1
                  ]
                ]
          addAlternative $ case indentPolicy of
            IndentPolicyLeft     -> docLines noHangingBinds
            IndentPolicyMultiple -> docLines noHangingBinds
            IndentPolicyFree     -> docLines
              [ docSeq
                [ appSep $ letDoc
                , wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs
                ]
              , docSeq
                [ appSep $ wrapIn $ docLit $ Text.pack "in "
                , docSetBaseY expDoc1
                ]
              ]
          addAlternative $ docLines
            [ docAddBaseY BrIndentRegular $ docPar
              (letDoc)
              (wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs)
            , docAddBaseY BrIndentRegular
              $ docPar (inDoc) (docSetBaseY $ expDoc1)
            ]
        _ -> docSeq
          [ docForceSingleline $ docSeq
            [letDoc, docSeparator, wrapBinds $ inDoc]
          , docSeparator
          , expDoc1
          ]
      -- docSeq [appSep $ docLit "let in", expDoc1]
    HsDo epAnn stmtCtx (L (SrcSpanAnn stmtEpAnn _) []) ->
      case stmtCtx of
        DoExpr _ ->
          docHandleComms epAnn $ docHandleComms stmtEpAnn $ docLitS "do"
        MDoExpr _ ->
          docHandleComms epAnn $ docHandleComms stmtEpAnn $ docLitS "mdo"
        ListComp ->
          error "brittany internal error: ListCompo with null statements"
        MonadComp ->
          error "brittany internal error: ListCompo with null statements"
        _ -> unknownNodeError "HsDo{} unknown stmtCtx" lexpr
    HsDo epAnn stmtCtx (L (SrcSpanAnn stmtEpAnn _) stmts) ->
      docHandleComms epAnn $ do
        case stmtCtx of
          DoExpr _ -> do
            let locDo = obtainAnnPos epAnn AnnDo
            stmtDocs <- docHandleComms stmtEpAnn $ do
              stmts `forM` docHandleListElemComms (callLayouter layout_stmt)
            docSetParSpacing $ docAddBaseY BrIndentRegularForce $ docPar
              ( docFlushCommsPost True locDo
              $ docHandleComms locDo
              $ docLit
              $ Text.pack "do"
              )
              ( docSetBaseAndIndent
              $ docNonBottomSpacing
              $ docLines
              $ (pure <$> stmtDocs)
              )
          MDoExpr _ -> do
            stmtDocs <- docHandleComms stmtEpAnn $ do
              stmts `forM` docHandleListElemComms (callLayouter layout_stmt)
            docSetParSpacing $ docAddBaseY BrIndentRegularForce $ docPar
              (docLit $ Text.pack "mdo")
              (   docSetBaseAndIndent
              $   docNonBottomSpacing
              $   docLines
              $   pure
              <$> stmtDocs
              )
          x
            | case x of
              ListComp  -> True
              MonadComp -> True
              _         -> False
            -> do
              stmtDocs <-
                docHandleComms stmtEpAnn
                $      stmts
                `forM` docHandleListElemComms (callLayouter layout_stmt)
              let hasComments = hasAnyCommentsBelow lexpr
              runFilteredAlternative $ do
                addAlternativeCond (not hasComments) $ docSeq
                  [ -- TODO92 docNodeAnnKW lexpr Nothing $
                    appSep $ docLit $ Text.pack "["
                  , -- TODO92 docNodeAnnKW lexpr (Just AnnOpenS) $
                    appSep $ docForceSingleline $ pure (List.last stmtDocs)
                  , appSep $ docLit $ Text.pack "|"
                  , docSeq
                  $   List.intersperse docCommaSep
                  $   (docForceSingleline . pure)
                  <$> List.init stmtDocs
                  , docLit $ Text.pack " ]"
                  ]
                addAlternative
                  $ let
                      start = docCols
                        ColListComp
                        [ -- TODO92 docNodeAnnKW lexpr Nothing $
                          appSep $ docLit $ Text.pack "["
                        , docSetBaseY
                        -- TODO92 $ docNodeAnnKW lexpr (Just AnnOpenS)
                                      $ pure (List.last stmtDocs)
                        ]
                      (s1, sM) = case List.init stmtDocs of
                        (a : b) -> (a, b)
                        _       -> error "layoutExp: stmtDocs list too short"
                      line1 = docCols
                        ColListComp
                        [appSep $ docLit $ Text.pack "|", pure s1]
                      lineM =
                        sM <&> \d -> docCols ColListComp [docCommaSep, pure d]
                      end = docLit $ Text.pack "]"
                    in
                      docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
          _ -> do
            -- TODO
            unknownNodeError "HsDo{} unknown stmtCtx" lexpr
    ExplicitList listEpAnn elems@(_ : _) -> docHandleComms listEpAnn $ do
      let posOpen  = obtainAnnPos listEpAnn AnnOpenS
      let posClose = obtainAnnPos listEpAnn AnnCloseS
      let openDoc  = docHandleComms posOpen $ docLitS "["
      let closeDoc = docHandleComms posClose $ docLitS "]"
      elemDocs <- docHandleListElemCommsProperPost layoutExpr elems
      let hasComments = hasAnyCommentsBelow lexpr
      case splitFirstLast elemDocs of
        FirstLastEmpty       -> docSeq [docLit $ Text.pack "[", closeDoc]
        FirstLastSingleton (_, ast, e) -> docAlt
          [ docSeq [openDoc, docForceSingleline e, closeDoc]
          , docSetBaseY $ docLines
            [ docSeq
              [ openDoc
              , docSeparator
              , docSetBaseY $ docFlushCommsPost True ast e
              ]
            , closeDoc
            ]
          ]
        FirstLast (_, _, e1) ems (finalCommaPos, _, eN) -> runFilteredAlternative $ do
          addAlternativeCond (not hasComments)
            $  docSeq
            $  [openDoc, docForceSingleline e1]
            ++ [ x
               | (commaPos, _, e) <- ems
               , x <- [docHandleComms commaPos docCommaSep, docForceSingleline e]
               ]
            ++ [ docHandleComms finalCommaPos docCommaSep
               , docForceSingleline eN
               , closeDoc]
          addAlternative
            $ let start  = docCols ColList [appSep $ openDoc, docSetBaseY e1]
                  linesM = ems <&> \(p, ast, d) ->
                    docCols
                      ColList
                      [ docHandleComms p docCommaSep
                      , docSetBaseY $ docFlushCommsPost True ast $ d
                      ]
                  lineN  = docCols ColList
                    [docHandleComms finalCommaPos $ docCommaSep, docSetBaseY eN]
              in  docSetBaseY
                  $  docLines
                  $  [start]
                  ++ linesM
                  ++ [lineN]
                  ++ [closeDoc]
    ExplicitList epAnn [] -> docHandleComms epAnn $ docLit $ Text.pack "[]"
    RecordCon epAnn lname fields -> docHandleComms epAnn $ do
      let (wrapOpen, wrapClose) = case epAnn of
            EpAnn _ [open, close] _ ->
              ( docHandleComms (obtainAnnPos open AnnOpenC)
              , docHandleComms (obtainAnnPos close AnnCloseC)
              )
            _ -> (id, id)
          fieldLayouter = \case
            FieldOcc _ lnameF -> docLit (lrdrNameToText lnameF)
            XFieldOcc _       -> error "XFieldOcc"
      case fields of
        HsRecFields fs Nothing -> do
          let nameDoc = docHandleComms lname $ docLit $ lrdrNameToText lname
          recordExpression False
                           wrapOpen
                           id
                           wrapClose
                           indentPolicy
                           lexpr
                           nameDoc
                           fieldLayouter
                           fs
        HsRecFields [] (Just (L dotdotLoc 0)) -> do
          let wrapDotDot = docHandleComms dotdotLoc
          let t          = lrdrNameToText lname
          docHandleComms lname $ docSeq
            [ docLit t
            , docSeparator
            , wrapOpen $ docLitS "{"
            , docSeparator
            , wrapDotDot $ docLitS ".."
            , docSeparator
            , wrapClose $ docLitS "}"
            ]
        HsRecFields fs@(_ : _) (Just (L dotdotLoc dotdoti))
          | dotdoti == length fs -> do
            let nameDoc = docHandleComms lname $ docLit $ lrdrNameToText lname
            let wrapDotDot = docHandleComms dotdotLoc
            recordExpression True
                             wrapOpen
                             wrapDotDot
                             wrapClose
                             indentPolicy
                             lexpr
                             nameDoc
                             fieldLayouter
                             fs
        _ -> unknownNodeError "RecordCon with puns" lexpr
    RecordUpd epAnn rExpr (Left fields) -> docHandleComms epAnn $ do
      let (wrapOpen, wrapClose) = case epAnn of
            EpAnn _ [open, close] _ ->
              ( docHandleComms $ obtainAnnPos open AnnOpenC
              , docHandleComms $ obtainAnnPos close AnnCloseC
              )
            _ -> (id, id)
      let fieldLayouter = \case
            Unambiguous _ n      -> docLit (lrdrNameToText n)
            Ambiguous   _ n      -> docLit (lrdrNameToText n)
            XAmbiguousFieldOcc _ -> error "XAmbiguousFieldOcc"
      rExprDoc <- shareDoc $ layoutExpr rExpr
      recordExpression False
                       wrapOpen
                       id
                       wrapClose
                       indentPolicy
                       lexpr
                       rExprDoc
                       fieldLayouter
                       fields
    RecordUpd epAnn rExpr (Right fields) -> do
      let (wrapOpen, wrapClose) = case epAnn of
            EpAnn _ [open, close] _ ->
              ( docHandleComms $ obtainAnnPos open AnnOpenC
              , docHandleComms $ obtainAnnPos close AnnCloseC
              )
            _ -> (id, id)
      rExprDoc <- shareDoc $ layoutExpr rExpr
      let labelLayouter label = case label of
            L flAnn (HsFieldLabel _ (L _ n)) ->
              docHandleComms flAnn $ docLitS $ FastString.unpackFS n
            L _ann (XHsFieldLabel _) -> error "XHsFieldLabel"
      let fieldLayouter = \case
            FieldLabelStrings []      -> docEmpty
            FieldLabelStrings [label] -> labelLayouter label
            FieldLabelStrings labels ->
              docSeq $ List.intersperse docCommaSep $ map labelLayouter labels
      recordExpression False
                       wrapOpen
                       id
                       wrapClose
                       indentPolicy
                       lexpr
                       rExprDoc
                       fieldLayouter
                       fields
    ExprWithTySig _ exp1 (HsWC _ typ1) -> do
      expDoc <- shareDoc $ callLayouter layout_expr exp1
      typDoc <- shareDoc $ callLayouter layout_sigType typ1
      docAlt
        [ docForceSingleline
          $ docSeq [appSep expDoc, appSep $ docLitS "::", typDoc]
        , docPar expDoc (docSeq [docLitS "::", docSeparator, typDoc])
        ]
    ArithSeq _ Nothing info -> case info of
      From e1 -> do
        e1Doc <- shareDoc $ layoutExpr e1
        docSeq
          [ docLit $ Text.pack "["
          , appSep $ docForceSingleline e1Doc
          , docLit $ Text.pack "..]"
          ]
      FromThen e1 e2 -> do
        e1Doc <- shareDoc $ layoutExpr e1
        e2Doc <- shareDoc $ layoutExpr e2
        docSeq
          [ docLit $ Text.pack "["
          , docForceSingleline e1Doc
          , appSep $ docLit $ Text.pack ","
          , appSep $ docForceSingleline e2Doc
          , docLit $ Text.pack "..]"
          ]
      FromTo e1 eN -> do
        e1Doc <- shareDoc $ layoutExpr e1
        eNDoc <- shareDoc $ layoutExpr eN
        docSeq
          [ docLit $ Text.pack "["
          , appSep $ docForceSingleline e1Doc
          , appSep $ docLit $ Text.pack ".."
          , docForceSingleline eNDoc
          , docLit $ Text.pack "]"
          ]
      FromThenTo e1 e2 eN -> do
        e1Doc <- shareDoc $ layoutExpr e1
        e2Doc <- shareDoc $ layoutExpr e2
        eNDoc <- shareDoc $ layoutExpr eN
        docSeq
          [ docLit $ Text.pack "["
          , docForceSingleline e1Doc
          , appSep $ docLit $ Text.pack ","
          , appSep $ docForceSingleline e2Doc
          , appSep $ docLit $ Text.pack ".."
          , docForceSingleline eNDoc
          , docLit $ Text.pack "]"
          ]
    HsGetField _epAnn _exp1 _field -> do
      let labelLayouter label = case label of
            L flAnn (HsFieldLabel _ (L _ n)) ->
              docHandleComms flAnn $ docLitS $ FastString.unpackFS n
            L _ann (XHsFieldLabel _) -> error "XHsFieldLabel"
          gather
            :: [ToBriDocM BriDocNumbered]
            -> LHsExpr GhcPs
            -> (LHsExpr GhcPs, [ToBriDocM BriDocNumbered])
          gather list = \case
            L _ (HsGetField epAnn l r) ->
              gather (docHandleComms epAnn $ labelLayouter r : list) l
            x -> (x, list)
      let (headE, paramEs) = gather [] lexpr
      expDoc <- shareDoc $ layoutExpr headE
      -- this only has single-line layout, afaik
      docForceSingleline $ docSeq $ intersperse (docLitS ".") (expDoc : paramEs)
    HsProjection epAnn (f1 :| fR) -> do
      let labelLayouter label = case label of
            L flAnn (HsFieldLabel _ (L _ n)) ->
              docHandleComms flAnn $ docLitS $ FastString.unpackFS n
            L _ann (XHsFieldLabel _) -> error "XHsFieldLabel"
      docForceSingleline $ docHandleComms epAnn $ docSeq
        (  [docLitS "("]
        ++ [ doc | f <- f1 : fR, doc <- [docLitS ".", labelLayouter f] ]
        ++ [docLitS ")"]
        )
    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 $ BDPlain
        (  Text.pack
        $  "["
        ++ showOutputable quoter
        ++ "|"
        ++ showOutputable content
        ++ "|]"
        )
    splice@HsSpliceE{} -> do
      -- TODO
      let epAnnWithoutCommas = case GHC.getLoc lexpr of
            SrcSpanAnn (EpAnn anch (AnnListItem _) comms) srcLoc -> do
              SrcSpanAnn (EpAnn anch (AnnListItem []) comms) srcLoc
            x@(SrcSpanAnn EpAnnNotUsed _) -> x
      briDocByExactInlineOnly "HsSpliceE{}" (L epAnnWithoutCommas splice)
    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
  :: Bool
  -> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
  -> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
  -> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
  -> IndentPolicy
  -> LocatedA lExpr
  -> ToBriDocM BriDocNumbered
  -> (field -> ToBriDocM BriDocNumbered)
  -- -> [LHsFieldBind GhcPs (LFieldOcc p) (LHsExpr GhcPs)]
  -> [LHsRecField' GhcPs field (LHsExpr GhcPs)]
  -> ToBriDocM BriDocNumbered
recordExpression False wrapO _wrapDD wrapC _ _lexpr nameDoc _ [] = docSeq
  [ -- TODO92 docNodeAnnKW lexpr (Just AnnOpenC) $
    docSeq [nameDoc, wrapO $ docLit $ Text.pack "{"]
  , wrapC $ docLit $ Text.pack "}"
  ]
recordExpression True wrapO wrapDD wrapC _ _lexpr nameDoc _ [] = docSeq -- this case might still be incomplete, and is probably not used
         -- atm anyway.
  [ nameDoc
  , wrapO $ docLit $ Text.pack "{"
  , docSeparator
  , wrapDD $ docLitS ".."
  , docSeparator
  , wrapC $ docLit $ Text.pack "}"
  ]
recordExpression dotdot wrapO wrapDD wrapC indentPolicy _lexpr nameDoc nameLayouter (rF1 : rFr)
  = do
    let
      mkFieldTuple = \case
        L srcSpan (HsRecField fEpAnn (L _ nameThing) rFExpr pun) -> do
          let (posStart, _posSomething) = case fEpAnn of -- TODO92 not sure what posSomething is
                EpAnn anch [AddEpAnn _ span] _ ->
                  ( Just $ GHC.realSrcSpanStart $ anchor anch
                  , Just $ epaLocationRealSrcSpanStart span
                  )
                _ -> (Nothing, Nothing)
          let posComma = case srcSpan of
                SrcSpanAnn (EpAnn _ (AnnListItem items) _) _ -> case items of
                  [AddCommaAnn span] -> Just $ epaLocationRealSrcSpanStart span
                  _                  -> Nothing
                SrcSpanAnn EpAnnNotUsed _ -> Nothing
          fnameDoc <- shareDoc $ docHandleComms fEpAnn $ nameLayouter nameThing
          if pun
            then pure $ Left (posStart, fnameDoc)
            else do
              expDoc <-
                shareDoc $ docFlushCommsPost True posComma $ layoutExpr rFExpr
              pure $ Right (posStart, fnameDoc, expDoc)
    fieldTuple1 <- mkFieldTuple rF1
    fieldTupleR <- rFr `forM` mkFieldTuple
    let fieldWiths
          :: a
          -> a
          -> (  a
             -> Either
                  (Maybe GHC.RealSrcLoc, ToBriDocM BriDocNumbered)
                  ( Maybe GHC.RealSrcLoc
                  , ToBriDocM BriDocNumbered
                  , ToBriDocM BriDocNumbered
                  )
             -> ToBriDocM BriDocNumbered
             )
          -> [ToBriDocM BriDocNumbered]
        fieldWiths extra1 extraR f =
          f extra1 fieldTuple1 : map (f extraR) fieldTupleR
    runFilteredAlternative $ do
      -- container { fieldA = blub, fieldB = blub }
      addAlternative $ docSeq
        [ -- TODO92 docNodeAnnKW lexpr Nothing $
          appSep $ docForceSingleline nameDoc
        , appSep $ wrapO $ docLit $ Text.pack "{"
        , docSeq $ List.intersperse docCommaSep $ fieldWiths () () $ \() ->
          \case
            Left  (pos, fnameDoc)         -> docHandleComms pos $ fnameDoc
            Right (pos, fnameDoc, expDoc) -> docHandleComms pos $ docSeq
              [ appSep $ fnameDoc
              , appSep $ docLit $ Text.pack "="
              , docForceSingleline $ expDoc
              ]
        , if dotdot
          then docSeq
            [docCommaSep, wrapDD $ docLit $ Text.pack "..", docSeparator]
          else docSeparator
        , wrapC $ docLit $ Text.pack "}"
        ]
      -- hanging single-line fields
      -- container { fieldA = blub
      --           , fieldB = blub
      --           }
      addAlternativeCond (indentPolicy == IndentPolicyFree) $ docSeq
        [ -- TODO92 docNodeAnnKW lexpr Nothing $
          docForceSingleline $ appSep nameDoc
        , docSetBaseY
        $ docLines
        $ let
            fieldLines =
              fieldWiths (appSep $ wrapO $ docLit $ Text.pack "{") docCommaSep
                $ \prep -> \case
                    Left (pos, fnameDoc) ->
                      docCols ColRec [prep, docHandleComms pos $ fnameDoc]
                    Right (pos, fnameDoc, expDoc) -> docCols
                      ColRec
                      [ prep
                      , docHandleComms pos $ appSep $ fnameDoc
                      , docSeq
                        [ appSep $ docLit $ Text.pack "="
                        , docForceSingleline expDoc
                        ]
                      ]
            dotdotLine = if dotdot
              then docCols
                ColRec
                [ -- TODO92 docNodeAnnKW lexpr (Just AnnOpenC)
                  docCommaSep
                , wrapDD $ docLit $ Text.pack ".."
                ]
              else -- TODO92 docNodeAnnKW lexpr (Just AnnOpenC)
                   docEmpty
            lineN = wrapC $ docLit $ Text.pack "}"
          in
            fieldLines ++ [dotdotLine, lineN]
        ]
      -- non-hanging with expressions placed to the right of the names
      -- container
      -- { fieldA = blub
      -- , fieldB = potentially
      --     multiline
      -- }
      addAlternative $ docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
        (-- TODO92 docNodeAnnKW lexpr Nothing
         nameDoc)
        ( docNonBottomSpacing
        $ docLines
        $ let
            fieldLines =
              fieldWiths (appSep $ wrapO $ docLit $ Text.pack "{") docCommaSep
                $ \prep -> \case
                    Left (pos, fnameDoc) ->
                      docCols ColRec [prep, docHandleComms pos $ fnameDoc]
                    Right (pos, fnameDoc, expDoc) -> docCols
                      ColRec
                      [ prep
                      , docHandleComms pos $ appSep $ fnameDoc
                      , runFilteredAlternative $ do
                        addAlternativeCond (indentPolicy == IndentPolicyFree)
                          $ do
                              docSeq
                                [ appSep $ docLit $ Text.pack "="
                                , docSetBaseY expDoc
                                ]
                        addAlternative $ do
                          docSeq
                            [ appSep $ docLit $ Text.pack "="
                            , docForceParSpacing expDoc
                            ]
                        addAlternative $ do
                          docAddBaseY BrIndentRegular
                            $ docPar (docLit $ Text.pack "=") expDoc
                      ]
            dotdotLine = if dotdot
              then docCols
                ColRec
                [ -- TODO92 docNodeAnnKW lexpr (Just AnnOpenC) 
                  docCommaSep
                , wrapDD $ docLit $ Text.pack ".."
                ]
              else -- TODO92 docNodeAnnKW lexpr (Just AnnOpenC) 
                   docEmpty
            lineN = wrapC $ docLit $ Text.pack "}"
          in
            fieldLines ++ [dotdotLine, lineN]
        )

litBriDoc :: HsLit GhcPs -> BriDocWrapped
litBriDoc = \case
  HsChar (SourceText t) _c -> BDLit $ Text.pack t -- BDLit $ Text.pack $ ['\'', c, '\'']
  HsCharPrim (SourceText t) _c -> BDLit $ Text.pack t -- BDLit $ Text.pack $ ['\'', c, '\'']
  HsString (SourceText t) _fastString -> BDLit $ Text.pack t -- BDLit $ Text.pack $ FastString.unpackFS fastString
  HsStringPrim (SourceText t) _byteString -> BDLit $ Text.pack t -- BDLit $ Text.pack $ Data.ByteString.Char8.unpack byteString
  HsInt _ (IL (SourceText t) _ _) -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
  HsIntPrim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
  HsWordPrim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
  HsInt64Prim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
  HsWord64Prim (SourceText t) _i -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
  HsInteger (SourceText t) _i _type -> BDLit $ Text.pack t -- BDLit $ Text.pack $ show i
  HsRat _ (FL (SourceText t) _ _ _ _) _type -> BDLit $ Text.pack t
  HsFloatPrim _ (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
  HsDoublePrim _ (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
  _ -> error "litBriDoc: literal with no SourceText"

overLitValBriDoc :: OverLitVal -> BriDocWrapped
overLitValBriDoc = \case
  HsIntegral (IL (SourceText t) _ _) -> BDLit $ Text.pack t
  HsFractional (FL (SourceText t) _ _ _ _) -> BDLit $ Text.pack t
  HsIsString (SourceText t) _ -> BDLit $ Text.pack t
  _ -> error "overLitValBriDoc: literal with no SourceText"
