{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Data.Solidity.Prim.Tuple.TH
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  noportable
--
-- This module is for internal usage only.
-- It contains tuple abi encoding template haskell generator.
--

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
newName String
"a"
    let types :: [Q Type]
types = (Name -> Q Type) -> [Name] -> [Q Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Type -> Q Type
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 :: ExpQ
areDynamic = [ExpQ] -> ExpQ
listE ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$ ((Q Type -> ExpQ) -> [Q Type] -> [ExpQ])
-> [Q Type] -> (Q Type -> ExpQ) -> [ExpQ]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Q Type -> ExpQ) -> [Q Type] -> [ExpQ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Q Type]
types ((Q Type -> ExpQ) -> [ExpQ]) -> (Q Type -> ExpQ) -> [ExpQ]
forall a b. (a -> b) -> a -> b
$ \Q Type
t -> [| isDynamic (Proxy :: Proxy $(t)) |]

    [Q Dec] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Q Dec] -> DecsQ) -> [Q Dec] -> DecsQ
forall a b. (a -> b) -> a -> b
$
      [ CxtQ -> Q Type -> [Q Dec] -> Q Dec
instanceD ([Q Type] -> CxtQ
cxt ([Q Type] -> CxtQ) -> [Q Type] -> CxtQ
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
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
conT ''AbiType) [Q Type]
types) (Q Type -> Q Type -> Q Type
appT (Name -> Q Type
conT ''AbiType) ((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
appT (Int -> Q Type
tupleT Int
n) [Q Type]
types))
          [Name -> [ClauseQ] -> Q Dec
funD 'isDynamic [[PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
clause [] (ExpQ -> BodyQ
normalB [|const (or $(areDynamic))|]) []]]
      , CxtQ -> Q Type -> [Q Dec] -> Q Dec
instanceD ([Q Type] -> CxtQ
cxt ([Q Type] -> CxtQ) -> [Q Type] -> CxtQ
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
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
conT ''AbiGet) [Q Type]
types) (Q Type -> Q Type -> Q Type
appT (Name -> Q Type
conT ''AbiGet) ((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
appT (Int -> Q Type
tupleT Int
n) [Q Type]
types)) []
      , CxtQ -> Q Type -> [Q Dec] -> Q Dec
instanceD ([Q Type] -> CxtQ
cxt ([Q Type] -> CxtQ) -> [Q Type] -> CxtQ
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
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
conT ''AbiPut) [Q Type]
types) (Q Type -> Q Type -> Q Type
appT (Name -> Q Type
conT ''AbiPut) ((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
appT (Int -> Q Type
tupleT Int
n) [Q Type]
types)) [] ]