{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{- HLINT ignore "Use camelCase" -}
{- HLINT ignore "Unused LANGUAGE pragma" -}

-- | 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
#if __GLASGOW_HASKELL__ < 906
import GHC.Unit.Types
#endif
#if __GLASGOW_HASKELL__ < 902
import GHC.Parser.Annotation
#endif
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
#if __GLASGOW_HASKELL__ >= 904
import GHC.Types.PkgQual (RawPkgQual(NoRawPkgQual))
#endif
import Data.IORef as Compat

---------------------------------------------------------------------
-- LOCATIONS

class WithoutLoc a b | b -> a where
  -- | Without location information
  --
  -- Different GHC versions want different kind of location information in
  -- different places. This class is intended to abstract over this.
  noL :: a -> b

#if __GLASGOW_HASKELL__ >= 902
instance WithoutLoc a (GenLocated (SrcAnn ann) a) where
  noL :: a -> GenLocated (SrcAnn ann) a
noL = Located a -> GenLocated (SrcAnn ann) a
forall e ann. Located e -> LocatedAn ann e
reLocA (Located a -> GenLocated (SrcAnn ann) a)
-> (a -> Located a) -> a -> GenLocated (SrcAnn ann) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Located a
forall e. e -> Located e
noLoc
#endif

instance WithoutLoc a (Located a) where
  noL :: a -> Located a
noL = a -> Located a
forall e. e -> Located e
noLoc

instance WithoutLoc (HsTupArg p)         (HsTupArg p)         where noL :: HsTupArg p -> HsTupArg p
noL = HsTupArg p -> HsTupArg p
forall a. a -> a
id
instance WithoutLoc (HsLocalBindsLR p q) (HsLocalBindsLR p q) where noL :: HsLocalBindsLR p q -> HsLocalBindsLR p q
noL = HsLocalBindsLR p q -> HsLocalBindsLR p q
forall a. a -> a
id

#if __GLASGOW_HASKELL__ < 902
reLocA :: Located e -> Located e
reLocA = id

reLoc :: Located e -> Located e
reLoc = id
#endif

---------------------------------------------------------------------
-- TREE EXTENSIONS

class WithoutExt a where
  -- | No extension
  --
  -- Different GHC versions want different kinds of annotations. This class is
  -- intended to abstract over this.
  noE :: a

#if __GLASGOW_HASKELL__ >= 902
instance WithoutExt (EpAnn a) where
  noE :: EpAnn a
noE = EpAnn a
forall a. EpAnn a
EpAnnNotUsed

instance WithoutExt EpAnnComments where
  noE :: EpAnnComments
noE = EpAnnComments
emptyComments
#endif

#if __GLASGOW_HASKELL__ >= 810
instance WithoutExt NoExtField where
  noE :: NoExtField
noE = NoExtField
noExtField
#else
instance WithoutExt NoExt where
  noE = NoExt
#endif

#if __GLASGOW_HASKELL__ >= 906
instance WithoutExt XImportDeclPass where
  noE :: XImportDeclPass
noE = EpAnn EpAnnImportDecl -> SourceText -> Bool -> XImportDeclPass
XImportDeclPass EpAnn EpAnnImportDecl
forall a. WithoutExt a => a
noE SourceText
NoSourceText Bool
True {- implicit -}

instance WithoutExt GHC.Types.Basic.Origin where
  noE :: Origin
noE = Origin
Generated
#if __GLASGOW_HASKELL__ >= 908
          SkipPmc
#endif
#endif

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

#if __GLASGOW_HASKELL__ < 902

mkNonDetFastString :: FastString -> FastString
mkNonDetFastString = id

#else

mkNonDetFastString :: FastString -> NonDetFastString
mkNonDetFastString :: FastString -> NonDetFastString
mkNonDetFastString = FastString -> NonDetFastString
NonDetFastString

#endif

realSrcLoc :: SrcLoc -> Maybe RealSrcLoc
#if __GLASGOW_HASKELL__ < 811
realSrcLoc (RealSrcLoc x) = Just x
#else
realSrcLoc :: SrcLoc -> Maybe RealSrcLoc
realSrcLoc (RealSrcLoc RealSrcLoc
x Maybe BufPos
_) = RealSrcLoc -> Maybe RealSrcLoc
forall a. a -> Maybe a
Just RealSrcLoc
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 :: forall (p :: Pass) flag.
(Anno (IdP (GhcPass p)) ~ SrcSpanAnn' (EpAnn NameAnn)) =>
LHsTyVarBndr flag (GhcPass p) -> LHsType (GhcPass p)
hsLTyVarBndrToType LHsTyVarBndr flag (GhcPass p)
x = HsType (GhcPass p) -> LHsType (GhcPass p)
forall a b. WithoutLoc a b => a -> b
noL (HsType (GhcPass p) -> LHsType (GhcPass p))
-> HsType (GhcPass p) -> LHsType (GhcPass p)
forall a b. (a -> b) -> a -> b
$ XTyVar (GhcPass p)
-> PromotionFlag -> LIdP (GhcPass p) -> HsType (GhcPass p)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass p)
forall a. WithoutExt a => a
noE PromotionFlag
NotPromoted (LIdP (GhcPass p) -> HsType (GhcPass p))
-> LIdP (GhcPass p) -> HsType (GhcPass p)
forall a b. (a -> b) -> a -> b
$ IdGhcP p -> LIdP (GhcPass p)
forall a b. WithoutLoc a b => a -> b
noL (IdGhcP p -> LIdP (GhcPass p)) -> IdGhcP p -> LIdP (GhcPass p)
forall a b. (a -> b) -> a -> b
$ LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName LHsTyVarBndr flag (GhcPass p)
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
#elif __GLASGOW_HASKELL__ >= 906
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 expr typ = noL $ HsAppType noE expr (HsWC noE typ)
mkTypeAnn expr typ = noL $ ExprWithTySig noE expr (HsWC noE (HsIB noE typ))

#elif __GLASGOW_HASKELL__ >= 906

-- GHC 9.6+
mkAppType :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
mkAppType LHsExpr GhcPs
expr LHsType GhcPs
typ = HsExpr GhcPs -> LHsExpr GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XAppTypeE GhcPs
-> LHsExpr GhcPs
-> LHsToken "@" GhcPs
-> LHsWcType (NoGhcTc GhcPs)
-> HsExpr GhcPs
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcPs
forall a. WithoutExt a => a
noE LHsExpr GhcPs
expr LHsToken "@" GhcPs
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok (XHsWC GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC XHsWC GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
NoExtField
forall a. WithoutExt a => a
noE LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
typ)
mkTypeAnn :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
mkTypeAnn LHsExpr GhcPs
expr LHsType GhcPs
typ = HsExpr GhcPs -> LHsExpr GhcPs
forall a b. WithoutLoc a b => a -> b
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 XExprWithTySig GhcPs
forall a. WithoutExt a => a
noE LHsExpr GhcPs
expr (LHsType GhcPs -> LHsSigWcType GhcPs
hsTypeToHsSigWcType LHsType GhcPs
typ)

#else

-- GHC 9.2-9.4
mkAppType expr typ = noL $ HsAppType noSrcSpan expr (HsWC noE typ)
mkTypeAnn expr typ = noL $ ExprWithTySig noE expr (hsTypeToHsSigWcType typ)

#endif

#if __GLASGOW_HASKELL__ < 811

-- GHC 8.10 and below
mkFunTy a b = noL $ HsFunTy noE a b
newFunBind a b = FunBind noE a b WpHole []

#elif __GLASGOW_HASKELL__ < 904

-- GHC 9.0 and 9.2
mkFunTy a b = noL $ HsFunTy noE (HsUnrestrictedArrow NormalSyntax) a b
newFunBind a b = FunBind noE (reLocA a) b []

#elif __GLASGOW_HASKELL__ >= 906

-- GHC 9.6+
mkFunTy :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
mkFunTy LHsType GhcPs
a LHsType GhcPs
b = HsType GhcPs -> LHsType GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XFunTy GhcPs
-> HsArrow GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcPs
forall a. WithoutExt a => a
noE (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs)
-> LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
forall a b. (a -> b) -> a -> b
$ TokenLocation
-> HsUniToken "->" "\8594"
-> GenLocated TokenLocation (HsUniToken "->" "\8594")
forall l e. l -> e -> GenLocated l e
L TokenLocation
NoTokenLoc HsUniToken "->" "\8594"
forall (tok :: Symbol) (utok :: Symbol). HsUniToken tok utok
HsNormalTok) LHsType GhcPs
a LHsType GhcPs
b
newFunBind :: Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsBind GhcPs
newFunBind Located RdrName
a = XFunBind GhcPs GhcPs
-> LIdP GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsBind GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
NoExtField
forall a. WithoutExt a => a
noE (Located RdrName -> LocatedAn NameAnn RdrName
forall e ann. Located e -> LocatedAn ann e
reLocA Located RdrName
a)

#else

-- GHC 9.4
mkFunTy a b = noL $ HsFunTy noE (HsUnrestrictedArrow $ L NoTokenLoc HsNormalTok) 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 SrcSpanAnnA (Pat GhcPs))
-> [Pat GhcPs] -> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. WithoutLoc a b => a -> b
noL

#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 x = noL $ ImportDecl noE NoSourceText (noL x) Nothing False False
    QualifiedPost {- qualified -} True {- implicit -} Nothing Nothing

#elif __GLASGOW_HASKELL__ < 904

-- GHC 9.0 and 9.2
qualifiedImplicitImport x = noL $ ImportDecl noE NoSourceText (noL x) Nothing NotBoot False
    QualifiedPost {- qualified -} True {- implicit -} Nothing Nothing

#elif __GLASGOW_HASKELL__ >= 906

-- GHC 9.6+
qualifiedImplicitImport :: ModuleName -> LImportDecl GhcPs
qualifiedImplicitImport ModuleName
x = ImportDecl GhcPs -> LImportDecl GhcPs
forall a b. WithoutLoc a b => a -> b
noL (ImportDecl GhcPs -> LImportDecl GhcPs)
-> ImportDecl GhcPs -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XCImportDecl GhcPs
-> XRec GhcPs ModuleName
-> ImportDeclPkgQual GhcPs
-> IsBootInterface
-> Bool
-> ImportDeclQualifiedStyle
-> Maybe (XRec GhcPs ModuleName)
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
-> ImportDecl GhcPs
forall pass.
XCImportDecl pass
-> XRec pass ModuleName
-> ImportDeclPkgQual pass
-> IsBootInterface
-> Bool
-> ImportDeclQualifiedStyle
-> Maybe (XRec pass ModuleName)
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
-> ImportDecl pass
ImportDecl XCImportDecl GhcPs
forall a. WithoutExt a => a
noE (ModuleName -> XRec GhcPs ModuleName
forall a b. WithoutLoc a b => a -> b
noL ModuleName
x) ImportDeclPkgQual GhcPs
RawPkgQual
NoRawPkgQual IsBootInterface
NotBoot Bool
False
    ImportDeclQualifiedStyle
QualifiedPost {- qualified -} Maybe (XRec GhcPs ModuleName)
forall a. Maybe a
Nothing Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall a. Maybe a
Nothing

#else

-- GHC 9.4
qualifiedImplicitImport x = noL $ ImportDecl noE NoSourceText (noL x) NoRawPkgQual 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 :: PluginEnv => LHsType GhcPs -> [Located RdrName]
freeTyVars = (LocatedAn NameAnn RdrName -> Located RdrName)
-> [LocatedAn NameAnn RdrName] -> [Located RdrName]
forall a b. (a -> b) -> [a] -> [b]
map LocatedAn NameAnn RdrName -> Located RdrName
forall a e. LocatedAn a e -> Located e
reLoc ([LocatedAn NameAnn RdrName] -> [Located RdrName])
-> (GenLocated SrcSpanAnnA (HsType GhcPs)
    -> [LocatedAn NameAnn RdrName])
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [Located RdrName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> [LocatedAn NameAnn RdrName]
GenLocated SrcSpanAnnA (HsType GhcPs)
-> [LocatedAn NameAnn RdrName]
extractHsTyRdrTyVars
#endif

#if __GLASGOW_HASKELL__ >= 902
isLHsForAllTy :: LHsType GhcPs -> Bool
isLHsForAllTy :: LHsType GhcPs -> Bool
isLHsForAllTy (L SrcSpanAnnA
_ (HsForAllTy {})) = Bool
True
isLHsForAllTy LHsType GhcPs
_                     = Bool
False
#endif

#if __GLASGOW_HASKELL__ >= 904
rdrNameFieldOcc :: FieldOcc GhcPs -> LocatedN RdrName
rdrNameFieldOcc :: FieldOcc GhcPs -> LocatedAn NameAnn RdrName
rdrNameFieldOcc = FieldOcc GhcPs -> XRec GhcPs RdrName
FieldOcc GhcPs -> LocatedAn NameAnn RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel
#endif