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

module PlutusTx.Compiler.Compat where

import GHC.Core.Class qualified as GHC
import GHC.Hs.Expr qualified as GHC
import GHC.Hs.Extension qualified as GHC
import GHC.Types.Id.Info qualified as GHC
import Language.Haskell.Syntax.Binds qualified as GHC
import Language.Haskell.Syntax.Extension qualified as GHC
import Language.Haskell.Syntax.Type qualified as GHC
#if __GLASGOW_HASKELL__ < 910
import GHC.Parser.Annotation qualified as GHC
#endif
#if __GLASGOW_HASKELL__ < 912
import GHC.Data.Bag qualified as GHC
#endif

maybeGetClassOpId :: GHC.IdDetails -> Maybe GHC.Class
#if __GLASGOW_HASKELL__ >= 912
maybeGetClassOpId (GHC.ClassOpId cls _) = Just cls
maybeGetClassOpId _ = Nothing
#else
maybeGetClassOpId :: IdDetails -> Maybe Class
maybeGetClassOpId (GHC.ClassOpId Class
cls) = Class -> Maybe Class
forall a. a -> Maybe a
Just Class
cls
maybeGetClassOpId IdDetails
_ = Maybe Class
forall a. Maybe a
Nothing
#endif

hsAppTc :: GHC.LHsExpr GHC.GhcTc -> GHC.LHsExpr GHC.GhcTc -> GHC.HsExpr GHC.GhcTc
#if __GLASGOW_HASKELL__ >= 910
hsAppTc = GHC.HsApp GHC.noExtField
#else
hsAppTc :: LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
hsAppTc = XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
GHC.HsApp XApp GhcTc
EpAnn NoEpAnns
forall ann. EpAnn ann
GHC.EpAnnNotUsed
#endif

pattern HsAppType
  :: GHC.XAppTypeE (GHC.GhcPass p)
  -> GHC.LHsExpr (GHC.GhcPass p)
  -> GHC.LHsWcType (GHC.NoGhcTc (GHC.GhcPass p))
  -> GHC.HsExpr (GHC.GhcPass p)
#if __GLASGOW_HASKELL__ >= 910
pattern HsAppType x expr ty <- GHC.HsAppType x expr ty
  where
    HsAppType x expr ty = GHC.HsAppType x expr ty
#else
pattern $mHsAppType :: forall {r} {p :: Pass}.
HsExpr (GhcPass p)
-> (XAppTypeE (GhcPass p)
    -> LHsExpr (GhcPass p) -> LHsWcType (NoGhcTc (GhcPass p)) -> r)
-> ((# #) -> r)
-> r
$bHsAppType :: forall (p :: Pass).
XAppTypeE (GhcPass p)
-> LHsExpr (GhcPass p)
-> LHsWcType (NoGhcTc (GhcPass p))
-> HsExpr (GhcPass p)
HsAppType x expr ty <- GHC.HsAppType x expr _ ty
  where
    HsAppType XAppTypeE (GhcPass p)
x LHsExpr (GhcPass p)
expr LHsWcType (NoGhcTc (GhcPass p))
ty = XAppTypeE (GhcPass p)
-> LHsExpr (GhcPass p)
-> LHsToken "@" (GhcPass p)
-> LHsWcType (NoGhcTc (GhcPass p))
-> HsExpr (GhcPass p)
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
GHC.HsAppType XAppTypeE (GhcPass p)
x LHsExpr (GhcPass p)
expr LHsToken "@" (GhcPass p)
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
GHC.noHsTok LHsWcType (NoGhcTc (GhcPass p))
ty
#endif

pattern WrapExpr
  :: GHC.HsExpr GHC.GhcTc -> GHC.XXExprGhcTc
#if __GLASGOW_HASKELL__ >= 912
pattern WrapExpr e <- GHC.WrapExpr _ e
#else
pattern $mWrapExpr :: forall {r}. XXExprGhcTc -> (HsExpr GhcTc -> r) -> ((# #) -> r) -> r
WrapExpr e <- GHC.WrapExpr (GHC.HsWrap _ e)
#endif

pattern HsPar :: GHC.LHsExpr GHC.GhcTc -> GHC.HsExpr GHC.GhcTc
#if __GLASGOW_HASKELL__ >= 912
pattern HsPar e <- GHC.HsPar _ e
#else
pattern $mHsPar :: forall {r}.
HsExpr GhcTc -> (LHsExpr GhcTc -> r) -> ((# #) -> r) -> r
HsPar e <- GHC.HsPar _ _ e _
#endif

modifyBinds :: ([GHC.LHsBindLR p p] -> [GHC.LHsBindLR p p]) -> GHC.LHsBinds p -> GHC.LHsBinds p
#if __GLASGOW_HASKELL__ >= 912
modifyBinds = ($)
#else
-- We need this because for some reason `transformBi` does not work on `Bag`,
-- even though `Bag` has a `Data` instance. It it perhaps because the `Data`
-- instance for `Bag` is buggy.
modifyBinds :: forall p.
([LHsBindLR p p] -> [LHsBindLR p p]) -> LHsBinds p -> LHsBinds p
modifyBinds [LHsBindLR p p] -> [LHsBindLR p p]
f = [LHsBindLR p p] -> Bag (LHsBindLR p p)
forall a. [a] -> Bag a
GHC.listToBag ([LHsBindLR p p] -> Bag (LHsBindLR p p))
-> (Bag (LHsBindLR p p) -> [LHsBindLR p p])
-> Bag (LHsBindLR p p)
-> Bag (LHsBindLR p p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsBindLR p p] -> [LHsBindLR p p]
f ([LHsBindLR p p] -> [LHsBindLR p p])
-> (Bag (LHsBindLR p p) -> [LHsBindLR p p])
-> Bag (LHsBindLR p p)
-> [LHsBindLR p p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (LHsBindLR p p) -> [LHsBindLR p p]
forall a. Bag a -> [a]
GHC.bagToList
#endif