{-# LANGUAGE TemplateHaskell #-}
module Data.Solidity.Prim.Tuple.TH (tupleDecs) where
import Control.Monad (replicateM)
import Data.Proxy
import Language.Haskell.TH (DecsQ, Type (VarT), appT, clause, conT,
cxt, funD, instanceD, listE, newName,
normalB, tupleT)
import Data.Solidity.Abi (AbiGet, AbiPut, AbiType (..))
tupleDecs :: Int -> DecsQ
tupleDecs :: Int -> DecsQ
tupleDecs Int
n = do
[Name]
vars <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Q Name -> Q [Name]) -> Q Name -> Q [Name]
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a"
let types :: [Q Type]
types = (Name -> Q Type) -> [Name] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> (Name -> Type) -> Name -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
VarT) [Name]
vars
areDynamic :: Q Exp
areDynamic = [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ((Q Type -> Q Exp) -> [Q Type] -> [Q Exp])
-> [Q Type] -> (Q Type -> Q Exp) -> [Q Exp]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Q Type -> Q Exp) -> [Q Type] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Q Type]
types ((Q Type -> Q Exp) -> [Q Exp]) -> (Q Type -> Q Exp) -> [Q Exp]
forall a b. (a -> b) -> a -> b
$ \Q Type
t -> [| isDynamic (Proxy :: Proxy $(Q Type
t)) |]
[Q Dec] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Q Dec] -> DecsQ) -> [Q Dec] -> DecsQ
forall a b. (a -> b) -> a -> b
$
[ Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt ([Q Type] -> Q Cxt) -> [Q Type] -> Q Cxt
forall a b. (a -> b) -> a -> b
$ (Q Type -> Q Type) -> [Q Type] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''AbiType) [Q Type]
types) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''AbiType) ((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Int -> Q Type
forall (m :: * -> *). Quote m => Int -> m Type
tupleT Int
n) [Q Type]
types))
[Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'isDynamic [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [|const (or $(Q Exp
areDynamic))|]) []]]
, Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt ([Q Type] -> Q Cxt) -> [Q Type] -> Q Cxt
forall a b. (a -> b) -> a -> b
$ (Q Type -> Q Type) -> [Q Type] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''AbiGet) [Q Type]
types) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''AbiGet) ((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Int -> Q Type
forall (m :: * -> *). Quote m => Int -> m Type
tupleT Int
n) [Q Type]
types)) []
, Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt ([Q Type] -> Q Cxt) -> [Q Type] -> Q Cxt
forall a b. (a -> b) -> a -> b
$ (Q Type -> Q Type) -> [Q Type] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''AbiPut) [Q Type]
types) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''AbiPut) ((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Int -> Q Type
forall (m :: * -> *). Quote m => Int -> m Type
tupleT Int
n) [Q Type]
types)) [] ]