{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
#endif
module Language.Haskell.TH.Syntax.Compat (
Quote(..)
, unsafeQToQuote
#if MIN_VERSION_template_haskell(2,9,0)
, unTypeQQuote
, unsafeTExpCoerceQuote
#endif
, liftQuote
#if MIN_VERSION_template_haskell(2,9,0)
, liftTypedQuote
#endif
, liftStringQuote
#if MIN_VERSION_template_haskell(2,9,0)
, Code(..), CodeQ
, IsCode(..)
, unsafeCodeCoerce
, liftCode
, unTypeCode
, hoistCode
, bindCode
, bindCode_
, joinCode
, Splice
, SpliceQ
, liftTypedFromUntypedSplice
, unsafeSpliceCoerce
#endif
) where
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO(..))
import Language.Haskell.TH (Exp)
import qualified Language.Haskell.TH.Lib as Lib ()
import Language.Haskell.TH.Syntax (Q, runQ, Quasi(..))
import qualified Language.Haskell.TH.Syntax as Syntax
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative
#endif
#if MIN_VERSION_template_haskell(2,16,0)
import GHC.Exts (RuntimeRep, TYPE)
#endif
#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH.Lib (CodeQ)
import Language.Haskell.TH.Syntax
( Code(..), Quote(..)
, bindCode, bindCode_, hoistCode, joinCode, liftCode, unsafeCodeCoerce, unTypeCode
, unsafeTExpCoerce, unTypeQ )
#else
import Language.Haskell.TH (Name)
#endif
#if !(MIN_VERSION_template_haskell(2,17,0))
class ( Monad m
# if !(MIN_VERSION_template_haskell(2,7,0))
, Functor m
# elif !(MIN_VERSION_template_haskell(2,10,0))
, Applicative m
# endif
) => Quote m where
newName :: String -> m Name
instance Quote Q where
newName :: String -> Q Name
newName = String -> Q Name
forall (m :: * -> *). Quasi m => String -> m Name
qNewName
#endif
#if MIN_VERSION_template_haskell(2,9,0)
unTypeQQuote ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => m (Syntax.TExp a) -> m Exp
# if MIN_VERSION_template_haskell(2,17,0)
unTypeQQuote = unTypeQ
# else
unTypeQQuote :: m (TExp a) -> m Exp
unTypeQQuote m (TExp a)
m = do { Syntax.TExp Exp
e <- m (TExp a)
m
; Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
e }
# endif
unsafeTExpCoerceQuote ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => m Exp -> m (Syntax.TExp a)
# if MIN_VERSION_template_haskell(2,17,0)
unsafeTExpCoerceQuote = unsafeTExpCoerce
# else
unsafeTExpCoerceQuote :: m Exp -> m (TExp a)
unsafeTExpCoerceQuote m Exp
m = do { Exp
e <- m Exp
m
; TExp a -> m (TExp a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> TExp a
forall a. Exp -> TExp a
Syntax.TExp Exp
e) }
# endif
#endif
liftQuote ::
#if MIN_VERSION_template_haskell(2,17,0)
forall (r :: RuntimeRep) (t :: TYPE r) m .
#else
forall t m .
#endif
(Syntax.Lift t, Quote m) => t -> m Exp
#if MIN_VERSION_template_haskell(2,17,0)
liftQuote = Syntax.lift
#else
liftQuote :: t -> m Exp
liftQuote = Q Exp -> m Exp
forall (m :: * -> *) a. Quote m => Q a -> m a
unsafeQToQuote (Q Exp -> m Exp) -> (t -> Q Exp) -> t -> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Q Exp
forall t. Lift t => t -> Q Exp
Syntax.lift
#endif
#if MIN_VERSION_template_haskell(2,9,0)
liftTypedQuote ::
# if MIN_VERSION_template_haskell(2,17,0)
forall (r :: RuntimeRep) (t :: TYPE r) m .
# else
forall t m .
# endif
(Syntax.Lift t, Quote m) => t -> Code m t
# if MIN_VERSION_template_haskell(2,17,0)
liftTypedQuote = Syntax.liftTyped
# elif MIN_VERSION_template_haskell(2,16,0)
liftTypedQuote :: t -> Code m t
liftTypedQuote = m (TExp t) -> Code m t
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (m (TExp t) -> Code m t) -> (t -> m (TExp t)) -> t -> Code m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q (TExp t) -> m (TExp t)
forall (m :: * -> *) a. Quote m => Q a -> m a
unsafeQToQuote (Q (TExp t) -> m (TExp t)) -> (t -> Q (TExp t)) -> t -> m (TExp t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Q (TExp t)
forall t. Lift t => t -> Q (TExp t)
Syntax.liftTyped
# else
liftTypedQuote = unsafeCodeCoerce . liftQuote
# endif
#endif
liftStringQuote :: Quote m => String -> m Exp
#if MIN_VERSION_template_haskell(2,17,0)
liftStringQuote = Syntax.liftString
#else
liftStringQuote :: String -> m Exp
liftStringQuote = Q Exp -> m Exp
forall (m :: * -> *) a. Quote m => Q a -> m a
unsafeQToQuote (Q Exp -> m Exp) -> (String -> Q Exp) -> String -> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Q Exp
Syntax.liftString
#endif
unsafeQToQuote :: Quote m => Q a -> m a
unsafeQToQuote :: Q a -> m a
unsafeQToQuote = QuoteToQuasi m a -> m a
forall (m :: * -> *) a. QuoteToQuasi m a -> m a
unQTQ (QuoteToQuasi m a -> m a)
-> (Q a -> QuoteToQuasi m a) -> Q a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q a -> QuoteToQuasi m a
forall (m :: * -> *) a. Quasi m => Q a -> m a
runQ
newtype QuoteToQuasi (m :: * -> *) a = QTQ { QuoteToQuasi m a -> m a
unQTQ :: m a }
deriving (a -> QuoteToQuasi m b -> QuoteToQuasi m a
(a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
(forall a b. (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b)
-> (forall a b. a -> QuoteToQuasi m b -> QuoteToQuasi m a)
-> Functor (QuoteToQuasi m)
forall a b. a -> QuoteToQuasi m b -> QuoteToQuasi m a
forall a b. (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
forall (m :: * -> *) a b.
Functor m =>
a -> QuoteToQuasi m b -> QuoteToQuasi m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> QuoteToQuasi m b -> QuoteToQuasi m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> QuoteToQuasi m b -> QuoteToQuasi m a
fmap :: (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
Functor, Functor (QuoteToQuasi m)
a -> QuoteToQuasi m a
Functor (QuoteToQuasi m)
-> (forall a. a -> QuoteToQuasi m a)
-> (forall a b.
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b)
-> (forall a b c.
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c)
-> (forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b)
-> (forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a)
-> Applicative (QuoteToQuasi m)
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
forall a. a -> QuoteToQuasi m a
forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall a b.
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
forall a b c.
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (QuoteToQuasi m)
forall (m :: * -> *) a. Applicative m => a -> QuoteToQuasi m a
forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
<* :: QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m a
*> :: QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
liftA2 :: (a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m c
<*> :: QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
QuoteToQuasi m (a -> b) -> QuoteToQuasi m a -> QuoteToQuasi m b
pure :: a -> QuoteToQuasi m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> QuoteToQuasi m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (QuoteToQuasi m)
Applicative, Applicative (QuoteToQuasi m)
a -> QuoteToQuasi m a
Applicative (QuoteToQuasi m)
-> (forall a b.
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b)
-> (forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b)
-> (forall a. a -> QuoteToQuasi m a)
-> Monad (QuoteToQuasi m)
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall a. a -> QuoteToQuasi m a
forall a b.
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall a b.
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
forall (m :: * -> *). Monad m => Applicative (QuoteToQuasi m)
forall (m :: * -> *) a. Monad m => a -> QuoteToQuasi m a
forall (m :: * -> *) a b.
Monad m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
forall (m :: * -> *) a b.
Monad m =>
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> QuoteToQuasi m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> QuoteToQuasi m a
>> :: QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
QuoteToQuasi m a -> QuoteToQuasi m b -> QuoteToQuasi m b
>>= :: QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
QuoteToQuasi m a -> (a -> QuoteToQuasi m b) -> QuoteToQuasi m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (QuoteToQuasi m)
Monad)
qtqError :: String -> a
qtqError :: String -> a
qtqError String
name = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"`unsafeQToQuote` does not support code that uses " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
instance Monad m => Fail.MonadFail (QuoteToQuasi m) where
fail :: String -> QuoteToQuasi m a
fail = String -> String -> QuoteToQuasi m a
forall a. String -> a
qtqError String
"MonadFail.fail"
instance Monad m => MonadIO (QuoteToQuasi m) where
liftIO :: IO a -> QuoteToQuasi m a
liftIO = String -> IO a -> QuoteToQuasi m a
forall a. String -> a
qtqError String
"liftIO"
instance Quote m => Quasi (QuoteToQuasi m) where
qNewName :: String -> QuoteToQuasi m Name
qNewName String
s = m Name -> QuoteToQuasi m Name
forall (m :: * -> *) a. m a -> QuoteToQuasi m a
QTQ (String -> m Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
s)
qRecover :: QuoteToQuasi m a -> QuoteToQuasi m a -> QuoteToQuasi m a
qRecover = String -> QuoteToQuasi m a -> QuoteToQuasi m a -> QuoteToQuasi m a
forall a. String -> a
qtqError String
"qRecover"
qReport :: Bool -> String -> QuoteToQuasi m ()
qReport = String -> Bool -> String -> QuoteToQuasi m ()
forall a. String -> a
qtqError String
"qReport"
qReify :: Name -> QuoteToQuasi m Info
qReify = String -> Name -> QuoteToQuasi m Info
forall a. String -> a
qtqError String
"qReify"
qLocation :: QuoteToQuasi m Loc
qLocation = String -> QuoteToQuasi m Loc
forall a. String -> a
qtqError String
"qLocation"
qRunIO :: IO a -> QuoteToQuasi m a
qRunIO = String -> IO a -> QuoteToQuasi m a
forall a. String -> a
qtqError String
"qRunIO"
#if MIN_VERSION_template_haskell(2,7,0)
qReifyInstances :: Name -> [Type] -> QuoteToQuasi m [Dec]
qReifyInstances = String -> Name -> [Type] -> QuoteToQuasi m [Dec]
forall a. String -> a
qtqError String
"qReifyInstances"
qLookupName :: Bool -> String -> QuoteToQuasi m (Maybe Name)
qLookupName = String -> Bool -> String -> QuoteToQuasi m (Maybe Name)
forall a. String -> a
qtqError String
"qLookupName"
qAddDependentFile :: String -> QuoteToQuasi m ()
qAddDependentFile = String -> String -> QuoteToQuasi m ()
forall a. String -> a
qtqError String
"qAddDependentFile"
# if MIN_VERSION_template_haskell(2,9,0)
qReifyRoles :: Name -> QuoteToQuasi m [Role]
qReifyRoles = String -> Name -> QuoteToQuasi m [Role]
forall a. String -> a
qtqError String
"qReifyRoles"
qReifyAnnotations :: AnnLookup -> QuoteToQuasi m [a]
qReifyAnnotations = String -> AnnLookup -> QuoteToQuasi m [a]
forall a. String -> a
qtqError String
"qReifyAnnotations"
qReifyModule :: Module -> QuoteToQuasi m ModuleInfo
qReifyModule = String -> Module -> QuoteToQuasi m ModuleInfo
forall a. String -> a
qtqError String
"qReifyModule"
qAddTopDecls :: [Dec] -> QuoteToQuasi m ()
qAddTopDecls = String -> [Dec] -> QuoteToQuasi m ()
forall a. String -> a
qtqError String
"qAddTopDecls"
qAddModFinalizer :: Q () -> QuoteToQuasi m ()
qAddModFinalizer = String -> Q () -> QuoteToQuasi m ()
forall a. String -> a
qtqError String
"qAddModFinalizer"
qGetQ :: QuoteToQuasi m (Maybe a)
qGetQ = String -> QuoteToQuasi m (Maybe a)
forall a. String -> a
qtqError String
"qGetQ"
qPutQ :: a -> QuoteToQuasi m ()
qPutQ = String -> a -> QuoteToQuasi m ()
forall a. String -> a
qtqError String
"qPutQ"
# endif
# if MIN_VERSION_template_haskell(2,11,0)
qReifyFixity :: Name -> QuoteToQuasi m (Maybe Fixity)
qReifyFixity = String -> Name -> QuoteToQuasi m (Maybe Fixity)
forall a. String -> a
qtqError String
"qReifyFixity"
qReifyConStrictness :: Name -> QuoteToQuasi m [DecidedStrictness]
qReifyConStrictness = String -> Name -> QuoteToQuasi m [DecidedStrictness]
forall a. String -> a
qtqError String
"qReifyConStrictness"
qIsExtEnabled :: Extension -> QuoteToQuasi m Bool
qIsExtEnabled = String -> Extension -> QuoteToQuasi m Bool
forall a. String -> a
qtqError String
"qIsExtEnabled"
qExtsEnabled :: QuoteToQuasi m [Extension]
qExtsEnabled = String -> QuoteToQuasi m [Extension]
forall a. String -> a
qtqError String
"qExtsEnabled"
# endif
#elif MIN_VERSION_template_haskell(2,5,0)
qClassInstances = qtqError "qClassInstances"
#endif
#if MIN_VERSION_template_haskell(2,13,0)
qAddCorePlugin :: String -> QuoteToQuasi m ()
qAddCorePlugin = String -> String -> QuoteToQuasi m ()
forall a. String -> a
qtqError String
"qAddCorePlugin"
#endif
#if MIN_VERSION_template_haskell(2,14,0)
qAddForeignFilePath :: ForeignSrcLang -> String -> QuoteToQuasi m ()
qAddForeignFilePath = String -> ForeignSrcLang -> String -> QuoteToQuasi m ()
forall a. String -> a
qtqError String
"qAddForeignFilePath"
qAddTempFile :: String -> QuoteToQuasi m String
qAddTempFile = String -> String -> QuoteToQuasi m String
forall a. String -> a
qtqError String
"qAddTempFile"
#elif MIN_VERSION_template_haskell(2,12,0)
qAddForeignFile = qtqError "qAddForeignFile"
#endif
#if MIN_VERSION_template_haskell(2,16,0)
qReifyType :: Name -> QuoteToQuasi m Type
qReifyType = String -> Name -> QuoteToQuasi m Type
forall a. String -> a
qtqError String
"qReifyType"
#endif
#if MIN_VERSION_template_haskell(2,9,0)
class IsCode q
# if MIN_VERSION_template_haskell(2,16,0)
(a :: TYPE r)
# else
a
# endif
c | c -> a q where
toCode :: c -> Code q a
fromCode :: Code q a -> c
instance Quote q => IsCode q
# if MIN_VERSION_template_haskell(2,16,0)
(a :: TYPE r)
# else
a
# endif
(Code q a) where
toCode :: Code q a -> Code q a
toCode = Code q a -> Code q a
forall a. a -> a
id
fromCode :: Code q a -> Code q a
fromCode = Code q a -> Code q a
forall a. a -> a
id
instance texp ~ Syntax.TExp a => IsCode Q
# if MIN_VERSION_template_haskell(2,16,0)
(a :: TYPE r)
# else
a
# endif
(Q texp) where
toCode :: Q texp -> Code Q a
toCode = Q texp -> Code Q a
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode
fromCode :: Code Q a -> Q texp
fromCode = Code Q a -> Q texp
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode
# if !(MIN_VERSION_template_haskell(2,17,0))
type role Code representational nominal
newtype Code m
# if MIN_VERSION_template_haskell(2,16,0)
(a :: TYPE (r :: RuntimeRep))
# else
a
# endif
= Code
{ Code m a -> m (TExp a)
examineCode :: m (Syntax.TExp a)
}
type CodeQ = Code Q
# if MIN_VERSION_template_haskell(2,16,0)
:: (TYPE r -> *)
# endif
unsafeCodeCoerce ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => m Exp -> Code m a
unsafeCodeCoerce :: m Exp -> Code m a
unsafeCodeCoerce m Exp
m = m (TExp a) -> Code m a
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code (m Exp -> m (TExp a)
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerceQuote m Exp
m)
liftCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
m (Syntax.TExp a) -> Code m a
liftCode :: m (TExp a) -> Code m a
liftCode = m (TExp a) -> Code m a
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code
unTypeCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => Code m a -> m Exp
unTypeCode :: Code m a -> m Exp
unTypeCode = m (TExp a) -> m Exp
forall a (m :: * -> *). Quote m => m (TExp a) -> m Exp
unTypeQQuote (m (TExp a) -> m Exp)
-> (Code m a -> m (TExp a)) -> Code m a -> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code m a -> m (TExp a)
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode
hoistCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m n (r :: RuntimeRep) (a :: TYPE r) .
# else
forall m n a .
# endif
Monad m => (forall x . m x -> n x) -> Code m a -> Code n a
hoistCode :: (forall x. m x -> n x) -> Code m a -> Code n a
hoistCode forall x. m x -> n x
f (Code m (TExp a)
a) = n (TExp a) -> Code n a
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code (m (TExp a) -> n (TExp a)
forall x. m x -> n x
f m (TExp a)
a)
bindCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m a (r :: RuntimeRep) (b :: TYPE r) .
# else
forall m a b .
# endif
Monad m => m a -> (a -> Code m b) -> Code m b
bindCode :: m a -> (a -> Code m b) -> Code m b
bindCode m a
q a -> Code m b
k = m (TExp b) -> Code m b
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (m a
q m a -> (a -> m (TExp b)) -> m (TExp b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Code m b -> m (TExp b)
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode (Code m b -> m (TExp b)) -> (a -> Code m b) -> a -> m (TExp b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Code m b
k)
bindCode_ ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m a (r :: RuntimeRep) (b :: TYPE r) .
# else
forall m a b .
# endif
Monad m => m a -> Code m b -> Code m b
bindCode_ :: m a -> Code m b -> Code m b
bindCode_ m a
q Code m b
c = m (TExp b) -> Code m b
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode ( m a
q m a -> m (TExp b) -> m (TExp b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Code m b -> m (TExp b)
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode Code m b
c)
joinCode ::
# if MIN_VERSION_template_haskell(2,16,0)
forall m (r :: RuntimeRep) (a :: TYPE r) .
# else
forall m a .
# endif
Monad m => m (Code m a) -> Code m a
joinCode :: m (Code m a) -> Code m a
joinCode = (m (Code m a) -> (Code m a -> Code m a) -> Code m a)
-> (Code m a -> Code m a) -> m (Code m a) -> Code m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (Code m a) -> (Code m a -> Code m a) -> Code m a
forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Code m b) -> Code m b
bindCode Code m a -> Code m a
forall a. a -> a
id
# endif
# if MIN_VERSION_template_haskell(2,17,0)
type Splice = Code :: (forall r. (* -> *) -> TYPE r -> *)
# elif MIN_VERSION_template_haskell(2,16,0)
type Splice m (a :: TYPE r) = m (Syntax.TExp a)
# else
type Splice m a = m (Syntax.TExp a)
# endif
# if MIN_VERSION_template_haskell(2,17,0)
type SpliceQ = Splice Q :: (TYPE r -> *)
# elif MIN_VERSION_template_haskell(2,16,0)
type SpliceQ (a :: TYPE r) = Splice Q a
# else
type SpliceQ a = Splice Q a
# endif
liftTypedFromUntypedSplice :: (Syntax.Lift t, Quote m) => t -> Splice m t
liftTypedFromUntypedSplice :: t -> Splice m t
liftTypedFromUntypedSplice = m Exp -> Splice m t
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeSpliceCoerce (m Exp -> Splice m t) -> (t -> m Exp) -> t -> Splice m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
liftQuote
unsafeSpliceCoerce ::
# if MIN_VERSION_template_haskell(2,16,0)
forall (r :: RuntimeRep) (a :: TYPE r) m .
# else
forall a m .
# endif
Quote m => m Exp -> Splice m a
# if MIN_VERSION_template_haskell(2,17,0)
unsafeSpliceCoerce = unsafeCodeCoerce
# else
unsafeSpliceCoerce :: m Exp -> Splice m a
unsafeSpliceCoerce = m Exp -> Splice m a
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerceQuote
# endif
#endif