{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedSums #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
module GHC.Internal.TH.Lift
( Lift(..)
, dataToQa
, dataToExpQ
, liftData
, dataToPatQ
, liftString
, trueName
, falseName
, nothingName
, justName
, leftName
, rightName
, nonemptyName
)
where
import GHC.Internal.TH.Syntax
import qualified GHC.Internal.TH.Lib as Lib (litE)
import GHC.Internal.Lexeme ( startsVarSym, startsVarId )
import GHC.Internal.Data.Either
import GHC.Internal.Type.Reflection
import GHC.Internal.Data.Bool
import GHC.Internal.Base hiding (Type, Module, inline)
import GHC.Internal.Data.Foldable
import GHC.Internal.Integer
import GHC.Internal.Real
import GHC.Internal.Word
import GHC.Internal.Int
import GHC.Internal.Data.Data hiding (Fixity)
import GHC.Internal.Natural
import GHC.Internal.ForeignPtr
class Lift (t :: TYPE r) where
lift :: Quote m => t -> m Exp
default lift :: (r ~ ('BoxedRep 'Lifted), Quote m) => t -> m Exp
lift = Code m t -> m Exp
forall a (m :: * -> *). Quote m => Code m a -> m Exp
unTypeCode (Code m t -> m Exp) -> (t -> Code m t) -> t -> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Code m t
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => t -> Code m t
liftTyped
liftTyped :: Quote m => t -> Code m t
instance Lift Integer where
liftTyped :: forall (m :: * -> *). Quote m => Integer -> Code m Integer
liftTyped Integer
x = m Exp -> Code m Integer
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Integer -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Integer -> m Exp
lift Integer
x)
lift :: forall (m :: * -> *). Quote m => Integer -> m Exp
lift Integer
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL Integer
x))
instance Lift Int where
liftTyped :: forall (m :: * -> *). Quote m => Int -> Code m Int
liftTyped Int
x = m Exp -> Code m Int
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Int -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
x)
lift :: forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)))
instance Lift Int# where
liftTyped :: forall (m :: * -> *). Quote m => Int# -> Code m Int#
liftTyped Int#
x = m Exp -> Code m Int#
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Int# -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int# -> m Exp
lift Int#
x)
lift :: forall (m :: * -> *). Quote m => Int# -> m Exp
lift Int#
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntPrimL (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# Int#
x))))
instance Lift Int8 where
liftTyped :: forall (m :: * -> *). Quote m => Int8 -> Code m Int8
liftTyped Int8
x = m Exp -> Code m Int8
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Int8 -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int8 -> m Exp
lift Int8
x)
lift :: forall (m :: * -> *). Quote m => Int8 -> m Exp
lift Int8
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x)))
instance Lift Int16 where
liftTyped :: forall (m :: * -> *). Quote m => Int16 -> Code m Int16
liftTyped Int16
x = m Exp -> Code m Int16
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Int16 -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int16 -> m Exp
lift Int16
x)
lift :: forall (m :: * -> *). Quote m => Int16 -> m Exp
lift Int16
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x)))
instance Lift Int32 where
liftTyped :: forall (m :: * -> *). Quote m => Int32 -> Code m Int32
liftTyped Int32
x = m Exp -> Code m Int32
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Int32 -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int32 -> m Exp
lift Int32
x)
lift :: forall (m :: * -> *). Quote m => Int32 -> m Exp
lift Int32
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)))
instance Lift Int64 where
liftTyped :: forall (m :: * -> *). Quote m => Int64 -> Code m Int64
liftTyped Int64
x = m Exp -> Code m Int64
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Int64 -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int64 -> m Exp
lift Int64
x)
lift :: forall (m :: * -> *). Quote m => Int64 -> m Exp
lift Int64
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)))
instance Lift Word# where
liftTyped :: forall (m :: * -> *). Quote m => Word# -> Code m Word#
liftTyped Word#
x = m Exp -> Code m Word#
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Word# -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Word# -> m Exp
lift Word#
x)
lift :: forall (m :: * -> *). Quote m => Word# -> m Exp
lift Word#
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
WordPrimL (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word# -> Word
W# Word#
x))))
instance Lift Word where
liftTyped :: forall (m :: * -> *). Quote m => Word -> Code m Word
liftTyped Word
x = m Exp -> Code m Word
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Word -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Word -> m Exp
lift Word
x)
lift :: forall (m :: * -> *). Quote m => Word -> m Exp
lift Word
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x)))
instance Lift Word8 where
liftTyped :: forall (m :: * -> *). Quote m => Word8 -> Code m Word8
liftTyped Word8
x = m Exp -> Code m Word8
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Word8 -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Word8 -> m Exp
lift Word8
x)
lift :: forall (m :: * -> *). Quote m => Word8 -> m Exp
lift Word8
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)))
instance Lift Word16 where
liftTyped :: forall (m :: * -> *). Quote m => Word16 -> Code m Word16
liftTyped Word16
x = m Exp -> Code m Word16
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Word16 -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Word16 -> m Exp
lift Word16
x)
lift :: forall (m :: * -> *). Quote m => Word16 -> m Exp
lift Word16
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)))
instance Lift Word32 where
liftTyped :: forall (m :: * -> *). Quote m => Word32 -> Code m Word32
liftTyped Word32
x = m Exp -> Code m Word32
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Word32 -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Word32 -> m Exp
lift Word32
x)
lift :: forall (m :: * -> *). Quote m => Word32 -> m Exp
lift Word32
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x)))
instance Lift Word64 where
liftTyped :: forall (m :: * -> *). Quote m => Word64 -> Code m Word64
liftTyped Word64
x = m Exp -> Code m Word64
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Word64 -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Word64 -> m Exp
lift Word64
x)
lift :: forall (m :: * -> *). Quote m => Word64 -> m Exp
lift Word64
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x)))
instance Lift Natural where
liftTyped :: forall (m :: * -> *). Quote m => Natural -> Code m Natural
liftTyped Natural
x = m Exp -> Code m Natural
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Natural -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Natural -> m Exp
lift Natural
x)
lift :: forall (m :: * -> *). Quote m => Natural -> m Exp
lift Natural
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Integer -> Lit
IntegerL (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
x)))
instance Integral a => Lift (Ratio a) where
liftTyped :: forall (m :: * -> *). Quote m => Ratio a -> Code m (Ratio a)
liftTyped Ratio a
x = m Exp -> Code m (Ratio a)
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Ratio a -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Ratio a -> m Exp
lift Ratio a
x)
lift :: forall (m :: * -> *). Quote m => Ratio a -> m Exp
lift Ratio a
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Rational -> Lit
RationalL (Ratio a -> Rational
forall a. Real a => a -> Rational
toRational Ratio a
x)))
instance Lift Float where
liftTyped :: forall (m :: * -> *). Quote m => Float -> Code m Float
liftTyped Float
x = m Exp -> Code m Float
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Float -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Float -> m Exp
lift Float
x)
lift :: forall (m :: * -> *). Quote m => Float -> m Exp
lift Float
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Rational -> Lit
RationalL (Float -> Rational
forall a. Real a => a -> Rational
toRational Float
x)))
instance Lift Float# where
liftTyped :: forall (m :: * -> *). Quote m => Float# -> Code m Float#
liftTyped Float#
x = m Exp -> Code m Float#
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Float# -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Float# -> m Exp
lift Float#
x)
lift :: forall (m :: * -> *). Quote m => Float# -> m Exp
lift Float#
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Rational -> Lit
FloatPrimL (Float -> Rational
forall a. Real a => a -> Rational
toRational (Float# -> Float
F# Float#
x))))
instance Lift Double where
liftTyped :: forall (m :: * -> *). Quote m => Double -> Code m Double
liftTyped Double
x = m Exp -> Code m Double
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Double -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Double -> m Exp
lift Double
x)
lift :: forall (m :: * -> *). Quote m => Double -> m Exp
lift Double
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Rational -> Lit
RationalL (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
x)))
instance Lift Double# where
liftTyped :: forall (m :: * -> *). Quote m => Double# -> Code m Double#
liftTyped Double#
x = m Exp -> Code m Double#
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Double# -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Double# -> m Exp
lift Double#
x)
lift :: forall (m :: * -> *). Quote m => Double# -> m Exp
lift Double#
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Rational -> Lit
DoublePrimL (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double# -> Double
D# Double#
x))))
instance Lift Char where
liftTyped :: forall (m :: * -> *). Quote m => Char -> Code m Char
liftTyped Char
x = m Exp -> Code m Char
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Char -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Char -> m Exp
lift Char
x)
lift :: forall (m :: * -> *). Quote m => Char -> m Exp
lift Char
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Char -> Lit
CharL Char
x))
instance Lift Char# where
liftTyped :: forall (m :: * -> *). Quote m => Char# -> Code m Char#
liftTyped Char#
x = m Exp -> Code m Char#
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Char# -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Char# -> m Exp
lift Char#
x)
lift :: forall (m :: * -> *). Quote m => Char# -> m Exp
lift Char#
x = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE (Char -> Lit
CharPrimL (Char# -> Char
C# Char#
x)))
instance Lift Addr# where
liftTyped :: forall (m :: * -> *). Quote m => Addr# -> Code m Addr#
liftTyped Addr#
x = m Exp -> Code m Addr#
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Addr# -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Addr# -> m Exp
lift Addr#
x)
lift :: forall (m :: * -> *). Quote m => Addr# -> m Exp
lift Addr#
x
= Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE ([Word8] -> Lit
StringPrimL ((Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) (Addr# -> [Char]
unpackCString# Addr#
x))))
instance Lift a => Lift [a] where
liftTyped :: forall (m :: * -> *). Quote m => [a] -> Code m [a]
liftTyped [a]
x = m Exp -> Code m [a]
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce ([a] -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => [a] -> m Exp
lift [a]
x)
lift :: forall (m :: * -> *). Quote m => [a] -> m Exp
lift [a]
xs = do { xs' <- (a -> m Exp) -> [a] -> m [Exp]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => a -> m Exp
lift [a]
xs; return (ListE xs') }
liftString :: Quote m => String -> m Exp
liftString :: forall (m :: * -> *). Quote m => [Char] -> m Exp
liftString [Char]
s = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE ([Char] -> Lit
StringL [Char]
s))
{-# RULES "TH:liftString" lift = liftString #-}
deriving instance Lift Bool
deriving instance Lift a => Lift (Maybe a)
deriving instance (Lift a, Lift b) => Lift (Either a b)
deriving instance Lift a => Lift (NonEmpty a)
deriving instance Lift Void
deriving instance Lift ()
deriving instance (Lift a, Lift b)
=> Lift (a, b)
deriving instance (Lift a, Lift b, Lift c)
=> Lift (a, b, c)
deriving instance (Lift a, Lift b, Lift c, Lift d)
=> Lift (a, b, c, d)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e)
=> Lift (a, b, c, d, e)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
=> Lift (a, b, c, d, e, f)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
=> Lift (a, b, c, d, e, f, g)
deriving instance Lift (# #)
deriving instance (Lift a)
=> Lift (# a #)
deriving instance (Lift a, Lift b)
=> Lift (# a, b #)
deriving instance (Lift a, Lift b, Lift c)
=> Lift (# a, b, c #)
deriving instance (Lift a, Lift b, Lift c, Lift d)
=> Lift (# a, b, c, d #)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e)
=> Lift (# a, b, c, d, e #)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
=> Lift (# a, b, c, d, e, f #)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
=> Lift (# a, b, c, d, e, f, g #)
deriving instance (Lift a, Lift b) => Lift (# a | b #)
deriving instance (Lift a, Lift b, Lift c)
=> Lift (# a | b | c #)
deriving instance (Lift a, Lift b, Lift c, Lift d)
=> Lift (# a | b | c | d #)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e)
=> Lift (# a | b | c | d | e #)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
=> Lift (# a | b | c | d | e | f #)
deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
=> Lift (# a | b | c | d | e | f | g #)
trueName, falseName :: Name
trueName :: Name
trueName = 'True
falseName :: Name
falseName = 'False
nothingName, justName :: Name
nothingName :: Name
nothingName = 'Nothing
justName :: Name
justName = 'Just
leftName, rightName :: Name
leftName :: Name
leftName = 'Left
rightName :: Name
rightName = 'Right
nonemptyName :: Name
nonemptyName :: Name
nonemptyName = '(:|)
deriving instance Lift Loc
deriving instance Lift DocLoc
deriving instance Lift ModName
deriving instance Lift GHC.Internal.TH.Syntax.Module
deriving instance Lift NameSpace
deriving instance Lift NamespaceSpecifier
deriving instance Lift PkgName
deriving instance Lift NameFlavour
deriving instance Lift OccName
deriving instance Lift Name
deriving instance Lift NameIs
deriving instance Lift Specificity
deriving instance Lift BndrVis
deriving instance Lift a => Lift (TyVarBndr a)
deriving instance Lift TyLit
deriving instance Lift Type
instance Lift Bytes where
liftTyped :: forall (m :: * -> *). Quote m => Bytes -> Code m Bytes
liftTyped Bytes
x = m Exp -> Code m Bytes
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (Bytes -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Bytes -> m Exp
lift Bytes
x)
lift :: forall (m :: * -> *). Quote m => Bytes -> m Exp
lift bytes :: Bytes
bytes@Bytes{} =
[| Bytes
{ bytesPtr = ForeignPtr $(Lit -> m Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
Lib.litE (Bytes -> Lit
BytesPrimL Bytes
bytes)) FinalPtr
, bytesOffset = 0
, bytesSize = $(Word -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Word -> m Exp
lift (Bytes -> Word
bytesSize Bytes
bytes))
}
|]
deriving instance Lift Lit
deriving instance Lift Pat
deriving instance Lift Clause
deriving instance Lift DerivClause
deriving instance Lift DerivStrategy
deriving instance Lift Overlap
deriving instance Lift FunDep
deriving instance Lift Safety
deriving instance Lift Callconv
deriving instance Lift Foreign
deriving instance Lift ForeignSrcLang
deriving instance Lift FixityDirection
deriving instance Lift Fixity
deriving instance Lift Inline
deriving instance Lift RuleMatch
deriving instance Lift Phases
deriving instance Lift RuleBndr
deriving instance Lift AnnTarget
deriving instance Lift Pragma
deriving instance Lift SourceStrictness
deriving instance Lift SourceUnpackedness
deriving instance Lift DecidedStrictness
deriving instance Lift Bang
deriving instance Lift Con
deriving instance Lift TySynEqn
deriving instance Lift FamilyResultSig
deriving instance Lift InjectivityAnn
deriving instance Lift TypeFamilyHead
deriving instance Lift Role
deriving instance Lift PatSynArgs
deriving instance Lift PatSynDir
deriving instance Lift Dec
deriving instance Lift Range
deriving instance Lift Exp
instance Lift (TExp a) where
lift :: forall (m :: * -> *). Quote m => TExp a -> m Exp
lift (TExp Exp
e) = [| TExp $(Exp -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Exp -> m Exp
lift Exp
e) |]
liftTyped :: forall (m :: * -> *). Quote m => TExp a -> Code m (TExp a)
liftTyped = m Exp -> Code m (TExp a)
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m (TExp a))
-> (TExp a -> m Exp) -> TExp a -> Code m (TExp a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TExp a -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => TExp a -> m Exp
lift
deriving instance Lift Match
deriving instance Lift Guard
deriving instance Lift Stmt
deriving instance Lift Body
deriving instance Lift Info
deriving instance Lift AnnLookup
deriving instance Lift Extension
dataToQa :: forall m a k q. (Quote m, Data a)
=> (Name -> k)
-> (Lit -> m q)
-> (k -> [m q] -> m q)
-> (forall b . Data b => b -> Maybe (m q))
-> a
-> m q
dataToQa :: forall (m :: * -> *) a k q.
(Quote m, Data a) =>
(Name -> k)
-> (Lit -> m q)
-> (k -> [m q] -> m q)
-> (forall b. Data b => b -> Maybe (m q))
-> a
-> m q
dataToQa Name -> k
mkCon Lit -> m q
mkLit k -> [m q] -> m q
appCon forall b. Data b => b -> Maybe (m q)
antiQ a
t =
case a -> Maybe (m q)
forall b. Data b => b -> Maybe (m q)
antiQ a
t of
Maybe (m q)
Nothing ->
case Constr -> ConstrRep
constrRep Constr
constr of
AlgConstr Int
_ ->
k -> [m q] -> m q
appCon (Name -> k
mkCon Name
funOrConName) [m q]
conArgs
where
funOrConName :: Name
funOrConName :: Name
funOrConName =
case Constr -> [Char]
showConstr Constr
constr of
[Char]
"(:)" -> OccName -> NameFlavour -> Name
Name ([Char] -> OccName
mkOccName [Char]
":")
(NameSpace -> PkgName -> ModName -> NameFlavour
NameG NameSpace
DataName
([Char] -> PkgName
mkPkgName [Char]
"ghc-prim")
([Char] -> ModName
mkModName [Char]
"GHC.Types"))
con :: [Char]
con@[Char]
"[]" -> OccName -> NameFlavour -> Name
Name ([Char] -> OccName
mkOccName [Char]
con)
(NameSpace -> PkgName -> ModName -> NameFlavour
NameG NameSpace
DataName
([Char] -> PkgName
mkPkgName [Char]
"ghc-prim")
([Char] -> ModName
mkModName [Char]
"GHC.Types"))
con :: [Char]
con@(Char
'(':[Char]
_) -> OccName -> NameFlavour -> Name
Name ([Char] -> OccName
mkOccName [Char]
con)
(NameSpace -> PkgName -> ModName -> NameFlavour
NameG NameSpace
DataName
([Char] -> PkgName
mkPkgName [Char]
"ghc-prim")
([Char] -> ModName
mkModName [Char]
"GHC.Tuple"))
fun :: [Char]
fun@(Char
x:[Char]
_) | Char -> Bool
startsVarSym Char
x Bool -> Bool -> Bool
|| Char -> Bool
startsVarId Char
x
-> [Char] -> [Char] -> [Char] -> Name
mkNameG_v [Char]
tyconPkg [Char]
tyconMod [Char]
fun
[Char]
con -> [Char] -> [Char] -> [Char] -> Name
mkNameG_d [Char]
tyconPkg [Char]
tyconMod [Char]
con
where
tycon :: TyCon
tycon :: TyCon
tycon = (TypeRep a -> TyCon
forall {k} (a :: k). TypeRep a -> TyCon
typeRepTyCon (TypeRep a -> TyCon) -> (a -> TypeRep a) -> a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf) a
t
tyconPkg, tyconMod :: String
tyconPkg :: [Char]
tyconPkg = TyCon -> [Char]
tyConPackage TyCon
tycon
tyconMod :: [Char]
tyconMod = TyCon -> [Char]
tyConModule TyCon
tycon
conArgs :: [m q]
conArgs :: [m q]
conArgs = (forall d. Data d => d -> m q) -> a -> [m q]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> a -> [u]
gmapQ ((Name -> k)
-> (Lit -> m q)
-> (k -> [m q] -> m q)
-> (forall b. Data b => b -> Maybe (m q))
-> d
-> m q
forall (m :: * -> *) a k q.
(Quote m, Data a) =>
(Name -> k)
-> (Lit -> m q)
-> (k -> [m q] -> m q)
-> (forall b. Data b => b -> Maybe (m q))
-> a
-> m q
dataToQa Name -> k
mkCon Lit -> m q
mkLit k -> [m q] -> m q
appCon b -> Maybe (m q)
forall b. Data b => b -> Maybe (m q)
antiQ) a
t
IntConstr Integer
n ->
Lit -> m q
mkLit (Lit -> m q) -> Lit -> m q
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
n
FloatConstr Rational
n ->
Lit -> m q
mkLit (Lit -> m q) -> Lit -> m q
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL Rational
n
CharConstr Char
c ->
Lit -> m q
mkLit (Lit -> m q) -> Lit -> m q
forall a b. (a -> b) -> a -> b
$ Char -> Lit
CharL Char
c
where
constr :: Constr
constr :: Constr
constr = a -> Constr
forall a. Data a => a -> Constr
toConstr a
t
Just m q
y -> m q
y
dataToExpQ :: (Quote m, Data a)
=> (forall b . Data b => b -> Maybe (m Exp))
-> a
-> m Exp
dataToExpQ :: forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ = (Name -> m Exp)
-> (Lit -> m Exp)
-> (m Exp -> [m Exp] -> m Exp)
-> (forall b. Data b => b -> Maybe (m Exp))
-> a
-> m Exp
forall (m :: * -> *) a k q.
(Quote m, Data a) =>
(Name -> k)
-> (Lit -> m q)
-> (k -> [m q] -> m q)
-> (forall b. Data b => b -> Maybe (m q))
-> a
-> m q
dataToQa Name -> m Exp
forall {m :: * -> *}. Monad m => Name -> m Exp
varOrConE Lit -> m Exp
forall {m :: * -> *}. Monad m => Lit -> m Exp
litE ((m Exp -> m Exp -> m Exp) -> m Exp -> [m Exp] -> m Exp
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl m Exp -> m Exp -> m Exp
forall {m :: * -> *}. Monad m => m Exp -> m Exp -> m Exp
appE)
where
varOrConE :: Name -> m Exp
varOrConE Name
s =
case Name -> Maybe NameSpace
nameSpace Name
s of
Just NameSpace
VarName -> Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Exp
VarE Name
s)
Just (FldName {}) -> Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Exp
VarE Name
s)
Just NameSpace
DataName -> Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Exp
ConE Name
s)
Maybe NameSpace
_ -> [Char] -> m Exp
forall a. HasCallStack => [Char] -> a
error ([Char] -> m Exp) -> [Char] -> m Exp
forall a b. (a -> b) -> a -> b
$ [Char]
"Can't construct an expression from name "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
showName Name
s
appE :: m Exp -> m Exp -> m Exp
appE m Exp
x m Exp
y = do { a <- m Exp
x; b <- y; return (AppE a b)}
litE :: Lit -> m Exp
litE Lit
c = Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Exp
LitE Lit
c)
liftData :: (Quote m, Data a) => a -> m Exp
liftData :: forall (m :: * -> *) a. (Quote m, Data a) => a -> m Exp
liftData = (forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ (Maybe (m Exp) -> b -> Maybe (m Exp)
forall a b. a -> b -> a
const Maybe (m Exp)
forall a. Maybe a
Nothing)
dataToPatQ :: (Quote m, Data a)
=> (forall b . Data b => b -> Maybe (m Pat))
-> a
-> m Pat
dataToPatQ :: forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ = (Name -> Name)
-> (Lit -> m Pat)
-> (Name -> [m Pat] -> m Pat)
-> (forall b. Data b => b -> Maybe (m Pat))
-> a
-> m Pat
forall (m :: * -> *) a k q.
(Quote m, Data a) =>
(Name -> k)
-> (Lit -> m q)
-> (k -> [m q] -> m q)
-> (forall b. Data b => b -> Maybe (m q))
-> a
-> m q
dataToQa Name -> Name
forall a. a -> a
id Lit -> m Pat
forall {m :: * -> *}. Monad m => Lit -> m Pat
litP Name -> [m Pat] -> m Pat
forall {m :: * -> *}. Monad m => Name -> [m Pat] -> m Pat
conP
where litP :: Lit -> m Pat
litP Lit
l = Pat -> m Pat
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Pat
LitP Lit
l)
conP :: Name -> [m Pat] -> m Pat
conP Name
n [m Pat]
ps =
case Name -> Maybe NameSpace
nameSpace Name
n of
Just NameSpace
DataName -> do
ps' <- [m Pat] -> m [Pat]
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [m Pat]
ps
return (ConP n [] ps')
Maybe NameSpace
_ -> [Char] -> m Pat
forall a. HasCallStack => [Char] -> a
error ([Char] -> m Pat) -> [Char] -> m Pat
forall a b. (a -> b) -> a -> b
$ [Char]
"Can't construct a pattern from name "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
showName Name
n