# 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?
        )
      ]
  we will (   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
     ( 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  = 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 (  ,  ) - > do
--       let (out, errs) = runIdentity
--                       $ runMultiRWSTNil
                        $ Control . Monad . Trans . MultiRWS.Lazy.withMultiWriterAW
                        $ Control . Monad . Trans . MultiRWS.Lazy.withMultiWriterW
                        $ Control . Monad . Trans .  
                        $ 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  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 $ ()

 re-export from utils:
 really only next in module
 by name
 TODO: use some proper utf8 encoder instead?
 line.
 Butcher.addCmd "module" $ do
   conf <- configParser
 | Exposes the transformation in an pseudo-pure fashion. The signature
 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.

 `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.
 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.
 unless () $ do

   debugStrings `forM_` \s ->
     trace s $ return ()
 | Additionally checks that the output compiles again, appending an error
 if it does not.
 used for testing mostly, currently.
 TODO: use parsePrintModule instead and remove this function.
 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 pragmaInfo = GHC.getOptions
         fakeFileName
         dflags1
         fakeFileName
         GHC.parseModule
         inputStr
     Left (_, s) -> Left $ "parsing error: " ++ s
       let (out, errs) = runIdentity
                       $ runMultiRWSTNil
       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
 Prints the information associated with the module annotation
 This includes the imports
 this can cause duplication of comments. So strip
 attached annotations that come after the module's where
 from the module node
 Note that briDoc is BriDocNumbered, but state type is BriDoc.
 That's why the alt-transform looks a bit special here.
 bridoc transformation: remove alts
 bridoc transformation: float stuff in
 bridoc transformation: par removal
 bridoc transformation: float stuff in
 bridoc transformation: indent
 -- convert to Simple type
 simpl <- mGet <&> transformToSimple
 return simpl
 important that we dont use left
 here because moveToAnn stuff
 its thing properly.
 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.
# LANGUAGE LambdaCase #
# LANGUAGE NoImplicitPrelude #
# LANGUAGE ScopedTypeVariables #

module Language.Haskell.Brittany.Internal
  ( parsePrintModule
  , parsePrintModuleTests
  , pPrintModule
  , pPrintModuleAndCheck
  , 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
    | 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
        )
      ]
  we will (   here to parse the inline config
      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
     ( 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]
    ]


  contains ` IO ` due to the GHC API not exposing a pure parsing function , but
  Note that the ghc parsing function used internally currently is wrapped in
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



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)

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)


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


    let  = GHC.unsafeGlobalDynFlags
    let fakeFileName = " SomeTestFakeFileName.hs "
          dflags
          ( GHC.stringToStringBuffer $ Text.unpack input )
    ( dflags1 , _ , _ ) < - GHC.parseDynamicFilePragma dflags pragmaInfo
    let parseResult = ExactPrint . Parsers.parseWith
    case parseResult of
      Right (  ,  ) - > do
                        $ Control . Monad . Trans . MultiRWS.Lazy.withMultiWriterAW
                        $ Control . Monad . Trans . MultiRWS.Lazy.withMultiWriterW
                        $ Control . Monad . Trans .  
                        $ ppModule parsedModule

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]
  _ -> []


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  and the elements in the module
  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
    traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw
      $ briDocToDoc
      $ unwrapBriDocNumbered
      $ briDoc
    transformAlts briDoc >>= mSet
    mGet
      >>= briDocToDoc
      .> traceIfDumpConf "bridoc post-alt" _dconf_dump_bridoc_simpl_alt
    mGet >>= transformSimplifyFloating .> mSet
    mGet
      >>= briDocToDoc
      .> traceIfDumpConf
           "bridoc post-floating"
           _dconf_dump_bridoc_simpl_floating
    mGet >>= transformSimplifyPar .> mSet
    mGet
      >>= briDocToDoc
      .> traceIfDumpConf "bridoc post-par" _dconf_dump_bridoc_simpl_par
    mGet >>= transformSimplifyColumns .> mSet
    mGet
      >>= briDocToDoc
      .> traceIfDumpConf "bridoc post-columns" _dconf_dump_bridoc_simpl_columns
    mGet >>= transformSimplifyIndent .> mSet
    mGet
      >>= briDocToDoc
      .> traceIfDumpConf "bridoc post-indent" _dconf_dump_bridoc_simpl_indent
    mGet
      >>= briDocToDoc
      .> traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final

  anns :: ExactPrint.Anns <- mAsk

  let
    state = LayoutState
      { _lstate_baseYs = [0]
  of the first node needs to do
      , _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')
      , ExactPrint.unConName con /= "ImportDecl"
      , c <- extractAllComments elemAnns
      ]
  remainingComments
    `forM_` (fst .> show .> ErrorUnusedComment .> (: []) .> mTell)

  return $ ()
