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