summaryrefslogtreecommitdiff
path: root/libraries/template-haskell/Language/Haskell/TH/Lib.hs
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/template-haskell/Language/Haskell/TH/Lib.hs')
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Lib.hs866
1 files changed, 74 insertions, 792 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 78fbc41d6f..778e6c0553 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -1,8 +1,13 @@
-- |
--- TH.Lib contains lots of useful helper functions for
+-- Language.Haskell.TH.Lib contains lots of useful helper functions for
-- generating and manipulating Template Haskell terms
-{-# LANGUAGE CPP #-}
+-- Note: this module mostly re-exports functions from
+-- Language.Haskell.TH.Lib.Internal, but if a change occurs to Template
+-- Haskell which requires breaking the API offered in this module, we opt to
+-- copy the old definition here, and make the changes in
+-- Language.Haskell.TH.Lib.Internal. This way, we can retain backwards
+-- compatibility while still allowing GHC to make changes as it needs.
module Language.Haskell.TH.Lib (
-- All of the exports from this module should
@@ -11,11 +16,12 @@ module Language.Haskell.TH.Lib (
-- * Library functions
-- ** Abbreviations
- InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ,
- DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ, StmtQ, RangeQ,
- SourceStrictnessQ, SourceUnpackednessQ, BangQ, BangTypeQ, VarBangTypeQ,
- StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ, FieldPatQ, RuleBndrQ,
- TySynEqnQ, PatSynDirQ, PatSynArgsQ,
+ InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ, TyVarBndrQ,
+ TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,
+ StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,
+ BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,
+ FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,
+ FamilyResultSigQ, DerivStrategyQ,
-- ** Constructors lifted to 'Q'
-- *** Literals
@@ -31,8 +37,8 @@ module Language.Haskell.TH.Lib (
normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,
-- *** Expressions
- dyn, varE, unboundVarE, labelE, conE, litE, appE, appTypeE, uInfixE, parensE,
- staticE, infixE, infixApp, sectionL, sectionR,
+ dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,
+ appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR,
lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE,
letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,
-- **** Ranges
@@ -42,13 +48,13 @@ module Language.Haskell.TH.Lib (
arithSeqE,
fromR, fromThenR, fromToR, fromThenToR,
-- **** Statements
- doE, compE,
- bindS, letS, noBindS, parS,
+ doE, mdoE, compE,
+ bindS, letS, noBindS, parS, recS,
-- *** Types
forallT, varT, conT, appT, arrowT, infixT, uInfixT, parensT, equalityT,
listT, tupleT, unboxedTupleT, unboxedSumT, sigT, litT, wildCardT,
- promotedT, promotedTupleT, promotedNilT, promotedConsT,
+ promotedT, promotedTupleT, promotedNilT, promotedConsT, implicitParamT,
-- **** Type literals
numTyLit, strTyLit,
-- **** Strictness
@@ -73,7 +79,9 @@ module Language.Haskell.TH.Lib (
-- *** Top Level Declarations
-- **** Data
valD, funD, tySynD, dataD, newtypeD,
- derivClause, DerivClause(..), DerivStrategy(..),
+ derivClause, DerivClause(..),
+ stockStrategy, anyclassStrategy, newtypeStrategy,
+ viaStrategy, DerivStrategy(..),
-- **** Class
classD, instanceD, instanceWithOverlapD, Overlap(..),
sigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,
@@ -82,9 +90,8 @@ module Language.Haskell.TH.Lib (
roleAnnotD,
-- **** Type Family / Data Family
dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,
- familyNoKindD, familyKindD, closedTypeFamilyNoKindD, closedTypeFamilyKindD,
newtypeInstD, tySynInstD,
- typeFam, dataFam, tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,
+ tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,
-- **** Fixity
infixLD, infixRD, infixND,
@@ -106,363 +113,57 @@ module Language.Haskell.TH.Lib (
patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn,
infixPatSyn, recordPatSyn,
+ -- **** Implicit Parameters
+ implicitParamBindD,
+
-- ** Reify
thisModule
) where
-import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
-import qualified Language.Haskell.TH.Syntax as TH
-import Control.Monad( liftM, liftM2 )
-import Data.Word( Word8 )
-
-----------------------------------------------------------
--- * Type synonyms
-----------------------------------------------------------
-
-type InfoQ = Q Info
-type PatQ = Q Pat
-type FieldPatQ = Q FieldPat
-type ExpQ = Q Exp
-type TExpQ a = Q (TExp a)
-type DecQ = Q Dec
-type DecsQ = Q [Dec]
-type ConQ = Q Con
-type TypeQ = Q Type
-type TyLitQ = Q TyLit
-type CxtQ = Q Cxt
-type PredQ = Q Pred
-type DerivClauseQ = Q DerivClause
-type MatchQ = Q Match
-type ClauseQ = Q Clause
-type BodyQ = Q Body
-type GuardQ = Q Guard
-type StmtQ = Q Stmt
-type RangeQ = Q Range
-type SourceStrictnessQ = Q SourceStrictness
-type SourceUnpackednessQ = Q SourceUnpackedness
-type BangQ = Q Bang
-type BangTypeQ = Q BangType
-type VarBangTypeQ = Q VarBangType
-type StrictTypeQ = Q StrictType
-type VarStrictTypeQ = Q VarStrictType
-type FieldExpQ = Q FieldExp
-type RuleBndrQ = Q RuleBndr
-type TySynEqnQ = Q TySynEqn
-type PatSynDirQ = Q PatSynDir
-type PatSynArgsQ = Q PatSynArgs
-
--- must be defined here for DsMeta to find it
-type Role = TH.Role
-type InjectivityAnn = TH.InjectivityAnn
-
-----------------------------------------------------------
--- * Lowercase pattern syntax functions
-----------------------------------------------------------
-
-intPrimL :: Integer -> Lit
-intPrimL = IntPrimL
-wordPrimL :: Integer -> Lit
-wordPrimL = WordPrimL
-floatPrimL :: Rational -> Lit
-floatPrimL = FloatPrimL
-doublePrimL :: Rational -> Lit
-doublePrimL = DoublePrimL
-integerL :: Integer -> Lit
-integerL = IntegerL
-charL :: Char -> Lit
-charL = CharL
-charPrimL :: Char -> Lit
-charPrimL = CharPrimL
-stringL :: String -> Lit
-stringL = StringL
-stringPrimL :: [Word8] -> Lit
-stringPrimL = StringPrimL
-rationalL :: Rational -> Lit
-rationalL = RationalL
-
-litP :: Lit -> PatQ
-litP l = return (LitP l)
-
-varP :: Name -> PatQ
-varP v = return (VarP v)
-
-tupP :: [PatQ] -> PatQ
-tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
-
-unboxedTupP :: [PatQ] -> PatQ
-unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
-
-unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ
-unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }
-
-conP :: Name -> [PatQ] -> PatQ
-conP n ps = do ps' <- sequence ps
- return (ConP n ps')
-infixP :: PatQ -> Name -> PatQ -> PatQ
-infixP p1 n p2 = do p1' <- p1
- p2' <- p2
- return (InfixP p1' n p2')
-uInfixP :: PatQ -> Name -> PatQ -> PatQ
-uInfixP p1 n p2 = do p1' <- p1
- p2' <- p2
- return (UInfixP p1' n p2')
-parensP :: PatQ -> PatQ
-parensP p = do p' <- p
- return (ParensP p')
-
-tildeP :: PatQ -> PatQ
-tildeP p = do p' <- p
- return (TildeP p')
-bangP :: PatQ -> PatQ
-bangP p = do p' <- p
- return (BangP p')
-asP :: Name -> PatQ -> PatQ
-asP n p = do p' <- p
- return (AsP n p')
-wildP :: PatQ
-wildP = return WildP
-recP :: Name -> [FieldPatQ] -> PatQ
-recP n fps = do fps' <- sequence fps
- return (RecP n fps')
-listP :: [PatQ] -> PatQ
-listP ps = do ps' <- sequence ps
- return (ListP ps')
-sigP :: PatQ -> TypeQ -> PatQ
-sigP p t = do p' <- p
- t' <- t
- return (SigP p' t')
-viewP :: ExpQ -> PatQ -> PatQ
-viewP e p = do e' <- e
- p' <- p
- return (ViewP e' p')
-
-fieldPat :: Name -> PatQ -> FieldPatQ
-fieldPat n p = do p' <- p
- return (n, p')
-
-
--------------------------------------------------------------------------------
--- * Stmt
-
-bindS :: PatQ -> ExpQ -> StmtQ
-bindS p e = liftM2 BindS p e
-
-letS :: [DecQ] -> StmtQ
-letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
-
-noBindS :: ExpQ -> StmtQ
-noBindS e = do { e1 <- e; return (NoBindS e1) }
-
-parS :: [[StmtQ]] -> StmtQ
-parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
-
--------------------------------------------------------------------------------
--- * Range
-
-fromR :: ExpQ -> RangeQ
-fromR x = do { a <- x; return (FromR a) }
-
-fromThenR :: ExpQ -> ExpQ -> RangeQ
-fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
-
-fromToR :: ExpQ -> ExpQ -> RangeQ
-fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
-
-fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
-fromThenToR x y z = do { a <- x; b <- y; c <- z;
- return (FromThenToR a b c) }
--------------------------------------------------------------------------------
--- * Body
-
-normalB :: ExpQ -> BodyQ
-normalB e = do { e1 <- e; return (NormalB e1) }
-
-guardedB :: [Q (Guard,Exp)] -> BodyQ
-guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
-
--------------------------------------------------------------------------------
--- * Guard
-
-normalG :: ExpQ -> GuardQ
-normalG e = do { e1 <- e; return (NormalG e1) }
-
-normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
-normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
-
-patG :: [StmtQ] -> GuardQ
-patG ss = do { ss' <- sequence ss; return (PatG ss') }
-
-patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
-patGE ss e = do { ss' <- sequence ss;
- e' <- e;
- return (PatG ss', e') }
-
--------------------------------------------------------------------------------
--- * Match and Clause
-
--- | Use with 'caseE'
-match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
-match p rhs ds = do { p' <- p;
- r' <- rhs;
- ds' <- sequence ds;
- return (Match p' r' ds') }
-
--- | Use with 'funD'
-clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
-clause ps r ds = do { ps' <- sequence ps;
- r' <- r;
- ds' <- sequence ds;
- return (Clause ps' r' ds') }
-
-
----------------------------------------------------------------------------
--- * Exp
-
--- | Dynamically binding a variable (unhygenic)
-dyn :: String -> ExpQ
-dyn s = return (VarE (mkName s))
-
-varE :: Name -> ExpQ
-varE s = return (VarE s)
-
-conE :: Name -> ExpQ
-conE s = return (ConE s)
-
-litE :: Lit -> ExpQ
-litE c = return (LitE c)
-
-appE :: ExpQ -> ExpQ -> ExpQ
-appE x y = do { a <- x; b <- y; return (AppE a b)}
-
-appTypeE :: ExpQ -> TypeQ -> ExpQ
-appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }
-
-parensE :: ExpQ -> ExpQ
-parensE x = do { x' <- x; return (ParensE x') }
-
-uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
- return (UInfixE x' s' y') }
-
-infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
-infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
- return (InfixE (Just a) s' (Just b))}
-infixE Nothing s (Just y) = do { s' <- s; b <- y;
- return (InfixE Nothing s' (Just b))}
-infixE (Just x) s Nothing = do { a <- x; s' <- s;
- return (InfixE (Just a) s' Nothing)}
-infixE Nothing s Nothing = do { s' <- s; return (InfixE Nothing s' Nothing) }
-
-infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-infixApp x y z = infixE (Just x) y (Just z)
-sectionL :: ExpQ -> ExpQ -> ExpQ
-sectionL x y = infixE (Just x) y Nothing
-sectionR :: ExpQ -> ExpQ -> ExpQ
-sectionR x y = infixE Nothing x (Just y)
-
-lamE :: [PatQ] -> ExpQ -> ExpQ
-lamE ps e = do ps' <- sequence ps
- e' <- e
- return (LamE ps' e')
-
--- | Single-arg lambda
-lam1E :: PatQ -> ExpQ -> ExpQ
-lam1E p e = lamE [p] e
-
-lamCaseE :: [MatchQ] -> ExpQ
-lamCaseE ms = sequence ms >>= return . LamCaseE
-
-tupE :: [ExpQ] -> ExpQ
-tupE es = do { es1 <- sequence es; return (TupE es1)}
-
-unboxedTupE :: [ExpQ] -> ExpQ
-unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
-
-unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ
-unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }
-
-condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-condE x y z = do { a <- x; b <- y; c <- z; return (CondE a b c)}
-
-multiIfE :: [Q (Guard, Exp)] -> ExpQ
-multiIfE alts = sequence alts >>= return . MultiIfE
-
-letE :: [DecQ] -> ExpQ -> ExpQ
-letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
-
-caseE :: ExpQ -> [MatchQ] -> ExpQ
-caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
-
-doE :: [StmtQ] -> ExpQ
-doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
-
-compE :: [StmtQ] -> ExpQ
-compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
-
-arithSeqE :: RangeQ -> ExpQ
-arithSeqE r = do { r' <- r; return (ArithSeqE r') }
-
-listE :: [ExpQ] -> ExpQ
-listE es = do { es1 <- sequence es; return (ListE es1) }
-
-sigE :: ExpQ -> TypeQ -> ExpQ
-sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
-
-recConE :: Name -> [Q (Name,Exp)] -> ExpQ
-recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
-
-recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
-recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }
-
-stringE :: String -> ExpQ
-stringE = litE . stringL
-
-fieldExp :: Name -> ExpQ -> Q (Name, Exp)
-fieldExp s e = do { e' <- e; return (s,e') }
-
--- | @staticE x = [| static x |]@
-staticE :: ExpQ -> ExpQ
-staticE = fmap StaticE
-
-unboundVarE :: Name -> ExpQ
-unboundVarE s = return (UnboundVarE s)
-
-labelE :: String -> ExpQ
-labelE s = return (LabelE s)
-
--- ** 'arithSeqE' Shortcuts
-fromE :: ExpQ -> ExpQ
-fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
-
-fromThenE :: ExpQ -> ExpQ -> ExpQ
-fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
-
-fromToE :: ExpQ -> ExpQ -> ExpQ
-fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
-
-fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-fromThenToE x y z = do { a <- x; b <- y; c <- z;
- return (ArithSeqE (FromThenToR a b c)) }
-
+import Language.Haskell.TH.Lib.Internal hiding
+ ( tySynD
+ , dataD
+ , newtypeD
+ , classD
+ , dataInstD
+ , newtypeInstD
+ , dataFamilyD
+ , openTypeFamilyD
+ , closedTypeFamilyD
+ , forallC
+
+ , forallT
+ , sigT
+
+ , plainTV
+ , kindedTV
+ , starK
+ , constraintK
+
+ , noSig
+ , kindSig
+ , tyVarSig
+
+ , derivClause
+ , standaloneDerivWithStrategyD
+
+ , Role
+ , InjectivityAnn
+ )
+import Language.Haskell.TH.Syntax
+
+import Control.Monad (liftM2)
+import Prelude
+
+-- All definitions below represent the "old" API, since their definitions are
+-- different in Language.Haskell.TH.Lib.Internal. Please think carefully before
+-- deciding to change the APIs of the functions below, as they represent the
+-- public API (as opposed to the Internal module, which has no API promises.)
-------------------------------------------------------------------------------
-- * Dec
-valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
-valD p b ds =
- do { p' <- p
- ; ds' <- sequence ds
- ; b' <- b
- ; return (ValD p' b' ds')
- }
-
-funD :: Name -> [ClauseQ] -> DecQ
-funD nm cs =
- do { cs1 <- sequence cs
- ; return (FunD nm cs1)
- }
-
tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ
tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
@@ -491,78 +192,6 @@ classD ctxt cls tvs fds decs =
ctxt1 <- ctxt
return $ ClassD ctxt1 cls tvs fds decs1
-instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
-instanceD = instanceWithOverlapD Nothing
-
-instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ
-instanceWithOverlapD o ctxt ty decs =
- do
- ctxt1 <- ctxt
- decs1 <- sequence decs
- ty1 <- ty
- return $ InstanceD o ctxt1 ty1 decs1
-
-
-
-sigD :: Name -> TypeQ -> DecQ
-sigD fun ty = liftM (SigD fun) $ ty
-
-forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
-forImpD cc s str n ty
- = do ty' <- ty
- return $ ForeignD (ImportF cc s str n ty')
-
-infixLD :: Int -> Name -> DecQ
-infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
-
-infixRD :: Int -> Name -> DecQ
-infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
-
-infixND :: Int -> Name -> DecQ
-infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
-
-pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
-pragInlD name inline rm phases
- = return $ PragmaD $ InlineP name inline rm phases
-
-pragSpecD :: Name -> TypeQ -> Phases -> DecQ
-pragSpecD n ty phases
- = do
- ty1 <- ty
- return $ PragmaD $ SpecialiseP n ty1 Nothing phases
-
-pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
-pragSpecInlD n ty inline phases
- = do
- ty1 <- ty
- return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
-
-pragSpecInstD :: TypeQ -> DecQ
-pragSpecInstD ty
- = do
- ty1 <- ty
- return $ PragmaD $ SpecialiseInstP ty1
-
-pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
-pragRuleD n bndrs lhs rhs phases
- = do
- bndrs1 <- sequence bndrs
- lhs1 <- lhs
- rhs1 <- rhs
- return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases
-
-pragAnnD :: AnnTarget -> ExpQ -> DecQ
-pragAnnD target expr
- = do
- exp1 <- expr
- return $ PragmaD $ AnnP target exp1
-
-pragLineD :: Int -> String -> DecQ
-pragLineD line file = return $ PragmaD $ LineP line file
-
-pragCompleteD :: [Name] -> Maybe Name -> DecQ
-pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty
-
dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
-> DecQ
dataInstD ctxt tc tys ksig cons derivs =
@@ -583,12 +212,6 @@ newtypeInstD ctxt tc tys ksig con derivs =
derivs1 <- sequence derivs
return (NewtypeInstD ctxt1 tc tys1 ksig con1 derivs1)
-tySynInstD :: Name -> TySynEqnQ -> DecQ
-tySynInstD tc eqn =
- do
- eqn1 <- eqn
- return (TySynInstD tc eqn1)
-
dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ
dataFamilyD tc tvs kind
= return $ DataFamilyD tc tvs kind
@@ -604,112 +227,9 @@ closedTypeFamilyD tc tvs result injectivity eqns =
do eqns1 <- sequence eqns
return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
--- These were deprecated in GHC 8.0 with a plan to remove them in 8.2. If you
--- remove this check please also:
--- 1. remove deprecated functions
--- 2. remove CPP language extension from top of this module
--- 3. remove the FamFlavour data type from Syntax module
--- 4. make sure that all references to FamFlavour are gone from DsMeta,
--- Convert, TcSplice (follows from 3)
-#if __GLASGOW_HASKELL__ >= 804
-#error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD
-#endif
-
-{-# DEPRECATED familyNoKindD, familyKindD
- "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-}
-familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
-familyNoKindD flav tc tvs =
- case flav of
- TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing)
- DataFam -> return $ DataFamilyD tc tvs Nothing
-
-familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ
-familyKindD flav tc tvs k =
- case flav of
- TypeFam ->
- return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing)
- DataFam -> return $ DataFamilyD tc tvs (Just k)
-
-{-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD
- "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-}
-closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ
-closedTypeFamilyNoKindD tc tvs eqns =
- do eqns1 <- sequence eqns
- return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1)
-
-closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ
-closedTypeFamilyKindD tc tvs kind eqns =
- do eqns1 <- sequence eqns
- return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing)
- eqns1)
-
-roleAnnotD :: Name -> [Role] -> DecQ
-roleAnnotD name roles = return $ RoleAnnotD name roles
-
-standaloneDerivD :: CxtQ -> TypeQ -> DecQ
-standaloneDerivD = standaloneDerivWithStrategyD Nothing
-
-standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
-standaloneDerivWithStrategyD ds ctxtq tyq =
- do
- ctxt <- ctxtq
- ty <- tyq
- return $ StandaloneDerivD ds ctxt ty
-
-defaultSigD :: Name -> TypeQ -> DecQ
-defaultSigD n tyq =
- do
- ty <- tyq
- return $ DefaultSigD n ty
-
--- | Pattern synonym declaration
-patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ
-patSynD name args dir pat = do
- args' <- args
- dir' <- dir
- pat' <- pat
- return (PatSynD name args' dir' pat')
-
--- | Pattern synonym type signature
-patSynSigD :: Name -> TypeQ -> DecQ
-patSynSigD nm ty =
- do ty' <- ty
- return $ PatSynSigD nm ty'
-
-tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
-tySynEqn lhs rhs =
- do
- lhs1 <- sequence lhs
- rhs1 <- rhs
- return (TySynEqn lhs1 rhs1)
-
-cxt :: [PredQ] -> CxtQ
-cxt = sequence
-
-derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
-derivClause ds p = do p' <- cxt p
- return $ DerivClause ds p'
-
-normalC :: Name -> [BangTypeQ] -> ConQ
-normalC con strtys = liftM (NormalC con) $ sequence strtys
-
-recC :: Name -> [VarBangTypeQ] -> ConQ
-recC con varstrtys = liftM (RecC con) $ sequence varstrtys
-
-infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ
-infixC st1 con st2 = do st1' <- st1
- st2' <- st2
- return $ InfixC st1' con st2'
-
forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ
forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
-gadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ
-gadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty
-
-recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ
-recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty
-
-------------------------------------------------------------------------------
-- * Type
@@ -719,145 +239,12 @@ forallT tvars ctxt ty = do
ty1 <- ty
return $ ForallT tvars ctxt1 ty1
-varT :: Name -> TypeQ
-varT = return . VarT
-
-conT :: Name -> TypeQ
-conT = return . ConT
-
-infixT :: TypeQ -> Name -> TypeQ -> TypeQ
-infixT t1 n t2 = do t1' <- t1
- t2' <- t2
- return (InfixT t1' n t2')
-
-uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ
-uInfixT t1 n t2 = do t1' <- t1
- t2' <- t2
- return (UInfixT t1' n t2')
-
-parensT :: TypeQ -> TypeQ
-parensT t = do t' <- t
- return (ParensT t')
-
-appT :: TypeQ -> TypeQ -> TypeQ
-appT t1 t2 = do
- t1' <- t1
- t2' <- t2
- return $ AppT t1' t2'
-
-arrowT :: TypeQ
-arrowT = return ArrowT
-
-listT :: TypeQ
-listT = return ListT
-
-litT :: TyLitQ -> TypeQ
-litT l = fmap LitT l
-
-tupleT :: Int -> TypeQ
-tupleT i = return (TupleT i)
-
-unboxedTupleT :: Int -> TypeQ
-unboxedTupleT i = return (UnboxedTupleT i)
-
-unboxedSumT :: SumArity -> TypeQ
-unboxedSumT arity = return (UnboxedSumT arity)
-
sigT :: TypeQ -> Kind -> TypeQ
sigT t k
= do
t' <- t
return $ SigT t' k
-equalityT :: TypeQ
-equalityT = return EqualityT
-
-wildCardT :: TypeQ
-wildCardT = return WildCardT
-
-{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
-classP :: Name -> [Q Type] -> Q Pred
-classP cla tys
- = do
- tysl <- sequence tys
- return (foldl AppT (ConT cla) tysl)
-
-{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}
-equalP :: TypeQ -> TypeQ -> PredQ
-equalP tleft tright
- = do
- tleft1 <- tleft
- tright1 <- tright
- eqT <- equalityT
- return (foldl AppT eqT [tleft1, tright1])
-
-promotedT :: Name -> TypeQ
-promotedT = return . PromotedT
-
-promotedTupleT :: Int -> TypeQ
-promotedTupleT i = return (PromotedTupleT i)
-
-promotedNilT :: TypeQ
-promotedNilT = return PromotedNilT
-
-promotedConsT :: TypeQ
-promotedConsT = return PromotedConsT
-
-noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ
-noSourceUnpackedness = return NoSourceUnpackedness
-sourceNoUnpack = return SourceNoUnpack
-sourceUnpack = return SourceUnpack
-
-noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ
-noSourceStrictness = return NoSourceStrictness
-sourceLazy = return SourceLazy
-sourceStrict = return SourceStrict
-
-{-# DEPRECATED isStrict
- ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
- "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}
-{-# DEPRECATED notStrict
- ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
- "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}
-{-# DEPRECATED unpacked
- ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
- "Example usage: 'bang sourceUnpack sourceStrict'"] #-}
-isStrict, notStrict, unpacked :: Q Strict
-isStrict = bang noSourceUnpackedness sourceStrict
-notStrict = bang noSourceUnpackedness noSourceStrictness
-unpacked = bang sourceUnpack sourceStrict
-
-bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ
-bang u s = do u' <- u
- s' <- s
- return (Bang u' s')
-
-bangType :: BangQ -> TypeQ -> BangTypeQ
-bangType = liftM2 (,)
-
-varBangType :: Name -> BangTypeQ -> VarBangTypeQ
-varBangType v bt = do (b, t) <- bt
- return (v, b, t)
-
-{-# DEPRECATED strictType
- "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}
-strictType :: Q Strict -> TypeQ -> StrictTypeQ
-strictType = bangType
-
-{-# DEPRECATED varStrictType
- "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}
-varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ
-varStrictType = varBangType
-
--- * Type Literals
-
-numTyLit :: Integer -> TyLitQ
-numTyLit n = if n >= 0 then return (NumTyLit n)
- else fail ("Negative type-level number: " ++ show n)
-
-strTyLit :: String -> TyLitQ
-strTyLit s = return (StrTyLit s)
-
-------------------------------------------------------------------------------
-- * Kind
@@ -867,24 +254,6 @@ plainTV = PlainTV
kindedTV :: Name -> Kind -> TyVarBndr
kindedTV = KindedTV
-varK :: Name -> Kind
-varK = VarT
-
-conK :: Name -> Kind
-conK = ConT
-
-tupleK :: Int -> Kind
-tupleK = TupleT
-
-arrowK :: Kind
-arrowK = ArrowT
-
-listK :: Kind
-listK = ListT
-
-appK :: Kind -> Kind -> Kind
-appK = AppT
-
starK :: Kind
starK = StarT
@@ -904,102 +273,15 @@ tyVarSig :: TyVarBndr -> FamilyResultSig
tyVarSig = TyVarSig
-------------------------------------------------------------------------------
--- * Injectivity annotation
-
-injectivityAnn :: Name -> [Name] -> InjectivityAnn
-injectivityAnn = TH.InjectivityAnn
-
--------------------------------------------------------------------------------
--- * Role
-
-nominalR, representationalR, phantomR, inferR :: Role
-nominalR = NominalR
-representationalR = RepresentationalR
-phantomR = PhantomR
-inferR = InferR
-
--------------------------------------------------------------------------------
--- * Callconv
-
-cCall, stdCall, cApi, prim, javaScript :: Callconv
-cCall = CCall
-stdCall = StdCall
-cApi = CApi
-prim = Prim
-javaScript = JavaScript
-
--------------------------------------------------------------------------------
--- * Safety
-
-unsafe, safe, interruptible :: Safety
-unsafe = Unsafe
-safe = Safe
-interruptible = Interruptible
-
--------------------------------------------------------------------------------
--- * FunDep
+-- * Top Level Declarations
-funDep :: [Name] -> [Name] -> FunDep
-funDep = FunDep
-
--------------------------------------------------------------------------------
--- * FamFlavour
-
-typeFam, dataFam :: FamFlavour
-typeFam = TypeFam
-dataFam = DataFam
-
--------------------------------------------------------------------------------
--- * RuleBndr
-ruleVar :: Name -> RuleBndrQ
-ruleVar = return . RuleVar
-
-typedRuleVar :: Name -> TypeQ -> RuleBndrQ
-typedRuleVar n ty = ty >>= return . TypedRuleVar n
-
--------------------------------------------------------------------------------
--- * AnnTarget
-valueAnnotation :: Name -> AnnTarget
-valueAnnotation = ValueAnnotation
-
-typeAnnotation :: Name -> AnnTarget
-typeAnnotation = TypeAnnotation
-
-moduleAnnotation :: AnnTarget
-moduleAnnotation = ModuleAnnotation
-
--------------------------------------------------------------------------------
--- * Pattern Synonyms (sub constructs)
-
-unidir, implBidir :: PatSynDirQ
-unidir = return Unidir
-implBidir = return ImplBidir
-
-explBidir :: [ClauseQ] -> PatSynDirQ
-explBidir cls = do
- cls' <- sequence cls
- return (ExplBidir cls')
-
-prefixPatSyn :: [Name] -> PatSynArgsQ
-prefixPatSyn args = return $ PrefixPatSyn args
-
-recordPatSyn :: [Name] -> PatSynArgsQ
-recordPatSyn sels = return $ RecordPatSyn sels
-
-infixPatSyn :: Name -> Name -> PatSynArgsQ
-infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2
-
---------------------------------------------------------------
--- * Useful helper function
-
-appsE :: [ExpQ] -> ExpQ
-appsE [] = error "appsE []"
-appsE [x] = x
-appsE (x:y:zs) = appsE ( (appE x y) : zs )
+derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
+derivClause mds p = do
+ p' <- cxt p
+ return $ DerivClause mds p'
--- | Return the Module at the place of splicing. Can be used as an
--- input for 'reifyModule'.
-thisModule :: Q Module
-thisModule = do
- loc <- location
- return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
+standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD mds ctxt ty = do
+ ctxt' <- ctxt
+ ty' <- ty
+ return $ StandaloneDerivD mds ctxt' ty'