module Language.Haskell.TH.Build.Extras where
import Language.Haskell.TH.Build.Convertible
import Language.Haskell.TH.Build.Convertible.Restr
import Language.Haskell.TH.Build.Wrappers
import Language.Haskell.TH
import Control.Monad
getFieldE :: (Convertible a Name) =>
a
-> Int
-> Int
-> Q Exp
getFieldE ctor n i = do
x <- newName "_x"
lamE'
(conP (name ctor) (map (\j -> if i==j then varP x else wildP) [0..n1]))
x
htuple' :: Convertible a TypeQ => Int -> a -> TypeQ
htuple' n t = foldl appT (tupleT n) (replicate n (typeQ t))
(\->) :: (Convertible a [PatQ], Convertible a1 ExpQ) =>
a -> a1 -> ExpQ
(\->) = lamE'
infixr 1 \->
class Arrows a b | a -> b, b -> a where
arrow :: a -> b -> b
instance Arrows Exp Pat where arrow = ViewP
instance Arrows Type Type where arrow x y = AppT (AppT ArrowT x) y
instance Arrows Kind Kind where arrow = ArrowK
(-->) :: (Convertible qa (Q a), Convertible qb (Q b), Arrows a b) =>
qa -> qb -> Q b
(-->) = preconvert2 (liftM2 arrow)
infixr 1 -->
class Sigs a b c | c -> a b, a -> b c where
signature :: a -> b -> c
(.::) :: (Convertible qa (Q a'), Convertible qb (Q b'), Sigs a' b' c) => qa -> qb -> Q c
(.::) = preconvert2 (liftM2 signature)
infixl 1 .::
instance Sigs Name Type Dec where signature = SigD
instance Sigs Exp Type Exp where signature = SigE
instance Sigs Pat Type Pat where signature = SigP
instance Sigs Type Kind Type where signature = SigT
svalD
:: (Convertible patQ PatQ, Convertible bodyQ BodyQ) =>
patQ -> bodyQ -> DecQ
svalD p e = valD' p e ()
smatch
:: (Convertible patQ PatQ, Convertible bodyQ BodyQ) =>
patQ -> bodyQ -> MatchQ
smatch p e = match' p e ()
sclause
:: (Convertible patQs [PatQ], Convertible bodyQ BodyQ) =>
patQs -> bodyQ -> ClauseQ
sclause p e = clause' p e ()
sdataD
:: (Convertible name Name, Convertible tyVarBndrs [TyVarBndr],
Convertible conQs [ConQ], Convertible names [Name]) =>
name -> tyVarBndrs -> conQs -> names -> DecQ
sdataD n vars cons derivs = dataD' () n vars cons derivs
snewtypeD
:: (Convertible name Name, Convertible tyVarBndrs [TyVarBndr],
Convertible conQ ConQ, Convertible names [Name]) =>
name -> tyVarBndrs -> conQ -> names -> DecQ
snewtypeD n vars con derivs = newtypeD' () n vars con derivs