{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Language.Haskell.Brittany.Internal
  ( parsePrintModule
  , parsePrintModuleTests
  , pPrintModule
  , pPrintModuleAndCheck
   -- re-export from utils:
  , parseModule
  , parseModuleFromString
  , extractCommentConfigs
  , getTopLevelDeclNameMap
  ) where

import Control.Monad.Trans.Except
import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
import qualified Data.ByteString.Char8
import Data.CZipWith
import Data.Char (isSpace)
import Data.HList.HList
import qualified Data.Map as Map
import qualified Data.Maybe
import qualified Data.Semigroup as Semigroup
import qualified Data.Sequence as Seq
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TextL
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Yaml
import qualified GHC hiding (parseModule)
import GHC (GenLocated(L))
import qualified GHC.Driver.Session as GHC
import GHC.Hs
import qualified GHC.LanguageExtensions.Type as GHC
import qualified GHC.OldList as List
import GHC.Parser.Annotation (AnnKeywordId(..))
import GHC.Types.SrcLoc (SrcSpan)
import Language.Haskell.Brittany.Internal.Backend
import Language.Haskell.Brittany.Internal.BackendUtils
import Language.Haskell.Brittany.Internal.Config
import Language.Haskell.Brittany.Internal.Config.Types
import Language.Haskell.Brittany.Internal.ExactPrintUtils
import Language.Haskell.Brittany.Internal.LayouterBasics
import Language.Haskell.Brittany.Internal.Layouters.Decl
import Language.Haskell.Brittany.Internal.Layouters.Module
import Language.Haskell.Brittany.Internal.Prelude
import Language.Haskell.Brittany.Internal.PreludeUtils
import Language.Haskell.Brittany.Internal.Transformations.Alt
import Language.Haskell.Brittany.Internal.Transformations.Columns
import Language.Haskell.Brittany.Internal.Transformations.Floating
import Language.Haskell.Brittany.Internal.Transformations.Indent
import Language.Haskell.Brittany.Internal.Transformations.Par
import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.Utils
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
import qualified UI.Butcher.Monadic as Butcher



data InlineConfigTarget
    = InlineConfigTargetModule
    | InlineConfigTargetNextDecl    -- really only next in module
    | InlineConfigTargetNextBinding -- by name
    | InlineConfigTargetBinding String

extractCommentConfigs
  :: ExactPrint.Anns
  -> TopLevelDeclNameMap
  -> Either (String, String) (CConfig Maybe, PerItemConfig)
extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
  let
    commentLiness =
      [ ( k
        , [ x
          | (ExactPrint.Comment x _ _, _) <-
            (  ExactPrint.annPriorComments ann
            ++ ExactPrint.annFollowingComments ann
            )
          ]
          ++ [ x
             | (ExactPrint.AnnComment (ExactPrint.Comment x _ _), _) <-
               ExactPrint.annsDP ann
             ]
        )
      | (k, ann) <- Map.toList anns
      ]
  let configLiness = commentLiness <&> second
        (Data.Maybe.mapMaybe $ \line -> do
          l1 <-
            List.stripPrefix "-- BRITTANY" line
            <|> List.stripPrefix "--BRITTANY" line
            <|> List.stripPrefix "-- brittany" line
            <|> List.stripPrefix "--brittany" line
            <|> (List.stripPrefix "{- BRITTANY" line >>= stripSuffix "-}")
          let l2 = dropWhile isSpace l1
          guard
            (  ("@" `isPrefixOf` l2)
            || ("-disable" `isPrefixOf` l2)
            || ("-next" `isPrefixOf` l2)
            || ("{" `isPrefixOf` l2)
            || ("--" `isPrefixOf` l2)
            )
          pure l2
        )
  let
    configParser = Butcher.addAlternatives
      [ ( "commandline-config"
        , \s -> "-" `isPrefixOf` dropWhile (== ' ') s
        , cmdlineConfigParser
        )
      , ( "yaml-config-document"
        , \s -> "{" `isPrefixOf` dropWhile (== ' ') s
        , Butcher.addCmdPart (Butcher.varPartDesc "yaml-config-document")
        $ fmap (\lconf -> (mempty { _conf_layout = lconf }, ""))
        . either (const Nothing) Just
        . Data.Yaml.decodeEither'
        . Data.ByteString.Char8.pack
          -- TODO: use some proper utf8 encoder instead?
        )
      ]
    parser = do -- we will (mis?)use butcher here to parse the inline config
                -- line.
      let nextDecl = do
            conf <- configParser
            Butcher.addCmdImpl (InlineConfigTargetNextDecl, conf)
      Butcher.addCmd "-next-declaration" nextDecl
      Butcher.addCmd "-Next-Declaration" nextDecl
      Butcher.addCmd "-NEXT-DECLARATION" nextDecl
      let nextBinding = do
            conf <- configParser
            Butcher.addCmdImpl (InlineConfigTargetNextBinding, conf)
      Butcher.addCmd "-next-binding" nextBinding
      Butcher.addCmd "-Next-Binding" nextBinding
      Butcher.addCmd "-NEXT-BINDING" nextBinding
      let disableNextBinding = do
            Butcher.addCmdImpl
              ( InlineConfigTargetNextBinding
              , mempty { _conf_roundtrip_exactprint_only = pure $ pure True }
              )
      Butcher.addCmd "-disable-next-binding" disableNextBinding
      Butcher.addCmd "-Disable-Next-Binding" disableNextBinding
      Butcher.addCmd "-DISABLE-NEXT-BINDING" disableNextBinding
      let disableNextDecl = do
            Butcher.addCmdImpl
              ( InlineConfigTargetNextDecl
              , mempty { _conf_roundtrip_exactprint_only = pure $ pure True }
              )
      Butcher.addCmd "-disable-next-declaration" disableNextDecl
      Butcher.addCmd "-Disable-Next-Declaration" disableNextDecl
      Butcher.addCmd "-DISABLE-NEXT-DECLARATION" disableNextDecl
      let disableFormatting = do
            Butcher.addCmdImpl
              ( InlineConfigTargetModule
              , mempty { _conf_disable_formatting = pure $ pure True }
              )
      Butcher.addCmd "-disable" disableFormatting
      Butcher.addCmd "@" $ do
        -- Butcher.addCmd "module" $ do
        --   conf <- configParser
        --   Butcher.addCmdImpl (InlineConfigTargetModule, conf)
        Butcher.addNullCmd $ do
          bindingName <- Butcher.addParamString "BINDING" mempty
          conf        <- configParser
          Butcher.addCmdImpl (InlineConfigTargetBinding bindingName, conf)
      conf <- configParser
      Butcher.addCmdImpl (InlineConfigTargetModule, conf)
  lineConfigss <- configLiness `forM` \(k, ss) -> do
    r <- ss `forM` \s -> case Butcher.runCmdParserSimple s parser of
      Left  err -> Left $ (err, s)
      Right c   -> Right $ c
    pure (k, r)

  let perModule = foldl'
        (<>)
        mempty
        [ conf
        | (_                       , lineConfigs) <- lineConfigss
        , (InlineConfigTargetModule, conf       ) <- lineConfigs
        ]
  let
    perBinding = Map.fromListWith
      (<>)
      [ (n, conf)
      | (k     , lineConfigs) <- lineConfigss
      , (target, conf       ) <- lineConfigs
      , n                     <- case target of
        InlineConfigTargetBinding s -> [s]
        InlineConfigTargetNextBinding | Just name <- Map.lookup k declNameMap ->
          [name]
        _ -> []
      ]
  let
    perKey = Map.fromListWith
      (<>)
      [ (k, conf)
      | (k     , lineConfigs) <- lineConfigss
      , (target, conf       ) <- lineConfigs
      , case target of
        InlineConfigTargetNextDecl -> True
        InlineConfigTargetNextBinding | Nothing <- Map.lookup k declNameMap ->
          True
        _ -> False
      ]

  pure
    $ ( perModule
      , PerItemConfig { _icd_perBinding = perBinding, _icd_perKey = perKey }
      )


getTopLevelDeclNameMap :: GHC.ParsedSource -> TopLevelDeclNameMap
getTopLevelDeclNameMap (L _ (HsModule _ _name _exports _ decls _ _)) =
  TopLevelDeclNameMap $ Map.fromList
    [ (ExactPrint.mkAnnKey decl, name)
    | decl       <- decls
    , (name : _) <- [getDeclBindingNames decl]
    ]


-- | Exposes the transformation in an pseudo-pure fashion. The signature
-- contains `IO` due to the GHC API not exposing a pure parsing function, but
-- there should be no observable effects.
--
-- Note that this function ignores/resets all config values regarding
-- debugging, i.e. it will never use `trace`/write to stderr.
--
-- Note that the ghc parsing function used internally currently is wrapped in
-- `mask_`, so cannot be killed easily. If you don't control the input, you
-- may wish to put some proper upper bound on the input's size as a timeout
-- won't do.
parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)
parsePrintModule configWithDebugs inputText = runExceptT $ do
  let config =
        configWithDebugs { _conf_debug = _conf_debug staticDefaultConfig }
  let ghcOptions         = config & _conf_forward & _options_ghc & runIdentity
  let config_pp          = config & _conf_preprocessor
  let cppMode            = config_pp & _ppconf_CPPMode & confUnpack
  let hackAroundIncludes = config_pp & _ppconf_hackAroundIncludes & confUnpack
  (anns, parsedSource, hasCPP) <- do
    let hackF s = if "#include" `isPrefixOf` s
          then "-- BRITANY_INCLUDE_HACK " ++ s
          else s
    let hackTransform = if hackAroundIncludes
          then List.intercalate "\n" . fmap hackF . lines'
          else id
    let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
          then case cppMode of
            CPPModeAbort  -> return $ Left "Encountered -XCPP. Aborting."
            CPPModeWarn   -> return $ Right True
            CPPModeNowarn -> return $ Right True
          else return $ Right False
    parseResult <- lift $ parseModuleFromString
      ghcOptions
      "stdin"
      cppCheckFunc
      (hackTransform $ Text.unpack inputText)
    case parseResult of
      Left  err -> throwE [ErrorInput err]
      Right x   -> pure x
  (inlineConf, perItemConf) <-
    either (throwE . (: []) . uncurry ErrorMacroConfig) pure
      $ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)
  let moduleConfig      = cZipWith fromOptionIdentity config inlineConf
  let disableFormatting = moduleConfig & _conf_disable_formatting & confUnpack
  if disableFormatting
    then do
      return inputText
    else do
      (errsWarns, outputTextL) <- do
        let omitCheck =
              moduleConfig
                & _conf_errorHandling
                & _econf_omit_output_valid_check
                & confUnpack
        (ews, outRaw) <- if hasCPP || omitCheck
          then return $ pPrintModule moduleConfig perItemConf anns parsedSource
          else lift
            $ pPrintModuleAndCheck moduleConfig perItemConf anns parsedSource
        let hackF s = fromMaybe s
              $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s
        pure $ if hackAroundIncludes
          then
            ( ews
            , TextL.intercalate (TextL.pack "\n") $ hackF <$> TextL.splitOn
              (TextL.pack "\n")
              outRaw
            )
          else (ews, outRaw)
      let customErrOrder ErrorInput{}         = 4
          customErrOrder LayoutWarning{}      = 0 :: Int
          customErrOrder ErrorOutputCheck{}   = 1
          customErrOrder ErrorUnusedComment{} = 2
          customErrOrder ErrorUnknownNode{}   = 3
          customErrOrder ErrorMacroConfig{}   = 5
      let hasErrors =
            if moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack
            then not $ null errsWarns
            else 0 < maximum (-1 : fmap customErrOrder errsWarns)
      if hasErrors
        then throwE $ errsWarns
        else pure $ TextL.toStrict outputTextL



-- BrittanyErrors can be non-fatal warnings, thus both are returned instead
-- of an Either.
-- This should be cleaned up once it is clear what kinds of errors really
-- can occur.
pPrintModule
  :: Config
  -> PerItemConfig
  -> ExactPrint.Anns
  -> GHC.ParsedSource
  -> ([BrittanyError], TextL.Text)
pPrintModule conf inlineConf anns parsedModule =
  let ((out, errs), debugStrings) =
        runIdentity
          $ MultiRWSS.runMultiRWSTNil
          $ MultiRWSS.withMultiWriterAW
          $ MultiRWSS.withMultiWriterAW
          $ MultiRWSS.withMultiWriterW
          $ MultiRWSS.withMultiReader anns
          $ MultiRWSS.withMultiReader conf
          $ MultiRWSS.withMultiReader inlineConf
          $ MultiRWSS.withMultiReader (extractToplevelAnns parsedModule anns)
          $ do
              traceIfDumpConf "bridoc annotations raw" _dconf_dump_annotations
                $ annsDoc anns
              ppModule parsedModule
      tracer = if Seq.null debugStrings
        then id
        else
          trace ("---- DEBUGMESSAGES ---- ")
            . foldr (seq . join trace) id debugStrings
  in  tracer $ (errs, Text.Builder.toLazyText out)
  -- unless () $ do
  --
  --   debugStrings `forM_` \s ->
  --     trace s $ return ()

-- | Additionally checks that the output compiles again, appending an error
-- if it does not.
pPrintModuleAndCheck
  :: Config
  -> PerItemConfig
  -> ExactPrint.Anns
  -> GHC.ParsedSource
  -> IO ([BrittanyError], TextL.Text)
pPrintModuleAndCheck conf inlineConf anns parsedModule = do
  let ghcOptions     = conf & _conf_forward & _options_ghc & runIdentity
  let (errs, output) = pPrintModule conf inlineConf anns parsedModule
  parseResult <- parseModuleFromString ghcOptions
                                       "output"
                                       (\_ -> return $ Right ())
                                       (TextL.unpack output)
  let errs' = errs ++ case parseResult of
        Left{}  -> [ErrorOutputCheck]
        Right{} -> []
  return (errs', output)


-- used for testing mostly, currently.
-- TODO: use parsePrintModule instead and remove this function.
parsePrintModuleTests :: Config -> String -> Text -> IO (Either String Text)
parsePrintModuleTests conf filename input = do
  let inputStr = Text.unpack input
  parseResult <- parseModuleFromString
    (conf & _conf_forward & _options_ghc & runIdentity)
    filename
    (const . pure $ Right ())
    inputStr
  case parseResult of
    Left  err                     -> return $ Left err
    Right (anns, parsedModule, _) -> runExceptT $ do
      (inlineConf, perItemConf) <-
        case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of
          Left  err -> throwE $ "error in inline config: " ++ show err
          Right x   -> pure x
      let moduleConf = cZipWith fromOptionIdentity conf inlineConf
      let omitCheck =
            conf
              &  _conf_errorHandling
              .> _econf_omit_output_valid_check
              .> confUnpack
      (errs, ltext) <- if omitCheck
        then return $ pPrintModule moduleConf perItemConf anns parsedModule
        else lift
          $ pPrintModuleAndCheck moduleConf perItemConf anns parsedModule
      if null errs
        then pure $ TextL.toStrict $ ltext
        else
          let
            errStrs = errs <&> \case
              ErrorInput         str -> str
              ErrorUnusedComment str -> str
              LayoutWarning      str -> str
              ErrorUnknownNode str _ -> str
              ErrorMacroConfig str _ -> "when parsing inline config: " ++ str
              ErrorOutputCheck       -> "Output is not syntactically valid."
          in  throwE $ "pretty printing error(s):\n" ++ List.unlines errStrs

-- this approach would for if there was a pure GHC.parseDynamicFilePragma.
-- Unfortunately that does not exist yet, so we cannot provide a nominally
-- pure interface.

-- parsePrintModuleTests :: Text -> Either String Text
-- parsePrintModuleTests input = do
--   let dflags = GHC.unsafeGlobalDynFlags
--   let fakeFileName = "SomeTestFakeFileName.hs"
--   let pragmaInfo = GHC.getOptions
--         dflags
--         (GHC.stringToStringBuffer $ Text.unpack input)
--         fakeFileName
--   (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags pragmaInfo
--   let parseResult = ExactPrint.Parsers.parseWith
--         dflags1
--         fakeFileName
--         GHC.parseModule
--         inputStr
--   case parseResult of
--     Left (_, s) -> Left $ "parsing error: " ++ s
--     Right (anns, parsedModule) -> do
--       let (out, errs) = runIdentity
--                       $ runMultiRWSTNil
--                       $ Control.Monad.Trans.MultiRWS.Lazy.withMultiWriterAW
--                       $ Control.Monad.Trans.MultiRWS.Lazy.withMultiWriterW
--                       $ Control.Monad.Trans.MultiRWS.Lazy.withMultiReader anns
--                       $ ppModule parsedModule
--       if (not $ null errs)
--         then do
--           let errStrs = errs <&> \case
--                 ErrorUnusedComment str -> str
--           Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
--         else return $ TextL.toStrict $ Text.Builder.toLazyText out

toLocal :: Config -> ExactPrint.Anns -> PPMLocal a -> PPM a
toLocal conf anns m = do
  (x, write) <-
    lift $ MultiRWSS.runMultiRWSTAW (conf :+: anns :+: HNil) HNil $ m
  MultiRWSS.mGetRawW >>= \w -> MultiRWSS.mPutRawW (w `mappend` write)
  pure x

ppModule :: GenLocated SrcSpan HsModule -> PPM ()
ppModule lmod@(L _loc _m@(HsModule _ _name _exports _ decls _ _)) = do
  defaultAnns <- do
    anns <- mAsk
    let annKey = ExactPrint.mkAnnKey lmod
    let annMap = Map.findWithDefault Map.empty annKey anns
    let isEof = (== ExactPrint.AnnEofPos)
    let overAnnsDP f a = a { ExactPrint.annsDP = f $ ExactPrint.annsDP a }
    pure $ fmap (overAnnsDP . filter $ isEof . fst) annMap

  post <- ppPreamble lmod
  decls `forM_` \decl -> do
    let declAnnKey       = ExactPrint.mkAnnKey decl
    let declBindingNames = getDeclBindingNames decl
    inlineConf <- mAsk
    let mDeclConf = Map.lookup declAnnKey $ _icd_perKey inlineConf
    let mBindingConfs =
          declBindingNames <&> \n -> Map.lookup n $ _icd_perBinding inlineConf
    filteredAnns <- mAsk
      <&> \annMap ->
        Map.union defaultAnns $
        Map.findWithDefault Map.empty declAnnKey annMap

    traceIfDumpConf "bridoc annotations filtered/transformed"
                    _dconf_dump_annotations
      $ annsDoc filteredAnns

    config <- mAsk

    let config' = cZipWith fromOptionIdentity config
          $ mconcat (catMaybes (mBindingConfs ++ [mDeclConf]))

    let exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack
    toLocal config' filteredAnns $ do
      bd <- if exactprintOnly
        then briDocMToPPM $ briDocByExactNoComment decl
        else do
          (r, errs, debugs) <- briDocMToPPMInner $ layoutDecl decl
          mTell debugs
          mTell errs
          if null errs
            then pure r
            else briDocMToPPM $ briDocByExactNoComment decl
      layoutBriDoc bd

  let finalComments = filter
        (fst .> \case
          ExactPrint.AnnComment{} -> True
          _                       -> False
        )
        post
  post `forM_` \case
    (ExactPrint.AnnComment (ExactPrint.Comment cmStr _ _), l) -> do
      ppmMoveToExactLoc l
      mTell $ Text.Builder.fromString cmStr
    (ExactPrint.AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->
      let folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
            ExactPrint.AnnComment cm
              | span <- ExactPrint.commentIdentifier cm
              -> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
                 , x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
                 )
            _ -> (acc + y, x)
          (cmY, cmX) = foldl' folder (0, 0) finalComments
      in  ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX)
    _ -> return ()

getDeclBindingNames :: LHsDecl GhcPs -> [String]
getDeclBindingNames (L _ decl) = case decl of
  SigD _ (TypeSig _ ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
  ValD _ (FunBind _ (L _ n) _ _) -> [Text.unpack $ rdrNameToText n]
  _                              -> []


-- Prints the information associated with the module annotation
-- This includes the imports
ppPreamble
  :: GenLocated SrcSpan HsModule
  -> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]
ppPreamble lmod@(L loc m@HsModule{}) = do
  filteredAnns <- mAsk <&> \annMap ->
    Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap
    -- Since ghc-exactprint adds annotations following (implicit)
    -- modules to both HsModule and the elements in the module
    -- this can cause duplication of comments. So strip
    -- attached annotations that come after the module's where
    -- from the module node
  config <- mAsk
  let shouldReformatPreamble =
        config & _conf_layout & _lconfig_reformatModulePreamble & confUnpack

  let
    (filteredAnns', post) =
      case Map.lookup (ExactPrint.mkAnnKey lmod) filteredAnns of
        Nothing -> (filteredAnns, [])
        Just mAnn ->
          let
            modAnnsDp = ExactPrint.annsDP mAnn
            isWhere (ExactPrint.G AnnWhere) = True
            isWhere _                       = False
            isEof (ExactPrint.AnnEofPos) = True
            isEof _                        = False
            whereInd     = List.findIndex (isWhere . fst) modAnnsDp
            eofInd       = List.findIndex (isEof . fst) modAnnsDp
            (pre, post') = case (whereInd, eofInd) of
              (Nothing, Nothing) -> ([], modAnnsDp)
              (Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
              (Nothing, Just _i) -> ([], modAnnsDp)
              (Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
            mAnn' = mAnn { ExactPrint.annsDP = pre }
            filteredAnns'' =
              Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
          in
            (filteredAnns'', post')
  traceIfDumpConf "bridoc annotations filtered/transformed"
                  _dconf_dump_annotations
    $ annsDoc filteredAnns'

  if shouldReformatPreamble
    then toLocal config filteredAnns' $ withTransformedAnns lmod $ do
      briDoc <- briDocMToPPM $ layoutModule lmod
      layoutBriDoc briDoc
    else
      let emptyModule = L loc m { hsmodDecls = [] }
      in  MultiRWSS.withMultiReader filteredAnns' $ processDefault emptyModule
  return post

_sigHead :: Sig GhcPs -> String
_sigHead = \case
  TypeSig _ names _ ->
    "TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)
  _ -> "unknown sig"

_bindHead :: HsBind GhcPs -> String
_bindHead = \case
  FunBind _ fId _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
  PatBind _ _pat _ ([], []) -> "PatBind smth"
  _                           -> "unknown bind"



layoutBriDoc :: BriDocNumbered -> PPMLocal ()
layoutBriDoc briDoc = do
  -- first step: transform the briDoc.
  briDoc' <- MultiRWSS.withMultiStateS BDEmpty $ do
    -- Note that briDoc is BriDocNumbered, but state type is BriDoc.
    -- That's why the alt-transform looks a bit special here.
    traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw
      $ briDocToDoc
      $ unwrapBriDocNumbered
      $ briDoc
    -- bridoc transformation: remove alts
    transformAlts briDoc >>= mSet
    mGet
      >>= briDocToDoc
      .>  traceIfDumpConf "bridoc post-alt" _dconf_dump_bridoc_simpl_alt
    -- bridoc transformation: float stuff in
    mGet >>= transformSimplifyFloating .> mSet
    mGet
      >>= briDocToDoc
      .>  traceIfDumpConf "bridoc post-floating"
                          _dconf_dump_bridoc_simpl_floating
    -- bridoc transformation: par removal
    mGet >>= transformSimplifyPar .> mSet
    mGet
      >>= briDocToDoc
      .>  traceIfDumpConf "bridoc post-par" _dconf_dump_bridoc_simpl_par
    -- bridoc transformation: float stuff in
    mGet >>= transformSimplifyColumns .> mSet
    mGet
      >>= briDocToDoc
      .>  traceIfDumpConf "bridoc post-columns" _dconf_dump_bridoc_simpl_columns
    -- bridoc transformation: indent
    mGet >>= transformSimplifyIndent .> mSet
    mGet
      >>= briDocToDoc
      .>  traceIfDumpConf "bridoc post-indent" _dconf_dump_bridoc_simpl_indent
    mGet
      >>= briDocToDoc
      .>  traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final
    -- -- convert to Simple type
    -- simpl <- mGet <&> transformToSimple
    -- return simpl

  anns :: ExactPrint.Anns <- mAsk

  let state = LayoutState { _lstate_baseYs           = [0]
                          , _lstate_curYOrAddNewline = Right 0 -- important that we dont use left
                                             -- here because moveToAnn stuff
                                             -- of the first node needs to do
                                             -- its thing properly.
                          , _lstate_indLevels        = [0]
                          , _lstate_indLevelLinger   = 0
                          , _lstate_comments         = anns
                          , _lstate_commentCol       = Nothing
                          , _lstate_addSepSpace      = Nothing
                          , _lstate_commentNewlines  = 0
                          }

  state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'

  let remainingComments =
        [ c
        | (ExactPrint.AnnKey _ con, elemAnns) <- Map.toList
          (_lstate_comments state')
          -- With the new import layouter, we manually process comments
          -- without relying on the backend to consume the comments out of
          -- the state/map. So they will end up here, and we need to ignore
          -- them.
        , ExactPrint.unConName con /= "ImportDecl"
        , c <- extractAllComments elemAnns
        ]
  remainingComments
    `forM_` (fst .> show .> ErrorUnusedComment .> (: []) .> mTell)

  return $ ()