{-# LANGUAGE CPP             #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections   #-}
{-# LANGUAGE ViewPatterns    #-}

-- | Interface to the GHC API that closely mimicks Template Haskell
--
-- See "Language.Haskell.TH.Lib".
--
-- This module is intended to be CPP-free, with all CPP confined to
-- "Data.Record.Plugin.GHC.Shim". The only exception to this is the redundant
-- pattern matches that we need for the poor extension design in ghc 9.0; I've
-- not yet found a nice way to shim this.
module Data.Record.Internal.GHC.TemplateHaskellStyle (
    -- * Names
    nameBase
  , mkExpVar
  , mkTyVar
  , mkTyCon
  , pattern ExpVar
  , pattern TyVar
  , pattern TyCon
    -- * Expressions
  , litE
  , stringE
  , pattern VarE
  , pattern ConE
  , recConE
  , pattern RecUpdE
  , appE
  , listE
  , lamE
  , lamE1
  , caseE
  , appsE
  , tupE
  , sigE
    -- ** Without direct equivalent
  , intE
    -- * Types
  , litT
  , pattern VarT
  , pattern ConT
  , appT
  , listT
    -- ** Without direct equivalent
  , stringT
  , appsT
  , funT
  , tupT
    -- * Patterns
  , varP
  , conP
  , bangP
  , listP
  , wildP
    -- * Strictness
  , bangType
    -- * Class contexts
  , equalP
    -- * Constructors
  , pattern RecC
  , forallRecC
    -- * Type variable binders
  , kindedTV
    -- ** Without direct equivalent
  , tyVarBndrName
    -- * Top-level declarations
  , sigD
  , valD
  , pattern DataD
  , pattern DerivClause
  , instanceD
  , classD
  , tySynEqn
    -- * Pragmas
  , pattern TypeAnnotation
  , pattern PragAnnD

    -- * Re-exported types (intentionally without constructors)
    --
    -- We intentionally:
    --
    -- o Do not export constructors (unless otherwise indicated): the functions
    --   in this module are replacements for those constructors.
    -- o Only export the located versions of these types: we should try to
    --   minimize location loss when generating code, for better errors.
  , AnnDecl
  , DerivStrategy(..) -- Exported with constructors, is similar enough to TH
  , GhcPs
  , HsLit
  , HsTyLit
  , LConDecl
  , LDerivStrategy
  , LHsDecl
  , LHsDerivingClause
  , LHsExpr
  , LHsType
  , LHsTyVarBndr
  , LPat
  , LTyFamInstDecl
  , LRdrName
  ) where

import Data.List (foldl')

import Data.Record.Internal.GHC.Shim hiding (mkTyVar)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE

{-------------------------------------------------------------------------------
  Internal auxiliary: types of names
-------------------------------------------------------------------------------}

isTermVar, isTermCon, isTypeVar, isTypeCon :: LRdrName -> Bool
isTermVar :: LRdrName -> Bool
isTermVar = (OccName -> Bool) -> LRdrName -> Bool
checkNameType OccName -> Bool
isVarOcc
isTermCon :: LRdrName -> Bool
isTermCon = (OccName -> Bool) -> LRdrName -> Bool
checkNameType OccName -> Bool
isDataOcc
isTypeVar :: LRdrName -> Bool
isTypeVar = (OccName -> Bool) -> LRdrName -> Bool
checkNameType OccName -> Bool
isTvOcc
isTypeCon :: LRdrName -> Bool
isTypeCon = (OccName -> Bool) -> LRdrName -> Bool
checkNameType OccName -> Bool
isTcOcc

checkNameType :: (OccName -> Bool) -> LRdrName -> Bool
checkNameType :: (OccName -> Bool) -> LRdrName -> Bool
checkNameType OccName -> Bool
f (L SrcSpan
_ RdrName
n) = OccName -> Bool
f (RdrName -> OccName
rdrNameOcc RdrName
n)

{-------------------------------------------------------------------------------
  Names
-------------------------------------------------------------------------------}

-- | Equivalent of 'Language.Haskell.TH.Syntax.nameBase'
nameBase :: LRdrName -> String
nameBase :: LRdrName -> String
nameBase = OccName -> String
occNameString (OccName -> String) -> (LRdrName -> OccName) -> LRdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (LRdrName -> RdrName) -> LRdrName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc

-- | Equivalent of 'Language.Haskell.TH.Syntax.mkName', for expression vars
mkExpVar :: SrcSpan -> String -> LRdrName
mkExpVar :: SrcSpan -> String -> LRdrName
mkExpVar SrcSpan
l = SrcSpan -> RdrName -> LRdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (RdrName -> LRdrName) -> (String -> RdrName) -> String -> LRdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> (String -> OccName) -> String -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OccName
mkVarOcc

-- | Equivalent of 'Language.Haskell.TH.Syntax.mkName', for type vars
mkTyVar :: SrcSpan -> String -> LRdrName
mkTyVar :: SrcSpan -> String -> LRdrName
mkTyVar SrcSpan
l = SrcSpan -> RdrName -> LRdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (RdrName -> LRdrName) -> (String -> RdrName) -> String -> LRdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> (String -> OccName) -> String -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OccName
mkTyVarOcc

-- | Equivalent of 'Language.Haskell.TH.Syntax.mkName', for type constructors
mkTyCon :: SrcSpan -> String -> LRdrName
mkTyCon :: SrcSpan -> String -> LRdrName
mkTyCon SrcSpan
l = SrcSpan -> RdrName -> LRdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (RdrName -> LRdrName) -> (String -> RdrName) -> String -> LRdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> (String -> OccName) -> String -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OccName
mkTcOcc

-- | Inverse to 'mkExpVar'
--
-- NOTE: Defined in terms of 'nameBase', so discards qualifiers.
viewExpVar :: LRdrName -> Maybe String
viewExpVar :: LRdrName -> Maybe String
viewExpVar LRdrName
n | LRdrName -> Bool
isTermVar LRdrName
n = String -> Maybe String
forall a. a -> Maybe a
Just (LRdrName -> String
nameBase LRdrName
n)
viewExpVar LRdrName
_otherwise = Maybe String
forall a. Maybe a
Nothing

-- | Inverse to 'mkTyVar'
--
-- NOTE: Defined in terms of 'nameBase', so discards qualifiers.
viewTyVar :: LRdrName -> Maybe String
viewTyVar :: LRdrName -> Maybe String
viewTyVar LRdrName
n | LRdrName -> Bool
isTypeVar LRdrName
n = String -> Maybe String
forall a. a -> Maybe a
Just (LRdrName -> String
nameBase LRdrName
n)
viewTyVar LRdrName
_otherwise = Maybe String
forall a. Maybe a
Nothing

-- | Inverse to 'mkTyCon'
viewTyCon :: LRdrName -> Maybe String
viewTyCon :: LRdrName -> Maybe String
viewTyCon LRdrName
n | LRdrName -> Bool
isTypeCon LRdrName
n = String -> Maybe String
forall a. a -> Maybe a
Just (LRdrName -> String
nameBase LRdrName
n)
viewTyCon LRdrName
_otherwise = Maybe String
forall a. Maybe a
Nothing

-- This patterns are not bidirectional: to construct a LRdrName, we need a
-- location. We may want to change this somehow. Use a Located String?

pattern ExpVar :: String -> LRdrName
pattern $mExpVar :: forall r. LRdrName -> (String -> r) -> (Void# -> r) -> r
ExpVar n <- (viewExpVar -> Just n)

pattern TyVar :: String -> LRdrName
pattern $mTyVar :: forall r. LRdrName -> (String -> r) -> (Void# -> r) -> r
TyVar n <- (viewTyVar -> Just n)

pattern TyCon :: String -> LRdrName
pattern $mTyCon :: forall r. LRdrName -> (String -> r) -> (Void# -> r) -> r
TyCon n <- (viewTyCon -> Just n)

{-------------------------------------------------------------------------------
  Expressions
-------------------------------------------------------------------------------}

-- | Equivalent of 'Language.Haskell.TH.Lib.varE'
varE :: HasCallStack => LRdrName -> LHsExpr GhcPs
varE :: LRdrName -> LHsExpr GhcPs
varE LRdrName
name
  | LRdrName -> Bool
isTermVar LRdrName
name = LRdrName -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XVar GhcPs -> Located (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcPs
forall a. HasDefaultExt a => a
defExt (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name)
  | Bool
otherwise      = String -> LHsExpr GhcPs
forall a. HasCallStack => String -> a
error String
"varE: incorrect name type"

-- | Inverse to 'varE'
viewVarE :: LHsExpr GhcPs -> Maybe LRdrName
viewVarE :: LHsExpr GhcPs -> Maybe LRdrName
viewVarE (LHsExpr GhcPs -> LHsExpr GhcPs
forall a. Located a -> Located a
reLoc -> L SrcSpan
_ (HsVar XVar GhcPs
_ (Located (IdP GhcPs) -> LRdrName
forall a. Located a -> Located a
reLoc -> LRdrName
name))) | LRdrName -> Bool
isTermVar LRdrName
name = LRdrName -> Maybe LRdrName
forall a. a -> Maybe a
Just LRdrName
name
viewVarE LHsExpr GhcPs
_ = Maybe LRdrName
forall a. Maybe a
Nothing

pattern VarE :: HasCallStack => () => LRdrName -> LHsExpr GhcPs
pattern $bVarE :: LRdrName -> LHsExpr GhcPs
$mVarE :: forall r.
HasCallStack =>
LHsExpr GhcPs -> (LRdrName -> r) -> (Void# -> r) -> r
VarE name <- (viewVarE -> Just name)
  where
    VarE = HasCallStack => LRdrName -> LHsExpr GhcPs
LRdrName -> LHsExpr GhcPs
varE

-- | Equivalent of 'Language.Haskell.TH.Lib.conE'
conE :: HasCallStack => LRdrName -> LHsExpr GhcPs
conE :: LRdrName -> LHsExpr GhcPs
conE LRdrName
name
  | LRdrName -> Bool
isTermCon LRdrName
name = LRdrName -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XVar GhcPs -> Located (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcPs
forall a. HasDefaultExt a => a
defExt (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name)
  | Bool
otherwise      = String -> LHsExpr GhcPs
forall a. HasCallStack => String -> a
error String
"conE: incorrect name type"

-- | Inverse to 'conE'
viewConE :: LHsExpr GhcPs -> Maybe LRdrName
viewConE :: LHsExpr GhcPs -> Maybe LRdrName
viewConE (LHsExpr GhcPs -> LHsExpr GhcPs
forall a. Located a -> Located a
reLoc -> L SrcSpan
_ (HsVar XVar GhcPs
_ (Located (IdP GhcPs) -> LRdrName
forall a. Located a -> Located a
reLoc -> LRdrName
name))) | LRdrName -> Bool
isTermCon LRdrName
name = LRdrName -> Maybe LRdrName
forall a. a -> Maybe a
Just LRdrName
name
viewConE LHsExpr GhcPs
_ = Maybe LRdrName
forall a. Maybe a
Nothing

pattern ConE :: HasCallStack => () => LRdrName -> LHsExpr GhcPs
pattern $bConE :: LRdrName -> LHsExpr GhcPs
$mConE :: forall r.
HasCallStack =>
LHsExpr GhcPs -> (LRdrName -> r) -> (Void# -> r) -> r
ConE name <- (viewConE -> Just name)
  where
    ConE = HasCallStack => LRdrName -> LHsExpr GhcPs
LRdrName -> LHsExpr GhcPs
conE

-- | Equivalent of 'Language.Haskell.TH.Lib.litE'
litE :: HsLit GhcPs -> LHsExpr GhcPs
litE :: HsLit GhcPs -> LHsExpr GhcPs
litE = HsExpr GhcPs -> LHsExpr GhcPs
forall e. e -> Located e
noLocA (HsExpr GhcPs -> LHsExpr GhcPs)
-> (HsLit GhcPs -> HsExpr GhcPs) -> HsLit GhcPs -> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XLitE GhcPs -> HsLit GhcPs -> HsExpr GhcPs
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcPs
forall a. HasDefaultExt a => a
defExt

-- | Equivalent of 'Language.Haskell.TH.Lib.stringE'
stringE :: String -> LHsExpr GhcPs
stringE :: String -> LHsExpr GhcPs
stringE = HsLit GhcPs -> LHsExpr GhcPs
litE (HsLit GhcPs -> LHsExpr GhcPs)
-> (String -> HsLit GhcPs) -> String -> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XHsString GhcPs -> FastString -> HsLit GhcPs
forall x. XHsString x -> FastString -> HsLit x
HsString XHsString GhcPs
SourceText
NoSourceText (FastString -> HsLit GhcPs)
-> (String -> FastString) -> String -> HsLit GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
fsLit

-- | Equivalent of 'Language.Haskell.TH.Lib.recConE'
recConE :: LRdrName -> [(LRdrName, LHsExpr GhcPs)] -> LHsExpr GhcPs
recConE :: LRdrName -> [(LRdrName, LHsExpr GhcPs)] -> LHsExpr GhcPs
recConE = \LRdrName
recName -> LRdrName -> [LHsRecField GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
mkRec LRdrName
recName ([LHsRecField GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs)
-> ([(LRdrName, LHsExpr GhcPs)]
    -> [LHsRecField GhcPs (LHsExpr GhcPs)])
-> [(LRdrName, LHsExpr GhcPs)]
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LRdrName, LHsExpr GhcPs) -> LHsRecField GhcPs (LHsExpr GhcPs))
-> [(LRdrName, LHsExpr GhcPs)]
-> [LHsRecField GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ((LRdrName -> LHsExpr GhcPs -> LHsRecField GhcPs (LHsExpr GhcPs))
-> (LRdrName, LHsExpr GhcPs) -> LHsRecField GhcPs (LHsExpr GhcPs)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LRdrName -> LHsExpr GhcPs -> LHsRecField GhcPs (LHsExpr GhcPs)
mkFld)
  where
    mkRec :: LRdrName -> [LHsRecField GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
    mkRec :: LRdrName -> [LHsRecField GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
mkRec LRdrName
name [LHsRecField GhcPs (LHsExpr GhcPs)]
fields = LRdrName -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
        XRecordCon GhcPs
-> Located (IdP GhcPs) -> HsRecordBinds GhcPs -> HsExpr GhcPs
forall p.
XRecordCon p -> Located (IdP p) -> HsRecordBinds p -> HsExpr p
RecordCon XRecordCon GhcPs
forall a. HasDefaultExt a => a
defExt (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name) ([LHsRecField GhcPs (LHsExpr GhcPs)]
-> Maybe (Located Int) -> HsRecordBinds GhcPs
forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields [LHsRecField GhcPs (LHsExpr GhcPs)]
fields Maybe (Located Int)
forall a. Maybe a
Nothing)

    mkFld :: LRdrName -> LHsExpr GhcPs -> LHsRecField GhcPs (LHsExpr GhcPs)
    mkFld :: LRdrName -> LHsExpr GhcPs -> LHsRecField GhcPs (LHsExpr GhcPs)
mkFld LRdrName
name LHsExpr GhcPs
val = LRdrName
-> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
-> LHsRecField GhcPs (LHsExpr GhcPs)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
 -> LHsRecField GhcPs (LHsExpr GhcPs))
-> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
-> LHsRecField GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
        Located (FieldOcc GhcPs)
-> LHsExpr GhcPs
-> Bool
-> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
forall id arg. Located id -> arg -> Bool -> HsRecField' id arg
HsRecField
#if __GLASGOW_HASKELL__ >= 902
          defExt
#endif
          (Located (FieldOcc GhcPs) -> Located (FieldOcc GhcPs)
forall a. Located a -> Located a
reLoc (LRdrName -> FieldOcc GhcPs -> Located (FieldOcc GhcPs)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (LRdrName -> FieldOcc GhcPs
mkFieldOcc (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name)))) LHsExpr GhcPs
val Bool
False

-- | Equivalent of 'Language.Haskell.TH.Lib.recUpdE'
recUpdE :: LHsExpr GhcPs -> [(LRdrName, LHsExpr GhcPs)] -> LHsExpr GhcPs
recUpdE :: LHsExpr GhcPs -> [(LRdrName, LHsExpr GhcPs)] -> LHsExpr GhcPs
recUpdE = \LHsExpr GhcPs
recExpr -> LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> LHsExpr GhcPs
updRec LHsExpr GhcPs
recExpr ([LHsRecUpdField GhcPs] -> LHsExpr GhcPs)
-> ([(LRdrName, LHsExpr GhcPs)] -> [LHsRecUpdField GhcPs])
-> [(LRdrName, LHsExpr GhcPs)]
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LRdrName, LHsExpr GhcPs) -> LHsRecUpdField GhcPs)
-> [(LRdrName, LHsExpr GhcPs)] -> [LHsRecUpdField GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map ((LRdrName -> LHsExpr GhcPs -> LHsRecUpdField GhcPs)
-> (LRdrName, LHsExpr GhcPs) -> LHsRecUpdField GhcPs
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LRdrName -> LHsExpr GhcPs -> LHsRecUpdField GhcPs
updFld)
  where
    updRec :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> LHsExpr GhcPs
    updRec :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> LHsExpr GhcPs
updRec LHsExpr GhcPs
expr [LHsRecUpdField GhcPs]
fields = LHsExpr GhcPs -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
expr (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
        XRecordUpd GhcPs
-> LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
forall p.
XRecordUpd p -> LHsExpr p -> [LHsRecUpdField p] -> HsExpr p
RecordUpd XRecordUpd GhcPs
forall a. HasDefaultExt a => a
defExt LHsExpr GhcPs
expr
#if __GLASGOW_HASKELL__ >= 902
          $ Left
#endif
            [LHsRecUpdField GhcPs]
fields

    updFld :: LRdrName -> LHsExpr GhcPs -> LHsRecUpdField GhcPs
    updFld :: LRdrName -> LHsExpr GhcPs -> LHsRecUpdField GhcPs
updFld LRdrName
name LHsExpr GhcPs
val = LRdrName
-> HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs)
-> LHsRecUpdField GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs)
 -> LHsRecUpdField GhcPs)
-> HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs)
-> LHsRecUpdField GhcPs
forall a b. (a -> b) -> a -> b
$
        Located (AmbiguousFieldOcc GhcPs)
-> LHsExpr GhcPs
-> Bool
-> HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs)
forall id arg. Located id -> arg -> Bool -> HsRecField' id arg
HsRecField
#if __GLASGOW_HASKELL__ >= 902
          defExt
#endif
         (Located (AmbiguousFieldOcc GhcPs)
-> Located (AmbiguousFieldOcc GhcPs)
forall a. Located a -> Located a
reLoc (LRdrName
-> AmbiguousFieldOcc GhcPs -> Located (AmbiguousFieldOcc GhcPs)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (LRdrName -> AmbiguousFieldOcc GhcPs
mkAmbiguousFieldOcc (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name)))) LHsExpr GhcPs
val Bool
False

viewRecUpdE ::
     LHsExpr GhcPs
  -> Maybe (LHsExpr GhcPs, [(LRdrName, LHsExpr GhcPs)])
#if __GLASGOW_HASKELL__ >= 902
viewRecUpdE (L _ (RecordUpd _ recExpr (Left fields))) =
#else
viewRecUpdE :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [(LRdrName, LHsExpr GhcPs)])
viewRecUpdE (L SrcSpan
_ (RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
recExpr [LHsRecUpdField GhcPs]
fields)) =
#endif
    (LHsExpr GhcPs
recExpr,) ([(LRdrName, LHsExpr GhcPs)]
 -> (LHsExpr GhcPs, [(LRdrName, LHsExpr GhcPs)]))
-> Maybe [(LRdrName, LHsExpr GhcPs)]
-> Maybe (LHsExpr GhcPs, [(LRdrName, LHsExpr GhcPs)])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsRecUpdField GhcPs -> Maybe (LRdrName, LHsExpr GhcPs))
-> [LHsRecUpdField GhcPs] -> Maybe [(LRdrName, LHsExpr GhcPs)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsRecUpdField GhcPs -> Maybe (LRdrName, LHsExpr GhcPs)
viewFieldUpd [LHsRecUpdField GhcPs]
fields
  where
    viewFieldUpd :: LHsRecUpdField GhcPs -> Maybe (LRdrName, LHsExpr GhcPs)
    viewFieldUpd :: LHsRecUpdField GhcPs -> Maybe (LRdrName, LHsExpr GhcPs)
viewFieldUpd (L SrcSpan
_ (HsRecField { hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl = L SrcSpan
_ (Unambiguous XUnambiguous GhcPs
_ LRdrName
name), hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecFieldArg = LHsExpr GhcPs
val, hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun = Bool
False })) =
        (LRdrName, LHsExpr GhcPs) -> Maybe (LRdrName, LHsExpr GhcPs)
forall a. a -> Maybe a
Just (LRdrName -> LRdrName
forall a. Located a -> Located a
reLoc LRdrName
name, LHsExpr GhcPs
val)
    viewFieldUpd LHsRecUpdField GhcPs
_otherwise =
        Maybe (LRdrName, LHsExpr GhcPs)
forall a. Maybe a
Nothing
viewRecUpdE LHsExpr GhcPs
_otherwise = Maybe (LHsExpr GhcPs, [(LRdrName, LHsExpr GhcPs)])
forall a. Maybe a
Nothing

pattern RecUpdE :: LHsExpr GhcPs -> [(LRdrName, LHsExpr GhcPs)] -> LHsExpr GhcPs
pattern $bRecUpdE :: LHsExpr GhcPs -> [(LRdrName, LHsExpr GhcPs)] -> LHsExpr GhcPs
$mRecUpdE :: forall r.
LHsExpr GhcPs
-> (LHsExpr GhcPs -> [(LRdrName, LHsExpr GhcPs)] -> r)
-> (Void# -> r)
-> r
RecUpdE recExpr fields <- (viewRecUpdE -> Just (recExpr, fields))
  where
    RecUpdE = LHsExpr GhcPs -> [(LRdrName, LHsExpr GhcPs)] -> LHsExpr GhcPs
recUpdE

-- | Equivalent of 'Language.Haskell.TH.Lib.appE'
appE :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
appE :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
appE LHsExpr GhcPs
a LHsExpr GhcPs
b = LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp LHsExpr GhcPs
a LHsExpr GhcPs
b

-- | Equivalent of 'Language.Haskell.TH.Lib.listE'
listE :: [LHsExpr GhcPs] -> LHsExpr GhcPs
listE :: [LHsExpr GhcPs] -> LHsExpr GhcPs
listE [LHsExpr GhcPs]
es = [LHsExpr GhcPs] -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc [LHsExpr GhcPs]
es (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XExplicitList GhcPs
-> Maybe (SyntaxExpr GhcPs) -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
forall a. HasDefaultExt a => a
defExt
#if __GLASGOW_HASKELL__ < 902
    Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing
#endif
    [LHsExpr GhcPs]
es

-- | Equivalent of 'Language.Haskell.TH.Lib.lamE'
lamE :: NonEmpty (LPat GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
lamE :: NonEmpty (LPat GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
lamE NonEmpty (LPat GhcPs)
pats LHsExpr GhcPs
body = LHsExpr GhcPs -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
body (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
    XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
forall a. HasDefaultExt a => a
defExt (MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs)
-> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
      XMG GhcPs (LHsExpr GhcPs)
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
-> Origin
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
forall a. HasDefaultExt a => a
defExt (LHsExpr GhcPs
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
body [LHsExpr GhcPs
-> Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
body Match GhcPs (LHsExpr GhcPs)
match]) Origin
Generated
  where
    match :: Match GhcPs (LHsExpr GhcPs)
    match :: Match GhcPs (LHsExpr GhcPs)
match = XCMatch GhcPs (LHsExpr GhcPs)
-> HsMatchContext (NameOrRdrName (IdP GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> Match GhcPs (LHsExpr GhcPs)
forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (LHsExpr GhcPs)
forall a. HasDefaultExt a => a
defExt HsMatchContext (NameOrRdrName (IdP GhcPs))
forall id. HsMatchContext id
LambdaExpr (NonEmpty (Located (Pat GhcPs)) -> [Located (Pat GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LPat GhcPs)
NonEmpty (Located (Pat GhcPs))
pats) (LHsExpr GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)
simpleGHRSs LHsExpr GhcPs
body)

-- | Convenience wrapper around 'lamE' for a single argument
lamE1 :: LPat GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
lamE1 :: LPat GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
lamE1 LPat GhcPs
p = NonEmpty (LPat GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
lamE (LPat GhcPs
Located (Pat GhcPs)
p Located (Pat GhcPs)
-> [Located (Pat GhcPs)] -> NonEmpty (Located (Pat GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [])

-- | Equivalent of 'Language.Haskell.TH.Lib.caseE'
caseE :: LHsExpr GhcPs -> [(LPat GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs
caseE :: LHsExpr GhcPs -> [(LPat GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs
caseE LHsExpr GhcPs
x [(LPat GhcPs, LHsExpr GhcPs)]
alts = LHsExpr GhcPs -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
x (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
    XCase GhcPs
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcPs
forall a. HasDefaultExt a => a
defExt LHsExpr GhcPs
x (XMG GhcPs (LHsExpr GhcPs)
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
-> Origin
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
forall a. HasDefaultExt a => a
defExt (LHsExpr GhcPs
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
x (((Located (Pat GhcPs), LHsExpr GhcPs)
 -> LMatch GhcPs (LHsExpr GhcPs))
-> [(Located (Pat GhcPs), LHsExpr GhcPs)]
-> [LMatch GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (LPat GhcPs, LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
(Located (Pat GhcPs), LHsExpr GhcPs)
-> LMatch GhcPs (LHsExpr GhcPs)
mkAlt [(LPat GhcPs, LHsExpr GhcPs)]
[(Located (Pat GhcPs), LHsExpr GhcPs)]
alts)) Origin
Generated)
  where
    mkAlt :: (LPat GhcPs, LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
    mkAlt :: (LPat GhcPs, LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
mkAlt (LPat GhcPs
pat, LHsExpr GhcPs
body) = LHsExpr GhcPs
-> Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
x (Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs))
-> Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
        XCMatch GhcPs (LHsExpr GhcPs)
-> HsMatchContext (NameOrRdrName (IdP GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> Match GhcPs (LHsExpr GhcPs)
forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (LHsExpr GhcPs)
forall a. HasDefaultExt a => a
defExt HsMatchContext (NameOrRdrName (IdP GhcPs))
forall id. HsMatchContext id
CaseAlt [LPat GhcPs
pat] (LHsExpr GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)
simpleGHRSs LHsExpr GhcPs
body)

-- | Equivalent of 'Language.Haskell.TH.Lib.appsE'
appsE :: LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
appsE :: LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
appsE = (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
appE

-- | Equivalent of 'Language.Haskell.TH.Lib.tupE'
tupE :: NonEmpty (LHsExpr GhcPs) -> LHsExpr GhcPs
tupE :: NonEmpty (LHsExpr GhcPs) -> LHsExpr GhcPs
tupE NonEmpty (LHsExpr GhcPs)
xs = NonEmpty (LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc NonEmpty (LHsExpr GhcPs)
xs (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
    XExplicitTuple GhcPs -> [LHsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple
      XExplicitTuple GhcPs
forall a. HasDefaultExt a => a
defExt
      [NonEmpty (LHsExpr GhcPs) -> HsTupArg GhcPs -> LHsTupArg GhcPs
forall a b. InheritLoc a => a -> b -> Located b
inheritLoc' NonEmpty (LHsExpr GhcPs)
xs (XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
forall a. HasDefaultExt a => a
defExt LHsExpr GhcPs
x) | LHsExpr GhcPs
x <- NonEmpty (LHsExpr GhcPs) -> [LHsExpr GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsExpr GhcPs)
xs]
      Boxity
Boxed

-- | Equivalent of 'Language.Haskell.TH.Lib.sigE'
sigE :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
sigE :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
sigE LHsExpr GhcPs
expr LHsType GhcPs
ty = LHsExpr GhcPs -> HsExpr GhcPs -> LHsExpr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
expr (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. HasDefaultExt a => a
defExt 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 XHsWC GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
forall a. HasDefaultExt a => a
defExt (LHsType GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs)
forall a. a -> HsImplicitBndrs GhcPs a
implicitBndrs LHsType GhcPs
ty))

{-------------------------------------------------------------------------------
  .. without direct equivalent
-------------------------------------------------------------------------------}

-- | By analogy with 'stringE'
intE :: Integral a => a -> LHsExpr GhcPs
intE :: a -> LHsExpr GhcPs
intE = HsLit GhcPs -> LHsExpr GhcPs
litE (HsLit GhcPs -> LHsExpr GhcPs)
-> (a -> HsLit GhcPs) -> a -> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XHsInt GhcPs -> IntegralLit -> HsLit GhcPs
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt GhcPs
forall a. HasDefaultExt a => a
defExt (IntegralLit -> HsLit GhcPs)
-> (a -> IntegralLit) -> a -> HsLit GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit

{-------------------------------------------------------------------------------
  Types
-------------------------------------------------------------------------------}

-- | Equivalent of 'Language.Haskell.TH.Lib.litT'
litT :: HsTyLit -> LHsType GhcPs
litT :: HsTyLit -> LHsType GhcPs
litT = HsType GhcPs -> LHsType GhcPs
forall e. e -> Located e
noLocA (HsType GhcPs -> LHsType GhcPs)
-> (HsTyLit -> HsType GhcPs) -> HsTyLit -> LHsType GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XTyLit GhcPs -> HsTyLit -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit XTyLit GhcPs
forall a. HasDefaultExt a => a
defExt

-- | Equivalent of 'Language.Haskell.TH.Lib.varT'
varT :: HasCallStack => LRdrName -> LHsType GhcPs
varT :: LRdrName -> LHsType GhcPs
varT LRdrName
name
  | LRdrName -> Bool
isTypeVar LRdrName
name = LRdrName -> HsType GhcPs -> LHsType GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (XTyVar GhcPs
-> PromotionFlag -> Located (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar XTyVar GhcPs
forall a. HasDefaultExt a => a
defExt PromotionFlag
NotPromoted (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name))
  | Bool
otherwise      = String -> LHsType GhcPs
forall a. HasCallStack => String -> a
error String
"varT: incorrect name type"

-- | Inverse to 'varT'
viewVarT :: LHsType GhcPs -> Maybe LRdrName
viewVarT :: LHsType GhcPs -> Maybe LRdrName
viewVarT (LHsType GhcPs -> LHsType GhcPs
forall a. Located a -> Located a
reLoc -> L SrcSpan
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ (Located (IdP GhcPs) -> LRdrName
forall a. Located a -> Located a
reLoc -> LRdrName
name))) | LRdrName -> Bool
isTypeVar LRdrName
name = LRdrName -> Maybe LRdrName
forall a. a -> Maybe a
Just LRdrName
name
viewVarT LHsType GhcPs
_otherwise = Maybe LRdrName
forall a. Maybe a
Nothing

pattern VarT :: HasCallStack => () => LRdrName -> LHsType GhcPs
pattern $bVarT :: LRdrName -> LHsType GhcPs
$mVarT :: forall r.
HasCallStack =>
LHsType GhcPs -> (LRdrName -> r) -> (Void# -> r) -> r
VarT name <- (viewVarT -> Just name)
  where
    VarT = HasCallStack => LRdrName -> LHsType GhcPs
LRdrName -> LHsType GhcPs
varT

-- | Equivalent of 'Language.Haskell.TH.Lib.conT'
conT :: HasCallStack => LRdrName -> LHsType GhcPs
conT :: LRdrName -> LHsType GhcPs
conT LRdrName
name
  | LRdrName -> Bool
isTypeCon LRdrName
name = LRdrName -> HsType GhcPs -> LHsType GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (XTyVar GhcPs
-> PromotionFlag -> Located (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar XTyVar GhcPs
forall a. HasDefaultExt a => a
defExt PromotionFlag
NotPromoted (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name))
  | Bool
otherwise      = String -> LHsType GhcPs
forall a. HasCallStack => String -> a
error String
"varT: incorrect name type"

-- | Inverse to 'conT'
viewConT :: LHsType GhcPs -> Maybe LRdrName
viewConT :: LHsType GhcPs -> Maybe LRdrName
viewConT (LHsType GhcPs -> LHsType GhcPs
forall a. Located a -> Located a
reLoc -> L SrcSpan
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ (Located (IdP GhcPs) -> LRdrName
forall a. Located a -> Located a
reLoc -> LRdrName
name))) | LRdrName -> Bool
isTypeCon LRdrName
name = LRdrName -> Maybe LRdrName
forall a. a -> Maybe a
Just LRdrName
name
viewConT LHsType GhcPs
_otherwise = Maybe LRdrName
forall a. Maybe a
Nothing

pattern ConT :: HasCallStack => () => LRdrName -> LHsType GhcPs
pattern $bConT :: LRdrName -> LHsType GhcPs
$mConT :: forall r.
HasCallStack =>
LHsType GhcPs -> (LRdrName -> r) -> (Void# -> r) -> r
ConT name <- (viewConT -> Just name)
  where
    ConT = HasCallStack => LRdrName -> LHsType GhcPs
LRdrName -> LHsType GhcPs
conT

-- | Equivalent of 'Language.Haskell.TH.Lib.appT'
appT :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
appT :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
appT = LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy

-- | Equivalent of 'Language.Haskell.TH.Lib.listT'
--
-- Signature by analogy with 'Language.Haskell.TH.Lib.listE'.
listT :: [LHsType GhcPs] -> LHsType GhcPs
listT :: [LHsType GhcPs] -> LHsType GhcPs
listT [LHsType GhcPs]
ts = [LHsType GhcPs] -> HsType GhcPs -> LHsType GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc [LHsType GhcPs]
ts (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XExplicitListTy GhcPs
-> PromotionFlag -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy XExplicitListTy GhcPs
forall a. HasDefaultExt a => a
defExt PromotionFlag
IsPromoted [LHsType GhcPs]
ts

{-------------------------------------------------------------------------------
  .. without direct equivalent
-------------------------------------------------------------------------------}

-- | By analogy with 'stringE'
stringT :: String -> LHsType GhcPs
stringT :: String -> LHsType GhcPs
stringT = HsTyLit -> LHsType GhcPs
litT (HsTyLit -> LHsType GhcPs)
-> (String -> HsTyLit) -> String -> LHsType GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceText -> FastString -> HsTyLit
HsStrTy SourceText
NoSourceText (FastString -> HsTyLit)
-> (String -> FastString) -> String -> HsTyLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
fsLit

-- | By analogy with 'appsE'
appsT :: LHsType GhcPs -> [LHsType GhcPs] -> LHsType GhcPs
appsT :: LHsType GhcPs -> [LHsType GhcPs] -> LHsType GhcPs
appsT = (LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs)
-> LHsType GhcPs -> [LHsType GhcPs] -> LHsType GhcPs
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
appT

-- | Function type
--
-- TH only provides 'Language.Haskell.TH.Lib.arrowT'.
funT :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
funT :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
funT LHsType GhcPs
a LHsType GhcPs
b = LHsType GhcPs -> HsType GhcPs -> LHsType GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsType GhcPs
a (XFunTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
hsFunTy XFunTy GhcPs
forall a. HasDefaultExt a => a
defExt LHsType GhcPs
a LHsType GhcPs
b)

-- | Tuple type
--
-- TH only provides 'Language.Haskell.TH.Lib.tupleT'.
-- Signature by analogy with 'tupE'.
tupT :: NonEmpty (LHsType GhcPs) -> LHsType GhcPs
tupT :: NonEmpty (LHsType GhcPs) -> LHsType GhcPs
tupT NonEmpty (LHsType GhcPs)
ts = NonEmpty (LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc NonEmpty (LHsType GhcPs)
ts (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XExplicitTupleTy GhcPs -> [LHsType GhcPs] -> HsType GhcPs
forall pass. XExplicitTupleTy pass -> [LHsType pass] -> HsType pass
HsExplicitTupleTy XExplicitTupleTy GhcPs
forall a. HasDefaultExt a => a
defExt (NonEmpty (LHsType GhcPs) -> [LHsType GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsType GhcPs)
ts)

{-------------------------------------------------------------------------------
  Patterns
-------------------------------------------------------------------------------}

-- | Equivalent of 'Language.Haskell.TH.Lib.varP'
varP :: LRdrName -> LPat GhcPs
varP :: LRdrName -> LPat GhcPs
varP LRdrName
name = LRdrName -> Pat GhcPs -> LPat GhcPs
forall a (p :: Pass).
InheritLoc a =>
a -> Pat (GhcPass p) -> LPat (GhcPass p)
inheritLocPat LRdrName
name (XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat XVarPat GhcPs
forall a. HasDefaultExt a => a
defExt (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name))

-- | Equivalent of 'Language.Haskell.TH.Lib.conP'
conP :: LRdrName -> [LPat GhcPs] -> LPat GhcPs
#if __GLASGOW_HASKELL__ >= 902
conP con args = inheritLocPat con (conPat con (PrefixCon [] args))
#else
conP :: LRdrName -> [LPat GhcPs] -> LPat GhcPs
conP LRdrName
con [LPat GhcPs]
args = LRdrName -> Pat GhcPs -> LPat GhcPs
forall a (p :: Pass).
InheritLoc a =>
a -> Pat (GhcPass p) -> LPat (GhcPass p)
inheritLocPat LRdrName
con (LRdrName -> HsConPatDetails GhcPs -> Pat GhcPs
conPat LRdrName
con ([Located (Pat GhcPs)]
-> HsConDetails
     (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon [LPat GhcPs]
[Located (Pat GhcPs)]
args))
#endif

-- | Equivalent of 'Language.Haskell.TH.Lib.bangP'
bangP :: LPat GhcPs -> LPat GhcPs
bangP :: LPat GhcPs -> LPat GhcPs
bangP LPat GhcPs
p = Located (Pat GhcPs) -> Pat GhcPs -> LPat GhcPs
forall a (p :: Pass).
InheritLoc a =>
a -> Pat (GhcPass p) -> LPat (GhcPass p)
inheritLocPat LPat GhcPs
Located (Pat GhcPs)
p (Pat GhcPs -> LPat GhcPs) -> Pat GhcPs -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ XBangPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XBangPat p -> LPat p -> Pat p
BangPat XBangPat GhcPs
forall a. HasDefaultExt a => a
defExt LPat GhcPs
p

-- | Equivalent of 'Language.Haskell.TH.Lib.listP'
listP :: [LPat GhcPs] -> LPat GhcPs
listP :: [LPat GhcPs] -> LPat GhcPs
listP [LPat GhcPs]
xs = [Located (Pat GhcPs)] -> Pat GhcPs -> LPat GhcPs
forall a (p :: Pass).
InheritLoc a =>
a -> Pat (GhcPass p) -> LPat (GhcPass p)
inheritLocPat [LPat GhcPs]
[Located (Pat GhcPs)]
xs (Pat GhcPs -> LPat GhcPs) -> Pat GhcPs -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ XListPat GhcPs -> [LPat GhcPs] -> Pat GhcPs
forall p. XListPat p -> [LPat p] -> Pat p
ListPat XListPat GhcPs
forall a. HasDefaultExt a => a
defExt [LPat GhcPs]
xs

-- | Equivalent of 'Language.Haskell.TH.Lib.wildP'
wildP :: LPat GhcPs
wildP :: LPat GhcPs
wildP = SrcSpan -> Pat GhcPs -> LPat GhcPs
forall a (p :: Pass).
InheritLoc a =>
a -> Pat (GhcPass p) -> LPat (GhcPass p)
inheritLocPat SrcSpan
noSrcSpan (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcPs
forall a. HasDefaultExt a => a
defExt)

{-------------------------------------------------------------------------------
  Strictness
-------------------------------------------------------------------------------}

-- | Approximate equivalent of 'Language.Haskell.TH.Lib.bangType'
--
-- The GHC API has no equivalent of 'Language.Haskell.TH.Syntax.BangType'.
bangType :: LHsType GhcPs -> LHsType GhcPs
bangType :: LHsType GhcPs -> LHsType GhcPs
bangType LHsType GhcPs
t = LHsType GhcPs -> HsType GhcPs -> LHsType GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsType GhcPs
t (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$
    XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy XBangTy GhcPs
forall a. HasDefaultExt a => a
defExt (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
SrcStrict) LHsType GhcPs
t

{-------------------------------------------------------------------------------
  Class contexts
-------------------------------------------------------------------------------}

-- | Equivalent of 'Language.Haskell.TH.Lib.equalP'
equalP :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
equalP :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
equalP LHsType GhcPs
x LHsType GhcPs
y = LHsType GhcPs -> HsType GhcPs -> LHsType GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsType GhcPs
x (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs
-> Located (IdP GhcPs) -> LHsType GhcPs -> HsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p)
-> Located (IdP (GhcPass p))
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
mkHsOpTy LHsType GhcPs
x (LHsType GhcPs -> RdrName -> LRdrName
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsType GhcPs
x RdrName
eqTyCon_RDR) LHsType GhcPs
y

{-------------------------------------------------------------------------------
  Constructors
-------------------------------------------------------------------------------}

-- | Equivalent of 'Language.Haskell.TH.Lib.rec'
--
-- NOTE: The GHC AST (but not TH) supports declaring multiple record fields
-- with the same type. We do not support this here (since we follow TH).
recC :: LRdrName -> [(LRdrName, LHsType GhcPs)] -> LConDecl GhcPs
recC :: LRdrName -> [(LRdrName, LHsType GhcPs)] -> LConDecl GhcPs
recC = [LRdrName]
-> [LHsType GhcPs]
-> LRdrName
-> [(LRdrName, LHsType GhcPs)]
-> LConDecl GhcPs
forallRecC [] []

-- | Inverse to 'recC'
viewRecC :: LConDecl GhcPs -> Maybe (LRdrName, [(LRdrName, LHsType GhcPs)])
viewRecC :: LConDecl GhcPs -> Maybe (LRdrName, [(LRdrName, LHsType GhcPs)])
viewRecC
    (L SrcSpan
_
       ConDeclH98 {
           con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_name   = Located (IdP GhcPs)
conName
#if __GLASGOW_HASKELL__ >= 902
         , con_forall = False
#else
         , con_forall :: forall pass. ConDecl pass -> Located Bool
con_forall = L SrcSpan
_ Bool
False
#endif
         , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_ex_tvs = []
         , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcPs)
Nothing
         , con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_args   = RecCon (L SrcSpan
_ [LConDeclField GhcPs]
fields)
         }
    ) = (LRdrName -> LRdrName
forall a. Located a -> Located a
reLoc Located (IdP GhcPs)
LRdrName
conName ,) ([(LRdrName, LHsType GhcPs)]
 -> (LRdrName, [(LRdrName, LHsType GhcPs)]))
-> Maybe [(LRdrName, LHsType GhcPs)]
-> Maybe (LRdrName, [(LRdrName, LHsType GhcPs)])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (LConDeclField GhcPs -> Maybe (LRdrName, LHsType GhcPs))
-> [LConDeclField GhcPs] -> Maybe [(LRdrName, LHsType GhcPs)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LConDeclField GhcPs -> Maybe (LRdrName, LHsType GhcPs)
viewRecField [LConDeclField GhcPs]
fields
  where
    viewRecField :: LConDeclField GhcPs -> Maybe (LRdrName, LHsType GhcPs)
    viewRecField :: LConDeclField GhcPs -> Maybe (LRdrName, LHsType GhcPs)
viewRecField
        (L SrcSpan
_
           ConDeclField {
               cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names = [L SrcSpan
_ FieldOcc GhcPs
fieldName]
             , cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_type  = LHsType GhcPs
ty
             }
        ) = (LRdrName, LHsType GhcPs) -> Maybe (LRdrName, LHsType GhcPs)
forall a. a -> Maybe a
Just ((LRdrName, LHsType GhcPs) -> Maybe (LRdrName, LHsType GhcPs))
-> (LRdrName, LHsType GhcPs) -> Maybe (LRdrName, LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ (FieldOcc GhcPs -> LRdrName
viewFieldOcc FieldOcc GhcPs
fieldName, LHsType GhcPs
ty)
    viewRecField LConDeclField GhcPs
_otherwise = Maybe (LRdrName, LHsType GhcPs)
forall a. Maybe a
Nothing

    viewFieldOcc :: FieldOcc GhcPs -> LRdrName
    viewFieldOcc :: FieldOcc GhcPs -> LRdrName
viewFieldOcc (FieldOcc XCFieldOcc GhcPs
_ (LRdrName -> LRdrName
forall a. Located a -> Located a
reLoc -> LRdrName
name)) = LRdrName
name
#if __GLASGOW_HASKELL__ < 900
    viewFieldOcc FieldOcc GhcPs
_ = String -> LRdrName
forall a. String -> a
panic String
"viewFieldOcc"
#endif
viewRecC LConDecl GhcPs
_otherwise = Maybe (LRdrName, [(LRdrName, LHsType GhcPs)])
forall a. Maybe a
Nothing

pattern RecC :: LRdrName -> [(LRdrName, LHsType GhcPs)] -> LConDecl GhcPs
pattern $bRecC :: LRdrName -> [(LRdrName, LHsType GhcPs)] -> LConDecl GhcPs
$mRecC :: forall r.
LConDecl GhcPs
-> (LRdrName -> [(LRdrName, LHsType GhcPs)] -> r)
-> (Void# -> r)
-> r
RecC conName args <- (viewRecC -> Just (conName, args))
  where
    RecC = LRdrName -> [(LRdrName, LHsType GhcPs)] -> LConDecl GhcPs
recC

-- | Equivalent of the combination of 'Language.Haskell.TH.Lib.forallC' and
-- 'Language.Haskell.TH.Lib.recC'.
forallRecC ::
     [LRdrName]                  -- ^ @forallC@ argument: bound type variables
  -> [LHsType GhcPs]             -- ^ @forallC@ argument: context
  -> LRdrName                    -- ^ @recC@ argument: record constructor name
  -> [(LRdrName, LHsType GhcPs)] -- ^ @recC@ argument: record fields
  -> LConDecl GhcPs
forallRecC :: [LRdrName]
-> [LHsType GhcPs]
-> LRdrName
-> [(LRdrName, LHsType GhcPs)]
-> LConDecl GhcPs
forallRecC [LRdrName]
vars [LHsType GhcPs]
ctxt LRdrName
conName [(LRdrName, LHsType GhcPs)]
args = LRdrName -> ConDecl GhcPs -> LConDecl GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
conName (ConDecl GhcPs -> LConDecl GhcPs)
-> ConDecl GhcPs -> LConDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ConDeclH98 :: forall pass.
XConDeclH98 pass
-> Located (IdP pass)
-> Located Bool
-> [LHsTyVarBndr pass]
-> Maybe (LHsContext pass)
-> HsConDeclDetails pass
-> Maybe LHsDocString
-> ConDecl pass
ConDeclH98 {
      con_ext :: XConDeclH98 GhcPs
con_ext    = XConDeclH98 GhcPs
forall a. HasDefaultExt a => a
defExt
    , con_name :: Located (IdP GhcPs)
con_name   = LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
conName
    , con_forall :: Located Bool
con_forall = LRdrName -> Bool -> Located Bool
forall a b. InheritLoc a => a -> b -> Located b
inheritLoc' LRdrName
conName Bool
True
    , con_ex_tvs :: [LHsTyVarBndr GhcPs]
con_ex_tvs = (LRdrName -> LHsTyVarBndr GhcPs)
-> [LRdrName] -> [LHsTyVarBndr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (LHsTyVarBndr GhcPs -> LHsTyVarBndr GhcPs
forall pass. LHsTyVarBndr pass -> LHsTyVarBndr pass
setDefaultSpecificity (LHsTyVarBndr GhcPs -> LHsTyVarBndr GhcPs)
-> (LRdrName -> LHsTyVarBndr GhcPs)
-> LRdrName
-> LHsTyVarBndr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRdrName -> LHsTyVarBndr GhcPs
mkBndr) [LRdrName]
vars
    , con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt = LHsContext GhcPs -> Maybe (LHsContext GhcPs)
forall a. a -> Maybe a
Just (LRdrName -> [LHsType GhcPs] -> LHsContext GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
conName [LHsType GhcPs]
ctxt)
    , con_args :: HsConDetails (LHsType GhcPs) (Located [LConDeclField GhcPs])
con_args   = Located [LConDeclField GhcPs]
-> HsConDetails (LHsType GhcPs) (Located [LConDeclField GhcPs])
forall arg rec. rec -> HsConDetails arg rec
RecCon (LRdrName -> [LConDeclField GhcPs] -> Located [LConDeclField GhcPs]
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
conName ([LConDeclField GhcPs] -> Located [LConDeclField GhcPs])
-> [LConDeclField GhcPs] -> Located [LConDeclField GhcPs]
forall a b. (a -> b) -> a -> b
$ ((LRdrName, LHsType GhcPs) -> LConDeclField GhcPs)
-> [(LRdrName, LHsType GhcPs)] -> [LConDeclField GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map ((LRdrName -> LHsType GhcPs -> LConDeclField GhcPs)
-> (LRdrName, LHsType GhcPs) -> LConDeclField GhcPs
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LRdrName -> LHsType GhcPs -> LConDeclField GhcPs
mkRecField) [(LRdrName, LHsType GhcPs)]
args)
    , con_doc :: Maybe LHsDocString
con_doc    = Maybe LHsDocString
forall a. Maybe a
Nothing
    }
  where
    mkBndr :: LRdrName -> LHsTyVarBndr GhcPs
    mkBndr :: LRdrName -> LHsTyVarBndr GhcPs
mkBndr LRdrName
name = LRdrName -> HsTyVarBndr GhcPs -> LHsTyVarBndr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (HsTyVarBndr GhcPs -> LHsTyVarBndr GhcPs)
-> HsTyVarBndr GhcPs -> LHsTyVarBndr GhcPs
forall a b. (a -> b) -> a -> b
$ XUserTyVar GhcPs -> Located (IdP GhcPs) -> HsTyVarBndr GhcPs
userTyVar XUserTyVar GhcPs
forall a. HasDefaultExt a => a
defExt Located (IdP GhcPs)
LRdrName
name

    mkRecField :: LRdrName -> LHsType GhcPs -> LConDeclField GhcPs
    mkRecField :: LRdrName -> LHsType GhcPs -> LConDeclField GhcPs
mkRecField LRdrName
name LHsType GhcPs
ty = LRdrName -> ConDeclField GhcPs -> LConDeclField GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (ConDeclField GhcPs -> LConDeclField GhcPs)
-> ConDeclField GhcPs -> LConDeclField GhcPs
forall a b. (a -> b) -> a -> b
$ ConDeclField :: forall pass.
XConDeclField pass
-> [LFieldOcc pass]
-> LBangType pass
-> Maybe LHsDocString
-> ConDeclField pass
ConDeclField {
          cd_fld_ext :: XConDeclField GhcPs
cd_fld_ext   = XConDeclField GhcPs
forall a. HasDefaultExt a => a
defExt
        , cd_fld_names :: [Located (FieldOcc GhcPs)]
cd_fld_names = [LRdrName -> FieldOcc GhcPs -> Located (FieldOcc GhcPs)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (FieldOcc GhcPs -> Located (FieldOcc GhcPs))
-> FieldOcc GhcPs -> Located (FieldOcc GhcPs)
forall a b. (a -> b) -> a -> b
$ LRdrName -> FieldOcc GhcPs
mkFieldOcc (LRdrName -> FieldOcc GhcPs) -> LRdrName -> FieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name]
        , cd_fld_type :: LHsType GhcPs
cd_fld_type  = LHsType GhcPs
ty
        , cd_fld_doc :: Maybe LHsDocString
cd_fld_doc   = Maybe LHsDocString
forall a. Maybe a
Nothing
        }

{-------------------------------------------------------------------------------
  Type variable binders
-------------------------------------------------------------------------------}

-- | Equivalent of 'Language.Haskell.TH.Lib.kindedTV'
kindedTV :: LRdrName -> LHsType GhcPs -> LHsTyVarBndr GhcPs
kindedTV :: LRdrName -> LHsType GhcPs -> LHsTyVarBndr GhcPs
kindedTV LRdrName
name LHsType GhcPs
ty = LRdrName -> HsTyVarBndr GhcPs -> LHsTyVarBndr GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (XKindedTyVar GhcPs
-> Located (IdP GhcPs) -> LHsType GhcPs -> HsTyVarBndr GhcPs
kindedTyVar XKindedTyVar GhcPs
forall a. HasDefaultExt a => a
defExt Located (IdP GhcPs)
LRdrName
name LHsType GhcPs
ty)

{-------------------------------------------------------------------------------
  .. without direct equivalent
-------------------------------------------------------------------------------}

tyVarBndrName :: LHsTyVarBndr GhcPs -> LRdrName
tyVarBndrName :: LHsTyVarBndr GhcPs -> LRdrName
tyVarBndrName = HsTyVarBndr GhcPs -> LRdrName
hsTyVarLName (HsTyVarBndr GhcPs -> LRdrName)
-> (LHsTyVarBndr GhcPs -> HsTyVarBndr GhcPs)
-> LHsTyVarBndr GhcPs
-> LRdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr GhcPs -> HsTyVarBndr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc

{-------------------------------------------------------------------------------
  Top-level declarations
-------------------------------------------------------------------------------}

-- | Equivalent of 'Language.Haskell.TH.Lib.sigD'
sigD :: LRdrName -> LHsType GhcPs -> LHsDecl GhcPs
sigD :: LRdrName -> LHsType GhcPs -> LHsDecl GhcPs
sigD LRdrName
name LHsType GhcPs
ty = LRdrName -> HsDecl GhcPs -> LHsDecl GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
forall a. HasDefaultExt a => a
defExt Sig GhcPs
sig
  where
    sig :: Sig GhcPs
    sig :: Sig GhcPs
sig = XTypeSig GhcPs
-> [Located (IdP GhcPs)]
-> HsWildCardBndrs GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
-> Sig GhcPs
forall pass.
XTypeSig pass
-> [Located (IdP pass)] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
forall a. HasDefaultExt a => a
defExt [LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name] (HsWildCardBndrs GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
 -> Sig GhcPs)
-> HsWildCardBndrs GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
-> Sig GhcPs
forall a b. (a -> b) -> a -> b
$ 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 XHsWC GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
forall a. HasDefaultExt a => a
defExt (LHsType GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs)
forall a. a -> HsImplicitBndrs GhcPs a
implicitBndrs LHsType GhcPs
ty)

-- | Equivalent of 'Language.Haskell.TH.Lib.valD'
--
-- Currently this offers a simplified API only.
valD :: LRdrName -> LHsExpr GhcPs -> LHsDecl GhcPs
valD :: LRdrName -> LHsExpr GhcPs -> LHsDecl GhcPs
valD LRdrName
fnName LHsExpr GhcPs
body = LRdrName -> HsDecl GhcPs -> LHsDecl GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
fnName (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
    XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
forall a. HasDefaultExt a => a
defExt (LHsBind GhcPs -> SrcSpanLess (LHsBind GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LRdrName -> LHsExpr GhcPs -> LHsBind GhcPs
simpleBinding LRdrName
fnName LHsExpr GhcPs
body))

-- | Equivalent of 'Language.Haskell.TH.Lib.dataD'
dataD ::
     LRdrName                  -- ^ Datatype name
  -> [LHsTyVarBndr GhcPs]      -- ^ Type arguments
  -> [LConDecl GhcPs]          -- ^ Constructors
  -> [LHsDerivingClause GhcPs] -- ^ Deriving clauses
  -> LHsDecl GhcPs
dataD :: LRdrName
-> [LHsTyVarBndr GhcPs]
-> [LConDecl GhcPs]
-> [LHsDerivingClause GhcPs]
-> LHsDecl GhcPs
dataD LRdrName
typeName [LHsTyVarBndr GhcPs]
tyVars [LConDecl GhcPs]
cons [LHsDerivingClause GhcPs]
derivs = LRdrName -> HsDecl GhcPs -> LHsDecl GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
typeName (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
    XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
forall a. HasDefaultExt a => a
defExt (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ DataDecl :: forall pass.
XDataDecl pass
-> Located (IdP pass)
-> LHsQTyVars pass
-> LexicalFixity
-> HsDataDefn pass
-> TyClDecl pass
DataDecl {
        tcdDExt :: XDataDecl GhcPs
tcdDExt     = XDataDecl GhcPs
forall a. HasDefaultExt a => a
defExt
      , tcdLName :: Located (IdP GhcPs)
tcdLName    = LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
typeName
      , tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars   = [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs
mkHsQTvs [LHsTyVarBndr GhcPs]
tyVars
      , tcdFixity :: LexicalFixity
tcdFixity   = LexicalFixity
Prefix
      , tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn = HsDataDefn :: forall pass.
XCHsDataDefn pass
-> NewOrData
-> LHsContext pass
-> Maybe (Located CType)
-> Maybe (LHsKind pass)
-> [LConDecl pass]
-> HsDeriving pass
-> HsDataDefn pass
HsDataDefn {
            dd_ext :: XCHsDataDefn GhcPs
dd_ext     = XCHsDataDefn GhcPs
forall a. HasDefaultExt a => a
defExt
          , dd_ND :: NewOrData
dd_ND      = NewOrData
DataType
#if __GLASGOW_HASKELL__ >= 902
          , dd_ctxt    = Nothing
#else
          , dd_ctxt :: LHsContext GhcPs
dd_ctxt    = LRdrName -> [LHsType GhcPs] -> LHsContext GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
typeName []
#endif
          , dd_cType :: Maybe (Located CType)
dd_cType   = Maybe (Located CType)
forall a. Maybe a
Nothing
          , dd_kindSig :: Maybe (LHsType GhcPs)
dd_kindSig = Maybe (LHsType GhcPs)
forall a. Maybe a
Nothing
          , dd_cons :: [LConDecl GhcPs]
dd_cons    = [LConDecl GhcPs]
cons
          , dd_derivs :: HsDeriving GhcPs
dd_derivs  = LRdrName -> [LHsDerivingClause GhcPs] -> HsDeriving GhcPs
forall a b. InheritLoc a => a -> b -> Located b
inheritLoc' LRdrName
typeName [LHsDerivingClause GhcPs]
derivs
          }
      }

-- | Inverse to 'dataD'
viewDataD ::
     LHsDecl GhcPs
  -> Maybe (
         LRdrName
       , [LHsTyVarBndr GhcPs]
       , [LConDecl GhcPs]
       , [LHsDerivingClause GhcPs]
       )
viewDataD :: LHsDecl GhcPs
-> Maybe
     (LRdrName, [LHsTyVarBndr GhcPs], [LConDecl GhcPs],
      [LHsDerivingClause GhcPs])
viewDataD
    (L SrcSpan
_
       (TyClD
         XTyClD GhcPs
_
         DataDecl {
             tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName    = Located (IdP GhcPs)
typeName
           , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars   = HsQTvs {hsq_explicit :: forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsq_explicit = [LHsTyVarBndr GhcPs]
tyVars}
           , tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity   = LexicalFixity
Prefix
           , tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn {
                   dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ND      = NewOrData
DataType
#if __GLASGOW_HASKELL__ >= 902
                 , dd_ctxt    = Nothing
#else
                 , dd_ctxt :: forall pass. HsDataDefn pass -> LHsContext pass
dd_ctxt    = L SrcSpan
_ []
#endif
                 , dd_cType :: forall pass. HsDataDefn pass -> Maybe (Located CType)
dd_cType   = Maybe (Located CType)
Nothing
                 , dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (LHsType GhcPs)
Nothing
                 , dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons    = [LConDecl GhcPs]
cons
#if __GLASGOW_HASKELL__ >= 902
                 , dd_derivs  = derivs
#else
                 , dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs  = L SrcSpan
_ [LHsDerivingClause GhcPs]
derivs
#endif
                 }
           }
       )
    ) = (LRdrName, [LHsTyVarBndr GhcPs], [LConDecl GhcPs],
 [LHsDerivingClause GhcPs])
-> Maybe
     (LRdrName, [LHsTyVarBndr GhcPs], [LConDecl GhcPs],
      [LHsDerivingClause GhcPs])
forall a. a -> Maybe a
Just (LRdrName -> LRdrName
forall a. Located a -> Located a
reLoc Located (IdP GhcPs)
LRdrName
typeName, [LHsTyVarBndr GhcPs]
tyVars, [LConDecl GhcPs]
cons, [LHsDerivingClause GhcPs]
derivs)
viewDataD LHsDecl GhcPs
_otherwise = Maybe
  (LRdrName, [LHsTyVarBndr GhcPs], [LConDecl GhcPs],
   [LHsDerivingClause GhcPs])
forall a. Maybe a
Nothing

pattern DataD ::
     LRdrName
  -> [LHsTyVarBndr GhcPs]
  -> [LConDecl GhcPs]
  -> [LHsDerivingClause GhcPs]
  -> LHsDecl GhcPs
pattern $bDataD :: LRdrName
-> [LHsTyVarBndr GhcPs]
-> [LConDecl GhcPs]
-> [LHsDerivingClause GhcPs]
-> LHsDecl GhcPs
$mDataD :: forall r.
LHsDecl GhcPs
-> (LRdrName
    -> [LHsTyVarBndr GhcPs]
    -> [LConDecl GhcPs]
    -> [LHsDerivingClause GhcPs]
    -> r)
-> (Void# -> r)
-> r
DataD typeName tyVars cons derivs <-
          (viewDataD -> Just (typeName, tyVars, cons, derivs))
  where
    DataD = LRdrName
-> [LHsTyVarBndr GhcPs]
-> [LConDecl GhcPs]
-> [LHsDerivingClause GhcPs]
-> LHsDecl GhcPs
dataD

-- | Equivalent of 'Language.Haskell.TH.derivClaus'
derivClause ::
     Maybe (LDerivStrategy GhcPs)
  -> NonEmpty (LHsType GhcPs)
  -> LHsDerivingClause GhcPs
derivClause :: Maybe (LDerivStrategy GhcPs)
-> NonEmpty (LHsType GhcPs) -> LHsDerivingClause GhcPs
derivClause Maybe (LDerivStrategy GhcPs)
strat NonEmpty (LHsType GhcPs)
tys = NonEmpty (LHsType GhcPs)
-> HsDerivingClause GhcPs -> LHsDerivingClause GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc NonEmpty (LHsType GhcPs)
tys (HsDerivingClause GhcPs -> LHsDerivingClause GhcPs)
-> HsDerivingClause GhcPs -> LHsDerivingClause GhcPs
forall a b. (a -> b) -> a -> b
$
    XCHsDerivingClause GhcPs
-> Maybe (LDerivStrategy GhcPs)
-> Located [HsImplicitBndrs GhcPs (LHsType GhcPs)]
-> HsDerivingClause GhcPs
forall pass.
XCHsDerivingClause pass
-> Maybe (LDerivStrategy pass)
-> Located [LHsSigType pass]
-> HsDerivingClause pass
HsDerivingClause XCHsDerivingClause GhcPs
forall a. HasDefaultExt a => a
defExt Maybe (LDerivStrategy GhcPs)
strat (Located [HsImplicitBndrs GhcPs (LHsType GhcPs)]
 -> HsDerivingClause GhcPs)
-> Located [HsImplicitBndrs GhcPs (LHsType GhcPs)]
-> HsDerivingClause GhcPs
forall a b. (a -> b) -> a -> b
$ NonEmpty (LHsType GhcPs)
-> [HsImplicitBndrs GhcPs (LHsType GhcPs)]
-> Located [HsImplicitBndrs GhcPs (LHsType GhcPs)]
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc NonEmpty (LHsType GhcPs)
tys ([HsImplicitBndrs GhcPs (LHsType GhcPs)]
 -> Located [HsImplicitBndrs GhcPs (LHsType GhcPs)])
-> [HsImplicitBndrs GhcPs (LHsType GhcPs)]
-> Located [HsImplicitBndrs GhcPs (LHsType GhcPs)]
forall a b. (a -> b) -> a -> b
$
#if __GLASGOW_HASKELL__ >= 902
      DctMulti defExt $
#endif
      (LHsType GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs))
-> [LHsType GhcPs] -> [HsImplicitBndrs GhcPs (LHsType GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LHsType GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs)
forall a. a -> HsImplicitBndrs GhcPs a
implicitBndrs (NonEmpty (LHsType GhcPs) -> [LHsType GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsType GhcPs)
tys)

-- | Inverse of 'derivClause'
viewDerivClause ::
     LHsDerivingClause GhcPs
  -> (Maybe (LDerivStrategy GhcPs), [LHsType GhcPs])
#if __GLASGOW_HASKELL__ >= 902
viewDerivClause (L _ (HsDerivingClause _ mStrat (L _ (DctMulti _ tys)))) =
    (mStrat, map viewImplicitBndrs tys)
viewDerivClause (L _ (HsDerivingClause _ mStrat (L _ (DctSingle _ ty)))) =
    (mStrat, map viewImplicitBndrs [ty])
#else
viewDerivClause :: LHsDerivingClause GhcPs
-> (Maybe (LDerivStrategy GhcPs), [LHsType GhcPs])
viewDerivClause (L SrcSpan
_ (HsDerivingClause XCHsDerivingClause GhcPs
_ Maybe (LDerivStrategy GhcPs)
mStrat (L SrcSpan
_ [HsImplicitBndrs GhcPs (LHsType GhcPs)]
tys))) =
    (Maybe (LDerivStrategy GhcPs)
mStrat, (HsImplicitBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs)
-> [HsImplicitBndrs GhcPs (LHsType GhcPs)] -> [LHsType GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map HsImplicitBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs
forall a. HsImplicitBndrs GhcPs a -> a
viewImplicitBndrs [HsImplicitBndrs GhcPs (LHsType GhcPs)]
tys)
#endif
#if __GLASGOW_HASKELL__ < 900
viewDerivClause LHsDerivingClause GhcPs
_ = String -> (Maybe (LDerivStrategy GhcPs), [LHsType GhcPs])
forall a. String -> a
panic String
"viewDerivClause"
#endif

pattern DerivClause ::
     Maybe (LDerivStrategy GhcPs)
  -> NonEmpty (LHsType GhcPs)
  -> LHsDerivingClause GhcPs
pattern $bDerivClause :: Maybe (LDerivStrategy GhcPs)
-> NonEmpty (LHsType GhcPs) -> LHsDerivingClause GhcPs
$mDerivClause :: forall r.
LHsDerivingClause GhcPs
-> (Maybe (LDerivStrategy GhcPs) -> NonEmpty (LHsType GhcPs) -> r)
-> (Void# -> r)
-> r
DerivClause strat tys <-
          (viewDerivClause -> (strat, NE.nonEmpty -> Just tys))
  where
    DerivClause = Maybe (LDerivStrategy GhcPs)
-> NonEmpty (LHsType GhcPs) -> LHsDerivingClause GhcPs
derivClause

-- | Equivalent of 'Language.Haskell.TH.Lib.instanceD'
--
-- Unlike in TH, the regular bindings and associated types are separate args.
instanceD ::
     [LHsType GhcPs]            -- ^ Context
  -> LHsType GhcPs              -- ^ Head
  -> [(LRdrName, LHsExpr GhcPs)] -- ^ Bindings
  -> [LTyFamInstDecl GhcPs]     -- ^ Associated types
  -> LHsDecl GhcPs
instanceD :: [LHsType GhcPs]
-> LHsType GhcPs
-> [(LRdrName, LHsExpr GhcPs)]
-> [LTyFamInstDecl GhcPs]
-> LHsDecl GhcPs
instanceD [LHsType GhcPs]
ctxt LHsType GhcPs
hd [(LRdrName, LHsExpr GhcPs)]
binds [LTyFamInstDecl GhcPs]
assocTypes = LHsType GhcPs -> HsDecl GhcPs -> LHsDecl GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsType GhcPs
hd (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
    XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD GhcPs
forall a. HasDefaultExt a => a
defExt (InstDecl GhcPs -> HsDecl GhcPs) -> InstDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XClsInstD GhcPs -> ClsInstDecl GhcPs -> InstDecl GhcPs
forall pass. XClsInstD pass -> ClsInstDecl pass -> InstDecl pass
ClsInstD XClsInstD GhcPs
forall a. HasDefaultExt a => a
defExt (ClsInstDecl GhcPs -> InstDecl GhcPs)
-> ClsInstDecl GhcPs -> InstDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ClsInstDecl :: forall pass.
XCClsInstDecl pass
-> LHsSigType pass
-> LHsBinds pass
-> [LSig pass]
-> [LTyFamInstDecl pass]
-> [LDataFamInstDecl pass]
-> Maybe (Located OverlapMode)
-> ClsInstDecl pass
ClsInstDecl {
        cid_ext :: XCClsInstDecl GhcPs
cid_ext           = XCClsInstDecl GhcPs
forall a. HasDefaultExt a => a
defExt
      , cid_poly_ty :: HsImplicitBndrs GhcPs (LHsType GhcPs)
cid_poly_ty       = LHsType GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs)
forall a. a -> HsImplicitBndrs GhcPs a
implicitBndrs ([LHsType GhcPs] -> LHsType GhcPs -> LHsType GhcPs
qualT [LHsType GhcPs]
ctxt LHsType GhcPs
hd)
      , cid_binds :: LHsBinds GhcPs
cid_binds         = [LHsBind GhcPs] -> LHsBinds GhcPs
forall a. [a] -> Bag a
listToBag ([LHsBind GhcPs] -> LHsBinds GhcPs)
-> [LHsBind GhcPs] -> LHsBinds GhcPs
forall a b. (a -> b) -> a -> b
$ ((LRdrName, LHsExpr GhcPs) -> LHsBind GhcPs)
-> [(LRdrName, LHsExpr GhcPs)] -> [LHsBind GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map ((LRdrName -> LHsExpr GhcPs -> LHsBind GhcPs)
-> (LRdrName, LHsExpr GhcPs) -> LHsBind GhcPs
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LRdrName -> LHsExpr GhcPs -> LHsBind GhcPs
simpleBinding) [(LRdrName, LHsExpr GhcPs)]
binds
      , cid_sigs :: [LSig GhcPs]
cid_sigs          = []
      , cid_tyfam_insts :: [LTyFamInstDecl GhcPs]
cid_tyfam_insts   = [LTyFamInstDecl GhcPs]
assocTypes
      , cid_datafam_insts :: [LDataFamInstDecl GhcPs]
cid_datafam_insts = []
      , cid_overlap_mode :: Maybe (Located OverlapMode)
cid_overlap_mode  = Maybe (Located OverlapMode)
forall a. Maybe a
Nothing
      }
  where
    qualT :: [LHsType GhcPs] -> LHsType GhcPs -> LHsType GhcPs
    qualT :: [LHsType GhcPs] -> LHsType GhcPs -> LHsType GhcPs
qualT []        LHsType GhcPs
a = LHsType GhcPs
a
    qualT ctx :: [LHsType GhcPs]
ctx@(LHsType GhcPs
c:[LHsType GhcPs]
_) LHsType GhcPs
a = LHsType GhcPs -> HsType GhcPs -> LHsType GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsType GhcPs
c (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XQualTy GhcPs -> LHsContext GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy XQualTy GhcPs
forall a. HasDefaultExt a => a
defExt
#if __GLASGOW_HASKELL__ >= 902
        (Just (inheritLoc c ctx))
#else
        (LHsType GhcPs -> [LHsType GhcPs] -> LHsContext GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsType GhcPs
c [LHsType GhcPs]
ctx)
#endif
        LHsType GhcPs
a

-- | Equivalent of 'Language.Haskell.TH.Lib.classD'
classD ::
     [LHsType GhcPs]            -- ^ Class context
  -> LRdrName                    -- ^ Class name
  -> [LHsTyVarBndr GhcPs]       -- ^ Type variables
  -> [(LRdrName, LHsType GhcPs)] -- ^ Method signatures
  -> LHsDecl GhcPs
classD :: [LHsType GhcPs]
-> LRdrName
-> [LHsTyVarBndr GhcPs]
-> [(LRdrName, LHsType GhcPs)]
-> LHsDecl GhcPs
classD = \[LHsType GhcPs]
ctx LRdrName
name [LHsTyVarBndr GhcPs]
clsVars [(LRdrName, LHsType GhcPs)]
sigs -> LRdrName -> HsDecl GhcPs -> LHsDecl GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
    XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
forall a. HasDefaultExt a => a
defExt (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ClassDecl :: forall pass.
XClassDecl pass
-> LHsContext pass
-> Located (IdP pass)
-> LHsQTyVars pass
-> LexicalFixity
-> [LHsFunDep pass]
-> [LSig pass]
-> LHsBinds pass
-> [LFamilyDecl pass]
-> [LTyFamDefltDecl pass]
-> [LDocDecl]
-> TyClDecl pass
ClassDecl {
        tcdCExt :: XClassDecl GhcPs
tcdCExt   = XClassDecl GhcPs
forall a. HasDefaultExt a => a
defExt
#if __GLASGOW_HASKELL__ >= 902
      , tcdCtxt   = Just (inheritLoc name ctx)
#else
      , tcdCtxt :: LHsContext GhcPs
tcdCtxt   = LRdrName -> [LHsType GhcPs] -> LHsContext GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name [LHsType GhcPs]
ctx
#endif
      , tcdLName :: Located (IdP GhcPs)
tcdLName  = LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name
      , tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs
mkHsQTvs [LHsTyVarBndr GhcPs]
clsVars
      , tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
      , tcdFDs :: [LHsFunDep GhcPs]
tcdFDs    = []
      , tcdSigs :: [LSig GhcPs]
tcdSigs   = ((LRdrName, LHsType GhcPs) -> LSig GhcPs)
-> [(LRdrName, LHsType GhcPs)] -> [LSig GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map ((LRdrName -> LHsType GhcPs -> LSig GhcPs)
-> (LRdrName, LHsType GhcPs) -> LSig GhcPs
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LRdrName -> LHsType GhcPs -> LSig GhcPs
classOpSig) [(LRdrName, LHsType GhcPs)]
sigs
      , tcdMeths :: LHsBinds GhcPs
tcdMeths  = LHsBinds GhcPs
forall a. Bag a
emptyBag
      , tcdATs :: [LFamilyDecl GhcPs]
tcdATs    = []
      , tcdATDefs :: [LTyFamInstDecl GhcPs]
tcdATDefs = []
      , tcdDocs :: [LDocDecl]
tcdDocs   = []
      }
  where
    classOpSig :: LRdrName -> LHsType GhcPs -> LSig GhcPs
    classOpSig :: LRdrName -> LHsType GhcPs -> LSig GhcPs
classOpSig LRdrName
name LHsType GhcPs
ty = LRdrName -> Sig GhcPs -> LSig GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
name (Sig GhcPs -> LSig GhcPs) -> Sig GhcPs -> LSig GhcPs
forall a b. (a -> b) -> a -> b
$
        XClassOpSig GhcPs
-> Bool
-> [Located (IdP GhcPs)]
-> HsImplicitBndrs GhcPs (LHsType GhcPs)
-> Sig GhcPs
forall pass.
XClassOpSig pass
-> Bool -> [Located (IdP pass)] -> LHsSigType pass -> Sig pass
ClassOpSig XClassOpSig GhcPs
forall a. HasDefaultExt a => a
defExt Bool
False [LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name] (LHsType GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs)
forall a. a -> HsImplicitBndrs GhcPs a
implicitBndrs LHsType GhcPs
ty)

-- | Approximate equivalent of 'Language.Haskell.TH.Lib.tySynEqn'
tySynEqn ::
     LRdrName         -- ^ Type family name
  -> [LHsType GhcPs] -- ^ Equation LHS
  -> LHsType GhcPs   -- ^ Equation RHS
  -> LTyFamInstDecl GhcPs
tySynEqn :: LRdrName
-> [LHsType GhcPs] -> LHsType GhcPs -> LTyFamInstDecl GhcPs
tySynEqn LRdrName
name [LHsType GhcPs]
pats LHsType GhcPs
val = LHsType GhcPs -> TyFamInstDecl GhcPs -> LTyFamInstDecl GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsType GhcPs
val (TyFamInstDecl GhcPs -> LTyFamInstDecl GhcPs)
-> TyFamInstDecl GhcPs -> LTyFamInstDecl GhcPs
forall a b. (a -> b) -> a -> b
$
    TyFamInstEqn GhcPs -> TyFamInstDecl GhcPs
forall pass. TyFamInstEqn pass -> TyFamInstDecl pass
TyFamInstDecl
#if __GLASGOW_HASKELL__ >= 902
      defExt $
#else
      (TyFamInstEqn GhcPs -> TyFamInstDecl GhcPs)
-> TyFamInstEqn GhcPs -> TyFamInstDecl GhcPs
forall a b. (a -> b) -> a -> b
$ FamEqn GhcPs (LHsType GhcPs) -> TyFamInstEqn GhcPs
forall a. a -> HsImplicitBndrs GhcPs a
implicitBndrs (FamEqn GhcPs (LHsType GhcPs) -> TyFamInstEqn GhcPs)
-> FamEqn GhcPs (LHsType GhcPs) -> TyFamInstEqn GhcPs
forall a b. (a -> b) -> a -> b
$
#endif
        XCFamEqn GhcPs (LHsType GhcPs)
-> Located (IdP GhcPs)
-> Maybe [LHsTyVarBndr GhcPs]
-> HsTyPats GhcPs
-> LexicalFixity
-> LHsType GhcPs
-> FamEqn GhcPs (LHsType GhcPs)
forall pass rhs.
XCFamEqn pass rhs
-> Located (IdP pass)
-> Maybe [LHsTyVarBndr pass]
-> HsTyPats pass
-> LexicalFixity
-> rhs
-> FamEqn pass rhs
FamEqn XCFamEqn GhcPs (LHsType GhcPs)
forall a. HasDefaultExt a => a
defExt
               (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name)
#if __GLASGOW_HASKELL__ >= 902
               (HsOuterImplicit defExt)
#else
               Maybe [LHsTyVarBndr GhcPs]
forall a. Maybe a
Nothing
#endif
               ((LHsType GhcPs -> HsArg (LHsType GhcPs) (LHsType GhcPs))
-> [LHsType GhcPs] -> HsTyPats GhcPs
forall a b. (a -> b) -> [a] -> [b]
map LHsType GhcPs -> HsArg (LHsType GhcPs) (LHsType GhcPs)
forall tm ty. tm -> HsArg tm ty
HsValArg [LHsType GhcPs]
pats)
               LexicalFixity
Prefix
               LHsType GhcPs
val

{-------------------------------------------------------------------------------
  Pragmas

  NOTE: We work with 'LRdrName' everywhere, but 'AnnProvenance' /already/ wraps
  the @name@ type in @Located@.
-------------------------------------------------------------------------------}

type AnnProvenancePs = AnnProvenance
#if __GLASGOW_HASKELL__ >= 902
    GhcPs
#else
    RdrName
#endif

-- | Equivalent of 'Language.Haskell.TH.Lib.typeAnnotation'
typeAnnotation :: LRdrName -> AnnProvenancePs
typeAnnotation :: LRdrName -> AnnProvenancePs
typeAnnotation LRdrName
name = LRdrName -> AnnProvenancePs
forall name. Located name -> AnnProvenance name
TypeAnnProvenance (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
name)

-- | Inverse to 'typeAnnotation'
viewTypeAnnotation :: AnnProvenancePs -> Maybe LRdrName
viewTypeAnnotation :: AnnProvenancePs -> Maybe LRdrName
viewTypeAnnotation (TypeAnnProvenance LRdrName
name) = LRdrName -> Maybe LRdrName
forall a. a -> Maybe a
Just (LRdrName -> LRdrName
forall a. Located a -> Located a
reLoc LRdrName
name)
viewTypeAnnotation AnnProvenancePs
_otherwise               = Maybe LRdrName
forall a. Maybe a
Nothing

pattern TypeAnnotation :: LRdrName -> AnnProvenancePs
pattern $bTypeAnnotation :: LRdrName -> AnnProvenancePs
$mTypeAnnotation :: forall r. AnnProvenancePs -> (LRdrName -> r) -> (Void# -> r) -> r
TypeAnnotation name <- (viewTypeAnnotation -> Just name)
  where
    TypeAnnotation = LRdrName -> AnnProvenancePs
typeAnnotation

-- | Equivalent of 'Language.Haskell.TH.Lib.pragAnnD'
pragAnnD :: AnnProvenancePs -> LHsExpr GhcPs -> AnnDecl GhcPs
pragAnnD :: AnnProvenancePs -> LHsExpr GhcPs -> AnnDecl GhcPs
pragAnnD AnnProvenancePs
prov LHsExpr GhcPs
value =
    XHsAnnotation GhcPs
-> SourceText
-> AnnProvenance (IdP GhcPs)
-> LHsExpr GhcPs
-> AnnDecl GhcPs
forall pass.
XHsAnnotation pass
-> SourceText
-> AnnProvenance (IdP pass)
-> Located (HsExpr pass)
-> AnnDecl pass
HsAnnotation
      XHsAnnotation GhcPs
forall a. HasDefaultExt a => a
defExt
      SourceText
NoSourceText
      AnnProvenance (IdP GhcPs)
AnnProvenancePs
prov
      LHsExpr GhcPs
value

viewPragAnnD :: AnnDecl GhcPs -> (AnnProvenancePs, LHsExpr GhcPs)
viewPragAnnD :: AnnDecl GhcPs -> (AnnProvenancePs, LHsExpr GhcPs)
viewPragAnnD (HsAnnotation XHsAnnotation GhcPs
_ SourceText
_ AnnProvenance (IdP GhcPs)
prov LHsExpr GhcPs
value) = (AnnProvenance (IdP GhcPs)
AnnProvenancePs
prov, LHsExpr GhcPs
value)
#if __GLASGOW_HASKELL__ < 900
viewPragAnnD AnnDecl GhcPs
_ = String -> (AnnProvenancePs, LHsExpr GhcPs)
forall a. String -> a
panic String
"viewPragAnnD"
#endif

pattern PragAnnD :: AnnProvenancePs -> LHsExpr GhcPs -> AnnDecl GhcPs
pattern $bPragAnnD :: AnnProvenancePs -> LHsExpr GhcPs -> AnnDecl GhcPs
$mPragAnnD :: forall r.
AnnDecl GhcPs
-> (AnnProvenancePs -> LHsExpr GhcPs -> r) -> (Void# -> r) -> r
PragAnnD prov value <- (viewPragAnnD -> (prov, value))
  where
    PragAnnD = AnnProvenancePs -> LHsExpr GhcPs -> AnnDecl GhcPs
pragAnnD

{-------------------------------------------------------------------------------
  Internal auxiliary
-------------------------------------------------------------------------------}

#if __GLASGOW_HASKELL__ >= 902
implicitBndrs :: LHsType GhcPs -> LHsSigType GhcPs
implicitBndrs t = inheritLoc t (HsSig defExt (HsOuterImplicit defExt) t)

viewImplicitBndrs :: LHsSigType GhcPs -> LHsType GhcPs
viewImplicitBndrs (L _ (HsSig _ _ ty)) = ty

#else
implicitBndrs :: a -> HsImplicitBndrs GhcPs a
implicitBndrs :: a -> HsImplicitBndrs GhcPs a
implicitBndrs a
a = XHsIB GhcPs a -> a -> HsImplicitBndrs GhcPs a
forall pass thing.
XHsIB pass thing -> thing -> HsImplicitBndrs pass thing
HsIB XHsIB GhcPs a
forall a. HasDefaultExt a => a
defExt a
a

viewImplicitBndrs :: HsImplicitBndrs GhcPs a -> a
viewImplicitBndrs :: HsImplicitBndrs GhcPs a -> a
viewImplicitBndrs (HsIB XHsIB GhcPs a
_ a
a) = a
a
#if __GLASGOW_HASKELL__ < 900
viewImplicitBndrs HsImplicitBndrs GhcPs a
_ = String -> a
forall a. String -> a
panic String
"viewImplicitBndrs"
#endif
#endif

-- | Simple binding (without patterns)
simpleBinding :: LRdrName -> LHsExpr GhcPs -> LHsBind GhcPs
simpleBinding :: LRdrName -> LHsExpr GhcPs -> LHsBind GhcPs
simpleBinding LRdrName
fnName LHsExpr GhcPs
body = LRdrName -> HsBind GhcPs -> LHsBind GhcPs
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
fnName (HsBind GhcPs -> LHsBind GhcPs) -> HsBind GhcPs -> LHsBind GhcPs
forall a b. (a -> b) -> a -> b
$
    LRdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs
mkFunBind LRdrName
fnName [LMatch GhcPs (LHsExpr GhcPs)
match]
  where
    grhs :: GRHSs GhcPs (LHsExpr GhcPs)
    grhs :: GRHSs GhcPs (LHsExpr GhcPs)
grhs = LHsExpr GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)
simpleGHRSs LHsExpr GhcPs
body

    match :: LMatch GhcPs (LHsExpr GhcPs)
    match :: LMatch GhcPs (LHsExpr GhcPs)
match = LRdrName
-> Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LRdrName
fnName (Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs))
-> Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
        XCMatch GhcPs (LHsExpr GhcPs)
-> HsMatchContext (NameOrRdrName (IdP GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> Match GhcPs (LHsExpr GhcPs)
forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (LHsExpr GhcPs)
forall a. HasDefaultExt a => a
defExt
              (LRdrName
-> LexicalFixity -> SrcStrictness -> HsMatchContext RdrName
forall id.
Located id -> LexicalFixity -> SrcStrictness -> HsMatchContext id
FunRhs (LRdrName -> LRdrName
forall a. Located a -> Located a
reLocA LRdrName
fnName) LexicalFixity
Prefix SrcStrictness
NoSrcStrict)
              []
              GRHSs GhcPs (LHsExpr GhcPs)
grhs

-- | Simple guarded RHS (no guards)
simpleGHRSs :: LHsExpr GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)
simpleGHRSs :: LHsExpr GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)
simpleGHRSs LHsExpr GhcPs
body =
    XCGRHSs GhcPs (LHsExpr GhcPs)
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> LHsLocalBinds GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
forall a. HasDefaultExt a => a
defExt
          [LHsExpr GhcPs
-> GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
forall a l b.
(InheritLoc a, FromSrcSpan l) =>
a -> b -> GenLocated l b
inheritLoc LHsExpr GhcPs
body (GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs))
-> GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcPs (LHsExpr GhcPs)
-> [GuardLStmt GhcPs]
-> LHsExpr GhcPs
-> GRHS GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (LHsExpr GhcPs)
forall a. HasDefaultExt a => a
defExt [] LHsExpr GhcPs
body]
          (LHsExpr GhcPs -> HsLocalBindsLR GhcPs GhcPs -> LHsLocalBinds GhcPs
forall a b. InheritLoc a => a -> b -> Located b
inheritLoc' LHsExpr GhcPs
body (HsLocalBindsLR GhcPs GhcPs -> LHsLocalBinds GhcPs)
-> HsLocalBindsLR GhcPs GhcPs -> LHsLocalBinds GhcPs
forall a b. (a -> b) -> a -> b
$ XEmptyLocalBinds GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
forall a. HasDefaultExt a => a
defExt)