1{-# LANGUAGE Safe #-}
2
3-- |
4-- Language.Haskell.TH.Lib contains lots of useful helper functions for
5-- generating and manipulating Template Haskell terms
6
7-- Note: this module mostly re-exports functions from
8-- Language.Haskell.TH.Lib.Internal, but if a change occurs to Template
9-- Haskell which requires breaking the API offered in this module, we opt to
10-- copy the old definition here, and make the changes in
11-- Language.Haskell.TH.Lib.Internal. This way, we can retain backwards
12-- compatibility while still allowing GHC to make changes as it needs.
13
14module Language.Haskell.TH.Lib (
15    -- All of the exports from this module should
16    -- be "public" functions.  The main module TH
17    -- re-exports them all.
18
19    -- * Library functions
20    -- ** Abbreviations
21        InfoQ, ExpQ, TExpQ, CodeQ, DecQ, DecsQ, ConQ, TypeQ, KindQ,
22        TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,
23        StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,
24        BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,
25        FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,
26        FamilyResultSigQ, DerivStrategyQ,
27        TyVarBndrUnit, TyVarBndrSpec,
28
29    -- ** Constructors lifted to 'Q'
30    -- *** Literals
31        intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,
32        charL, stringL, stringPrimL, charPrimL, bytesPrimL, mkBytes,
33    -- *** Patterns
34        litP, varP, tupP, unboxedTupP, unboxedSumP, conP, uInfixP, parensP,
35        infixP, tildeP, bangP, asP, wildP, recP,
36        listP, sigP, viewP,
37        fieldPat,
38
39    -- *** Pattern Guards
40        normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,
41
42    -- *** Expressions
43        dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,
44        appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR,
45        lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE,
46        letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,
47    -- **** Ranges
48    fromE, fromThenE, fromToE, fromThenToE,
49
50    -- ***** Ranges with more indirection
51    arithSeqE,
52    fromR, fromThenR, fromToR, fromThenToR,
53    -- **** Statements
54    doE, mdoE, compE,
55    bindS, letS, noBindS, parS, recS,
56
57    -- *** Types
58        forallT, forallVisT, varT, conT, appT, appKindT, arrowT, infixT,
59        mulArrowT,
60        uInfixT, parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT,
61        sigT, litT, wildCardT, promotedT, promotedTupleT, promotedNilT,
62        promotedConsT, implicitParamT,
63    -- **** Type literals
64    numTyLit, strTyLit,
65    -- **** Strictness
66    noSourceUnpackedness, sourceNoUnpack, sourceUnpack,
67    noSourceStrictness, sourceLazy, sourceStrict,
68    isStrict, notStrict, unpacked,
69    bang, bangType, varBangType, strictType, varStrictType,
70    -- **** Class Contexts
71    cxt, classP, equalP,
72    -- **** Constructors
73    normalC, recC, infixC, forallC, gadtC, recGadtC,
74
75    -- *** Kinds
76    varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,
77
78    -- *** Type variable binders
79    plainTV, kindedTV,
80    plainInvisTV, kindedInvisTV,
81    specifiedSpec, inferredSpec,
82
83    -- *** Roles
84    nominalR, representationalR, phantomR, inferR,
85
86    -- *** Top Level Declarations
87    -- **** Data
88    valD, funD, tySynD, dataD, newtypeD,
89    derivClause, DerivClause(..),
90    stockStrategy, anyclassStrategy, newtypeStrategy,
91    viaStrategy, DerivStrategy(..),
92    -- **** Class
93    classD, instanceD, instanceWithOverlapD, Overlap(..),
94    sigD, kiSigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,
95
96    -- **** Role annotations
97    roleAnnotD,
98    -- **** Type Family / Data Family
99    dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,
100    newtypeInstD, tySynInstD,
101    tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,
102
103    -- **** Fixity
104    infixLD, infixRD, infixND,
105
106    -- **** Foreign Function Interface (FFI)
107    cCall, stdCall, cApi, prim, javaScript,
108    unsafe, safe, interruptible, forImpD,
109
110    -- **** Functional dependencies
111    funDep,
112
113    -- **** Pragmas
114    ruleVar, typedRuleVar,
115    valueAnnotation, typeAnnotation, moduleAnnotation,
116    pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,
117    pragLineD, pragCompleteD,
118
119    -- **** Pattern Synonyms
120    patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn,
121    infixPatSyn, recordPatSyn,
122
123    -- **** Implicit Parameters
124    implicitParamBindD,
125
126    -- ** Reify
127    thisModule
128
129   ) where
130
131import Language.Haskell.TH.Lib.Internal hiding
132  ( tySynD
133  , dataD
134  , newtypeD
135  , classD
136  , pragRuleD
137  , dataInstD
138  , newtypeInstD
139  , dataFamilyD
140  , openTypeFamilyD
141  , closedTypeFamilyD
142  , tySynEqn
143  , forallC
144
145  , forallT
146  , sigT
147
148  , plainTV
149  , kindedTV
150  , starK
151  , constraintK
152
153  , noSig
154  , kindSig
155  , tyVarSig
156
157  , derivClause
158  , standaloneDerivWithStrategyD
159
160  , doE
161  , mdoE
162  , tupE
163  , unboxedTupE
164
165  , Role
166  , InjectivityAnn
167  )
168import qualified Language.Haskell.TH.Lib.Internal as Internal
169import Language.Haskell.TH.Syntax
170
171import Control.Applicative ( liftA2 )
172import Foreign.ForeignPtr
173import Data.Word
174import Prelude
175
176-- All definitions below represent the "old" API, since their definitions are
177-- different in Language.Haskell.TH.Lib.Internal. Please think carefully before
178-- deciding to change the APIs of the functions below, as they represent the
179-- public API (as opposed to the Internal module, which has no API promises.)
180
181-------------------------------------------------------------------------------
182-- *   Dec
183
184tySynD :: Quote m => Name -> [TyVarBndr ()] -> m Type -> m Dec
185tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
186
187dataD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> Maybe Kind -> [m Con] -> [m DerivClause]
188      -> m Dec
189dataD ctxt tc tvs ksig cons derivs =
190  do
191    ctxt1 <- ctxt
192    cons1 <- sequenceA cons
193    derivs1 <- sequenceA derivs
194    return (DataD ctxt1 tc tvs ksig cons1 derivs1)
195
196newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> Maybe Kind -> m Con -> [m DerivClause]
197         -> m Dec
198newtypeD ctxt tc tvs ksig con derivs =
199  do
200    ctxt1 <- ctxt
201    con1 <- con
202    derivs1 <- sequenceA derivs
203    return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)
204
205classD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> [FunDep] -> [m Dec] -> m Dec
206classD ctxt cls tvs fds decs =
207  do
208    decs1 <- sequenceA decs
209    ctxt1 <- ctxt
210    return $ ClassD ctxt1 cls tvs fds decs1
211
212pragRuleD :: Quote m => String -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec
213pragRuleD n bndrs lhs rhs phases
214  = do
215      bndrs1 <- sequenceA bndrs
216      lhs1   <- lhs
217      rhs1   <- rhs
218      return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases
219
220dataInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> [m Con] -> [m DerivClause]
221          -> m Dec
222dataInstD ctxt tc tys ksig cons derivs =
223  do
224    ctxt1 <- ctxt
225    ty1 <- foldl appT (conT tc) tys
226    cons1 <- sequenceA cons
227    derivs1 <- sequenceA derivs
228    return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1)
229
230newtypeInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> m Con -> [m DerivClause]
231             -> m Dec
232newtypeInstD ctxt tc tys ksig con derivs =
233  do
234    ctxt1 <- ctxt
235    ty1 <- foldl appT (conT tc) tys
236    con1  <- con
237    derivs1 <- sequenceA derivs
238    return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1)
239
240dataFamilyD :: Quote m => Name -> [TyVarBndr ()] -> Maybe Kind -> m Dec
241dataFamilyD tc tvs kind
242    = pure $ DataFamilyD tc tvs kind
243
244openTypeFamilyD :: Quote m => Name -> [TyVarBndr ()] -> FamilyResultSig
245                -> Maybe InjectivityAnn -> m Dec
246openTypeFamilyD tc tvs res inj
247    = pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)
248
249closedTypeFamilyD :: Quote m => Name -> [TyVarBndr ()] -> FamilyResultSig
250                  -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
251closedTypeFamilyD tc tvs result injectivity eqns =
252  do eqns1 <- sequenceA eqns
253     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
254
255tySynEqn :: Quote m => (Maybe [TyVarBndr ()]) -> m Type -> m Type -> m TySynEqn
256tySynEqn tvs lhs rhs =
257  do
258    lhs1 <- lhs
259    rhs1 <- rhs
260    return (TySynEqn tvs lhs1 rhs1)
261
262forallC :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Con -> m Con
263forallC ns ctxt con = liftA2 (ForallC ns) ctxt con
264
265-------------------------------------------------------------------------------
266-- *   Type
267
268forallT :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Type -> m Type
269forallT tvars ctxt ty = do
270    ctxt1 <- ctxt
271    ty1   <- ty
272    return $ ForallT tvars ctxt1 ty1
273
274sigT :: Quote m => m Type -> Kind -> m Type
275sigT t k
276  = do
277      t' <- t
278      return $ SigT t' k
279
280-------------------------------------------------------------------------------
281-- *   Kind
282
283plainTV :: Name -> TyVarBndr ()
284plainTV n = PlainTV n ()
285
286kindedTV :: Name -> Kind -> TyVarBndr ()
287kindedTV n k = KindedTV n () k
288
289starK :: Kind
290starK = StarT
291
292constraintK :: Kind
293constraintK = ConstraintT
294
295-------------------------------------------------------------------------------
296-- *   Type family result
297
298noSig :: FamilyResultSig
299noSig = NoSig
300
301kindSig :: Kind -> FamilyResultSig
302kindSig = KindSig
303
304tyVarSig :: TyVarBndr () -> FamilyResultSig
305tyVarSig = TyVarSig
306
307-------------------------------------------------------------------------------
308-- * Top Level Declarations
309
310derivClause :: Quote m => Maybe DerivStrategy -> [m Pred] -> m DerivClause
311derivClause mds p = do
312  p' <- cxt p
313  return $ DerivClause mds p'
314
315standaloneDerivWithStrategyD :: Quote m => Maybe DerivStrategy -> m Cxt -> m Type -> m Dec
316standaloneDerivWithStrategyD mds ctxt ty = do
317  ctxt' <- ctxt
318  ty'   <- ty
319  return $ StandaloneDerivD mds ctxt' ty'
320
321-------------------------------------------------------------------------------
322-- * Bytes literals
323
324-- | Create a Bytes datatype representing raw bytes to be embedded into the
325-- program/library binary.
326--
327-- @since 2.16.0.0
328mkBytes
329   :: ForeignPtr Word8 -- ^ Pointer to the data
330   -> Word             -- ^ Offset from the pointer
331   -> Word             -- ^ Number of bytes
332   -> Bytes
333mkBytes = Bytes
334
335-------------------------------------------------------------------------------
336-- * Tuple expressions
337
338tupE :: Quote m => [m Exp] -> m Exp
339tupE es = do { es1 <- sequenceA es; return (TupE $ map Just es1)}
340
341unboxedTupE :: Quote m => [m Exp] -> m Exp
342unboxedTupE es = do { es1 <- sequenceA es; return (UnboxedTupE $ map Just es1)}
343
344-------------------------------------------------------------------------------
345-- * Do expressions
346
347doE :: Quote m => [m Stmt] -> m Exp
348doE = Internal.doE Nothing
349
350mdoE :: Quote m => [m Stmt] -> m Exp
351mdoE = Internal.mdoE Nothing
352