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

module Refact.Compat (
  -- * ApiAnnotation / GHC.Parser.ApiAnnotation
#if MIN_VERSION_ghc(9,12,0)
#else
  AnnKeywordId (..),
#endif
  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,
  commentSrcSpan,
  ann,
  transferEntryDP,
  transferEntryDP',
  AnnConstraint,
  showAst,

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

import Control.Monad.Trans.State.Strict (StateT)
#if MIN_VERSION_ghc(9,12,0)
import Data.Data (Data, Typeable)
#else
import Data.Data (Data)
#endif
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, ann)
#else
import GHC.Hs hiding (Pat, Stmt, ann)
#endif
import GHC.Parser.Header (getOptions)
#if MIN_VERSION_ghc(9,8,0)
import GHC.Types.Error (defaultDiagnosticOpts, getMessages)
#elif 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)
#if MIN_VERSION_ghc(9,12,0)
import qualified Language.Haskell.GHC.ExactPrint.Transform as Exact
#else
import Language.Haskell.GHC.ExactPrint (transferEntryDP, transferEntryDP', showAst)
#endif


#if MIN_VERSION_ghc(9,12,0)
type AnnConstraint an = (NoAnn an, Semigroup an)
#else
type AnnConstraint an = (Monoid an)
#endif

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 = String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
s (SDoc -> a) -> (ErrorMessages -> SDoc) -> ErrorMessages -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc)
-> (ErrorMessages -> [SDoc]) -> ErrorMessages -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessages -> [SDoc]
ppp

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

#if MIN_VERSION_ghc(9,12,0)
type FunBind = HsMatchContext (LocatedN RdrName)
#else
type FunBind = HsMatchContext GhcPs
#endif

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

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

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

decomposeSrcSpan :: a -> a
decomposeSrcSpan :: forall a. a -> a
decomposeSrcSpan = a -> a
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)
  (RealSrcSpan -> Maybe BufSpan -> SrcSpan)
-> Maybe BufSpan -> RealSrcSpan -> SrcSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan Maybe BufSpan
forall a. Maybe a
Strict.Nothing
#else
  flip RealSrcSpan 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 :: DynFlags -> SrcSpan -> String -> ErrorMessages
mkErr DynFlags
_df SrcSpan
l String
s =
  Bag (MsgEnvelope GhcMessage) -> ErrorMessages
forall e. Bag (MsgEnvelope e) -> Messages e
mkMessages (Bag (MsgEnvelope GhcMessage) -> ErrorMessages)
-> Bag (MsgEnvelope GhcMessage) -> ErrorMessages
forall a b. (a -> b) -> a -> b
$
    MsgEnvelope GhcMessage -> Bag (MsgEnvelope GhcMessage)
forall a. a -> Bag a
unitBag (SrcSpan -> GhcMessage -> MsgEnvelope GhcMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
l (DiagnosticMessage -> GhcMessage
forall a.
(DiagnosticOpts a ~ NoDiagnosticOpts, Diagnostic a, Typeable a) =>
a -> GhcMessage
ghcUnknownMessage (DiagnosticMessage -> GhcMessage)
-> DiagnosticMessage -> GhcMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> [SDoc] -> DiagnosticMessage
mkDecoratedError [] [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
s]))
#else
mkErr _df l s = unitBag (mkPlainMsgEnvelope l (text 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 =  SrcAnn AnnListItem -> ModuleName -> LocatedA ModuleName
forall l e. l -> e -> GenLocated l e
GHC.L (SrcSpan -> SrcAnn AnnListItem
forall ann. SrcSpan -> SrcAnn ann
GHC.noAnnSrcSpan SrcSpan
ss) (String -> ModuleName
GHC.mkModuleName String
s)
  in LocatedA ModuleName -> Either ErrorMessages (LocatedA ModuleName)
forall a. a -> Either ErrorMessages a
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


commentSrcSpan :: GHC.LEpaComment -> SrcSpan
#if MIN_VERSION_ghc(9,12,0)
commentSrcSpan (GHC.L (GHC.EpaSpan l) _) = l
commentSrcSpan (GHC.L (GHC.EpaDelta l _ _) _) = l
#elif MIN_VERSION_ghc(9,4,0)
commentSrcSpan :: LEpaComment -> SrcSpan
commentSrcSpan (GHC.L (GHC.Anchor RealSrcSpan
l AnchorOperation
_) EpaComment
_) = RealSrcSpan -> Maybe BufSpan -> SrcSpan
GHC.RealSrcSpan RealSrcSpan
l Maybe BufSpan
forall a. Maybe a
Strict.Nothing
#else
commentSrcSpan (GHC.L (GHC.Anchor l _) _) = GHC.RealSrcSpan l Nothing
#endif

#if MIN_VERSION_ghc(9,12,0)
transferEntryDP :: (Typeable t1, Typeable t2, Exact.HasTransform m)
  => LocatedAn t1 a -> LocatedAn t2 b -> m (LocatedAn t2 b)
transferEntryDP a b = return $ Exact.transferEntryDP a b
#endif

#if MIN_VERSION_ghc(9,12,0)
transferEntryDP' ::(Exact.HasTransform m)
    => LHsDecl GhcPs -> LHsDecl GhcPs -> m (LHsDecl GhcPs)
transferEntryDP' a b = return $ Exact.transferEntryDP' a b
#endif


#if MIN_VERSION_ghc(9,12,0)
ann :: EpAnn a -> a
ann ls = GHC.anns ls
#else
ann :: SrcSpanAnn' a -> a
ann :: forall a. SrcSpanAnn' a -> a
ann = SrcSpanAnn' a -> a
forall a. SrcSpanAnn' a -> a
GHC.ann
#endif