{-# LANGUAGE CPP                    #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE PatternSynonyms        #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# LANGUAGE ViewPatterns           #-}

-- | Thin compatibility layer around GHC
--
-- This should be the only module with GHC-specific CPP directives, and the
-- rest of the plugin should not import from any GHC modules directly.
module Data.Record.Internal.GHC.Shim (
    -- * Miscellaneous
    importDecl
  , conPat
  , mkFunBind
  , HsModule
  , LHsModule
  , LRdrName
  , pattern GHC.HsModule

    -- * Annotations
#if __GLASGOW_HASKELL__ < 902
  , reLoc
  , reLocA
  , noLocA
#endif

    -- * Extensions
  , HasDefaultExt(..)
  , withDefExt

    -- * Generalized @forall@
#if __GLASGOW_HASKELL__ >= 900
  , HsTyVarBndr
  , LHsTyVarBndr
#endif
  , hsFunTy
  , userTyVar
  , kindedTyVar
  , hsTyVarLName
  , setDefaultSpecificity

    -- * New functionality
  , compareHs
  , inheritLoc
  , inheritLoc'
  , inheritLocPat

    -- * Re-exports

    -- The whole-sale module exports are not ideal for preserving compatibility
    -- across ghc versions, but we'll deal with this on a case by case basis.
#if __GLASGOW_HASKELL__ < 900
  , module Bag
  , module BasicTypes
  , module ErrUtils
  , module GHC
  , module GhcPlugins
  , module HscMain
  , module NameCache
  , module TcEvidence
#else
  , module GHC.Data.Bag
  , module GHC.Driver.Main
  , module GHC.Hs
  , module GHC.Plugins
  , module GHC.Tc.Types.Evidence
  , module GHC.Types.Name.Cache
  , module GHC.Utils.Error
#if __GLASGOW_HASKELL__ >= 902
  , module GHC.Types.SourceText
  , module GHC.Types.Fixity
#endif
#endif
  ) where

import Data.List.NonEmpty (NonEmpty(..))
import Data.Generics (Data, GenericQ, cast, toConstr, gzipWithQ)

import qualified Data.List.NonEmpty as NE

#if __GLASGOW_HASKELL__ < 900

import BasicTypes (SourceText (NoSourceText))
import Bag (listToBag, emptyBag)
import ConLike (ConLike)
import ErrUtils (mkErrMsg, mkWarnMsg)
import GHC hiding (AnnKeywordId(..), HsModule, exprType, typeKind, mkFunBind)
import GhcPlugins hiding ((<>), getHscEnv,)
import HscMain (getHscEnv)
import NameCache (NameCache(nsUniqs))
import PatSyn (PatSyn)
import TcEvidence (HsWrapper(WpHole))

import qualified GHC
import qualified GhcPlugins as GHC

#else

import GHC.Hs hiding (LHsTyVarBndr, HsTyVarBndr, HsModule, mkFunBind)

import GHC.Core.Class (Class)
import GHC.Core.ConLike (ConLike)
import GHC.Core.PatSyn (PatSyn)
import GHC.Data.Bag (listToBag, emptyBag)
import GHC.Driver.Main (getHscEnv)
import GHC.Tc.Types.Evidence (HsWrapper(WpHole))
import GHC.Types.Name.Cache (NameCache(nsUniqs))
import GHC.Utils.Error (Severity(SevError, SevWarning))

import GHC.Plugins hiding ((<>), getHscEnv
#if __GLASGOW_HASKELL__ >=902
    , AnnType, AnnLet, AnnRec, AnnLam, AnnCase
    , Exception
#endif
    )

#if __GLASGOW_HASKELL__ < 902
import GHC.Utils.Error (mkErrMsg, mkWarnMsg)
import GHC.Parser.Annotation (IsUnicodeSyntax(NormalSyntax))
#else
import GHC.Types.SourceText (SourceText(NoSourceText), mkIntegralLit)
import GHC.Types.Fixity
#endif

import qualified GHC.Hs      as GHC

#endif

{-------------------------------------------------------------------------------
  Miscellaneous
-------------------------------------------------------------------------------}

-- | Optionally @qualified@ import declaration
importDecl :: ModuleName -> Bool -> LImportDecl GhcPs
importDecl :: ModuleName -> Bool -> LImportDecl GhcPs
importDecl ModuleName
name Bool
qualified = ImportDecl GhcPs -> LImportDecl GhcPs
forall e. e -> Located e
noLocA (ImportDecl GhcPs -> LImportDecl GhcPs)
-> ImportDecl GhcPs -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ImportDecl :: forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
ImportDecl {
      ideclExt :: XCImportDecl GhcPs
ideclExt       = XCImportDecl GhcPs
forall a. HasDefaultExt a => a
defExt
    , ideclSourceSrc :: SourceText
ideclSourceSrc = SourceText
NoSourceText
    , ideclName :: Located ModuleName
ideclName      = ModuleName -> Located ModuleName
forall e. e -> Located e
noLocA ModuleName
name
    , ideclPkgQual :: Maybe StringLiteral
ideclPkgQual   = Maybe StringLiteral
forall a. Maybe a
Nothing
    , ideclSafe :: Bool
ideclSafe      = Bool
False
    , ideclImplicit :: Bool
ideclImplicit  = Bool
False
    , ideclAs :: Maybe (Located ModuleName)
ideclAs        = Maybe (Located ModuleName)
forall a. Maybe a
Nothing
    , ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding    = Maybe (Bool, Located [LIE GhcPs])
forall a. Maybe a
Nothing
#if __GLASGOW_HASKELL__ < 810
    , ideclQualified = qualified
#else
    , ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = if Bool
qualified then ImportDeclQualifiedStyle
QualifiedPre else ImportDeclQualifiedStyle
NotQualified
#endif
#if __GLASGOW_HASKELL__ < 900
    , ideclSource :: Bool
ideclSource    = Bool
False
#else
    , ideclSource    = NotBoot
#endif
    }

conPat :: Located RdrName -> HsConPatDetails GhcPs -> Pat GhcPs
#if __GLASGOW_HASKELL__ < 900
conPat :: Located RdrName -> HsConPatDetails GhcPs -> Pat GhcPs
conPat Located RdrName
x HsConPatDetails GhcPs
y = Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located (IdP GhcPs)
Located RdrName
x HsConPatDetails GhcPs
y
#else
conPat x y = ConPat defExt (reLocA x) y
#endif

mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs
#if __GLASGOW_HASKELL__ < 810
mkFunBind = GHC.mkFunBind
#else
mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs
mkFunBind (Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLocA -> Located RdrName
n) = Origin
-> Located RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
GHC.mkFunBind Origin
Generated Located RdrName
n
#endif

#if __GLASGOW_HASKELL__ < 900
type HsModule = GHC.HsModule GhcPs
#else
type HsModule = GHC.HsModule
#endif

type LHsModule = Located HsModule
type LRdrName  = Located RdrName

{-------------------------------------------------------------------------------
  Exact-print annotations
-------------------------------------------------------------------------------}

#if __GLASGOW_HASKELL__ < 902
reLoc :: Located a -> Located a
reLoc :: Located a -> Located a
reLoc = Located a -> Located a
forall a. a -> a
id

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

noLocA :: e -> Located e
noLocA :: e -> Located e
noLocA = e -> Located e
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc

#if __GLASGOW_HASKELL__ >= 900
mapXRec :: forall pass f g l. (f pass -> g pass) -> GenLocated l (f pass) -> GenLocated l (g pass)
mapXRec = fmap
#endif
#endif

{-------------------------------------------------------------------------------
  Extensions
-------------------------------------------------------------------------------}

class HasDefaultExt a where
  defExt :: a

#if __GLASGOW_HASKELL__ < 810
instance HasDefaultExt NoExt where
  defExt = noExt
#else
instance HasDefaultExt NoExtField where
  defExt :: NoExtField
defExt = NoExtField
noExtField
#endif

#if __GLASGOW_HASKELL__ >= 900
instance HasDefaultExt LayoutInfo where
  defExt = NoLayoutInfo
#endif

instance (HasDefaultExt a, HasDefaultExt b) => HasDefaultExt (a, b) where
  defExt :: (a, b)
defExt = (a
forall a. HasDefaultExt a => a
defExt, b
forall a. HasDefaultExt a => a
defExt)

instance (HasDefaultExt a, HasDefaultExt b, HasDefaultExt c) => HasDefaultExt (a, b, c) where
  defExt :: (a, b, c)
defExt = (a
forall a. HasDefaultExt a => a
defExt, b
forall a. HasDefaultExt a => a
defExt, c
forall a. HasDefaultExt a => a
defExt)

#if __GLASGOW_HASKELL__ >= 902
instance HasDefaultExt (EpAnn ann) where
  defExt = noAnn

instance HasDefaultExt AnnSortKey where
  defExt = NoAnnSortKey

instance HasDefaultExt EpAnnComments where
  defExt = epAnnComments noAnn
#endif

-- In GHC-9.2 some things have extension fields.
#if __GLASGOW_HASKELL__ >= 902
withDefExt :: HasDefaultExt a => (a -> b) -> b
withDefExt f = f defExt 
#else
withDefExt :: a -> a
withDefExt :: a -> a
withDefExt a
a = a
a
#endif

{-------------------------------------------------------------------------------
  Generalized @forall@ in 9.0
-------------------------------------------------------------------------------}

#if __GLASGOW_HASKELL__ >= 900
type  HsTyVarBndr pass =  GHC.HsTyVarBndr () pass
type LHsTyVarBndr pass = GHC.LHsTyVarBndr () pass
#endif

hsFunTy :: XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
#if __GLASGOW_HASKELL__ < 900
hsFunTy :: XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
hsFunTy = XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy
#else
hsFunTy ext = HsFunTy ext (HsUnrestrictedArrow NormalSyntax)
#endif

userTyVar ::
     XUserTyVar GhcPs
  -> Located (IdP GhcPs)
  -> HsTyVarBndr GhcPs
#if __GLASGOW_HASKELL__ < 900
userTyVar :: XUserTyVar GhcPs -> Located (IdP GhcPs) -> HsTyVarBndr GhcPs
userTyVar = XUserTyVar GhcPs -> Located (IdP GhcPs) -> HsTyVarBndr GhcPs
forall pass.
XUserTyVar pass -> Located (IdP pass) -> HsTyVarBndr pass
UserTyVar
#else
userTyVar ext x = UserTyVar ext () (reLocA x)
#endif

kindedTyVar ::
     XKindedTyVar GhcPs
  -> Located (IdP GhcPs)
  -> LHsKind GhcPs
  -> HsTyVarBndr GhcPs
#if __GLASGOW_HASKELL__ < 900
kindedTyVar :: XKindedTyVar GhcPs
-> Located (IdP GhcPs) -> LHsKind GhcPs -> HsTyVarBndr GhcPs
kindedTyVar = XKindedTyVar GhcPs
-> Located (IdP GhcPs) -> LHsKind GhcPs -> HsTyVarBndr GhcPs
forall pass.
XKindedTyVar pass
-> Located (IdP pass) -> LHsKind pass -> HsTyVarBndr pass
KindedTyVar
#else
kindedTyVar ext k = KindedTyVar ext () (reLocA k)
#endif

-- | Like 'hsTyVarName', but don't throw away the location information
hsTyVarLName :: HsTyVarBndr GhcPs -> LRdrName
#if __GLASGOW_HASKELL__ < 900
hsTyVarLName :: HsTyVarBndr GhcPs -> Located RdrName
hsTyVarLName (UserTyVar   XUserTyVar GhcPs
_ Located (IdP GhcPs)
n  ) = Located (IdP GhcPs)
Located RdrName
n
hsTyVarLName (KindedTyVar XKindedTyVar GhcPs
_ Located (IdP GhcPs)
n LHsKind GhcPs
_) = Located (IdP GhcPs)
Located RdrName
n
hsTyVarLName HsTyVarBndr GhcPs
_ = String -> Located RdrName
forall a. String -> a
panic String
"hsTyVarLName"
#else
hsTyVarLName (UserTyVar   _ _ n  ) = reLoc n
hsTyVarLName (KindedTyVar _ _ n _) = reLoc n
#endif

#if __GLASGOW_HASKELL__ < 900
setDefaultSpecificity :: LHsTyVarBndr pass -> GHC.LHsTyVarBndr pass
setDefaultSpecificity :: LHsTyVarBndr pass -> LHsTyVarBndr pass
setDefaultSpecificity = LHsTyVarBndr pass -> LHsTyVarBndr pass
forall a. a -> a
id
#else
setDefaultSpecificity :: LHsTyVarBndr GhcPs -> GHC.LHsTyVarBndr Specificity GhcPs
setDefaultSpecificity = mapXRec @GhcPs $ \v -> case v of
    UserTyVar   ext () name      -> UserTyVar   ext SpecifiedSpec name
    KindedTyVar ext () name kind -> KindedTyVar ext SpecifiedSpec name kind
#if __GLASGOW_HASKELL__ < 900
    XTyVarBndr  ext              -> XTyVarBndr  ext
#endif
#endif

{-------------------------------------------------------------------------------
  New functionality
-------------------------------------------------------------------------------}

-- | Generic comparison for (parts of) the AST
--
-- NOTE: Not all abstract types are given special treatment here; in particular,
-- types only used in type-checked code ignored. To extend/audit this function,
-- grep the @ghc@ source for @abstractConstr@. Without further extensions,
-- all values of these types are considered equal.
--
-- NOTE: Although @ghc@ declares the constructor of @Bag@ as abstract as well,
-- we don't actually need a special case here: the constructors will be
-- considered equal, but 'gfoldl' will traverse the /elements/ of the @Bag@
-- nonetheless, which is precisely what we want.
compareHs' :: GenericQ (GenericQ Bool)
compareHs' :: a -> GenericQ Bool
compareHs' a
x a
y
    | (Just ConLike
x', Just ConLike
y') <- (a -> Maybe ConLike
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe ConLike
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = ConLike -> ConLike -> Bool
forall a. Eq a => a -> a -> Bool
(==) @ConLike     ConLike
x' ConLike
y'
    | (Just PatSyn
x', Just PatSyn
y') <- (a -> Maybe PatSyn
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe PatSyn
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = PatSyn -> PatSyn -> Bool
forall a. Eq a => a -> a -> Bool
(==) @PatSyn      PatSyn
x' PatSyn
y'
    | (Just Class
x', Just Class
y') <- (a -> Maybe Class
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe Class
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
(==) @Class       Class
x' Class
y'
    | (Just DataCon
x', Just DataCon
y') <- (a -> Maybe DataCon
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe DataCon
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
(==) @DataCon     DataCon
x' DataCon
y'
    | (Just FastString
x', Just FastString
y') <- (a -> Maybe FastString
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe FastString
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
(==) @FastString  FastString
x' FastString
y'
    | (Just Module
x', Just Module
y') <- (a -> Maybe Module
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe Module
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
(==) @Module      Module
x' Module
y'
    | (Just ModuleName
x', Just ModuleName
y') <- (a -> Maybe ModuleName
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe ModuleName
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
(==) @ModuleName  ModuleName
x' ModuleName
y'
    | (Just Name
x', Just Name
y') <- (a -> Maybe Name
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe Name
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) @Name        Name
x' Name
y'
    | (Just OccName
x', Just OccName
y') <- (a -> Maybe OccName
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe OccName
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
(==) @OccName     OccName
x' OccName
y'
    | (Just TyCon
x', Just TyCon
y') <- (a -> Maybe TyCon
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe TyCon
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
(==) @TyCon       TyCon
x' TyCon
y'
    | (Just UnitId
x', Just UnitId
y') <- (a -> Maybe UnitId
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe UnitId
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
(==) @UnitId      UnitId
x' UnitId
y'
    | (Just Var
x', Just Var
y') <- (a -> Maybe Var
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe Var
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
(==) @Var         Var
x' Var
y'
#if __GLASGOW_HASKELL__ >= 900
    | (Just x', Just y') <- (cast x, cast y) = (==) @Unit        x' y'
#endif
    | (Just RealSrcSpan
x', Just RealSrcSpan
y') <- (a -> Maybe RealSrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe RealSrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = RealSrcSpan -> RealSrcSpan -> Bool
forall a. a -> a -> Bool
ignr @RealSrcSpan RealSrcSpan
x' RealSrcSpan
y'
    | (Just SrcSpan
x', Just SrcSpan
y') <- (a -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x, a -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y) = SrcSpan -> SrcSpan -> Bool
forall a. a -> a -> Bool
ignr @SrcSpan     SrcSpan
x' SrcSpan
y'
    | Bool
otherwise = (a -> Constr
forall a. Data a => a -> Constr
toConstr a
x Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Constr
forall a. Data a => a -> Constr
toConstr a
y)
               Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
and (GenericQ (GenericQ Bool) -> a -> a -> [Bool]
forall r. GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
gzipWithQ GenericQ (GenericQ Bool)
compareHs' a
x a
y)
  where
    ignr :: a -> a -> Bool
    ignr :: a -> a -> Bool
ignr a
_ a
_ = Bool
True

-- | Compare two (parts) of a Haskell source tree for equality
--
-- The trees are compared for literal equality, but 'SrcSpan's are ignored.
compareHs :: Data a => a -> a -> Bool
compareHs :: a -> a -> Bool
compareHs a
x a
y = a -> a -> Bool
GenericQ (GenericQ Bool)
compareHs' a
x a
y

{-------------------------------------------------------------------------------
  Working with locations
-------------------------------------------------------------------------------}

class FromSrcSpan l where
  fromSrcSpan :: SrcSpan -> l

instance FromSrcSpan SrcSpan where
  fromSrcSpan :: SrcSpan -> SrcSpan
fromSrcSpan = SrcSpan -> SrcSpan
forall a. a -> a
id

#if __GLASGOW_HASKELL__ >= 902
instance HasDefaultExt ann => FromSrcSpan (SrcSpanAnn' ann) where
  fromSrcSpan = SrcSpanAnn defExt
#endif

class InheritLoc a where
  inheritLoc :: FromSrcSpan l => a -> b -> GenLocated l b

#if __GLASGOW_HASKELL__ >= 902
-- GHC-9.2 may not require annotation
inheritLoc' :: a -> b -> b
inheritLoc' _ = id
#else
inheritLoc' :: InheritLoc a => a -> b -> Located b
inheritLoc' :: a -> b -> Located b
inheritLoc' = a -> b -> Located b
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc
#endif

instance InheritLoc a => InheritLoc (NonEmpty a) where
  inheritLoc :: NonEmpty a -> b -> GenLocated l b
inheritLoc = a -> b -> GenLocated l b
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc (a -> b -> GenLocated l b)
-> (NonEmpty a -> a) -> NonEmpty a -> b -> GenLocated l b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> a
forall a. NonEmpty a -> a
NE.head

instance InheritLoc l => InheritLoc (GenLocated l a) where
  inheritLoc :: GenLocated l a -> b -> GenLocated l b
inheritLoc (L l
l a
_) = l -> b -> GenLocated l b
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc l
l

instance InheritLoc SrcSpan where
  inheritLoc :: SrcSpan -> b -> GenLocated l b
inheritLoc SrcSpan
l b
x = l -> b -> GenLocated l b
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> l
forall l. FromSrcSpan l => SrcSpan -> l
fromSrcSpan SrcSpan
l) b
x

#if __GLASGOW_HASKELL__ >= 902
instance InheritLoc (SrcSpanAnn' ann) where
  inheritLoc (SrcSpanAnn _ l) = inheritLoc l
#endif

--
-- -- | The instance for @[]@ is not ideal: we use 'noLoc' if the list is empty
-- --
-- -- For the use cases in this library, this is acceptable: typically these are
-- -- lists with elements for the record fields, and having slightly poorer error
-- -- messages for highly unusual "empty large" records is fine.
instance InheritLoc a => InheritLoc [a] where
   inheritLoc :: [a] -> b -> GenLocated l b
inheritLoc (a
a:[a]
_) = a -> b -> GenLocated l b
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc a
a
   inheritLoc []    = SrcSpan -> b -> GenLocated l b
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc SrcSpan
noSrcSpan

#if __GLASGOW_HASKELL__ < 810
inheritLocPat :: a -> Pat p -> LPat p
inheritLocPat _ = id -- In 8.8, 'LPat' is a synonym for 'Pat'
#else
inheritLocPat :: InheritLoc a => a -> Pat (GhcPass p) -> LPat (GhcPass p)
inheritLocPat :: a -> Pat (GhcPass p) -> LPat (GhcPass p)
inheritLocPat = a -> Pat (GhcPass p) -> LPat (GhcPass p)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc
#endif