-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

{-# LANGUAGE CPP #-}
-- | This module overloads some combinators so they can be used in
-- different contexts: for expressions, types and/or patterns.
module GHC.SourceGen.Overloaded
    ( Par(..)
    , App(..)
    , HasTuple(..)
    , tuple
    , unboxedTuple
    , HasList(..)
    , Var(..)
    , BVar(..)
    ) where

import GHC.Hs.Type
    ( HsType(..)
    , HsTyVarBndr(..)
    )
import GHC.Hs (IE(..), IEWrappedName(..))
#if !MIN_VERSION_ghc(8,6,0)
import PlaceHolder(PlaceHolder(..))
#endif

import GHC.Hs
    ( HsExpr(..)
    , Pat(..)
    , HsTupArg(..)
    , HsTupleSort(..)
    )
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (Boxity(..))
import GHC.Core.DataCon (dataConName)
import GHC.Types.Name.Reader (nameRdrName)
import GHC.Builtin.Types (consDataCon_RDR, nilDataCon, unitDataCon)
import GHC.Types.Var (Specificity(..))
#else
import BasicTypes (Boxity(..))
import DataCon (dataConName)
import RdrName (nameRdrName)
import TysWiredIn (consDataCon_RDR, nilDataCon, unitDataCon)
#endif

import GHC.SourceGen.Expr.Internal
import GHC.SourceGen.Name.Internal
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Type.Internal

-- | A class for wrapping terms in parentheses.
class Par e where
    par :: e -> e

instance Par HsExpr' where
    par :: HsExpr' -> HsExpr'
par = (NoExtField -> LHsExpr GhcPs -> HsExpr')
-> LHsExpr GhcPs -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LHsExpr GhcPs -> HsExpr'
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar (LHsExpr GhcPs -> HsExpr')
-> (HsExpr' -> LHsExpr GhcPs) -> HsExpr' -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated

instance Par Pat' where
    par :: Pat' -> Pat'
par = (NoExtField -> Located Pat' -> Pat') -> Located Pat' -> Pat'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> Located Pat' -> Pat'
forall p. XParPat p -> LPat p -> Pat p
ParPat (Located Pat' -> Pat') -> (Pat' -> Located Pat') -> Pat' -> Pat'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat' -> LPat'
Pat' -> Located Pat'
builtPat

instance Par HsType' where
    par :: HsType' -> HsType'
par = (NoExtField -> LHsType GhcPs -> HsType')
-> LHsType GhcPs -> HsType'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LHsType GhcPs -> HsType'
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy (LHsType GhcPs -> HsType')
-> (HsType' -> LHsType GhcPs) -> HsType' -> HsType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType' -> LHsType GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated

-- | A class for term application.
--
-- These functions may add additional parentheses to the AST.
-- GHC's pretty-printing functions expect those parentheses
-- to already be present, because GHC preserves parentheses when it
-- parses the AST from a source file.
class App e where
    -- | Prefix-apply a term:
    --
    -- > f x
    -- > =====
    -- > var "f" @@ var "x"
    --
    -- > (+) x
    -- > =====
    -- > var "+" @@ var "x"
    --
    -- Also parenthesizes the right-hand side in order to preserve its
    -- semantics when pretty-printed, but tries to do so only when
    -- necessary:
    --
    -- > f x y
    -- > =====
    -- > var "f" @@ var "x" @@ var "y"
    -- > -- equivalently:
    -- > (var "f" @@ var "x") @@ var "y"
    --
    -- > f (g x)
    -- > =====
    -- > var "f" @@ (var "g" @@ var "x")
    --
    -- > f (g x)
    -- > =====
    -- > var "f" @@ par (var "g" @@ par (var "x"))
    (@@) :: e -> e -> e

    -- | Infix-apply an operator or function.
    --
    -- For example:
    --
    -- > x + y
    -- > =====
    -- > op (var "x") "+" (var "y")
    --
    -- Also parenthesizes the right-hand side in order to preserve its
    -- semantics when pretty-printed, but tries to do so only when necessary:
    --
    -- > f x + g y
    -- > =====
    -- > op (var "f" @@ var "x") "+" (var "g" @@ var "y")
    --
    -- > x + (y + z)
    -- > =====
    -- > op (var "x") "+" (op (var "y") "+" (var "z"))
    --
    -- > f x `plus` g y
    -- > =====
    -- > op (var "f" @@ var "x") "plus" (var "g" @@ var "y")
    op :: e -> RdrNameStr -> e -> e
infixl 2 @@

instance App HsExpr' where
    op :: HsExpr' -> RdrNameStr -> HsExpr' -> HsExpr'
op HsExpr'
x RdrNameStr
o HsExpr'
y
        = (NoExtField
 -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr')
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr'
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp
            (LHsExpr GhcPs -> LHsExpr GhcPs
parenthesizeExprForOp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
x)
            (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (HsExpr' -> LHsExpr GhcPs) -> HsExpr' -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ RdrNameStr -> HsExpr'
forall a. Var a => RdrNameStr -> a
var RdrNameStr
o)
#if !MIN_VERSION_ghc(8,6,0)
            PlaceHolder
#endif
            (LHsExpr GhcPs -> LHsExpr GhcPs
parenthesizeExprForOp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
y)
    HsExpr'
x @@ :: HsExpr' -> HsExpr' -> HsExpr'
@@ HsExpr'
y = (NoExtField -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr')
-> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr'
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp (LHsExpr GhcPs -> LHsExpr GhcPs
parenthesizeExprForOp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
x)
                (LHsExpr GhcPs -> LHsExpr GhcPs
parenthesizeExprForApp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
y)

instance App HsType' where
    op :: HsType' -> RdrNameStr -> HsType' -> HsType'
op HsType'
x RdrNameStr
o HsType'
y
        = (NoExtField
 -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> HsType')
-> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> HsType'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> HsType'
forall pass.
XOpTy pass
-> LHsType pass
-> Located (IdP pass)
-> LHsType pass
-> HsType pass
HsOpTy (LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForOp (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ HsType' -> LHsType GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
x)
                (RdrNameStr -> LocatedN RdrName
typeRdrName RdrNameStr
o)
                (LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForOp (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ HsType' -> LHsType GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
y)
    HsType'
x @@ :: HsType' -> HsType' -> HsType'
@@ HsType'
y = (NoExtField -> LHsType GhcPs -> LHsType GhcPs -> HsType')
-> LHsType GhcPs -> LHsType GhcPs -> HsType'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LHsType GhcPs -> LHsType GhcPs -> HsType'
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy
                (LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForOp (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ HsType' -> LHsType GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
x)
                (LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForApp (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ HsType' -> LHsType GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
y)

class HasTuple e where
    unit :: e
    tupleOf :: Boxity -> [e] -> e

tuple, unboxedTuple :: HasTuple e => [e] -> e
tuple :: [e] -> e
tuple = Boxity -> [e] -> e
forall e. HasTuple e => Boxity -> [e] -> e
tupleOf Boxity
Boxed
unboxedTuple :: [e] -> e
unboxedTuple = Boxity -> [e] -> e
forall e. HasTuple e => Boxity -> [e] -> e
tupleOf Boxity
Unboxed

instance HasTuple HsExpr' where
    tupleOf :: Boxity -> [HsExpr'] -> HsExpr'
tupleOf Boxity
b [HsExpr']
ts =
        [HsTupArg GhcPs] -> Boxity -> HsExpr'
explicitTuple
            ((HsExpr' -> HsTupArg GhcPs) -> [HsExpr'] -> [HsTupArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map ((NoExtField -> LHsExpr GhcPs -> HsTupArg GhcPs)
-> LHsExpr GhcPs -> HsTupArg GhcPs
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present (LHsExpr GhcPs -> HsTupArg GhcPs)
-> (HsExpr' -> LHsExpr GhcPs) -> HsExpr' -> HsTupArg GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated) [HsExpr']
ts)
            Boxity
b
      where
#if MIN_VERSION_ghc(9,2,0)
        explicitTuple = withEpAnnNotUsed ExplicitTuple
#else
        explicitTuple :: [HsTupArg GhcPs] -> Boxity -> HsExpr'
explicitTuple = (NoExtField -> [LHsTupArg GhcPs] -> Boxity -> HsExpr')
-> [LHsTupArg GhcPs] -> Boxity -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> [LHsTupArg GhcPs] -> Boxity -> HsExpr'
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple ([LHsTupArg GhcPs] -> Boxity -> HsExpr')
-> ([HsTupArg GhcPs] -> [LHsTupArg GhcPs])
-> [HsTupArg GhcPs]
-> Boxity
-> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTupArg GhcPs -> LHsTupArg GhcPs)
-> [HsTupArg GhcPs] -> [LHsTupArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map HsTupArg GhcPs -> LHsTupArg GhcPs
forall e. e -> Located e
builtLoc
#endif
    unit :: HsExpr'
unit = (NoExtField -> LocatedN RdrName -> HsExpr')
-> LocatedN RdrName -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> HsExpr'
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar LIdP
LocatedN RdrName
unitDataConName

unitDataConName :: LIdP
unitDataConName :: LIdP
unitDataConName = RdrName -> LocatedN RdrName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (RdrName -> LocatedN RdrName) -> RdrName -> LocatedN RdrName
forall a b. (a -> b) -> a -> b
$ Name -> RdrName
nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ DataCon
unitDataCon

instance HasTuple HsType' where
    tupleOf :: Boxity -> [HsType'] -> HsType'
tupleOf Boxity
b = (NoExtField -> HsTupleSort -> [LHsType GhcPs] -> HsType')
-> HsTupleSort -> [LHsType GhcPs] -> HsType'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> HsTupleSort -> [LHsType GhcPs] -> HsType'
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy HsTupleSort
b' ([LHsType GhcPs] -> HsType')
-> ([HsType'] -> [LHsType GhcPs]) -> [HsType'] -> HsType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType' -> LHsType GhcPs) -> [HsType'] -> [LHsType GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map HsType' -> LHsType GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated
        where
            b' :: HsTupleSort
b' = case Boxity
b of
                    Boxity
Unboxed -> HsTupleSort
HsUnboxedTuple
                    -- See the note [Unit tuples] in HsType.hs for why
                    -- this isn't just HsBoxed.
                    Boxity
Boxed -> HsTupleSort
HsBoxedOrConstraintTuple
    unit :: HsType'
unit = Boxity -> [HsType'] -> HsType'
forall e. HasTuple e => Boxity -> [e] -> e
tupleOf Boxity
Boxed []

instance HasTuple Pat' where
    tupleOf :: Boxity -> [Pat'] -> Pat'
tupleOf Boxity
b [Pat']
ps =
        (NoExtField -> [Located Pat'] -> Boxity -> Pat')
-> [Located Pat'] -> Boxity -> Pat'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> [Located Pat'] -> Boxity -> Pat'
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat ((Pat' -> Located Pat') -> [Pat'] -> [Located Pat']
forall a b. (a -> b) -> [a] -> [b]
map Pat' -> LPat'
Pat' -> Located Pat'
builtPat [Pat']
ps) Boxity
b
#if !MIN_VERSION_ghc(8,6,0)
        []
#endif
    unit :: Pat'
unit = (NoExtField -> LocatedN RdrName -> Pat')
-> LocatedN RdrName -> Pat'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> Pat'
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat LIdP
LocatedN RdrName
unitDataConName

-- | An explicit list of terms.
--
-- > [x, y]
-- > =====
-- > list [var "x", var "y"]
--
-- NOTE: for types, use either @listTy@ or @promotedListTy@.
class HasList e where
    list :: [e] -> e
    -- | The empty list @[]@.
    nil :: e

    -- | The list cons constructor @(:)@.
    cons :: e

-- TODO: allow something like "consOp" which applies (:) as an operator, but using
-- the built-in RdrName.

nilDataConName :: LIdP
nilDataConName :: LIdP
nilDataConName = RdrName -> LocatedN RdrName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (RdrName -> LocatedN RdrName) -> RdrName -> LocatedN RdrName
forall a b. (a -> b) -> a -> b
$ Name -> RdrName
nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ DataCon
nilDataCon

instance HasList HsExpr' where
    list :: [HsExpr'] -> HsExpr'
list = ([LHsExpr GhcPs] -> HsExpr') -> [LHsExpr GhcPs] -> HsExpr'
forall a. a -> a
withPlaceHolder ((NoExtField -> [LHsExpr GhcPs] -> HsExpr')
-> [LHsExpr GhcPs] -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> [LHsExpr GhcPs] -> HsExpr'
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
explicitList) ([LHsExpr GhcPs] -> HsExpr')
-> ([HsExpr'] -> [LHsExpr GhcPs]) -> [HsExpr'] -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr' -> LHsExpr GhcPs) -> [HsExpr'] -> [LHsExpr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated
      where
#if MIN_VERSION_ghc(9,2,0)
        explicitList = ExplicitList
#else
        explicitList :: XExplicitList p -> [LHsExpr p] -> HsExpr p
explicitList XExplicitList p
x = XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList p
x Maybe (SyntaxExpr p)
forall a. Maybe a
Nothing
#endif
    nil :: HsExpr'
nil = (NoExtField -> LocatedN RdrName -> HsExpr')
-> LocatedN RdrName -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> HsExpr'
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar LIdP
LocatedN RdrName
nilDataConName
    cons :: HsExpr'
cons = (NoExtField -> LocatedN RdrName -> HsExpr')
-> LocatedN RdrName -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> HsExpr'
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar (LocatedN RdrName -> HsExpr') -> LocatedN RdrName -> HsExpr'
forall a b. (a -> b) -> a -> b
$ RdrName -> LocatedN RdrName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated RdrName
consDataCon_RDR

instance HasList Pat' where
#if MIN_VERSION_ghc(8,6,0)
    list :: [Pat'] -> Pat'
list = (NoExtField -> [Located Pat'] -> Pat') -> [Located Pat'] -> Pat'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> [Located Pat'] -> Pat'
forall p. XListPat p -> [LPat p] -> Pat p
ListPat ([Located Pat'] -> Pat')
-> ([Pat'] -> [Located Pat']) -> [Pat'] -> Pat'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat' -> Located Pat') -> [Pat'] -> [Located Pat']
forall a b. (a -> b) -> [a] -> [b]
map Pat' -> LPat'
Pat' -> Located Pat'
builtPat
#else
    list ps = ListPat (map builtPat ps) PlaceHolder Nothing
#endif
    nil :: Pat'
nil = (NoExtField -> LocatedN RdrName -> Pat')
-> LocatedN RdrName -> Pat'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> Pat'
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat LIdP
LocatedN RdrName
nilDataConName
    cons :: Pat'
cons = (NoExtField -> LocatedN RdrName -> Pat')
-> LocatedN RdrName -> Pat'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> Pat'
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat (LocatedN RdrName -> Pat') -> LocatedN RdrName -> Pat'
forall a b. (a -> b) -> a -> b
$ RdrName -> LocatedN RdrName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (RdrName -> LocatedN RdrName) -> RdrName -> LocatedN RdrName
forall a b. (a -> b) -> a -> b
$ RdrName
consDataCon_RDR

-- | Terms that can contain references to locally-bound variables.
--
-- Depending on the context, @'bvar' \"a\"@ could refer to either a
-- pattern variable or a type variable.
class BVar a where
    bvar :: OccNameStr -> a

-- | Terms that can contain references to named things.  They may be actual variables,
-- functions, or constructors.  For example, @'var' \"a\"@ and @'var' \"A\"@
-- are equally valid.
-- Depending on the context, the former could refer to either a function,
-- value, type variable, or pattern; and the latter could refer to either a type
-- constructor or a  data constructor,
class BVar a => Var a where
    var :: RdrNameStr -> a

instance BVar Pat' where
    bvar :: OccNameStr -> Pat'
bvar = (NoExtField -> LocatedN RdrName -> Pat')
-> LocatedN RdrName -> Pat'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> Pat'
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat (LocatedN RdrName -> Pat')
-> (OccNameStr -> LocatedN RdrName) -> OccNameStr -> Pat'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
valueRdrName (RdrNameStr -> LocatedN RdrName)
-> (OccNameStr -> RdrNameStr) -> OccNameStr -> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr

instance Var HsExpr' where
    var :: RdrNameStr -> HsExpr'
var = (NoExtField -> LocatedN RdrName -> HsExpr')
-> LocatedN RdrName -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> HsExpr'
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar (LocatedN RdrName -> HsExpr')
-> (RdrNameStr -> LocatedN RdrName) -> RdrNameStr -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
valueRdrName

instance BVar HsExpr' where
    bvar :: OccNameStr -> HsExpr'
bvar = RdrNameStr -> HsExpr'
forall a. Var a => RdrNameStr -> a
var (RdrNameStr -> HsExpr')
-> (OccNameStr -> RdrNameStr) -> OccNameStr -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr

instance Var HsType' where
    var :: RdrNameStr -> HsType'
var = (NoExtField -> PromotionFlag -> LocatedN RdrName -> HsType')
-> PromotionFlag -> LocatedN RdrName -> HsType'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> PromotionFlag -> LocatedN RdrName -> HsType'
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar PromotionFlag
notPromoted (LocatedN RdrName -> HsType')
-> (RdrNameStr -> LocatedN RdrName) -> RdrNameStr -> HsType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
typeRdrName

instance BVar HsType' where
    bvar :: OccNameStr -> HsType'
bvar = RdrNameStr -> HsType'
forall a. Var a => RdrNameStr -> a
var (RdrNameStr -> HsType')
-> (OccNameStr -> RdrNameStr) -> OccNameStr -> HsType'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr

#if MIN_VERSION_ghc(9,0,0)
instance BVar HsTyVarBndr' where
    bvar = withEpAnnNotUsed UserTyVar () . typeRdrName . UnqualStr

instance BVar HsTyVarBndrS' where
    bvar = withEpAnnNotUsed UserTyVar SpecifiedSpec . typeRdrName . UnqualStr
#else
instance BVar HsTyVarBndr' where
    bvar :: OccNameStr -> HsTyVarBndr'
bvar = (NoExtField -> LocatedN RdrName -> HsTyVarBndr')
-> LocatedN RdrName -> HsTyVarBndr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LocatedN RdrName -> HsTyVarBndr'
forall pass.
XUserTyVar pass -> Located (IdP pass) -> HsTyVarBndr pass
UserTyVar (LocatedN RdrName -> HsTyVarBndr')
-> (OccNameStr -> LocatedN RdrName) -> OccNameStr -> HsTyVarBndr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
typeRdrName (RdrNameStr -> LocatedN RdrName)
-> (OccNameStr -> RdrNameStr) -> OccNameStr -> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr
#endif

instance Var IE' where
    var :: RdrNameStr -> IE'
var RdrNameStr
n = (NoExtField
 -> GenLocated (SrcSpanAnn ann) (IEWrappedName RdrName) -> IE')
-> GenLocated (SrcSpanAnn ann) (IEWrappedName RdrName) -> IE'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> GenLocated (SrcSpanAnn ann) (IEWrappedName RdrName) -> IE'
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar (GenLocated (SrcSpanAnn ann) (IEWrappedName RdrName) -> IE')
-> GenLocated (SrcSpanAnn ann) (IEWrappedName RdrName) -> IE'
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName
-> GenLocated (SrcSpanAnn ann) (IEWrappedName RdrName)
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (IEWrappedName RdrName
 -> GenLocated (SrcSpanAnn ann) (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> GenLocated (SrcSpanAnn ann) (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName (LocatedN RdrName -> IEWrappedName RdrName)
-> LocatedN RdrName -> IEWrappedName RdrName
forall a b. (a -> b) -> a -> b
$ RdrNameStr -> LocatedN RdrName
exportRdrName RdrNameStr
n

instance BVar IE' where
    bvar :: OccNameStr -> IE'
bvar = RdrNameStr -> IE'
forall a. Var a => RdrNameStr -> a
var (RdrNameStr -> IE')
-> (OccNameStr -> RdrNameStr) -> OccNameStr -> IE'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr