{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PatternSynonyms #-}

module Refact.Compat (
  -- * ApiAnnotation / GHC.Parser.ApiAnnotation
  AnnKeywordId (..),
  DeltaPos(..),

  -- * BasicTypes / GHC.Types.Basic
  Fixity(..),
  SourceText (..),

  -- * DynFlags / GHC.Driver.Session
  FlagSpec (..),
  GeneralFlag (..),
  gopt_set,
  gopt_unset,
  parseDynamicFilePragma,
  xopt_set,
  xopt_unset,
  xFlags,

  -- * ErrUtils
  Errors,
  ErrorMessages,
  onError,

  -- * FastString / GHC.Data.FastString
  FastString,
  mkFastString,

  -- * HeaderInfo / GHC.Parser.Header
  getOptions,

  -- * HsExpr / GHC.Hs.Expr
  GRHS (..),
  HsExpr (..),
  HsMatchContext (..),
  HsStmtContext (..),
  Match (..),
  MatchGroup (..),
  StmtLR (..),

  -- * HsSyn / GHC.Hs
  module GHC.Hs,

  -- * Name / OccName / GHC.Types.Name
  nameOccName,
  occName,
  occNameString,
  ppr,

  -- * Outputable / GHC.Utils.Outputable
  showSDocUnsafe,

  -- * Panic / GHC.Utils.Panic
  handleGhcException,

  -- * RdrName / GHC.Types.Name.Reader
  RdrName (..),
  rdrNameOcc,

  -- * SrcLoc / GHC.Types.SrcLoc
  GenLocated (..),
  pattern RealSrcLoc',
  pattern RealSrcSpan',
  RealSrcSpan (..),
  SrcSpanLess,
  combineSrcSpans,
  composeSrcSpan,
  decomposeSrcSpan,

  -- * StringBuffer
  stringToStringBuffer,

  -- * Misc
  impliedXFlags,

  -- * Non-GHC stuff
  -- AnnKeyMap,
  FunBind,
  DoGenReplacement,
  Module,
  MonadFail',
  ReplaceWorker,
  annSpanToSrcSpan,
  badAnnSpan,
  mkErr,
  parseModuleName,
  setAnnSpanFile,
  setRealSrcSpanFile,
  setSrcSpanFile,
  srcSpanToAnnSpan,
  AnnSpan,

#if MIN_VERSION_ghc(9,4,0)
  -- * GHC 9.4 stuff
  initParserOpts,
#endif
) where

import Control.Monad.Trans.State.Strict (StateT)
import Data.Data (Data)
import qualified GHC
import GHC.Data.Bag (unitBag, bagToList)
import GHC.Data.FastString (FastString, mkFastString)
#if MIN_VERSION_ghc(9,4,0)
import qualified GHC.Data.Strict as Strict
#endif
import GHC.Data.StringBuffer (stringToStringBuffer)
#if MIN_VERSION_ghc(9,4,0)
import GHC.Driver.Config.Parser
import GHC.Driver.Errors.Types (ErrorMessages, ghcUnknownMessage, GhcMessage)
#endif
import GHC.Driver.Session hiding (initDynFlags)
#if MIN_VERSION_ghc(9,6,0)
import GHC.Hs hiding (Pat, Stmt, parseModuleName)
#else
import GHC.Hs hiding (Pat, Stmt)
#endif
import GHC.Parser.Header (getOptions)
#if MIN_VERSION_ghc(9,4,0)
import GHC.Types.Error (getMessages)
#endif
import GHC.Types.Fixity  ( Fixity(..) )
import GHC.Types.Name (nameOccName, occName, occNameString)
import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc)
import GHC.Types.SrcLoc hiding (spans)
import GHC.Types.SourceText
#if MIN_VERSION_ghc(9,4,0)
import GHC.Utils.Error
#else
import GHC.Utils.Error hiding (mkErr)
#endif
import GHC.Utils.Outputable
  ( ppr,
    showSDocUnsafe,
    text,
    vcat,
  )
import GHC.Utils.Panic
  ( handleGhcException
  , pprPanic
  )
import Language.Haskell.GHC.ExactPrint.Parsers (Parser)
import Language.Haskell.GHC.ExactPrint.Utils
import Refact.Types (Refactoring)

type MonadFail' = MonadFail

#if MIN_VERSION_ghc(9,6,0)
type Module = Located (HsModule GhcPs)
#else
type Module = Located HsModule
#endif

type Errors = ErrorMessages

onError :: String -> Errors -> a
onError :: forall a. String -> ErrorMessages -> a
onError String
s = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessages -> [SDoc]
ppp

ppp :: Errors -> [SDoc]
#if MIN_VERSION_ghc(9,6,0)
ppp pst = concatMap unDecorated $ fmap ((diagnosticMessage (defaultDiagnosticOpts @GhcMessage)) . errMsgDiagnostic) $ bagToList $ getMessages pst
#elif MIN_VERSION_ghc(9,4,0)
ppp pst = concatMap unDecorated $ fmap (diagnosticMessage . errMsgDiagnostic) $ bagToList $ getMessages pst
#else
ppp :: ErrorMessages -> [SDoc]
ppp ErrorMessages
pst = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DecoratedSDoc -> [SDoc]
unDecorated (forall e. MsgEnvelope e -> e
errMsgDiagnostic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Bag a -> [a]
bagToList ErrorMessages
pst)
#endif

type FunBind = HsMatchContext GhcPs

pattern RealSrcLoc' :: RealSrcLoc -> SrcLoc
pattern $bRealSrcLoc' :: RealSrcLoc -> SrcLoc
$mRealSrcLoc' :: forall {r}. SrcLoc -> (RealSrcLoc -> r) -> ((# #) -> r) -> r
RealSrcLoc' r <- RealSrcLoc r _ where
#if MIN_VERSION_ghc(9,4,0)
  RealSrcLoc' r = RealSrcLoc r Strict.Nothing
#else
  RealSrcLoc' RealSrcLoc
r = RealSrcLoc -> Maybe BufPos -> SrcLoc
RealSrcLoc RealSrcLoc
r forall a. Maybe a
Nothing
#endif
{-# COMPLETE RealSrcLoc', UnhelpfulLoc #-}

pattern RealSrcSpan' :: RealSrcSpan -> SrcSpan
pattern $bRealSrcSpan' :: RealSrcSpan -> SrcSpan
$mRealSrcSpan' :: forall {r}. SrcSpan -> (RealSrcSpan -> r) -> ((# #) -> r) -> r
RealSrcSpan' r <- RealSrcSpan r _ where
#if MIN_VERSION_ghc(9,4,0)
  RealSrcSpan' r = RealSrcSpan r Strict.Nothing
#else
  RealSrcSpan' RealSrcSpan
r = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r forall a. Maybe a
Nothing
#endif
{-# COMPLETE RealSrcSpan', UnhelpfulSpan #-}

composeSrcSpan :: a -> a
composeSrcSpan :: forall a. a -> a
composeSrcSpan = forall a. a -> a
id

decomposeSrcSpan :: a -> a
decomposeSrcSpan :: forall a. a -> a
decomposeSrcSpan = forall a. a -> a
id

type SrcSpanLess a = a

type AnnSpan = RealSrcSpan
badAnnSpan :: AnnSpan
badAnnSpan :: RealSrcSpan
badAnnSpan =
  RealSrcSpan
badRealSrcSpan

srcSpanToAnnSpan :: SrcSpan -> AnnSpan
srcSpanToAnnSpan :: SrcSpan -> RealSrcSpan
srcSpanToAnnSpan =
  \case RealSrcSpan RealSrcSpan
l Maybe BufSpan
_ -> RealSrcSpan
l; SrcSpan
_ -> RealSrcSpan
badRealSrcSpan

annSpanToSrcSpan :: AnnSpan -> SrcSpan
annSpanToSrcSpan :: RealSrcSpan -> SrcSpan
annSpanToSrcSpan =
#if MIN_VERSION_ghc(9,4,0)
  flip RealSrcSpan Strict.Nothing
#else
  forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan forall a. Maybe a
Nothing
#endif

setSrcSpanFile :: FastString -> SrcSpan -> SrcSpan
setSrcSpanFile :: FastString -> SrcSpan -> SrcSpan
setSrcSpanFile FastString
file SrcSpan
s
  | RealSrcLoc' RealSrcLoc
start <- SrcSpan -> SrcLoc
srcSpanStart SrcSpan
s,
    RealSrcLoc' RealSrcLoc
end <- SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
s =
    let start' :: SrcLoc
start' = FastString -> Int -> Int -> SrcLoc
mkSrcLoc FastString
file (RealSrcLoc -> Int
srcLocLine RealSrcLoc
start) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
start)
        end' :: SrcLoc
end' = FastString -> Int -> Int -> SrcLoc
mkSrcLoc FastString
file (RealSrcLoc -> Int
srcLocLine RealSrcLoc
end) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
end)
     in SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
start' SrcLoc
end'
setSrcSpanFile FastString
_ SrcSpan
s = SrcSpan
s

setRealSrcSpanFile :: FastString -> RealSrcSpan -> RealSrcSpan
setRealSrcSpanFile :: FastString -> RealSrcSpan -> RealSrcSpan
setRealSrcSpanFile FastString
file RealSrcSpan
s = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
start' RealSrcLoc
end'
  where
    start :: RealSrcLoc
start = RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s
    end :: RealSrcLoc
end = RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
s
    start' :: RealSrcLoc
start' = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
file (RealSrcLoc -> Int
srcLocLine RealSrcLoc
start) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
start)
    end' :: RealSrcLoc
end' = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
file (RealSrcLoc -> Int
srcLocLine RealSrcLoc
end) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
end)

setAnnSpanFile :: FastString -> AnnSpan -> AnnSpan
setAnnSpanFile :: FastString -> RealSrcSpan -> RealSrcSpan
setAnnSpanFile =
  FastString -> RealSrcSpan -> RealSrcSpan
setRealSrcSpanFile

mkErr :: DynFlags -> SrcSpan -> String -> Errors
#if MIN_VERSION_ghc(9,4,0)
mkErr _df l s =
  mkMessages $
    unitBag (mkPlainErrorMsgEnvelope l (ghcUnknownMessage $ mkDecoratedError [] [text s]))
#else
mkErr :: DynFlags -> SrcSpan -> String -> ErrorMessages
mkErr DynFlags
_df SrcSpan
l String
s = forall a. a -> Bag a
unitBag (SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkPlainMsgEnvelope SrcSpan
l (String -> SDoc
text String
s))
#endif

parseModuleName :: SrcSpan -> Parser (LocatedA GHC.ModuleName)
parseModuleName :: SrcSpan -> Parser (LocatedA ModuleName)
parseModuleName SrcSpan
ss DynFlags
_ String
_ String
s =
  let newMN :: LocatedA ModuleName
newMN =  forall l e. l -> e -> GenLocated l e
GHC.L (forall ann. SrcSpan -> SrcAnn ann
GHC.noAnnSrcSpan SrcSpan
ss) (String -> ModuleName
GHC.mkModuleName String
s)
  in forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedA ModuleName
newMN

type DoGenReplacement an ast a =
  (Data ast, Data a) =>
  a ->
  (LocatedAn an ast -> Bool) ->
  LocatedAn an ast ->
  LocatedAn an ast ->
  StateT Bool IO (LocatedAn an ast)

type ReplaceWorker a mod =
  (Data a, Data mod) =>
  mod ->
  Parser (GHC.LocatedA a) ->
  Int ->
  Refactoring SrcSpan ->
  IO mod