1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE KindSignatures #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE RankNTypes #-}
9{-# LANGUAGE UndecidableInstances #-}
10
11#if __GLASGOW_HASKELL__ >= 702
12{-# LANGUAGE Trustworthy #-}
13#endif
14
15#if __GLASGOW_HASKELL__ >= 706
16{-# LANGUAGE PolyKinds #-}
17#endif
18
19#if __GLASGOW_HASKELL__ >= 708
20{-# LANGUAGE RoleAnnotations #-}
21#endif
22
23-- | This module exists to make it possible to define code that works across
24-- a wide range of @template-haskell@ versions with as little CPP as possible.
25-- To that end, this module currently backports the following
26-- @template-haskell@ constructs:
27--
28-- * The 'Quote' class
29--
30-- * The 'Code' type
31--
32-- Refer to the Haddocks below for examples of how to use each of these in a
33-- backwards-compatible way.
34module Language.Haskell.TH.Syntax.Compat (
35    -- * The @Quote@ class
36    -- $quote
37    Quote(..)
38    -- * @Quote@ functionality
39    -- ** The @unsafeQToQuote@ function
40  , unsafeQToQuote
41    -- ** Functions from @Language.Haskell.TH.Syntax@
42#if MIN_VERSION_template_haskell(2,9,0)
43  , unTypeQQuote
44  , unsafeTExpCoerceQuote
45#endif
46  , liftQuote
47#if MIN_VERSION_template_haskell(2,9,0)
48  , liftTypedQuote
49#endif
50  , liftStringQuote
51
52#if MIN_VERSION_template_haskell(2,9,0)
53    -- * The @Code@ and @CodeQ@ types
54    -- $code
55  , Code(..), CodeQ
56    -- * @Code@ functionality
57    -- ** The @IsCode@ class
58  , IsCode(..)
59    -- ** Limitations of @IsCode@
60    -- $isCodeLimitations
61    -- ** Functions from @Language.Haskell.TH.Syntax@
62  , unsafeCodeCoerce
63  , liftCode
64  , unTypeCode
65  , hoistCode
66  , bindCode
67  , bindCode_
68  , joinCode
69
70  -- * @Splice@
71  , Splice
72  , SpliceQ
73  , bindSplice
74  , bindSplice_
75  , examineSplice
76  , hoistSplice
77  , joinSplice
78  , liftSplice
79  , liftTypedFromUntypedSplice
80  , unsafeSpliceCoerce
81  , unTypeSplice
82#endif
83  ) where
84
85import qualified Control.Monad.Fail as Fail
86import Control.Monad.IO.Class (MonadIO(..))
87import Language.Haskell.TH (Exp)
88import qualified Language.Haskell.TH.Lib as Lib ()
89import Language.Haskell.TH.Syntax (Q, runQ, Quasi(..))
90import qualified Language.Haskell.TH.Syntax as Syntax
91
92#if !(MIN_VERSION_base(4,8,0))
93import Control.Applicative
94#endif
95
96#if MIN_VERSION_template_haskell(2,16,0)
97import GHC.Exts (RuntimeRep, TYPE)
98#endif
99
100#if MIN_VERSION_template_haskell(2,17,0)
101import Language.Haskell.TH.Lib (CodeQ)
102import Language.Haskell.TH.Syntax
103  ( Code(..), Quote(..)
104  , bindCode, bindCode_, hoistCode, joinCode, liftCode, unsafeCodeCoerce, unTypeCode
105  , unsafeTExpCoerce, unTypeQ )
106#else
107import Language.Haskell.TH (Name)
108#endif
109
110-------------------------------------------------------------------------------
111-- Quote
112-------------------------------------------------------------------------------
113
114-- $quote
115-- The 'Quote' class (first proposed in
116-- <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0246-overloaded-bracket.rst GHC Proposal 246>)
117-- was introduced in @template-haskell-2.17.0.0@. This module defines a version
118-- of 'Quote' that is backward-compatible with older @template-haskell@
119-- releases and is forward-compatible with the existing 'Quote' class.
120--
121-- In addition to 'Quote', this module also backports versions of functions in
122-- "Language.Haskell.TH.Syntax" that work over any 'Quote' instance instead of
123-- just 'Q'. Since this module is designed to coexist with the existing
124-- definitions in @template-haskell@ as much as possible, the backported
125-- functions are suffixed with @-Quote@ to avoid name clashes. For instance,
126-- the backported version of 'lift' is named 'liftQuote'.
127--
128-- The one exception to the no-name-clashes policy is the backported 'newName'
129-- method of 'Quote'. We could have conceivably named it 'newNameQuote', but
130-- then it would not have been possible to define backwards-compatible 'Quote'
131-- instances without the use of CPP. As a result, some care must be exercised
132-- when combining this module with "Language.Haskell.TH" or
133-- "Language.Haskell.TH.Syntax" on older versions of @template-haskell@, as
134-- they both export a version of 'newName' with a different type. Here is an
135-- example of how to safely combine these modules:
136--
137-- @
138-- &#123;-&#35; LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell &#35;-&#125;
139--
140-- import Control.Monad.State (MonadState(..), State, evalState)
141-- import "Language.Haskell.TH" hiding ('newName')
142-- import "Language.Haskell.TH.Syntax" hiding ('newName')
143-- import "Language.Haskell.TH.Syntax.Compat"
144--
145-- newtype PureQ a = MkPureQ (State Uniq a)
146--   deriving (Functor, Applicative, Monad, MonadState Uniq)
147--
148-- runPureQ :: PureQ a -> a
149-- runPureQ m = case m of MkPureQ m' -> evalState m' 0
150--
151-- instance 'Quote' PureQ where
152--   'newName' s = state $ \i -> (mkNameU s i, i + 1)
153--
154-- main :: IO ()
155-- main = putStrLn $ runPureQ $ do
156--   a <- newName "a"
157--   return $ nameBase a
158-- @
159--
160-- We do not make an effort to backport any combinators from the
161-- "Language.Haskell.TH.Lib" module, as the surface area is simply too large.
162-- If you wish to generalize code that uses these combinators to work over
163-- 'Quote' in a backwards-compatible way, use the 'unsafeQToQuote' function.
164
165#if !(MIN_VERSION_template_haskell(2,17,0))
166-- | The 'Quote' class implements the minimal interface which is necessary for
167-- desugaring quotations.
168--
169-- * The @Monad m@ superclass is needed to stitch together the different
170-- AST fragments.
171-- * 'newName' is used when desugaring binding structures such as lambdas
172-- to generate fresh names.
173--
174-- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`
175--
176-- For many years the type of a quotation was fixed to be `Q Exp` but by
177-- more precisely specifying the minimal interface it enables the `Exp` to
178-- be extracted purely from the quotation without interacting with `Q`.
179class ( Monad m
180# if   !(MIN_VERSION_template_haskell(2,7,0))
181      , Functor m
182# elif !(MIN_VERSION_template_haskell(2,10,0))
183      , Applicative m
184# endif
185      ) => Quote m where
186  {- |
187  Generate a fresh name, which cannot be captured.
188
189  For example, this:
190
191  @f = $(do
192    nm1 <- newName \"x\"
193    let nm2 = 'mkName' \"x\"
194    return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
195   )@
196
197  will produce the splice
198
199  >f = \x0 -> \x -> x0
200
201  In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
202  and is not captured by the binding @VarP nm2@.
203
204  Although names generated by @newName@ cannot /be captured/, they can
205  /capture/ other names. For example, this:
206
207  >g = $(do
208  >  nm1 <- newName "x"
209  >  let nm2 = mkName "x"
210  >  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
211  > )
212
213  will produce the splice
214
215  >g = \x -> \x0 -> x0
216
217  since the occurrence @VarE nm2@ is captured by the innermost binding
218  of @x@, namely @VarP nm1@.
219  -}
220  newName :: String -> m Name
221
222instance Quote Q where
223  newName = qNewName
224#endif
225
226#if MIN_VERSION_template_haskell(2,9,0)
227-- | Discard the type annotation and produce a plain Template Haskell
228-- expression
229--
230-- Levity-polymorphic since /template-haskell-2.16.0.0/.
231--
232-- This is a variant of the 'unTypeQ' function that is always guaranteed to
233-- use a 'Quote' constraint, even on old versions of @template-haskell@.
234--
235-- As this function interacts with typed Template Haskell, this function is
236-- only defined on @template-haskell-2.9.0.0@ (GHC 7.8) or later.
237unTypeQQuote ::
238# if MIN_VERSION_template_haskell(2,16,0)
239  forall (r :: RuntimeRep) (a :: TYPE r) m .
240# else
241  forall a m .
242# endif
243  Quote m => m (Syntax.TExp a) -> m Exp
244# if MIN_VERSION_template_haskell(2,17,0)
245unTypeQQuote = unTypeQ
246# else
247unTypeQQuote m = do { Syntax.TExp e <- m
248                    ; return e }
249# endif
250
251-- | Annotate the Template Haskell expression with a type
252--
253-- This is unsafe because GHC cannot check for you that the expression
254-- really does have the type you claim it has.
255--
256-- Levity-polymorphic since /template-haskell-2.16.0.0/.
257--
258-- This is a variant of the 'unsafeTExpCoerce' function that is always
259-- guaranteed to use a 'Quote' constraint, even on old versions of
260-- @template-haskell@.
261--
262-- As this function interacts with typed Template Haskell, this function is
263-- only defined on @template-haskell-2.9.0.0@ (GHC 7.8) or later.
264unsafeTExpCoerceQuote ::
265# if MIN_VERSION_template_haskell(2,16,0)
266  forall (r :: RuntimeRep) (a :: TYPE r) m .
267# else
268  forall a m .
269# endif
270  Quote m => m Exp -> m (Syntax.TExp a)
271# if MIN_VERSION_template_haskell(2,17,0)
272unsafeTExpCoerceQuote = unsafeTExpCoerce
273# else
274unsafeTExpCoerceQuote m = do { e <- m
275                             ; return (Syntax.TExp e) }
276# endif
277#endif
278
279-- | Turn a value into a Template Haskell expression, suitable for use in
280-- a splice.
281--
282-- This is a variant of the 'Syntax.lift' method of 'Syntax.Lift' that is
283-- always guaranteed to use a 'Quote' constraint, even on old versions of
284-- @template-haskell@.
285--
286-- Levity-polymorphic since /template-haskell-2.17.0.0/.
287liftQuote ::
288#if MIN_VERSION_template_haskell(2,17,0)
289  forall (r :: RuntimeRep) (t :: TYPE r) m .
290#else
291  forall t m .
292#endif
293  (Syntax.Lift t, Quote m) => t -> m Exp
294#if MIN_VERSION_template_haskell(2,17,0)
295liftQuote = Syntax.lift
296#else
297liftQuote = unsafeQToQuote . Syntax.lift
298#endif
299
300#if MIN_VERSION_template_haskell(2,9,0)
301-- | Turn a value into a Template Haskell typed expression, suitable for use
302-- in a typed splice.
303--
304-- This is a variant of the 'Syntax.liftTyped' method of 'Syntax.Lift' that is
305-- always guaranteed to use a 'Quote' constraint and return a 'Code', even on
306-- old versions of @template-haskell@.
307--
308-- As this function interacts with typed Template Haskell, this function is
309-- only defined on @template-haskell-2.9.0.0@ (GHC 7.8) or later. While the
310-- 'Syntax.liftTyped' method of 'Syntax.Lift' was first introduced in
311-- @template-haskell-2.16.0.0@, we are able to backport it back to
312-- @template-haskell-2.9.0.0@ by making use of the 'Syntax.lift' method on
313-- older versions of @template-haskell@. This crucially relies on the
314-- 'Syntax.Lift' law that @'lift' x ≡ 'unTypeQ' ('liftTyped' x)@ to work,
315-- so beware if you use 'liftTypedQuote' with an unlawful 'Syntax.Lift'
316-- instance.
317--
318-- Levity-polymorphic since /template-haskell-2.17.0.0/.
319liftTypedQuote ::
320# if MIN_VERSION_template_haskell(2,17,0)
321  forall (r :: RuntimeRep) (t :: TYPE r) m .
322# else
323  forall t m .
324# endif
325  (Syntax.Lift t, Quote m) => t -> Code m t
326# if MIN_VERSION_template_haskell(2,17,0)
327liftTypedQuote = Syntax.liftTyped
328# elif MIN_VERSION_template_haskell(2,16,0)
329liftTypedQuote = liftCode . unsafeQToQuote . Syntax.liftTyped
330# else
331liftTypedQuote = unsafeCodeCoerce . liftQuote
332# endif
333#endif
334
335-- | This is a variant of the 'Syntax.liftString' function that is always
336-- guaranteed to use a 'Quote' constraint, even on old versions of
337-- @template-haskell@.
338liftStringQuote :: Quote m => String -> m Exp
339#if MIN_VERSION_template_haskell(2,17,0)
340liftStringQuote = Syntax.liftString
341#else
342liftStringQuote = unsafeQToQuote . Syntax.liftString
343#endif
344
345-- | Use a 'Q' computation in a 'Quote' context. This function is only safe
346-- when the 'Q' computation performs actions from the 'Quote' instance for 'Q'
347-- or any of `Quote`'s subclasses ('Functor', 'Applicative', and 'Monad').
348-- Attempting to perform actions from the 'MonadFail', 'MonadIO', or 'Quasi'
349-- instances for 'Q' will result in runtime errors.
350--
351-- This is useful when you have some 'Q'-valued functions that only performs
352-- actions from 'Quote' and wish to generalise it from 'Q' to 'Quote' without
353-- having to rewrite the internals of the function. This is especially handy
354-- for code defined in terms of combinators from "Language.Haskell.TH.Lib",
355-- which were all hard-coded to 'Q' prior to @template-haskell-2.17.0.0@. For
356-- instance, consider this function:
357--
358-- @
359-- apply :: 'Exp' -> 'Exp' -> 'Q' 'Exp'
360-- apply f x = 'Lib.appE' (return x) (return y)
361-- @
362--
363-- There are two ways to generalize this function to use 'Quote' in a
364-- backwards-compatible way. One way to do so is to rewrite @apply@ to avoid
365-- the use of 'Lib.appE', like so:
366--
367-- @
368-- applyQuote :: 'Quote' m => 'Exp' -> 'Exp' -> m 'Exp'
369-- applyQuote f x = return ('Syntax.AppE' x y)
370-- @
371--
372-- For a small example like @applyQuote@, there isn't much work involved. But
373-- this can become tiresome for larger examples. In such cases,
374-- 'unsafeQToQuote' can do the heavy lifting for you. For example, @applyQuote@
375-- can also be defined as:
376--
377-- @
378-- applyQuote :: 'Quote' m => 'Exp' -> 'Exp' -> m 'Exp'
379-- applyQuote f x = 'unsafeQToQuote' (apply f x)
380-- @
381unsafeQToQuote :: Quote m => Q a -> m a
382unsafeQToQuote = unQTQ . runQ
383
384-- | An internal definition that powers 'unsafeQToQuote'. Its 'Quasi' instance
385-- defines 'qNewName' in terms of 'newName' from 'Quote', but defines every
386-- other method of 'Quasi' to be an error, since they cannot be implemented
387-- using 'Quote' alone. Similarly, its 'MonadFail' and 'MonadIO' instances
388-- define 'fail' and 'liftIO', respectively, to be errors.
389newtype QuoteToQuasi (m :: * -> *) a = QTQ { unQTQ :: m a }
390  deriving (Functor, Applicative, Monad)
391
392qtqError :: String -> a
393qtqError name = error $ "`unsafeQToQuote` does not support code that uses " ++ name
394
395instance Monad m => Fail.MonadFail (QuoteToQuasi m) where
396  fail = qtqError "MonadFail.fail"
397
398instance Monad m => MonadIO (QuoteToQuasi m) where
399  liftIO = qtqError "liftIO"
400
401instance Quote m => Quasi (QuoteToQuasi m) where
402  qNewName s = QTQ (newName s)
403
404  qRecover            = qtqError "qRecover"
405  qReport             = qtqError "qReport"
406  qReify              = qtqError "qReify"
407  qLocation           = qtqError "qLocation"
408  qRunIO              = qtqError "qRunIO"
409#if MIN_VERSION_template_haskell(2,7,0)
410  qReifyInstances     = qtqError "qReifyInstances"
411  qLookupName         = qtqError "qLookupName"
412  qAddDependentFile   = qtqError "qAddDependentFile"
413# if MIN_VERSION_template_haskell(2,9,0)
414  qReifyRoles         = qtqError "qReifyRoles"
415  qReifyAnnotations   = qtqError "qReifyAnnotations"
416  qReifyModule        = qtqError "qReifyModule"
417  qAddTopDecls        = qtqError "qAddTopDecls"
418  qAddModFinalizer    = qtqError "qAddModFinalizer"
419  qGetQ               = qtqError "qGetQ"
420  qPutQ               = qtqError "qPutQ"
421# endif
422# if MIN_VERSION_template_haskell(2,11,0)
423  qReifyFixity        = qtqError "qReifyFixity"
424  qReifyConStrictness = qtqError "qReifyConStrictness"
425  qIsExtEnabled       = qtqError "qIsExtEnabled"
426  qExtsEnabled        = qtqError "qExtsEnabled"
427# endif
428#elif MIN_VERSION_template_haskell(2,5,0)
429  qClassInstances     = qtqError "qClassInstances"
430#endif
431#if MIN_VERSION_template_haskell(2,13,0)
432  qAddCorePlugin      = qtqError "qAddCorePlugin"
433#endif
434#if MIN_VERSION_template_haskell(2,14,0)
435  qAddForeignFilePath = qtqError "qAddForeignFilePath"
436  qAddTempFile        = qtqError "qAddTempFile"
437#elif MIN_VERSION_template_haskell(2,12,0)
438  qAddForeignFile     = qtqError "qAddForeignFile"
439#endif
440#if MIN_VERSION_template_haskell(2,16,0)
441  qReifyType          = qtqError "qReifyType"
442#endif
443
444-------------------------------------------------------------------------------
445-- Code
446-------------------------------------------------------------------------------
447
448-- $code
449-- The 'Code' type (first proposed in
450-- <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0195-code-texp.rst GHC Proposal 195>)
451-- was introduced in @template-haskell-2.17.0.0@. This module defines a version
452-- of 'Code' that is backward-compatible with older @template-haskell@
453-- releases and is forward-compatible with the existing 'Code' class.
454-- In addition to 'Code', this module also backports the functions in
455-- "Language.Haskell.TH.Syntax" that manipulate 'Code' values.
456--
457-- One troublesome aspect of writing backwards-compatible code involving 'Code'
458-- is that GHC 9.0 changed the types of typed Template Haskell splices. Before,
459-- they were of type @'Q' ('TExp' a)@, but they are now of type @'Code' 'Q' a@.
460-- This modules provides two mechanisms for smoothing over the differences
461-- between these two types:
462--
463-- * The 'IsCode' class can be used to convert 'Code' or 'TExp' values to
464--   'Code', and vice versa.
465--
466-- * The 'Splice' type synonym uses CPP so that @'Splice' q a@ is a synonym for
467--   @'Code' q a@ on GHC 9.0 or later and @q ('TExp' a)@ on older versions of
468--   GHC. This module also defines versions of 'Code'- and 'TExp'-related
469--   combinators that work over 'Splice'.
470--
471-- Refer to the Haddocks for 'IsCode' and 'Splice' for more information on each
472-- approach. Both approaches have pros and cons, and as a result, neither
473-- approach is a one-size-fits-all solution.
474--
475-- Because 'Code' interacts with typed Template Haskell, the 'Code' type and
476-- any function that mentions 'Code' in its type are only defined on
477-- @template-haskell-2.9.0.0@ (GHC 7.8) or later.
478
479#if MIN_VERSION_template_haskell(2,9,0)
480-- | A class that allows one to smooth over the differences between
481-- @'Code' 'm' a@ (the type of typed Template Haskell quotations on
482-- @template-haskell-2.17.0.0@ or later) and @'m' ('TExp' a)@ (the type of
483-- typed Template Haskell quotations on older versions of @template-haskell@).
484-- Here are two examples that demonstrate how to use each method of 'IsCode':
485--
486-- @
487-- &#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;
488--
489-- import "Language.Haskell.TH"
490-- import "Language.Haskell.TH.Syntax.Compat"
491--
492-- -- 'toCode' will ensure that the end result is a 'Code', regardless of
493-- -- whether the quote itself returns a 'Code' or a 'TExp'.
494-- myCode :: 'Code' 'Q' Int
495-- myCode = 'toCode' [|| 42 ||]
496--
497-- -- 'fromCode' will ensure that the input 'Code' is suitable for splicing
498-- -- (i.e., it will return a 'Code' or a 'TExp' depending on the
499-- -- @template-haskell@ version in use).
500-- fortyTwo :: Int
501-- fortyTwo = $$('fromCode' myCode)
502-- @
503--
504-- Levity-polymorphic since /template-haskell-2.16.0.0/.
505class IsCode q
506# if MIN_VERSION_template_haskell(2,16,0)
507             (a :: TYPE r)
508# else
509             a
510# endif
511             c | c -> a q where
512  -- | Convert something to a 'Code'.
513  toCode   :: c -> Code q a
514  -- | Convert to something from a 'Code'.
515  fromCode :: Code q a -> c
516
517-- | Levity-polymorphic since /template-haskell-2.16.0.0/.
518instance Quote q => IsCode q
519# if MIN_VERSION_template_haskell(2,16,0)
520                           (a :: TYPE r)
521# else
522                           a
523# endif
524                           (Code q a) where
525  toCode   = id
526  fromCode = id
527
528-- | Levity-polymorphic since /template-haskell-2.16.0.0/.
529instance texp ~ Syntax.TExp a => IsCode Q
530# if MIN_VERSION_template_haskell(2,16,0)
531                                        (a :: TYPE r)
532# else
533                                        a
534# endif
535                                        (Q texp) where
536  toCode   = liftCode
537  fromCode = examineCode
538
539-- $isCodeLimitations
540-- 'IsCode' makes it possible to backport code involving typed Template Haskell
541-- quotations and splices where the types are monomorphized to 'Q'. GHC 9.0
542-- and later, however, make it possible to use typed TH quotations and splices
543-- that are polymorphic over any 'Quote' instance. Unfortunately, the
544-- @th-compat@ library does not yet have a good story for backporting
545-- 'Quote'-polymorphic quotations or splices. For example, consider this code:
546--
547-- @
548-- instance ('Syntax.Lift' a, 'Quote' q, 'Num' a) => 'Num' ('Code' q a) where
549--   -- ...
550--   x + y = [|| $$x + $$y ||]
551--   -- ...
552-- @
553--
554-- How might we backport this code? If we were in a setting where @q@ were
555-- monomorphized to 'Q', we could simply write this:
556--
557-- @
558--   x + y = 'toCode' [|| $$('fromCode' x) + $$('fromCode' y) ||]
559-- @
560--
561-- In a 'Quote'-polymorphic setting, however, we run into issues. While this
562-- will compile on GHC 9.0 or later, it will not compile on earlier GHC
563-- versions because all typed TH quotations and splices must use 'Q'. At
564-- present, the @th-compat@ library does not offer any solution to this
565-- problem.
566
567-- | Levity-polymorphic since /template-haskell-2.16.0.0/.
568# if !(MIN_VERSION_template_haskell(2,17,0))
569type role Code representational nominal
570newtype Code m
571#  if MIN_VERSION_template_haskell(2,16,0)
572             (a :: TYPE (r :: RuntimeRep))
573#  else
574             a
575#  endif
576  = Code
577  { examineCode :: m (Syntax.TExp a) -- ^ Underlying monadic value
578  }
579
580type CodeQ = Code Q
581# if MIN_VERSION_template_haskell(2,16,0)
582                    :: (TYPE r -> *)
583# endif
584
585-- | Unsafely convert an untyped code representation into a typed code
586-- representation.
587--
588-- Levity-polymorphic since /template-haskell-2.16.0.0/.
589unsafeCodeCoerce ::
590#  if MIN_VERSION_template_haskell(2,16,0)
591  forall (r :: RuntimeRep) (a :: TYPE r) m .
592#  else
593  forall a m .
594#  endif
595  Quote m => m Exp -> Code m a
596unsafeCodeCoerce m = Code (unsafeTExpCoerceQuote m)
597
598-- | Lift a monadic action producing code into the typed 'Code'
599-- representation
600--
601-- Levity-polymorphic since /template-haskell-2.16.0.0/.
602liftCode ::
603#  if MIN_VERSION_template_haskell(2,16,0)
604  forall (r :: RuntimeRep) (a :: TYPE r) m .
605#  else
606  forall a m .
607#  endif
608  m (Syntax.TExp a) -> Code m a
609liftCode = Code
610
611-- | Extract the untyped representation from the typed representation
612--
613-- Levity-polymorphic since /template-haskell-2.16.0.0/.
614unTypeCode ::
615#  if MIN_VERSION_template_haskell(2,16,0)
616  forall (r :: RuntimeRep) (a :: TYPE r) m .
617#  else
618  forall a m .
619#  endif
620  Quote m => Code m a -> m Exp
621unTypeCode = unTypeQQuote . examineCode
622
623-- | Modify the ambient monad used during code generation. For example, you
624-- can use `hoistCode` to handle a state effect:
625--
626-- @
627--  handleState :: Code (StateT Int Q) a -> Code Q a
628--  handleState = hoistCode (flip runState 0)
629-- @
630--
631-- Levity-polymorphic since /template-haskell-2.16.0.0/.
632hoistCode ::
633#  if MIN_VERSION_template_haskell(2,16,0)
634  forall m n (r :: RuntimeRep) (a :: TYPE r) .
635#  else
636  forall m n a .
637#  endif
638  Monad m => (forall x . m x -> n x) -> Code m a -> Code n a
639hoistCode f (Code a) = Code (f a)
640
641
642-- | Variant of (>>=) which allows effectful computations to be injected
643-- into code generation.
644--
645-- Levity-polymorphic since /template-haskell-2.16.0.0/.
646bindCode ::
647#  if MIN_VERSION_template_haskell(2,16,0)
648  forall m a (r :: RuntimeRep) (b :: TYPE r) .
649#  else
650  forall m a b .
651#  endif
652  Monad m => m a -> (a -> Code m b) -> Code m b
653bindCode q k = liftCode (q >>= examineCode . k)
654
655-- | Variant of (>>) which allows effectful computations to be injected
656-- into code generation.
657--
658-- Levity-polymorphic since /template-haskell-2.16.0.0/.
659bindCode_ ::
660#  if MIN_VERSION_template_haskell(2,16,0)
661  forall m a (r :: RuntimeRep) (b :: TYPE r) .
662#  else
663  forall m a b .
664#  endif
665  Monad m => m a -> Code m b -> Code m b
666bindCode_ q c = liftCode ( q >> examineCode c)
667
668-- | A useful combinator for embedding monadic actions into 'Code'
669-- @
670-- myCode :: ... => Code m a
671-- myCode = joinCode $ do
672--   x <- someSideEffect
673--   return (makeCodeWith x)
674-- @
675--
676-- Levity-polymorphic since /template-haskell-2.16.0.0/.
677joinCode ::
678#  if MIN_VERSION_template_haskell(2,16,0)
679  forall m (r :: RuntimeRep) (a :: TYPE r) .
680#  else
681  forall m a .
682#  endif
683  Monad m => m (Code m a) -> Code m a
684joinCode = flip bindCode id
685# endif
686
687-- | @'Splice' m a@ is a type alias for:
688--
689-- * @'Code' m a@, if using @template-haskell-2.17.0.0@ or later, or
690--
691-- * @m ('Syntax.TExp' a)@, if using an older version of @template-haskell@.
692--
693-- This should be used with caution, as its definition differs depending on
694-- which version of @template-haskell@ you are using. It is mostly useful for
695-- contexts in which one is writing a definition that is intended to be used
696-- directly in a typed Template Haskell splice, as the types of TH splices
697-- differ between @template-haskell@ versions as well.
698--
699-- Levity-polymorphic since /template-haskell-2.16.0.0/.
700# if MIN_VERSION_template_haskell(2,17,0)
701type Splice  = Code :: (forall r. (* -> *) -> TYPE r -> *)
702# elif MIN_VERSION_template_haskell(2,16,0)
703type Splice m (a :: TYPE r) = m (Syntax.TExp a)
704# else
705type Splice m a = m (Syntax.TExp a)
706# endif
707
708-- | @'SpliceQ' a@ is a type alias for:
709--
710-- * @'Code' 'Q' a@, if using @template-haskell-2.17.0.0@ or later, or
711--
712-- * @'Q' ('Syntax.TExp' a)@, if using an older version of @template-haskell@.
713--
714-- This should be used with caution, as its definition differs depending on
715-- which version of @template-haskell@ you are using. It is mostly useful for
716-- contexts in which one is writing a definition that is intended to be used
717-- directly in a typed Template Haskell splice, as the types of TH splices
718-- differ between @template-haskell@ versions as well.
719--
720-- Levity-polymorphic since /template-haskell-2.16.0.0/.
721# if MIN_VERSION_template_haskell(2,17,0)
722type SpliceQ = Splice Q :: (TYPE r -> *)
723# elif MIN_VERSION_template_haskell(2,16,0)
724type SpliceQ (a :: TYPE r) = Splice Q a
725# else
726type SpliceQ a = Splice Q a
727# endif
728
729-- | A variant of 'bindCode' that works over 'Splice's. Because this function
730-- uses 'Splice', the type of this function will be different depending on
731-- which version of @template-haskell@ you are using. (See the Haddocks for
732-- 'Splice' for more information on this point.)
733--
734-- Levity-polymorphic since /template-haskell-2.16.0.0/.
735bindSplice ::
736#  if MIN_VERSION_template_haskell(2,16,0)
737  forall m a (r :: RuntimeRep) (b :: TYPE r) .
738#  else
739  forall m a b .
740#  endif
741  Monad m => m a -> (a -> Splice m b) -> Splice m b
742# if MIN_VERSION_template_haskell(2,17,0)
743bindSplice = bindCode
744# else
745bindSplice q k = liftSplice (q >>= examineSplice . k)
746# endif
747
748-- | A variant of 'bindCode_' that works over 'Splice's. Because this function
749-- uses 'Splice', the type of this function will be different depending on
750-- which version of @template-haskell@ you are using. (See the Haddocks for
751-- 'Splice' for more information on this point.)
752--
753-- Levity-polymorphic since /template-haskell-2.16.0.0/.
754bindSplice_ ::
755#  if MIN_VERSION_template_haskell(2,16,0)
756  forall m a (r :: RuntimeRep) (b :: TYPE r) .
757#  else
758  forall m a b .
759#  endif
760  Monad m => m a -> Splice m b -> Splice m b
761# if MIN_VERSION_template_haskell(2,17,0)
762bindSplice_ = bindCode_
763# else
764bindSplice_ q c = liftSplice ( q >> examineSplice c)
765# endif
766
767-- | A variant of 'examineCode' that takes a 'Splice' as an argument. Because
768-- this function takes a 'Splice' as an argyment, the type of this function
769-- will be different depending on which version of @template-haskell@ you are
770-- using. (See the Haddocks for 'Splice' for more information on this point.)
771--
772-- Levity-polymorphic since /template-haskell-2.16.0.0/.
773examineSplice ::
774# if MIN_VERSION_template_haskell(2,16,0)
775  forall (r :: RuntimeRep) m (a :: TYPE r) .
776# else
777  forall m a .
778# endif
779  Splice m a -> m (Syntax.TExp a)
780# if MIN_VERSION_template_haskell(2,17,0)
781examineSplice = examineCode
782# else
783examineSplice = id
784# endif
785
786-- | A variant of 'hoistCode' that works over 'Splice's. Because this function
787-- uses 'Splice', the type of this function will be different depending on
788-- which version of @template-haskell@ you are using. (See the Haddocks for
789-- 'Splice' for more information on this point.)
790--
791-- Levity-polymorphic since /template-haskell-2.16.0.0/.
792hoistSplice ::
793#  if MIN_VERSION_template_haskell(2,16,0)
794  forall m n (r :: RuntimeRep) (a :: TYPE r) .
795#  else
796  forall m n a .
797#  endif
798  Monad m => (forall x . m x -> n x) -> Splice m a -> Splice n a
799# if MIN_VERSION_template_haskell(2,17,0)
800hoistSplice = hoistCode
801# else
802hoistSplice f a = f a
803# endif
804
805-- | A variant of 'joinCode' that works over 'Splice's. Because this function
806-- uses 'Splice', the type of this function will be different depending on
807-- which version of @template-haskell@ you are using. (See the Haddocks for
808-- 'Splice' for more information on this point.)
809--
810-- Levity-polymorphic since /template-haskell-2.16.0.0/.
811joinSplice ::
812#  if MIN_VERSION_template_haskell(2,16,0)
813  forall m (r :: RuntimeRep) (a :: TYPE r) .
814#  else
815  forall m a .
816#  endif
817  Monad m => m (Splice m a) -> Splice m a
818# if MIN_VERSION_template_haskell(2,17,0)
819joinSplice = joinCode
820# else
821joinSplice = flip bindSplice id
822# endif
823
824-- | A variant of 'liftCode' that returns a 'Splice'. Because this function
825-- returns a 'Splice', the return type of this function will be different
826-- depending on which version of @template-haskell@ you are using. (See the
827-- Haddocks for 'Splice' for more
828-- information on this point.)
829--
830-- Levity-polymorphic since /template-haskell-2.16.0.0/.
831liftSplice ::
832# if MIN_VERSION_template_haskell(2,16,0)
833  forall (r :: RuntimeRep) (a :: TYPE r) m .
834# else
835  forall a m .
836# endif
837  m (Syntax.TExp a) -> Splice m a
838# if MIN_VERSION_template_haskell(2,17,0)
839liftSplice = liftCode
840# else
841liftSplice = id
842# endif
843
844-- | A variant of 'liftTypedQuote' that is:
845--
846-- 1. Always implemented in terms of 'Syntax.lift' behind the scenes, and
847--
848-- 2. Returns a 'Splice'. This means that the return type of this function will
849--    be different depending on which version of @template-haskell@ you are
850--    using. (See the Haddocks for 'Splice' for more information on this
851--    point.)
852--
853-- This is especially useful for minimizing CPP in one particular scenario:
854-- implementing 'Syntax.liftTyped' in hand-written 'Syntax.Lift' instances
855-- where the corresponding 'Syntax.lift' implementation cannot be derived. For
856-- instance, consider this example from the @text@ library:
857--
858-- @
859-- instance 'Syntax.Lift' Text where
860--   'Syntax.lift' = appE (varE 'pack) . stringE . unpack
861-- #if MIN\_VERSION\_template\_haskell(2,17,0)
862--   'Syntax.liftTyped' = 'unsafeCodeCoerce' . 'Syntax.lift'
863-- #elif MIN\_VERSION\_template\_haskell(2,16,0)
864--   'Syntax.liftTyped' = 'Syntax.unsafeTExpCoerce' . 'Syntax.lift'
865-- #endif
866-- @
867--
868-- The precise details of how this 'Syntax.lift' implementation works are not
869-- important, only that it is something that @DeriveLift@ could not generate.
870-- The main point of this example is to illustrate how tiresome it is to write
871-- the CPP necessary to define 'Syntax.liftTyped' in a way that works across
872-- multiple versions of @template-haskell@. With 'liftTypedFromUntypedSplice',
873-- however, this becomes slightly easier to manage:
874--
875-- @
876-- instance 'Syntax.Lift' Text where
877--   'Syntax.lift' = appE (varE 'pack) . stringE . unpack
878-- #if MIN\_VERSION\_template\_haskell(2,16,0)
879--   'Syntax.liftTyped' = 'liftTypedFromUntypedSplice'
880-- #endif
881-- @
882--
883-- Note that due to the way this function is defined, this will only work
884-- for 'Syntax.Lift' instances @t@ such that @(t :: Type)@. If you wish to
885-- manually define 'Syntax.liftTyped' for a type with a different kind, you
886-- will have to use 'unsafeSpliceCoerce' to overcome levity polymorphism
887-- restrictions.
888liftTypedFromUntypedSplice :: (Syntax.Lift t, Quote m) => t -> Splice m t
889liftTypedFromUntypedSplice = unsafeSpliceCoerce . liftQuote
890
891-- | Unsafely convert an untyped splice representation into a typed 'Splice'
892-- representation. Because this function returns a 'Splice', the return type of
893-- this function will be different depending on which version of
894-- @template-haskell@ you are using. (See the Haddocks for 'Splice' for more
895-- information on this point.)
896--
897-- This is especially useful for minimizing CPP when:
898--
899-- 1. You need to implement 'Syntax.liftTyped' in a hand-written 'Syntax.Lift'
900--    instance where the corresponding 'Syntax.lift' implementation cannot be
901--    derived, and
902--
903-- 2. The data type receiving a 'Lift' instance has a kind besides @Type@.
904--
905-- Condition (2) is important because while it is possible to simply define
906-- @'Syntax.liftTyped = 'liftTypedFromUntypedSplice'@ for 'Syntax.Lift'
907-- instances @t@ such that @(t :: Type)@, this will not work for types with
908-- different types, such as unboxed types or unlifted newtypes. This is because
909-- GHC restrictions prevent defining 'liftTypedFromUntypedSplice' in a levity
910-- polymorphic fashion, so one must use 'unsafeSpliceCoerce' to work around
911-- these restrictions. Here is an example of how to use 'unsafeSpliceCoerce`:
912--
913-- @
914-- instance 'Syntax.Lift' Int# where
915--   'Syntax.lift' x = litE (intPrimL (fromIntegral (I# x)))
916-- #if MIN\_VERSION\_template\_haskell(2,16,0)
917--   'Syntax.liftTyped' x = 'unsafeSpliceCoerce' ('Syntax.lift' x)
918-- #endif
919-- @
920--
921-- Levity-polymorphic since /template-haskell-2.16.0.0/.
922unsafeSpliceCoerce ::
923# if MIN_VERSION_template_haskell(2,16,0)
924  forall (r :: RuntimeRep) (a :: TYPE r) m .
925# else
926  forall a m .
927# endif
928  Quote m => m Exp -> Splice m a
929# if MIN_VERSION_template_haskell(2,17,0)
930unsafeSpliceCoerce = unsafeCodeCoerce
931# else
932unsafeSpliceCoerce = unsafeTExpCoerceQuote
933# endif
934
935-- | A variant of 'unTypeCode' that takes a 'Splice' as an argument. Because
936-- this function takes a 'Splice' as an argyment, the type of this function
937-- will be different depending on which version of @template-haskell@ you are
938-- using. (See the Haddocks for 'Splice' for more information on this point.)
939--
940-- Levity-polymorphic since /template-haskell-2.16.0.0/.
941unTypeSplice ::
942# if MIN_VERSION_template_haskell(2,16,0)
943  forall (r :: RuntimeRep) (a :: TYPE r) m .
944# else
945  forall a m .
946# endif
947  Quote m => Splice m a -> m Exp
948# if MIN_VERSION_template_haskell(2,17,0)
949unTypeSplice = unTypeCode
950# else
951unTypeSplice = unTypeQQuote
952# endif
953#endif
954