module Language.Haskell.TH.Instances where
import Data.Ratio
import GHC.Exts
import GHC.Prim
import Language.Haskell.TH.Syntax
instance Lift a => Lift (Q a) where
lift x = x >>= \x -> [| return x |]
instance Lift Exp where
lift (VarE name) = [|VarE name|]
lift (ConE name) = [|ConE name|]
lift (LitE lit) = [|LitE lit|]
lift (AppE e1 e2) = [|AppE e1 e2|]
lift (InfixE e1 e2 e3) = [|InfixE e1 e2 e3|]
lift (LamE p e) = [|LamE p e|]
lift (TupE e) = [|TupE e|]
lift (CondE e1 e2 e3) = [|CondE e1 e2 e3|]
lift (LetE d e) = [|LetE d e|]
lift (CaseE e m) = [|CaseE e m|]
lift (DoE s) = [|DoE s|]
lift (CompE s) = [|CompE s|]
lift (ArithSeqE r) = [|ArithSeqE r|]
lift (ListE e) = [|ListE e|]
lift (SigE e t) = [|SigE e t|]
lift (RecConE n f) = [|RecConE n f|]
lift (RecUpdE e f) = [|RecUpdE e f|]
instance Lift Name where
lift (Name o f) = [|Name o f|]
instance Lift OccName where
lift s = let s' = occString s in [|mkOccName s'|]
fromInt (I# i) = i
instance Lift NameFlavour where
lift NameS = [|NameS|]
lift (NameQ n) = [|NameQ n|]
lift (NameU i) = let i' = I# i in [|NameU (fromInt i')|]
lift (NameL i) = let i' = I# i in [|NameL (fromInt i')|]
lift (NameG n p m) = [|NameG n p m|]
instance Lift Range where
lift (FromR e) = [|FromR e|]
lift (FromThenR e1 e2) = [|FromThenR e1 e2|]
lift (FromToR e1 e2) = [|FromToR e1 e2|]
lift (FromThenToR e1 e2 e3) = [|FromThenToR e1 e2 e3|]
instance Lift Stmt where
lift (BindS p e) = [|BindS p e|]
lift (LetS d) = [|LetS d|]
lift (NoBindS e) = [|NoBindS e|]
lift (ParS s) = [|ParS s|]
instance Lift Match where
lift (Match p b d) = [|Match p b d|]
instance Lift Type where
lift (ForallT n c t) = [|ForallT n c t|]
lift (VarT n) = [|VarT n|]
lift (ConT n) = [|ConT n|]
lift (TupleT i) = [|TupleT i|]
lift (ArrowT) = [|ArrowT|]
lift (ListT) = [|ListT|]
lift (AppT t1 t2) = [|AppT t1 t2|]
instance Lift Pat where
lift (LitP l) = [|LitP l|]
lift (VarP n) = [|VarP n|]
lift (TupP p) = [|TupP p|]
lift (ConP n p) = [|ConP n p|]
lift (InfixP p1 n p2) = [|InfixP p1 n p2|]
lift (TildeP p) = [|TildeP p|]
lift (AsP n p) = [|AsP n p|]
lift (WildP) = [|WildP|]
lift (RecP n f) = [|RecP n f|]
lift (ListP p) = [|ListP p|]
lift (SigP p t) = [|SigP p t|]
instance Lift Lit where
lift (CharL c) = [|CharL c|]
lift (StringL s) = [|StringL s|]
lift (IntegerL i) = [|IntegerL i|]
lift (RationalL r) = [|RationalL r|]
lift (IntPrimL i) = [|IntPrimL i|]
#if __GLASGOW_HASKELL__ >= 610
lift (WordPrimL i) = [|WordPrimL i|]
#endif
lift (FloatPrimL r) = [|FloatPrimL r|]
lift (DoublePrimL r) = [|DoublePrimL r|]
instance Lift Dec where
lift (FunD n c) = [|FunD n c|]
lift (ValD p b d) = [|ValD p b d|]
lift (DataD c n l1 l2 l3) = [|DataD c n l1 l2 l3|]
lift (NewtypeD c n l1 c' l2) = [|NewtypeD c n l1 c' l2|]
lift (TySynD n l t) = [|TySynD n l t|]
lift (ClassD c n l1 l2 l3) = [|ClassD c n l1 l2 l3|]
lift (InstanceD c t d) = [|InstanceD c t d|]
lift (SigD n t) = [|SigD n t|]
lift (ForeignD f) = [|ForeignD f|]
instance Lift NameSpace where
lift (VarName) = [|VarName|]
lift (DataName) = [|DataName|]
lift (TcClsName) = [|TcClsName|]
instance Lift Body where
lift (GuardedB l) = [|GuardedB l|]
lift (NormalB e) = [|NormalB e|]
instance Lift Clause where
lift (Clause p b d) = [|Clause p b d|]
instance Lift Con where
lift (NormalC n m) = [|NormalC n m|]
lift (RecC n s) = [|RecC n s|]
lift (InfixC s1 n s2) = [|InfixC s1 n s2|]
lift (ForallC n c c') = [|ForallC n c c'|]
instance Lift FunDep where
lift (FunDep l1 l) = [|FunDep l1 l|]
instance Lift Foreign where
lift (ImportF c f s n t) = [|ImportF c f s n t|]
lift (ExportF c s n t) = [|ExportF c s n t|]
instance Lift Guard where
lift (NormalG e) = [|NormalG e|]
lift (PatG s) = [|PatG s|]
instance Lift Strict where
lift (IsStrict) = [|IsStrict|]
lift (NotStrict) = [|NotStrict|]
instance Lift Safety where
lift (Unsafe) = [|Unsafe|]
lift (safe) = [|safe|]
instance Lift Callconv where
lift (CCall) = [|CCall|]
lift (StdCall) = [|StdCall|]
instance Lift Rational where
lift r = let n = numerator r
d = denominator r
in [|n % d|]
instance Lift Double where
lift d = [| D# $(return (LitE (DoublePrimL (toRational d)))) |]