module Language.Haskell.TH.ToExp
( ToExp(..)
, toExpIntegral
) where
import GHC.Generics
import Language.Haskell.TH.Syntax as TH
import Data.Ratio (Ratio, (%), numerator, denominator)
import Data.Word (Word8)
class ToExp a where
toExp :: a -> Exp
default toExp :: (Generic a, GToExp (Rep a)) => a -> Exp
toExp = gToExp . from
instance ToExp Integer where
toExp n = SigE (LitE $ IntegerL n) (ConT ''Integer)
toExpIntegral
:: Integral a
=> Type
-> a
-> Exp
toExpIntegral ty n = SigE (LitE $ IntegerL (toInteger n)) ty
instance ToExp Int where toExp = toExpIntegral (ConT ''Int)
instance ToExp Word8 where toExp = toExpIntegral (ConT ''Word8)
instance ToExp a => ToExp (Ratio a) where
toExp r = AppE (AppE (VarE '(%)) (toExp $ numerator r)) (toExp $ denominator r)
instance ToExp Char where
toExp = LitE . CharL
instance ToExp a => ToExp [a] where
toExp = ListE . map toExp
instance ToExp ()
instance ToExp Bool
instance ToExp Ordering
instance ToExp a => ToExp (Maybe a)
instance (ToExp a, ToExp b) => ToExp (Either a b)
instance (ToExp a, ToExp b) => ToExp (a, b)
instance (ToExp a, ToExp b, ToExp c) => ToExp (a, b, c)
instance (ToExp a, ToExp b, ToExp c, ToExp d) => ToExp (a, b, c, d)
instance (ToExp a, ToExp b, ToExp c, ToExp d, ToExp e) => ToExp (a, b, c, d, e)
instance (ToExp a, ToExp b, ToExp c, ToExp d, ToExp e, ToExp f) => ToExp (a, b, c, d, e, f)
instance (ToExp a, ToExp b, ToExp c, ToExp d, ToExp e, ToExp f, ToExp g) => ToExp (a, b, c, d, e, f, g)
instance ToExp TH.AnnLookup
instance ToExp TH.AnnTarget
instance ToExp TH.Bang
instance ToExp TH.Body
instance ToExp TH.Callconv
instance ToExp TH.Clause
instance ToExp TH.Con
instance ToExp TH.Dec
instance ToExp TH.DecidedStrictness
instance ToExp TH.Exp
instance ToExp TH.Extension
instance ToExp TH.FamilyResultSig
instance ToExp TH.Fixity
instance ToExp TH.FixityDirection
instance ToExp TH.Foreign
instance ToExp TH.FunDep
instance ToExp TH.Guard
instance ToExp TH.Info
instance ToExp TH.InjectivityAnn
instance ToExp TH.Inline
instance ToExp TH.Lit
instance ToExp TH.Match
instance ToExp TH.ModName
instance ToExp TH.Module
instance ToExp TH.ModuleInfo
instance ToExp TH.Name
instance ToExp TH.NameFlavour
instance ToExp TH.NameSpace
instance ToExp TH.OccName
instance ToExp TH.Overlap
instance ToExp TH.Pat
instance ToExp TH.Phases
instance ToExp TH.PkgName
instance ToExp TH.Pragma
instance ToExp TH.Range
instance ToExp TH.Role
instance ToExp TH.RuleBndr
instance ToExp TH.RuleMatch
instance ToExp TH.Safety
instance ToExp TH.SourceStrictness
instance ToExp TH.SourceUnpackedness
instance ToExp TH.Stmt
instance ToExp TH.TyLit
instance ToExp TH.Type
instance ToExp TH.TypeFamilyHead
instance ToExp TH.TySynEqn
instance ToExp TH.TyVarBndr
#if MIN_VERSION_template_haskell(2,12,0)
instance ToExp TH.DerivClause
instance ToExp TH.DerivStrategy
instance ToExp TH.PatSynArgs
instance ToExp TH.PatSynDir
#endif
class GToExp f where
gToExp :: f a -> Exp
instance (Datatype d, GToExp' (D1 d cs)) => GToExp (D1 d cs) where
gToExp x = gToExp' x (Module package name)
where name = ModName $ moduleName x
package = PkgName $ packageName x
class GToExp' f where
gToExp' :: f a -> Module -> Exp
instance GToExp' f => GToExp' (D1 t f) where
gToExp' (M1 x) = gToExp' x
instance (GToExp' f, GToExp' g) => GToExp' (f :+: g) where
gToExp' (L1 x) = gToExp' x
gToExp' (R1 x) = gToExp' x
instance (Constructor c, GProductToExps f) => GToExp' (C1 c f) where
gToExp' x (Module pkgName modName) = foldl AppE (ConE name) (gProductToExps x)
where nameStr = conName x
nameFlavour = NameG DataName pkgName modName
name = Name (OccName nameStr) nameFlavour
class GProductToExps f where
gProductToExps :: f a -> [Exp]
instance GProductToExps U1 where
gProductToExps _ = []
instance ToExp c => GProductToExps (K1 i c) where
gProductToExps (K1 x) = [toExp x]
instance GProductToExps f => GProductToExps (M1 i t f) where
gProductToExps (M1 x) = gProductToExps x
instance (GProductToExps a, GProductToExps b) => GProductToExps (a :*: b) where
gProductToExps (x :*: y) = gProductToExps x ++ gProductToExps y