{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE TypeFamilies #-}
{- HLINT ignore "Use camelCase" -}

-- | Module containing the plugin.
module Compat(module Compat) where

import GHC
#if __GLASGOW_HASKELL__ > 901
import GHC.Types.SourceText ( SourceText(NoSourceText) )
import GHC.Data.FastString (FastString, NonDetFastString (NonDetFastString))
#elif __GLASGOW_HASKELL__ >=900
import GHC.Data.FastString (FastString)
#else
import FastString (FastString)
#endif

#if __GLASGOW_HASKELL__ < 900
import BasicTypes
import TcEvidence
import RnTypes as Compat
import UniqSupply
#else
import GHC.Types.Basic
import GHC.Unit.Types
import GHC.Parser.Annotation
import GHC.Rename.HsType as Compat
import GHC.Types.Unique.Supply
#endif
#if __GLASGOW_HASKELL__ < 810
import HsSyn as Compat
#else
import GHC.Hs as Compat
#endif
#if __GLASGOW_HASKELL__ < 808
import System.IO.Unsafe as Compat (unsafePerformIO)
import TcRnTypes
import IOEnv
import DynFlags
import HscTypes
#endif
import Data.IORef as Compat

---------------------------------------------------------------------
-- UTILITIES

noL :: e -> GenLocated SrcSpan e
noL :: e -> GenLocated SrcSpan e
noL = e -> GenLocated SrcSpan e
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc

#if __GLASGOW_HASKELL__ < 902
noLA :: e -> GenLocated SrcSpan e
noLA :: e -> GenLocated SrcSpan e
noLA = e -> GenLocated SrcSpan e
forall e. e -> GenLocated SrcSpan e
noL

emptyComments :: NoExtField
emptyComments :: NoExtField
emptyComments = NoExtField
noE

noAnn :: NoExtField
noAnn :: NoExtField
noAnn = NoExtField
noE

reLocA :: Located e -> Located e
reLocA :: Located e -> Located e
reLocA = Located e -> Located e
forall a. a -> a
id

reLoc :: Located e -> Located e
reLoc :: Located e -> Located e
reLoc = Located e -> Located e
forall a. a -> a
id

mkNonDetFastString :: FastString -> FastString
mkNonDetFastString :: FastString -> FastString
mkNonDetFastString = FastString -> FastString
forall a. a -> a
id

noL' :: e -> GenLocated SrcSpan e
noL' :: e -> GenLocated SrcSpan e
noL' = e -> GenLocated SrcSpan e
forall e. e -> GenLocated SrcSpan e
noL

#else
noLA :: e -> LocatedAn ann e
noLA = reLocA . noL

noL' :: a -> a
noL' = id

mkNonDetFastString :: FastString -> NonDetFastString
mkNonDetFastString = NonDetFastString
#endif

#if __GLASGOW_HASKELL__ < 810
type NoExtField = NoExt

noE :: NoExt
noE = NoExt
#else
noE :: NoExtField
noE :: NoExtField
noE = NoExtField
noExtField
#endif

realSrcLoc :: SrcLoc -> Maybe RealSrcLoc
#if __GLASGOW_HASKELL__ < 811
realSrcLoc :: SrcLoc -> Maybe RealSrcLoc
realSrcLoc (RealSrcLoc RealSrcLoc
x) = RealSrcLoc -> Maybe RealSrcLoc
forall a. a -> Maybe a
Just RealSrcLoc
x
#else
realSrcLoc (RealSrcLoc x _) = Just x
#endif
realSrcLoc SrcLoc
_ = Maybe RealSrcLoc
forall a. Maybe a
Nothing

#if __GLASGOW_HASKELL__ >= 902
hsLTyVarBndrToType :: (Anno (IdP (GhcPass p)) ~ SrcSpanAnn' (EpAnn NameAnn)) => LHsTyVarBndr flag (GhcPass p) -> LHsType (GhcPass p)
hsLTyVarBndrToType x = noLA $ HsTyVar noAnn NotPromoted $ noLA $ hsLTyVarName x
#elif __GLASGOW_HASKELL__ >= 900
hsLTyVarBndrToType :: LHsTyVarBndr flag (GhcPass p) -> LHsType (GhcPass p)
hsLTyVarBndrToType x = noL $ HsTyVar noE NotPromoted $ noL $ hsLTyVarName x
#endif

---------------------------------------------------------------------
-- COMMON SIGNATURES

#if __GLASGOW_HASKELL__ < 811
type Module = HsModule GhcPs
#else
type Module = HsModule
#endif

mkAppType :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
mkTypeAnn :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
mkFunTy :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
newFunBind :: Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsBind GhcPs

#if __GLASGOW_HASKELL__ < 807

-- GHC 8.6
mkAppType expr typ = noL $ HsAppType (HsWC noE typ) expr
mkTypeAnn expr typ = noL $ ExprWithTySig (HsWC noE (HsIB noE typ)) expr

#elif __GLASGOW_HASKELL__ < 901

-- GHC 8.8-9.0
mkAppType :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
mkAppType LHsExpr GhcPs
expr LHsType GhcPs
typ = HsExpr GhcPs -> LHsExpr GhcPs
forall e. e -> GenLocated SrcSpan e
noL (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XAppTypeE GhcPs
-> LHsExpr GhcPs -> LHsWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType NoExtField
XAppTypeE GhcPs
noE LHsExpr GhcPs
expr (XHsWC GhcPs (LHsType GhcPs)
-> LHsType GhcPs -> HsWildCardBndrs GhcPs (LHsType GhcPs)
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC NoExtField
XHsWC GhcPs (LHsType GhcPs)
noE LHsType GhcPs
typ)
mkTypeAnn :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
mkTypeAnn LHsExpr GhcPs
expr LHsType GhcPs
typ = HsExpr GhcPs -> LHsExpr GhcPs
forall e. e -> GenLocated SrcSpan e
noL (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XExprWithTySig GhcPs
-> LHsExpr GhcPs -> LHsSigWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig NoExtField
XExprWithTySig GhcPs
noE LHsExpr GhcPs
expr (XHsWC GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
-> HsImplicitBndrs GhcPs (LHsType GhcPs)
-> HsWildCardBndrs GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC NoExtField
XHsWC GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
noE (XHsIB GhcPs (LHsType GhcPs)
-> LHsType GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs)
forall pass thing.
XHsIB pass thing -> thing -> HsImplicitBndrs pass thing
HsIB NoExtField
XHsIB GhcPs (LHsType GhcPs)
noE LHsType GhcPs
typ))

#else

-- GHC 9.2+
mkAppType expr typ = noLA $ HsAppType noSrcSpan expr (HsWC noE typ)
mkTypeAnn expr typ = noLA $ ExprWithTySig noAnn expr (hsTypeToHsSigWcType typ)

#endif

#if __GLASGOW_HASKELL__ < 811

-- GHC 8.10 and below
mkFunTy :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
mkFunTy LHsType GhcPs
a LHsType GhcPs
b = HsType GhcPs -> LHsType GhcPs
forall e. e -> GenLocated SrcSpan e
noL (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XFunTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy NoExtField
XFunTy GhcPs
noE LHsType GhcPs
a LHsType GhcPs
b
newFunBind :: Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsBind GhcPs
newFunBind Located RdrName
a MatchGroup GhcPs (LHsExpr GhcPs)
b = XFunBind GhcPs GhcPs
-> Located (IdP GhcPs)
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsWrapper
-> [Tickish Id]
-> HsBind GhcPs
forall idL idR.
XFunBind idL idR
-> Located (IdP idL)
-> MatchGroup idR (LHsExpr idR)
-> HsWrapper
-> [Tickish Id]
-> HsBindLR idL idR
FunBind NoExtField
XFunBind GhcPs GhcPs
noE Located (IdP GhcPs)
Located RdrName
a MatchGroup GhcPs (LHsExpr GhcPs)
b HsWrapper
WpHole []

#else

-- GHC 9.0
mkFunTy a b = noLA $ HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) a b
newFunBind a b = FunBind noE (reLocA a) b []

#endif


#if __GLASGOW_HASKELL__ < 807

-- GHC 8.6
compat_m_pats :: [Pat GhcPs] -> [LPat GhcPs]
compat_m_pats = map noL

#elif __GLASGOW_HASKELL__ < 809

-- GHC 8.8
compat_m_pats :: [Pat GhcPs] -> [Pat GhcPs]
compat_m_pats = id

#else

-- 8.10
compat_m_pats :: [Pat GhcPs] -> [LPat GhcPs]
compat_m_pats :: [Pat GhcPs] -> [LPat GhcPs]
compat_m_pats = (Pat GhcPs -> GenLocated SrcSpan (Pat GhcPs))
-> [Pat GhcPs] -> [GenLocated SrcSpan (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map Pat GhcPs -> GenLocated SrcSpan (Pat GhcPs)
forall e. e -> GenLocated SrcSpan e
noLA

#endif


qualifiedImplicitImport :: ModuleName -> LImportDecl GhcPs

#if __GLASGOW_HASKELL__ < 809

-- GHC 8.8
qualifiedImplicitImport x = noL $ ImportDecl noE NoSourceText (noL x) Nothing False False
    True {- qualified -} True {- implicit -} Nothing Nothing

#elif __GLASGOW_HASKELL__ < 811

-- GHC 8.10
qualifiedImplicitImport :: ModuleName -> LImportDecl GhcPs
qualifiedImplicitImport ModuleName
x = ImportDecl GhcPs -> LImportDecl GhcPs
forall e. e -> GenLocated SrcSpan e
noL (ImportDecl GhcPs -> LImportDecl GhcPs)
-> ImportDecl GhcPs -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XCImportDecl GhcPs
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE GhcPs])
-> ImportDecl GhcPs
forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
ImportDecl NoExtField
XCImportDecl GhcPs
noE SourceText
NoSourceText (ModuleName -> Located ModuleName
forall e. e -> GenLocated SrcSpan e
noL ModuleName
x) Maybe StringLiteral
forall a. Maybe a
Nothing Bool
False Bool
False
    ImportDeclQualifiedStyle
QualifiedPost {- qualified -} Bool
True {- implicit -} Maybe (Located ModuleName)
forall a. Maybe a
Nothing Maybe (Bool, Located [LIE GhcPs])
forall a. Maybe a
Nothing

#else

-- GHC 9.0
qualifiedImplicitImport x = noLA $ ImportDecl noAnn NoSourceText (noLA x) Nothing NotBoot False
    QualifiedPost {- qualified -} True {- implicit -} Nothing Nothing

#endif

type PluginEnv = (?hscenv :: HscEnv, ?uniqSupply :: IORef UniqSupply)

dropRnTraceFlags :: HscEnv -> HscEnv
#if __GLASGOW_HASKELL__ < 808
dropRnTraceFlags env@HscEnv{hsc_dflags = dflags} =  env{hsc_dflags = dopt_unset dflags Opt_D_dump_rn_trace}
#else
dropRnTraceFlags :: HscEnv -> HscEnv
dropRnTraceFlags = HscEnv -> HscEnv
forall a. a -> a
id
#endif

freeTyVars :: PluginEnv => LHsType GhcPs -> [Located RdrName]
#if __GLASGOW_HASKELL__ < 808
{-# NOINLINE freeTyVars #-}
freeTyVars  = freeKiTyVarsAllVars . runRnM . extractHsTyRdrTyVars
  where
    runRnM :: RnM a -> a
    runRnM rnm = unsafePerformIO $ do
      let env = Env ?hscenv ?uniqSupply unused unused
      runIOEnv env rnm
    unused = error "never called"
#elif __GLASGOW_HASKELL__ < 810
freeTyVars = freeKiTyVarsAllVars . extractHsTyRdrTyVars
#else
freeTyVars :: LHsType GhcPs -> [Located RdrName]
freeTyVars = (Located RdrName -> Located RdrName)
-> [Located RdrName] -> [Located RdrName]
forall a b. (a -> b) -> [a] -> [b]
map Located RdrName -> Located RdrName
forall e. Located e -> Located e
reLoc ([Located RdrName] -> [Located RdrName])
-> (LHsType GhcPs -> [Located RdrName])
-> LHsType GhcPs
-> [Located RdrName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> [Located RdrName]
extractHsTyRdrTyVars
#endif