content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE ExplicitNamespaces #-}
  {-# LANGUAGE PatternSynonyms #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE ViewPatterns #-}
  
  module Refact.Internal
    ( apply,
      runRefactoring,
      addExtensionsToFlags,
      parseModuleWithArgs,
      parseExtensions,
  
      -- * Support for runPipe in the main process
      Verbosity (..),
      refactOptions,
      type Errors,
      onError,
      mkErr,
    )
  where
  
  import Control.Exception
  import Control.Monad
  import Control.Monad.IO.Class (MonadIO (..))
  import Control.Monad.Trans.Maybe (MaybeT (..))
  import Control.Monad.Trans.State.Strict
  import Data.Data
  #if MIN_VERSION_ghc(9,10,0)
  #else
  import Data.Default
  #endif
  import Data.Foldable (foldlM, for_)
  import Data.Functor.Identity (Identity (..))
  import Data.Generics (everywhere, everywhereM, extM, listify, mkM, mkQ, mkT, something)
  import Data.Generics.Uniplate.Data (transformBi, transformBiM)
  import Data.IORef.Extra
  import Data.List.Extra
  import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe)
  import Data.Ord (comparing)
  import Data.Tuple.Extra
  import Debug.Trace
  import qualified GHC
  #if MIN_VERSION_ghc(9,12,0)
  import qualified GHC.Data.Strict as Strict
  #endif
  import GHC.IO.Exception (IOErrorType (..))
  import GHC.LanguageExtensions.Type (Extension (..))
  import Language.Haskell.GHC.ExactPrint
    ( ExactPrint,
      exactPrint,
      getEntryDP,
      makeDeltaAst,
      runTransform,
      setEntryDP,
    )
  import Language.Haskell.GHC.ExactPrint.ExactPrint
    ( EPOptions,
  #if MIN_VERSION_ghc(9,12,0)
  #else
      epRigidity,
  #endif
      exactPrintWithOptions,
      stringOptions,
    )
  import Language.Haskell.GHC.ExactPrint.Parsers
  -- import Language.Haskell.GHC.ExactPrint.Types
  #if MIN_VERSION_ghc(9,12,0)
  #else
  import Language.Haskell.GHC.ExactPrint.Types
      -- epRigidity,
      -- Rigidity(..),
  #endif
  -- #if MIN_VERSION_ghc(9,12,0)
  -- import Language.Haskell.GHC.ExactPrint.Utils (showAst)
  -- #else
  -- import Language.Haskell.GHC.ExactPrint.ExactPrint (showAst)
  -- #endif
  import Language.Haskell.GHC.ExactPrint.Utils (ss2pos)
  import Refact.Compat
    ( AnnSpan,
      DoGenReplacement,
      Errors,
      FlagSpec (..),
      FunBind,
      Module,
      ReplaceWorker,
  
      combineSrcSpansA,
      composeSrcSpan,
      getOptions,
      gopt_set,
      handleGhcException,
      impliedXFlags,
      mkErr,
      occName,
      occNameString,
      onError,
      parseDynamicFilePragma,
      parseModuleName,
      ppr,
      setSrcSpanFile,
      showSDocUnsafe,
      srcSpanToAnnSpan,
      stringToStringBuffer,
      xFlags,
      xopt_set,
      xopt_unset,
      pattern RealSrcSpan',
      transferEntryDP,
      transferEntryDP',
      commentSrcSpan,
  #if MIN_VERSION_ghc(9,12,0)
  #else
      ann,
  #endif
  
  #if MIN_VERSION_ghc(9,4,0)
      mkGeneratedHsDocString,
      initParserOpts,
  #else
  #endif
      AnnConstraint
    )
  import Refact.Types hiding (SrcSpan)
  import qualified Refact.Types as R
  import Refact.Utils
    ( Decl,
      Expr,
      Import,
      M,
      Name,
      Pat,
      Stmt,
      Type,
      -- foldAnnKey,
      getAnnSpanA,
      modifyAnnKey,
      toGhcSrcSpan,
      toGhcSrcSpan',
    )
  import System.IO.Error (mkIOError)
  import System.IO.Extra
  import System.IO.Unsafe (unsafePerformIO)
  -- import qualified GHC
  
  refactOptions :: EPOptions Identity String
  #if MIN_VERSION_ghc(9,12,0)
  refactOptions = stringOptions
  #else
  refactOptions = stringOptions {epRigidity = RigidLayout}
  #endif
  
  -- | Apply a set of refactorings as supplied by hlint
  apply ::
    Maybe (Int, Int) ->
    Bool ->
    [(String, [Refactoring R.SrcSpan])] ->
    Maybe FilePath ->
    Verbosity ->
    -- Anns ->
    Module ->
    IO String
  apply mpos step inp mbfile verb m0 = do
    toGhcSS <-
      maybe
        ( case GHC.getLoc m0 of
            GHC.UnhelpfulSpan s -> fail $ "Module has UnhelpfulSpan: " ++ show s
            RealSrcSpan' s ->
              pure $ toGhcSrcSpan' (GHC.srcSpanFile s)
        )
        (pure . toGhcSrcSpan)
        mbfile
    let allRefacts :: [((String, [Refactoring GHC.SrcSpan]), R.SrcSpan)]
        allRefacts =
          sortBy cmpSrcSpan
            . map (first . second . map . fmap $ toGhcSS)
            . mapMaybe (sequenceA . (id &&& aggregateSrcSpans . map pos . snd))
            . filter (maybe (const True) (\p -> any ((`spans` p) . pos) . snd) mpos)
            $ inp
  
        cmpSrcSpan (_, s1) (_, s2) =
          comparing startLine s1 s2
            <> comparing startCol s1 s2 -- s1 first if it starts on earlier line
            <> comparing endLine s2 s1 --             or on earlier column
            <> comparing endCol s2 s1 -- they start in same place, s2 comes
            -- first if it ends later
            -- else, completely same span, so s1 will be first
    when (verb >= Normal) . traceM $
      "Applying " ++ (show . sum . map (length . snd . fst) $ allRefacts) ++ " hints"
    when (verb == Loud) . traceM $ show (map fst allRefacts)
  
    m <-
      if step
        then fromMaybe m0 <$> runMaybeT (refactoringLoop m0 allRefacts)
        else evalStateT (runRefactorings verb m0 (first snd <$> allRefacts)) 0
  
    -- liftIO $ putStrLn $ "apply:final AST\n" ++ showAst m
    pure . snd . runIdentity $ exactPrintWithOptions refactOptions m
  
  spans :: R.SrcSpan -> (Int, Int) -> Bool
  spans R.SrcSpan {..} loc = (startLine, startCol) <= loc && loc <= (endLine, endCol)
  
  aggregateSrcSpans :: [R.SrcSpan] -> Maybe R.SrcSpan
  aggregateSrcSpans = \case
    [] -> Nothing
    rs -> Just (foldr1 alg rs)
    where
      alg (R.SrcSpan sl1 sc1 el1 ec1) (R.SrcSpan sl2 sc2 el2 ec2) =
        let (sl, sc) = case compare sl1 sl2 of
              LT -> (sl1, sc1)
              EQ -> (sl1, min sc1 sc2)
              GT -> (sl2, sc2)
            (el, ec) = case compare el1 el2 of
              LT -> (el2, ec2)
              EQ -> (el2, max ec1 ec2)
              GT -> (el1, ec1)
         in R.SrcSpan sl sc el ec
  
  runRefactorings ::
    Verbosity ->
    Module ->
    [([Refactoring GHC.SrcSpan], R.SrcSpan)] ->
    StateT Int IO Module
  runRefactorings verb m0 ((rs, ss) : rest) = do
    runRefactorings' verb m0 rs >>= \case
      Nothing -> runRefactorings verb m0 rest
      Just m -> do
        let (overlaps, rest') = span (overlap ss . snd) rest
        when (verb >= Normal) . for_ overlaps $ \(rs', _) ->
          traceM $ "Ignoring " ++ show rs' ++ " due to overlap."
        runRefactorings verb m rest'
  runRefactorings _ m [] = pure m
  
  runRefactorings' ::
    Verbosity ->
    Module ->
    [Refactoring GHC.SrcSpan] ->
    StateT Int IO (Maybe Module)
  runRefactorings' verb m0 rs = do
    seed <- get
    m <- foldlM runRefactoring m0 rs
    if droppedComments rs m0 m
      then do
        put seed
        when (verb >= Normal) . traceM $
          "Ignoring " ++ show rs ++ " since applying them would cause comments to be dropped."
        pure Nothing
      else pure $ Just m
  
  overlap :: R.SrcSpan -> R.SrcSpan -> Bool
  overlap s1 s2 =
    -- We know s1 always starts <= s2, due to our sort
    case compare (startLine s2) (endLine s1) of
      LT -> True
      EQ -> startCol s2 <= endCol s1
      GT -> False
  
  data LoopOption = LoopOption
    { desc :: String,
      -- perform :: MaybeT IO (Anns, Module)
      perform :: MaybeT IO Module
    }
  
  refactoringLoop ::
    Module ->
    [((String, [Refactoring GHC.SrcSpan]), R.SrcSpan)] ->
    MaybeT IO Module
  refactoringLoop m [] = pure m
  refactoringLoop m (((_, []), _) : rs) = refactoringLoop m rs
  refactoringLoop m0 hints@(((hintDesc, rs), ss) : rss) = do
    res <- liftIO . flip evalStateT 0 $ runRefactorings' Silent m0 rs
    let yAction :: MaybeT IO Module
        yAction = case res of
          Just m -> do
            exactPrint m `seq` pure ()
            refactoringLoop m $ dropWhile (overlap ss . snd) rss
          Nothing -> do
            liftIO $ putStrLn "Hint skipped since applying it would cause comments to be dropped"
            refactoringLoop m0 rss
        opts :: [(String, LoopOption)]
        opts =
          [ ("y", LoopOption "Apply current hint" yAction),
            ("n", LoopOption "Don't apply the current hint" (refactoringLoop m0 rss)),
            ("q", LoopOption "Apply no further hints" (pure m0)),
            ("d", LoopOption "Discard previous changes" mzero),
            ( "v",
              LoopOption
                "View current file"
                ( liftIO (putStrLn (exactPrint m0))
                    >> refactoringLoop m0 hints
                )
            ),
            ("?", LoopOption "Show this help menu" loopHelp)
          ]
        loopHelp = do
          liftIO . putStrLn . unlines . map mkLine $ opts
          refactoringLoop m0 hints
        mkLine (c, opt) = c ++ " - " ++ desc opt
    inp <- liftIO $ do
      putStrLn hintDesc
      putStrLn $ "Apply hint [" ++ intercalate ", " (map fst opts) ++ "]"
      -- In case that the input also comes from stdin
      withFile "/dev/tty" ReadMode hGetLine
    maybe loopHelp perform (lookup inp opts)
  
  data Verbosity = Silent | Normal | Loud deriving (Eq, Show, Ord)
  
  -- ---------------------------------------------------------------------
  
  -- Perform the substitutions
  
  -- | Peform a @Refactoring@.
  runRefactoring ::
    Data a =>
    a ->
    Refactoring GHC.SrcSpan ->
    StateT Int IO a
  runRefactoring m = \case
    r@Replace {} -> do
      seed <- get <* modify (+ 1)
      liftIO $ case rtype r of
        Expr -> replaceWorker m parseExpr seed r
        Decl -> replaceWorker m parseDecl seed r
        Type -> replaceWorker m parseType seed r
        Pattern -> replaceWorker m parsePattern seed r
        Stmt -> replaceWorker m parseStmt seed r
        Bind -> replaceWorker m parseBind seed r
        R.Match -> replaceWorker m parseMatch seed r
        ModuleName -> replaceWorker m (parseModuleName (pos r)) seed r
        Import -> replaceWorker m parseImport seed r
    ModifyComment {..} -> pure (modifyComment pos newComment m)
    Delete {rtype, pos} -> pure (f m)
      where
        annSpan = srcSpanToAnnSpan pos
        f = case rtype of
          Stmt -> doDeleteStmt ((/= annSpan) . getAnnSpanA)
          Import -> doDeleteImport ((/= annSpan) . getAnnSpanA)
          _ -> id
    InsertComment {..} -> pure (addComment m)
      where
        addComment = transformBi go
        r = srcSpanToAnnSpan pos
        go :: GHC.LHsDecl GHC.GhcPs -> GHC.LHsDecl GHC.GhcPs
        go old@(GHC.L l d) =
          if ss2pos (srcSpanToAnnSpan $ GHC.locA l) == ss2pos r
            then
              let dp = case getEntryDP old of
                    GHC.SameLine 0 -> GHC.DifferentLine 1 0
                    dp' -> dp'
                  (GHC.L l' d') = setEntryDP (GHC.L l d) (GHC.DifferentLine 1 0)
  #if MIN_VERSION_ghc(9,12,0)
                  comment =
                    GHC.L
                      (GHC.EpaDelta (GHC.RealSrcSpan r Strict.Nothing) dp GHC.NoComments)
                      (GHC.EpaComment (GHC.EpaLineComment newComment) r)
                  l'' = GHC.addCommentsToEpAnn l' (GHC.EpaComments [comment])
  #else
                  comment =
                    GHC.L
                      (GHC.Anchor r (GHC.MovedAnchor dp))
                      (GHC.EpaComment (GHC.EpaLineComment newComment) r)
                  l'' = GHC.addCommentsToSrcAnn l' (GHC.EpaComments [comment])
  #endif
               in GHC.L l'' d'
            else old
    RemoveAsKeyword {..} -> pure (removeAsKeyword m)
      where
        removeAsKeyword = transformBi go
        go :: GHC.LImportDecl GHC.GhcPs -> GHC.LImportDecl GHC.GhcPs
        go imp@(GHC.L l i)
          | srcSpanToAnnSpan (GHC.locA l) == srcSpanToAnnSpan pos = GHC.L l (i {GHC.ideclAs = Nothing})
          | otherwise = imp
  
  modifyComment :: (Data a) => GHC.SrcSpan -> String -> a -> a
  modifyComment pos newComment = transformBi go
    where
  
  #if MIN_VERSION_ghc(9,12,0)
      newTok :: GHC.EpaCommentTok -> GHC.EpaCommentTok
      newTok (GHC.EpaDocComment _) = GHC.EpaDocComment $ mkGeneratedHsDocString newComment
      newTok (GHC.EpaDocOptions _) = GHC.EpaDocOptions newComment
      newTok (GHC.EpaLineComment _) = GHC.EpaLineComment newComment
      newTok (GHC.EpaBlockComment _) = GHC.EpaBlockComment newComment
  #else
  #if MIN_VERSION_ghc(9,4,0)
      newTok :: GHC.EpaCommentTok -> GHC.EpaCommentTok
      newTok (GHC.EpaDocComment _) = GHC.EpaDocComment $ mkGeneratedHsDocString newComment
      newTok (GHC.EpaDocOptions _) = GHC.EpaDocOptions newComment
      newTok (GHC.EpaLineComment _) = GHC.EpaLineComment newComment
      newTok (GHC.EpaBlockComment _) = GHC.EpaBlockComment newComment
      newTok GHC.EpaEofComment = GHC.EpaEofComment
  #else
      newTok (GHC.EpaDocCommentNext _) = GHC.EpaDocCommentNext newComment
      newTok (GHC.EpaDocCommentPrev _) = GHC.EpaDocCommentPrev newComment
      newTok (GHC.EpaDocCommentNamed _) = GHC.EpaDocCommentNamed newComment
      newTok (GHC.EpaDocSection i _) = GHC.EpaDocSection i newComment
      newTok (GHC.EpaDocOptions _) = GHC.EpaDocOptions newComment
      newTok (GHC.EpaLineComment _) = GHC.EpaLineComment newComment
      newTok (GHC.EpaBlockComment _) = GHC.EpaBlockComment newComment
      newTok GHC.EpaEofComment = GHC.EpaEofComment
  #endif
  #endif
  
      go :: GHC.LEpaComment -> GHC.LEpaComment
      go old@(GHC.L anc (GHC.EpaComment t r)) =
        if ss2pos (GHC.realSrcSpan $ commentSrcSpan old) == ss2pos (GHC.realSrcSpan pos)
          then GHC.L anc (GHC.EpaComment (newTok t) r)
          else old
  
  droppedComments :: [Refactoring GHC.SrcSpan] -> Module -> Module -> Bool
  droppedComments rs orig_m m = not (all (`elem` current_comments) orig_comments)
    where
      mcs = foldl' runModifyComment orig_m rs
      runModifyComment m' (ModifyComment pos newComment) = modifyComment pos newComment m'
      runModifyComment m' _ = m'
  
      all_comments :: forall r. (Data r, Typeable r) => r -> [GHC.EpaComment]
      all_comments = listify (False `mkQ` isComment)
      isComment :: GHC.EpaComment -> Bool
      isComment _ = True
      orig_comments = all_comments mcs
      current_comments = all_comments m
  
  parseBind :: Parser (GHC.LHsBind GHC.GhcPs)
  parseBind dyn fname s =
    case parseDecl dyn fname s of
      -- Safe as we add no annotations to the ValD
      Right (GHC.L l (GHC.ValD _ b)) -> Right (GHC.L l b)
      Right (GHC.L l _) -> Left (mkErr dyn (GHC.locA l) "Not a HsBind")
      Left e -> Left e
  
  parseMatch :: Parser (GHC.LMatch GHC.GhcPs (GHC.LHsExpr GHC.GhcPs))
  parseMatch dyn fname s =
    case parseBind dyn fname s of
      Right (GHC.L l GHC.FunBind {fun_matches}) ->
        case GHC.unLoc (GHC.mg_alts fun_matches) of
          [x] -> Right x
          _ -> Left (mkErr dyn (GHC.locA l) "Not a single match")
      Right (GHC.L l _) -> Left (mkErr dyn (GHC.locA l) "Not a funbind")
      Left e -> Left e
  
  -- Substitute variables into templates
  -- Finds places in the templates where we need to insert variables.
  
  substTransform :: (Data a, Data b) => b -> [(String, GHC.SrcSpan)] -> a -> M a
  substTransform m ss =
    everywhereM
      ( mkM (typeSub m ss)
          `extM` identSub m ss
          `extM` patSub m ss
          `extM` stmtSub m ss
          `extM` exprSub m ss
      )
  
  stmtSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Stmt -> M Stmt
  stmtSub m subs old@(GHC.L _ (GHC.BodyStmt _ (GHC.L _ (GHC.HsVar _ (GHC.L _ name))) _ _)) =
    resolveRdrName m (findOrError m) old subs name
  stmtSub _ _ e = pure e
  
  patSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Pat -> M Pat
  patSub m subs old@(GHC.L _ (GHC.VarPat _ (GHC.L _ name))) =
    resolveRdrName m (findOrError m) old subs name
  patSub _ _ e = pure e
  
  typeSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Type -> M Type
  typeSub m subs old@(GHC.L _ (GHC.HsTyVar _ _ (GHC.L _ name))) =
    resolveRdrName m (findOrError m) old subs name
  typeSub _ _ e = pure e
  
  exprSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Expr -> M Expr
  exprSub m subs old@(GHC.L _ (GHC.HsVar _ (GHC.L _ name))) =
    resolveRdrName m (findOrError m) old subs name
  exprSub _ _ e = pure e
  
  -- Used for Monad10, Monad11 tests.
  -- The issue being that in one case the information is attached to a VarPat
  -- but we need to move the annotations onto the actual name
  --
  -- This looks convoluted but we can't match directly on a located name as
  -- it is not specific enough. Instead we match on some bigger context which
  -- is contains the located name we want to replace.
  identSub :: Data a => a -> [(String, GHC.SrcSpan)] -> FunBind -> M FunBind
  #if MIN_VERSION_ghc(9,12,0)
  identSub m subs old@(GHC.FunRhs {mc_fun=name}) =
    resolveRdrName' subst (findOrError m) old subs (GHC.unLoc name)
    where
      subst :: FunBind -> Name -> M FunBind
      subst f@(GHC.FunRhs{}) new = do
        -- Low level version as we need to combine the annotation information
        -- from the template RdrName and the original VarPat.
        -- modify . first $
        --   replaceAnnKey (mkAnnKey n) (mkAnnKey fakeExpr) (mkAnnKey new) (mkAnnKey fakeExpr)
        pure $ f {GHC.mc_fun=new}
      subst o _ = pure o
  #else
  identSub m subs old@(GHC.FunRhs (GHC.L _ name) _ _) =
    resolveRdrName' subst (findOrError m) old subs name
    where
      subst :: FunBind -> Name -> M FunBind
      subst (GHC.FunRhs _ b s) new = do
        -- Low level version as we need to combine the annotation information
        -- from the template RdrName and the original VarPat.
        -- modify . first $
        --   replaceAnnKey (mkAnnKey n) (mkAnnKey fakeExpr) (mkAnnKey new) (mkAnnKey fakeExpr)
        pure $ GHC.FunRhs new b s
      subst o _ = pure o
  #endif
  identSub _ _ e = pure e
  
  -- g is usually modifyAnnKey
  -- f is usually a function which checks the locations are equal
  resolveRdrName' ::
    (a -> GHC.LocatedAn an b -> M a) -> -- How to combine the value to insert and the replaced value
    (AnnSpan -> M (GHC.LocatedAn an b)) -> -- How to find the new value, when given the location it is in
    a -> -- The old thing which we are going to possibly replace
    [(String, GHC.SrcSpan)] -> -- Substs
    GHC.RdrName -> -- The name of the position in the template
    --we are replacing into
    M a
  resolveRdrName' g f old subs name =
    case name of
      -- Todo: this should replace anns as well?
      GHC.Unqual (occNameString . occName -> oname)
        | Just ss <- lookup oname subs -> f (srcSpanToAnnSpan ss) >>= g old
      _ -> pure old
  
  resolveRdrName ::
    (Data old, Data a, Data an, Typeable an, AnnConstraint an) =>
    a ->
    (AnnSpan -> M (GHC.LocatedAn an old)) ->
    GHC.LocatedAn an old ->
    [(String, GHC.SrcSpan)] ->
    GHC.RdrName ->
    M (GHC.LocatedAn an old)
  resolveRdrName m = resolveRdrName' (modifyAnnKey m)
  
  doGenReplacement :: forall ast a. DoGenReplacement GHC.AnnListItem ast a
  doGenReplacement _ p new old
    | p old = do
      let (new', _, _) = runTransform $ transferEntryDP old new
      put True
      pure new'
    -- If "f a = body where local" doesn't satisfy the predicate, but "f a = body" does,
    -- run the replacement on "f a = body", and add "local" back afterwards.
    -- This is useful for hints like "Eta reduce" and "Redundant where".
    | Just Refl <- eqT @(GHC.LocatedA ast) @(GHC.LHsDecl GHC.GhcPs),
      GHC.L _ (GHC.ValD xvald newBind@GHC.FunBind {}) <- new,
      Just (oldNoLocal, oldLocal) <- stripLocalBind old,
      (RealSrcSpan' newLocReal) <- GHC.getLocA new,
      p (composeSrcSpan oldNoLocal) = do
      let newFile = GHC.srcSpanFile newLocReal
          newLocal :: GHC.HsLocalBinds GHC.GhcPs
          newLocal = transformBi (setSrcSpanFile newFile) oldLocal
          newLocalLoc = GHC.spanHsLocaLBinds newLocal
          newMG :: GHC.MatchGroup GHC.GhcPs (GHC.LHsExpr GHC.GhcPs)
          newMG = GHC.fun_matches newBind
          -- GHC.L locMG [GHC.L locMatch newMatch] = GHC.mg_alts newMG
          -- locMG1 :: GHC.SrcSpanAnnLW
          GHC.L locMG1 [GHC.L locMatch newMatch] = GHC.mg_alts newMG
          -- xx :: GHC.SrcSpanAnnLW -> GHC.EpAnn (GHC.AnnList ())
          -- xx (GHC.EpAnn anc alw cs) = GHC.EpAnn anc (yy alw) cs
          -- yy :: GHC.AnnList (GHC.EpToken "where") -> GHC.AnnList ()
          -- yy (GHC.AnnList anc bs semis _ lt) = GHC.AnnList anc bs semis () lt
     -- = AnnList {
     --    al_anchor    :: !(Maybe EpaLocation), -- ^ start point of a list having layout
     --    al_brackets  :: !AnnListBrackets,
     --    al_semis     :: [EpToken ";"], -- decls
     --    al_rest      :: !a,
     --    al_trailing  :: ![TrailingAnn] -- ^ items appearing after the
  
          locMG = locMG1
          newGRHSs = GHC.m_grhss newMatch
          finalLoc = combineSrcSpansA (GHC.noAnnSrcSpan newLocalLoc) (GHC.getLoc new)
          newWithLocalBinds0 =
            setLocalBind
              newLocal
              xvald
              newBind
              finalLoc
              newMG
              (combineSrcSpansLW (GHC.noAnnSrcSpan newLocalLoc) locMG)
              newMatch
              (combineSrcSpansA (GHC.noAnnSrcSpan newLocalLoc) locMatch)
              newGRHSs
          (newWithLocalBinds, _, _) = runTransform $ transferEntryDP' old newWithLocalBinds0
  
      put True
      pure $ composeSrcSpan newWithLocalBinds
    | otherwise = pure old
  
  
  #if MIN_VERSION_ghc(9,12,0)
  combineSrcSpansLW :: GHC.SrcSpanAnnA -> GHC.SrcSpanAnnLW -> GHC.SrcSpanAnnLW
  combineSrcSpansLW (GHC.EpAnn anca _ csa) (GHC.EpAnn ancb anb csb)
      = GHC.EpAnn (anca <> ancb) anb (csa <> csb)
  #else
  combineSrcSpansLW :: Semigroup a => GHC.SrcAnn a -> GHC.SrcAnn a -> GHC.SrcAnn a
  combineSrcSpansLW = combineSrcSpansA
  #endif
  
  -- | If the input is a FunBind with a single match, e.g., "foo a = body where x = y"
  -- return "Just (foo a = body, x = y)". Otherwise return Nothing.
  stripLocalBind ::
    Decl ->
    Maybe (Decl, GHC.HsLocalBinds GHC.GhcPs)
  stripLocalBind = \case
    GHC.L _ (GHC.ValD xvald origBind@GHC.FunBind {})
      | let origMG = GHC.fun_matches origBind,
        GHC.L locMG [GHC.L locMatch origMatch] <- GHC.mg_alts origMG,
        let origGRHSs = GHC.m_grhss origMatch,
  #if MIN_VERSION_ghc(9,12,0)
        [GHC.L loc2 _] <- GHC.grhssGRHSs origGRHSs ->
  #else
        [GHC.L _ (GHC.GRHS _ _ (GHC.L loc2 _))] <- GHC.grhssGRHSs origGRHSs ->
  #endif
        let loc1 = GHC.getLoc (GHC.fun_id origBind)
            newLoc = combineSrcSpansA (GHC.l2l loc1) (GHC.l2l loc2)
            withoutLocalBinds =
              setLocalBind
                (GHC.EmptyLocalBinds GHC.noExtField)
                xvald
                origBind
                newLoc
                origMG
                locMG
                origMatch
                locMatch
                origGRHSs
         in Just (withoutLocalBinds, GHC.grhssLocalBinds origGRHSs)
    _ -> Nothing
  
  -- | Set the local binds in a HsBind.
  setLocalBind ::
    GHC.HsLocalBinds GHC.GhcPs ->
    GHC.XValD GHC.GhcPs ->
    GHC.HsBind GHC.GhcPs ->
    GHC.SrcSpanAnnA ->
    GHC.MatchGroup GHC.GhcPs Expr ->
  #if MIN_VERSION_ghc(9,12,0)
    GHC.SrcSpanAnnLW ->
  #else
    GHC.SrcSpanAnnL ->
  #endif
    GHC.Match GHC.GhcPs Expr ->
    GHC.SrcSpanAnnA ->
    GHC.GRHSs GHC.GhcPs Expr ->
    Decl
  setLocalBind newLocalBinds xvald origBind newLoc origMG locMG origMatch locMatch origGRHSs =
    GHC.L newLoc (GHC.ValD xvald newBind)
    where
      newGRHSs = origGRHSs {GHC.grhssLocalBinds = newLocalBinds}
      newMatch = origMatch {GHC.m_grhss = newGRHSs}
      newMG = origMG {GHC.mg_alts = GHC.L locMG [GHC.L locMatch newMatch]}
      newBind = origBind {GHC.fun_matches = newMG}
  
  replaceWorker :: forall a mod. (ExactPrint a) => ReplaceWorker a mod
  replaceWorker m parser seed Replace {..} = do
    let replExprLocation = srcSpanToAnnSpan pos
        uniqueName = "template" ++ show seed
    let libdir = undefined
  
    template <- do
      flags <- maybe (withDynFlags libdir id) pure =<< readIORef dynFlagsRef
      either (onError "replaceWorker") pure $ parser flags uniqueName orig
  
    (newExpr, ()) <-
      runStateT
        -- (substTransform m subts template)
        (substTransform m subts (makeDeltaAst template))
        -- (mergeAnns as relat, keyMap)
        ()
    -- Add a space if needed, so that we avoid refactoring `y = do(foo bar)` into `y = dofoo bar`.
    -- ensureDoSpace :: Anns -> Anns
    let ensureSpace :: forall t. (Data t) => t -> t
        ensureSpace = everywhere (mkT ensureExprSpace)
  
        ensureExprSpace :: Expr -> Expr
        ensureExprSpace e@(GHC.L l (GHC.HsDo an v (GHC.L ls stmts))) = e' -- ensureDoSpace
          where
            isDo = case v of
              GHC.ListComp -> False
              _ -> True
            e' =
              if isDo
  #if MIN_VERSION_ghc(9,12,0)
                && manchorOp ls == Just (GHC.SameLine 0)
  #else
                && manchorOp an == Just (GHC.SameLine 0)
                && manchorOp (GHC.ann ls) == Just (GHC.SameLine 0)
  #endif
                then GHC.L l (GHC.HsDo an v (setEntryDP (GHC.L ls stmts) (GHC.SameLine 1)))
                else e
        ensureExprSpace e@(GHC.L l (GHC.HsApp x (GHC.L la a) (GHC.L lb b))) = e' -- ensureAppSpace
          where
            e' =
  #if MIN_VERSION_ghc(9,12,0)
              if manchorOp lb == Just (GHC.SameLine 0)
  #else
              if manchorOp (ann lb) == Just (GHC.SameLine 0)
  #endif
                then GHC.L l (GHC.HsApp x (GHC.L la a) (setEntryDP (GHC.L lb b) (GHC.SameLine 1)))
                else e
        ensureExprSpace e = e
  
        replacementPred = (== replExprLocation) . getAnnSpanA
  
        tt :: GHC.LocatedA a -> StateT Bool IO (GHC.LocatedA a)
        tt = doGenReplacement m replacementPred newExpr
        transformation :: mod -> StateT Bool IO mod
        transformation = transformBiM tt
    runStateT (transformation m) False >>= \case
      (finalM, True) ->
        pure (ensureSpace finalM)
      -- Failed to find a replacment so don't make any changes
      _ -> pure m
  replaceWorker m _ _ _ = pure m
  
  manchorOp :: GHC.EpAnn ann -> Maybe GHC.DeltaPos
  #if MIN_VERSION_ghc(9,12,0)
  manchorOp (GHC.EpAnn (GHC.EpaSpan{}) _ _) = Nothing
  manchorOp (GHC.EpAnn (GHC.EpaDelta _ dp _) _ _) = Just dp
  #else
  manchorOp (GHC.EpAnn (GHC.Anchor _ (GHC.MovedAnchor dp)) _ _) = Just dp
  manchorOp _ = Nothing
  #endif
  
  data NotFound = NotFound
    { nfExpected :: String,
      nfActual :: Maybe String,
      nfLoc :: AnnSpan
    }
  
  renderNotFound :: NotFound -> String
  renderNotFound NotFound {..} =
    "Expected type not found at the location specified in the refact file.\n"
      ++ "  Expected type: "
      ++ nfExpected
      ++ "\n"
      ++ maybe "" (\actual -> "  Actual type: " ++ actual ++ "\n") nfActual
      ++ "  Location: "
      ++ showSDocUnsafe (ppr nfLoc)
  
  -- Find a given type with a given SrcSpan
  findInModule ::
    forall an a modu.
    (Typeable an, Data a, Data modu) =>
    modu ->
    AnnSpan ->
    Either NotFound (GHC.LocatedAn an a)
  findInModule m ss = case doTrans m of
    Just a -> Right a
    Nothing ->
      let expected = show (typeRep (Proxy @a))
          actual =
            listToMaybe $
              catMaybes
                [ showType (doTrans m :: Maybe Expr),
                  showType (doTrans m :: Maybe Type),
                  showType (doTrans m :: Maybe Decl),
                  showType (doTrans m :: Maybe Pat),
                  showType (doTrans m :: Maybe Name)
                ]
       in Left $ NotFound expected actual ss
    where
      doTrans :: forall an' b. (Typeable an', Data b) => modu -> Maybe (GHC.LocatedAn an' b)
      doTrans = something (mkQ Nothing (findLargestExpression ss))
  
      showType :: forall an' b. Typeable b => Maybe (GHC.LocatedAn an' b) -> Maybe String
      showType = fmap $ \_ -> show (typeRep (Proxy @b))
  
  findLargestExpression ::
    forall an a.
    Data a =>
    AnnSpan ->
    GHC.LocatedAn an a ->
    Maybe (GHC.LocatedAn an a)
  findLargestExpression as e@(getAnnSpanA -> l) = if l == as then Just e else Nothing
  
  findOrError ::
    forall a an modu m.
    (Typeable an, Data a, Data modu, MonadIO m) =>
    modu ->
    AnnSpan ->
    m (GHC.LocatedAn an a)
  findOrError m = either f pure . findInModule m
    where
      f nf = liftIO . throwIO $ mkIOError InappropriateType (renderNotFound nf) Nothing Nothing
  
  -- Deletion from a list
  
  doDeleteStmt :: Data a => (Stmt -> Bool) -> a -> a
  doDeleteStmt = transformBi . filterAndSetDP
  
  doDeleteImport :: Data a => (Import -> Bool) -> a -> a
  doDeleteImport = transformBi . filterAndSetDP
  
  -- | Like `filter`, but after filtering one or multiple consecutive elements
  -- out, it applies `setEntryDP` to the next element.
  filterAndSetDP ::
    forall t a.
  #if MIN_VERSION_ghc(9,10,0)
  #else
    (Default t) =>
  #endif
    (GHC.LocatedAn t a -> Bool) ->
    [GHC.LocatedAn t a] ->
    [GHC.LocatedAn t a]
  filterAndSetDP p = go
    where
      go xs = case break p xs of
        (_, []) -> []
        -- No prefix is filtered out; do not apply `setEntryDP` to `y`
        ([], y : ys) -> y : go ys
        -- Some prefix is filtered out; apply `setEntryDP` to `y`
        (_ : _, y : ys) -> setEntryDP y (GHC.SameLine 0) : go ys
  
  addExtensionsToFlags ::
    [Extension] ->
    [Extension] ->
    FilePath ->
    GHC.DynFlags ->
    IO (Either String GHC.DynFlags)
  addExtensionsToFlags es ds fp flags = catchErrors $ do
    (stringToStringBuffer -> buf) <- readFileUTF8' fp
  #if MIN_VERSION_ghc(9,4,0)
    let (_, opts) = getOptions (initParserOpts flags) buf fp
  #else
    let opts = getOptions flags buf fp
  #endif
        withExts =
          flip (foldl' xopt_unset) ds
            . flip (foldl' xopt_set) es
            $ flags
    (withPragmas, _, _) <- parseDynamicFilePragma withExts opts
    pure . Right $ withPragmas `gopt_set` GHC.Opt_KeepRawTokenStream
    where
      catchErrors =
        handleGhcException (pure . Left . show)
          . GHC.handleSourceError (pure . Left . show)
  
  parseModuleWithArgs ::
    LibDir ->
    ([Extension], [Extension]) ->
    FilePath ->
    IO (Either Errors GHC.ParsedSource)
  parseModuleWithArgs libdir (es, ds) fp = ghcWrapper libdir $ do
    initFlags <- initDynFlags fp
    eflags <- liftIO $ addExtensionsToFlags es ds fp initFlags
    case eflags of
      -- TODO: report error properly.
      Left err -> pure . Left $ mkErr initFlags GHC.noSrcSpan err
      Right flags -> do
        liftIO $ writeIORef' dynFlagsRef (Just flags)
        res <- parseModuleEpAnnsWithCppInternal defaultCppOptions flags fp
  
        -- pure $ postParseTransform res rigidLayout
        case postParseTransform res of
          Left e -> pure (Left e)
          Right ast -> pure $ Right (makeDeltaAst ast)
  
  -- | Parse the input into (enabled extensions, disabled extensions, invalid input).
  -- Implied extensions are automatically added. For example, @FunctionalDependencies@
  -- implies @MultiParamTypeClasses@, and @RebindableSyntax@ implies @NoImplicitPrelude@.
  --
  -- The input is processed from left to right. An extension (e.g., @StarIsType@)
  -- may be overridden later (e.g., by @NoStarIsType@).
  --
  -- Extensions that appear earlier in the input will appear later in the output.
  -- Implied extensions appear in the end. If an extension occurs multiple times in the input,
  -- the last one is used.
  --
  -- >>> parseExtensions ["GADTs", "RebindableSyntax", "StarIsType", "GADTs", "InvalidExtension", "NoStarIsType"]
  -- ([GADTs, RebindableSyntax, GADTSyntax, MonoLocalBinds], [StarIsType, ImplicitPrelude], ["InvalidExtension"])
  parseExtensions :: [String] -> ([Extension], [Extension], [String])
  parseExtensions = addImplied . foldl' f mempty
    where
      f :: ([Extension], [Extension], [String]) -> String -> ([Extension], [Extension], [String])
      f (ys, ns, is) ('N' : 'o' : s)
        | Just ext <- readExtension s =
          (delete ext ys, ext : delete ext ns, is)
      f (ys, ns, is) s
        | Just ext <- readExtension s =
          (ext : delete ext ys, delete ext ns, is)
      f (ys, ns, is) s = (ys, ns, s : is)
  
      addImplied :: ([Extension], [Extension], [String]) -> ([Extension], [Extension], [String])
      addImplied (ys, ns, is) = (ys ++ impliedOn, ns ++ impliedOff, is)
        where
          impliedOn = [b | ext <- ys, (a, True, b) <- impliedXFlags, a == ext]
          impliedOff = [b | ext <- ys, (a, False, b) <- impliedXFlags, a == ext]
  
  readExtension :: String -> Maybe Extension
  readExtension s = flagSpecFlag <$> find ((== s) . flagSpecName) xFlags
  
  -- TODO: This is added to avoid a breaking change. We should remove it and
  -- directly pass the `DynFlags` as arguments, before the 0.10 release.
  dynFlagsRef :: IORef (Maybe GHC.DynFlags)
  dynFlagsRef = unsafePerformIO $ newIORef Nothing
  {-# NOINLINE dynFlagsRef #-}
  