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