Add proper GADTs support to Template Haskell
[ghc.git] / libraries / template-haskell / Language / Haskell / TH / Lib.hs
1 -- |
2 -- TH.Lib contains lots of useful helper functions for
3 -- generating and manipulating Template Haskell terms
4
5 {-# LANGUAGE CPP #-}
6
7 module Language.Haskell.TH.Lib where
8 -- All of the exports from this module should
9 -- be "public" functions. The main module TH
10 -- re-exports them all.
11
12 import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
13 import qualified Language.Haskell.TH.Syntax as TH
14 import Control.Monad( liftM, liftM2, liftM3 )
15 import Data.Word( Word8 )
16
17 ----------------------------------------------------------
18 -- * Type synonyms
19 ----------------------------------------------------------
20
21 type InfoQ = Q Info
22 type PatQ = Q Pat
23 type FieldPatQ = Q FieldPat
24 type ExpQ = Q Exp
25 type TExpQ a = Q (TExp a)
26 type DecQ = Q Dec
27 type DecsQ = Q [Dec]
28 type ConQ = Q Con
29 type TypeQ = Q Type
30 type TyLitQ = Q TyLit
31 type CxtQ = Q Cxt
32 type PredQ = Q Pred
33 type MatchQ = Q Match
34 type ClauseQ = Q Clause
35 type BodyQ = Q Body
36 type GuardQ = Q Guard
37 type StmtQ = Q Stmt
38 type RangeQ = Q Range
39 type StrictTypeQ = Q StrictType
40 type VarStrictTypeQ = Q VarStrictType
41 type FieldExpQ = Q FieldExp
42 type RuleBndrQ = Q RuleBndr
43 type TySynEqnQ = Q TySynEqn
44 type Role = TH.Role -- must be defined here for DsMeta to find it
45 type InjectivityAnn = TH.InjectivityAnn
46
47 ----------------------------------------------------------
48 -- * Lowercase pattern syntax functions
49 ----------------------------------------------------------
50
51 intPrimL :: Integer -> Lit
52 intPrimL = IntPrimL
53 wordPrimL :: Integer -> Lit
54 wordPrimL = WordPrimL
55 floatPrimL :: Rational -> Lit
56 floatPrimL = FloatPrimL
57 doublePrimL :: Rational -> Lit
58 doublePrimL = DoublePrimL
59 integerL :: Integer -> Lit
60 integerL = IntegerL
61 charL :: Char -> Lit
62 charL = CharL
63 charPrimL :: Char -> Lit
64 charPrimL = CharPrimL
65 stringL :: String -> Lit
66 stringL = StringL
67 stringPrimL :: [Word8] -> Lit
68 stringPrimL = StringPrimL
69 rationalL :: Rational -> Lit
70 rationalL = RationalL
71
72 litP :: Lit -> PatQ
73 litP l = return (LitP l)
74 varP :: Name -> PatQ
75 varP v = return (VarP v)
76 tupP :: [PatQ] -> PatQ
77 tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
78 unboxedTupP :: [PatQ] -> PatQ
79 unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
80 conP :: Name -> [PatQ] -> PatQ
81 conP n ps = do ps' <- sequence ps
82 return (ConP n ps')
83 infixP :: PatQ -> Name -> PatQ -> PatQ
84 infixP p1 n p2 = do p1' <- p1
85 p2' <- p2
86 return (InfixP p1' n p2')
87 uInfixP :: PatQ -> Name -> PatQ -> PatQ
88 uInfixP p1 n p2 = do p1' <- p1
89 p2' <- p2
90 return (UInfixP p1' n p2')
91 parensP :: PatQ -> PatQ
92 parensP p = do p' <- p
93 return (ParensP p')
94
95 tildeP :: PatQ -> PatQ
96 tildeP p = do p' <- p
97 return (TildeP p')
98 bangP :: PatQ -> PatQ
99 bangP p = do p' <- p
100 return (BangP p')
101 asP :: Name -> PatQ -> PatQ
102 asP n p = do p' <- p
103 return (AsP n p')
104 wildP :: PatQ
105 wildP = return WildP
106 recP :: Name -> [FieldPatQ] -> PatQ
107 recP n fps = do fps' <- sequence fps
108 return (RecP n fps')
109 listP :: [PatQ] -> PatQ
110 listP ps = do ps' <- sequence ps
111 return (ListP ps')
112 sigP :: PatQ -> TypeQ -> PatQ
113 sigP p t = do p' <- p
114 t' <- t
115 return (SigP p' t')
116 viewP :: ExpQ -> PatQ -> PatQ
117 viewP e p = do e' <- e
118 p' <- p
119 return (ViewP e' p')
120
121 fieldPat :: Name -> PatQ -> FieldPatQ
122 fieldPat n p = do p' <- p
123 return (n, p')
124
125
126 -------------------------------------------------------------------------------
127 -- * Stmt
128
129 bindS :: PatQ -> ExpQ -> StmtQ
130 bindS p e = liftM2 BindS p e
131
132 letS :: [DecQ] -> StmtQ
133 letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
134
135 noBindS :: ExpQ -> StmtQ
136 noBindS e = do { e1 <- e; return (NoBindS e1) }
137
138 parS :: [[StmtQ]] -> StmtQ
139 parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
140
141 -------------------------------------------------------------------------------
142 -- * Range
143
144 fromR :: ExpQ -> RangeQ
145 fromR x = do { a <- x; return (FromR a) }
146
147 fromThenR :: ExpQ -> ExpQ -> RangeQ
148 fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
149
150 fromToR :: ExpQ -> ExpQ -> RangeQ
151 fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
152
153 fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
154 fromThenToR x y z = do { a <- x; b <- y; c <- z;
155 return (FromThenToR a b c) }
156 -------------------------------------------------------------------------------
157 -- * Body
158
159 normalB :: ExpQ -> BodyQ
160 normalB e = do { e1 <- e; return (NormalB e1) }
161
162 guardedB :: [Q (Guard,Exp)] -> BodyQ
163 guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
164
165 -------------------------------------------------------------------------------
166 -- * Guard
167
168 normalG :: ExpQ -> GuardQ
169 normalG e = do { e1 <- e; return (NormalG e1) }
170
171 normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
172 normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
173
174 patG :: [StmtQ] -> GuardQ
175 patG ss = do { ss' <- sequence ss; return (PatG ss') }
176
177 patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
178 patGE ss e = do { ss' <- sequence ss;
179 e' <- e;
180 return (PatG ss', e') }
181
182 -------------------------------------------------------------------------------
183 -- * Match and Clause
184
185 -- | Use with 'caseE'
186 match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
187 match p rhs ds = do { p' <- p;
188 r' <- rhs;
189 ds' <- sequence ds;
190 return (Match p' r' ds') }
191
192 -- | Use with 'funD'
193 clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
194 clause ps r ds = do { ps' <- sequence ps;
195 r' <- r;
196 ds' <- sequence ds;
197 return (Clause ps' r' ds') }
198
199
200 ---------------------------------------------------------------------------
201 -- * Exp
202
203 -- | Dynamically binding a variable (unhygenic)
204 dyn :: String -> ExpQ
205 dyn s = return (VarE (mkName s))
206
207 varE :: Name -> ExpQ
208 varE s = return (VarE s)
209
210 conE :: Name -> ExpQ
211 conE s = return (ConE s)
212
213 litE :: Lit -> ExpQ
214 litE c = return (LitE c)
215
216 appE :: ExpQ -> ExpQ -> ExpQ
217 appE x y = do { a <- x; b <- y; return (AppE a b)}
218
219 parensE :: ExpQ -> ExpQ
220 parensE x = do { x' <- x; return (ParensE x') }
221
222 uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
223 uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
224 return (UInfixE x' s' y') }
225
226 infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
227 infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
228 return (InfixE (Just a) s' (Just b))}
229 infixE Nothing s (Just y) = do { s' <- s; b <- y;
230 return (InfixE Nothing s' (Just b))}
231 infixE (Just x) s Nothing = do { a <- x; s' <- s;
232 return (InfixE (Just a) s' Nothing)}
233 infixE Nothing s Nothing = do { s' <- s; return (InfixE Nothing s' Nothing) }
234
235 infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
236 infixApp x y z = infixE (Just x) y (Just z)
237 sectionL :: ExpQ -> ExpQ -> ExpQ
238 sectionL x y = infixE (Just x) y Nothing
239 sectionR :: ExpQ -> ExpQ -> ExpQ
240 sectionR x y = infixE Nothing x (Just y)
241
242 lamE :: [PatQ] -> ExpQ -> ExpQ
243 lamE ps e = do ps' <- sequence ps
244 e' <- e
245 return (LamE ps' e')
246
247 -- | Single-arg lambda
248 lam1E :: PatQ -> ExpQ -> ExpQ
249 lam1E p e = lamE [p] e
250
251 lamCaseE :: [MatchQ] -> ExpQ
252 lamCaseE ms = sequence ms >>= return . LamCaseE
253
254 tupE :: [ExpQ] -> ExpQ
255 tupE es = do { es1 <- sequence es; return (TupE es1)}
256
257 unboxedTupE :: [ExpQ] -> ExpQ
258 unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
259
260 condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
261 condE x y z = do { a <- x; b <- y; c <- z; return (CondE a b c)}
262
263 multiIfE :: [Q (Guard, Exp)] -> ExpQ
264 multiIfE alts = sequence alts >>= return . MultiIfE
265
266 letE :: [DecQ] -> ExpQ -> ExpQ
267 letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
268
269 caseE :: ExpQ -> [MatchQ] -> ExpQ
270 caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
271
272 doE :: [StmtQ] -> ExpQ
273 doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
274
275 compE :: [StmtQ] -> ExpQ
276 compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
277
278 arithSeqE :: RangeQ -> ExpQ
279 arithSeqE r = do { r' <- r; return (ArithSeqE r') }
280
281 listE :: [ExpQ] -> ExpQ
282 listE es = do { es1 <- sequence es; return (ListE es1) }
283
284 sigE :: ExpQ -> TypeQ -> ExpQ
285 sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
286
287 recConE :: Name -> [Q (Name,Exp)] -> ExpQ
288 recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
289
290 recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
291 recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }
292
293 stringE :: String -> ExpQ
294 stringE = litE . stringL
295
296 fieldExp :: Name -> ExpQ -> Q (Name, Exp)
297 fieldExp s e = do { e' <- e; return (s,e') }
298
299 -- | @staticE x = [| static x |]@
300 staticE :: ExpQ -> ExpQ
301 staticE = fmap StaticE
302
303 unboundVarE :: Name -> ExpQ
304 unboundVarE s = return (UnboundVarE s)
305
306 -- ** 'arithSeqE' Shortcuts
307 fromE :: ExpQ -> ExpQ
308 fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
309
310 fromThenE :: ExpQ -> ExpQ -> ExpQ
311 fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
312
313 fromToE :: ExpQ -> ExpQ -> ExpQ
314 fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
315
316 fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
317 fromThenToE x y z = do { a <- x; b <- y; c <- z;
318 return (ArithSeqE (FromThenToR a b c)) }
319
320
321 -------------------------------------------------------------------------------
322 -- * Dec
323
324 valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
325 valD p b ds =
326 do { p' <- p
327 ; ds' <- sequence ds
328 ; b' <- b
329 ; return (ValD p' b' ds')
330 }
331
332 funD :: Name -> [ClauseQ] -> DecQ
333 funD nm cs =
334 do { cs1 <- sequence cs
335 ; return (FunD nm cs1)
336 }
337
338 tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ
339 tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
340
341 dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> CxtQ -> DecQ
342 dataD ctxt tc tvs ksig cons derivs =
343 do
344 ctxt1 <- ctxt
345 cons1 <- sequence cons
346 derivs1 <- derivs
347 return (DataD ctxt1 tc tvs ksig cons1 derivs1)
348
349 newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> CxtQ -> DecQ
350 newtypeD ctxt tc tvs ksig con derivs =
351 do
352 ctxt1 <- ctxt
353 con1 <- con
354 derivs1 <- derivs
355 return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)
356
357 classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ
358 classD ctxt cls tvs fds decs =
359 do
360 decs1 <- sequence decs
361 ctxt1 <- ctxt
362 return $ ClassD ctxt1 cls tvs fds decs1
363
364 instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
365 instanceD ctxt ty decs =
366 do
367 ctxt1 <- ctxt
368 decs1 <- sequence decs
369 ty1 <- ty
370 return $ InstanceD ctxt1 ty1 decs1
371
372 sigD :: Name -> TypeQ -> DecQ
373 sigD fun ty = liftM (SigD fun) $ ty
374
375 forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
376 forImpD cc s str n ty
377 = do ty' <- ty
378 return $ ForeignD (ImportF cc s str n ty')
379
380 infixLD :: Int -> Name -> DecQ
381 infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
382
383 infixRD :: Int -> Name -> DecQ
384 infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
385
386 infixND :: Int -> Name -> DecQ
387 infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
388
389 pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
390 pragInlD name inline rm phases
391 = return $ PragmaD $ InlineP name inline rm phases
392
393 pragSpecD :: Name -> TypeQ -> Phases -> DecQ
394 pragSpecD n ty phases
395 = do
396 ty1 <- ty
397 return $ PragmaD $ SpecialiseP n ty1 Nothing phases
398
399 pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
400 pragSpecInlD n ty inline phases
401 = do
402 ty1 <- ty
403 return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
404
405 pragSpecInstD :: TypeQ -> DecQ
406 pragSpecInstD ty
407 = do
408 ty1 <- ty
409 return $ PragmaD $ SpecialiseInstP ty1
410
411 pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
412 pragRuleD n bndrs lhs rhs phases
413 = do
414 bndrs1 <- sequence bndrs
415 lhs1 <- lhs
416 rhs1 <- rhs
417 return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases
418
419 pragAnnD :: AnnTarget -> ExpQ -> DecQ
420 pragAnnD target expr
421 = do
422 exp1 <- expr
423 return $ PragmaD $ AnnP target exp1
424
425 pragLineD :: Int -> String -> DecQ
426 pragLineD line file = return $ PragmaD $ LineP line file
427
428 dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> CxtQ -> DecQ
429 dataInstD ctxt tc tys ksig cons derivs =
430 do
431 ctxt1 <- ctxt
432 tys1 <- sequence tys
433 cons1 <- sequence cons
434 derivs1 <- derivs
435 return (DataInstD ctxt1 tc tys1 ksig cons1 derivs1)
436
437 newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> CxtQ -> DecQ
438 newtypeInstD ctxt tc tys ksig con derivs =
439 do
440 ctxt1 <- ctxt
441 tys1 <- sequence tys
442 con1 <- con
443 derivs1 <- derivs
444 return (NewtypeInstD ctxt1 tc tys1 ksig con1 derivs1)
445
446 tySynInstD :: Name -> TySynEqnQ -> DecQ
447 tySynInstD tc eqn =
448 do
449 eqn1 <- eqn
450 return (TySynInstD tc eqn1)
451
452 dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ
453 dataFamilyD tc tvs kind
454 = return $ DataFamilyD tc tvs kind
455
456 openTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig
457 -> Maybe InjectivityAnn -> DecQ
458 openTypeFamilyD tc tvs res inj
459 = return $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)
460
461 closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig
462 -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ
463 closedTypeFamilyD tc tvs result injectivity eqns =
464 do eqns1 <- sequence eqns
465 return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
466
467 -- These were deprecated in GHC 7.12 with a plan to remove them in 7.14. If you
468 -- remove this check please also:
469 -- 1. remove deprecated functions
470 -- 2. remove CPP language extension from top of this module
471 -- 3. remove the FamFlavour data type from Syntax module
472 -- 4. make sure that all references to FamFlavour are gone from DsMeta,
473 -- Convert, TcSplice (follows from 3)
474 #if __GLASGOW_HASKELL__ > 800
475 #error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD
476 #endif
477
478 {-# DEPRECATED familyNoKindD, familyKindD
479 "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-}
480 familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
481 familyNoKindD flav tc tvs =
482 case flav of
483 TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing)
484 DataFam -> return $ DataFamilyD tc tvs Nothing
485
486 familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ
487 familyKindD flav tc tvs k =
488 case flav of
489 TypeFam ->
490 return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing)
491 DataFam -> return $ DataFamilyD tc tvs (Just k)
492
493 {-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD
494 "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-}
495 closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ
496 closedTypeFamilyNoKindD tc tvs eqns =
497 do eqns1 <- sequence eqns
498 return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1)
499
500 closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ
501 closedTypeFamilyKindD tc tvs kind eqns =
502 do eqns1 <- sequence eqns
503 return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing)
504 eqns1)
505
506 roleAnnotD :: Name -> [Role] -> DecQ
507 roleAnnotD name roles = return $ RoleAnnotD name roles
508
509 standaloneDerivD :: CxtQ -> TypeQ -> DecQ
510 standaloneDerivD ctxtq tyq =
511 do
512 ctxt <- ctxtq
513 ty <- tyq
514 return $ StandaloneDerivD ctxt ty
515
516 defaultSigD :: Name -> TypeQ -> DecQ
517 defaultSigD n tyq =
518 do
519 ty <- tyq
520 return $ DefaultSigD n ty
521
522 tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
523 tySynEqn lhs rhs =
524 do
525 lhs1 <- sequence lhs
526 rhs1 <- rhs
527 return (TySynEqn lhs1 rhs1)
528
529 cxt :: [PredQ] -> CxtQ
530 cxt = sequence
531
532 normalC :: Name -> [StrictTypeQ] -> ConQ
533 normalC con strtys = liftM (NormalC con) $ sequence strtys
534
535 recC :: Name -> [VarStrictTypeQ] -> ConQ
536 recC con varstrtys = liftM (RecC con) $ sequence varstrtys
537
538 infixC :: Q (Strict, Type) -> Name -> Q (Strict, Type) -> ConQ
539 infixC st1 con st2 = do st1' <- st1
540 st2' <- st2
541 return $ InfixC st1' con st2'
542
543 forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ
544 forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
545
546 gadtC :: [Name] -> [StrictTypeQ] -> Name -> [TypeQ] -> ConQ
547 gadtC cons strtys ty idx = liftM3 (GadtC cons) (sequence strtys)
548 (return ty) (sequence idx)
549
550 recGadtC :: [Name] -> [VarStrictTypeQ] -> Name -> [TypeQ] -> ConQ
551 recGadtC cons varstrtys ty idx = liftM3 (RecGadtC cons) (sequence varstrtys)
552 (return ty) (sequence idx)
553
554 -------------------------------------------------------------------------------
555 -- * Type
556
557 forallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ
558 forallT tvars ctxt ty = do
559 ctxt1 <- ctxt
560 ty1 <- ty
561 return $ ForallT tvars ctxt1 ty1
562
563 varT :: Name -> TypeQ
564 varT = return . VarT
565
566 conT :: Name -> TypeQ
567 conT = return . ConT
568
569 infixT :: TypeQ -> Name -> TypeQ -> TypeQ
570 infixT t1 n t2 = do t1' <- t1
571 t2' <- t2
572 return (InfixT t1' n t2')
573
574 uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ
575 uInfixT t1 n t2 = do t1' <- t1
576 t2' <- t2
577 return (UInfixT t1' n t2')
578
579 parensT :: TypeQ -> TypeQ
580 parensT t = do t' <- t
581 return (ParensT t')
582
583 appT :: TypeQ -> TypeQ -> TypeQ
584 appT t1 t2 = do
585 t1' <- t1
586 t2' <- t2
587 return $ AppT t1' t2'
588
589 arrowT :: TypeQ
590 arrowT = return ArrowT
591
592 listT :: TypeQ
593 listT = return ListT
594
595 litT :: TyLitQ -> TypeQ
596 litT l = fmap LitT l
597
598 tupleT :: Int -> TypeQ
599 tupleT i = return (TupleT i)
600
601 unboxedTupleT :: Int -> TypeQ
602 unboxedTupleT i = return (UnboxedTupleT i)
603
604 sigT :: TypeQ -> Kind -> TypeQ
605 sigT t k
606 = do
607 t' <- t
608 return $ SigT t' k
609
610 equalityT :: TypeQ
611 equalityT = return EqualityT
612
613 wildCardT :: TypeQ
614 wildCardT = return (WildCardT Nothing)
615
616 namedWildCardT :: Name -> TypeQ
617 namedWildCardT = return . WildCardT . Just
618
619 {-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
620 classP :: Name -> [Q Type] -> Q Pred
621 classP cla tys
622 = do
623 tysl <- sequence tys
624 return (foldl AppT (ConT cla) tysl)
625
626 {-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}
627 equalP :: TypeQ -> TypeQ -> PredQ
628 equalP tleft tright
629 = do
630 tleft1 <- tleft
631 tright1 <- tright
632 eqT <- equalityT
633 return (foldl AppT eqT [tleft1, tright1])
634
635 promotedT :: Name -> TypeQ
636 promotedT = return . PromotedT
637
638 promotedTupleT :: Int -> TypeQ
639 promotedTupleT i = return (PromotedTupleT i)
640
641 promotedNilT :: TypeQ
642 promotedNilT = return PromotedNilT
643
644 promotedConsT :: TypeQ
645 promotedConsT = return PromotedConsT
646
647 isStrict, notStrict, unpacked :: Q Strict
648 isStrict = return $ IsStrict
649 notStrict = return $ NotStrict
650 unpacked = return Unpacked
651
652 strictType :: Q Strict -> TypeQ -> StrictTypeQ
653 strictType = liftM2 (,)
654
655 varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ
656 varStrictType v st = do (s, t) <- st
657 return (v, s, t)
658
659 -- * Type Literals
660
661 numTyLit :: Integer -> TyLitQ
662 numTyLit n = if n >= 0 then return (NumTyLit n)
663 else fail ("Negative type-level number: " ++ show n)
664
665 strTyLit :: String -> TyLitQ
666 strTyLit s = return (StrTyLit s)
667
668
669
670 -------------------------------------------------------------------------------
671 -- * Kind
672
673 plainTV :: Name -> TyVarBndr
674 plainTV = PlainTV
675
676 kindedTV :: Name -> Kind -> TyVarBndr
677 kindedTV = KindedTV
678
679 varK :: Name -> Kind
680 varK = VarT
681
682 conK :: Name -> Kind
683 conK = ConT
684
685 tupleK :: Int -> Kind
686 tupleK = TupleT
687
688 arrowK :: Kind
689 arrowK = ArrowT
690
691 listK :: Kind
692 listK = ListT
693
694 appK :: Kind -> Kind -> Kind
695 appK = AppT
696
697 starK :: Kind
698 starK = StarT
699
700 constraintK :: Kind
701 constraintK = ConstraintT
702
703 -------------------------------------------------------------------------------
704 -- * Type family result
705
706 noSig :: FamilyResultSig
707 noSig = NoSig
708
709 kindSig :: Kind -> FamilyResultSig
710 kindSig = KindSig
711
712 tyVarSig :: TyVarBndr -> FamilyResultSig
713 tyVarSig = TyVarSig
714
715 -------------------------------------------------------------------------------
716 -- * Injectivity annotation
717
718 injectivityAnn :: Name -> [Name] -> InjectivityAnn
719 injectivityAnn = TH.InjectivityAnn
720
721 -------------------------------------------------------------------------------
722 -- * Role
723
724 nominalR, representationalR, phantomR, inferR :: Role
725 nominalR = NominalR
726 representationalR = RepresentationalR
727 phantomR = PhantomR
728 inferR = InferR
729
730 -------------------------------------------------------------------------------
731 -- * Callconv
732
733 cCall, stdCall, cApi, prim, javaScript :: Callconv
734 cCall = CCall
735 stdCall = StdCall
736 cApi = CApi
737 prim = Prim
738 javaScript = JavaScript
739
740 -------------------------------------------------------------------------------
741 -- * Safety
742
743 unsafe, safe, interruptible :: Safety
744 unsafe = Unsafe
745 safe = Safe
746 interruptible = Interruptible
747
748 -------------------------------------------------------------------------------
749 -- * FunDep
750
751 funDep :: [Name] -> [Name] -> FunDep
752 funDep = FunDep
753
754 -------------------------------------------------------------------------------
755 -- * FamFlavour
756
757 typeFam, dataFam :: FamFlavour
758 typeFam = TypeFam
759 dataFam = DataFam
760
761 -------------------------------------------------------------------------------
762 -- * RuleBndr
763 ruleVar :: Name -> RuleBndrQ
764 ruleVar = return . RuleVar
765
766 typedRuleVar :: Name -> TypeQ -> RuleBndrQ
767 typedRuleVar n ty = ty >>= return . TypedRuleVar n
768
769 -------------------------------------------------------------------------------
770 -- * AnnTarget
771 valueAnnotation :: Name -> AnnTarget
772 valueAnnotation = ValueAnnotation
773
774 typeAnnotation :: Name -> AnnTarget
775 typeAnnotation = TypeAnnotation
776
777 moduleAnnotation :: AnnTarget
778 moduleAnnotation = ModuleAnnotation
779
780 --------------------------------------------------------------
781 -- * Useful helper function
782
783 appsE :: [ExpQ] -> ExpQ
784 appsE [] = error "appsE []"
785 appsE [x] = x
786 appsE (x:y:zs) = appsE ( (appE x y) : zs )
787
788 -- | Return the Module at the place of splicing. Can be used as an
789 -- input for 'reifyModule'.
790 thisModule :: Q Module
791 thisModule = do
792 loc <- location
793 return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)