diff --git a/src/Network/Ethereum/Web3/Contract.purs b/src/Network/Ethereum/Web3/Contract.purs index cc925cb..b2615c3 100644 --- a/src/Network/Ethereum/Web3/Contract.purs +++ b/src/Network/Ethereum/Web3/Contract.purs @@ -16,7 +16,7 @@ import Control.Monad.Error.Class (throwError) import Data.Bifunctor (lmap) import Data.Either (Either(..)) import Data.Functor.Tagged (Tagged, untagged) -import Data.Generic.Rep (class Generic, Constructor) +import Data.Generic.Rep (class Generic) import Data.Lens ((.~), (%~), (?~)) import Data.Maybe (Maybe(..)) import Data.Symbol (class IsSymbol, reflectSymbol) @@ -25,7 +25,7 @@ import Network.Ethereum.Core.Keccak256 (toSelector) import Network.Ethereum.Types (Address, HexString) import Network.Ethereum.Web3.Api (eth_call, eth_sendTransaction) import Network.Ethereum.Web3.Contract.Events (MultiFilterStreamState(..), event', FilterStreamState, ChangeReceipt, EventHandler) -import Network.Ethereum.Web3.Solidity (class DecodeEvent, class GenericABIDecode, class GenericABIEncode, class RecordFieldsIso, genericFromRecordFields) +import Network.Ethereum.Web3.Solidity (class DecodeEvent, class GenericABIDecode, class GenericABIEncode, class GRecordFieldsIso, fromRecord) import Network.Ethereum.Web3.Solidity.AbiEncoding (abiDecode, abiEncode) import Network.Ethereum.Web3.Types (class TokenUnit, CallError(..), ChainCursor, ETHER, Filter, NoPay, TransactionOptions, Value, Web3, _data, _value, convert) import Type.Proxy (Proxy(..)) @@ -159,11 +159,11 @@ deployContract txOptions deployByteCode args = eth_sendTransaction txdata mkDataField - :: forall selector a name args fields l + :: forall selector a rep fields l . IsSymbol selector - => Generic a (Constructor name args) - => RecordFieldsIso args fields l - => GenericABIEncode (Constructor name args) + => Generic a rep + => GRecordFieldsIso rep fields l + => GenericABIEncode rep => Proxy (Tagged selector a) -> Record fields -> HexString @@ -173,6 +173,6 @@ mkDataField _ r = sel = toSelector sig - args = genericFromRecordFields r :: a + args = fromRecord r :: a in sel <> abiEncode args diff --git a/src/Network/Ethereum/Web3/Contract/Internal.purs b/src/Network/Ethereum/Web3/Contract/Internal.purs index 0da9ee6..69cf420 100644 --- a/src/Network/Ethereum/Web3/Contract/Internal.purs +++ b/src/Network/Ethereum/Web3/Contract/Internal.purs @@ -18,10 +18,10 @@ import Type.Proxy (Proxy(..)) class UncurryFields fields curried result | curried -> result fields where uncurryFields :: Record fields -> curried -> result -instance uncurryFieldsEmpty :: UncurryFields () (Web3 b) (Web3 b) where +instance UncurryFields () (Web3 b) (Web3 b) where uncurryFields _ = identity -instance uncurryFieldsInductive :: (IsSymbol s, Row.Cons s a before after, Row.Lacks s before, UncurryFields before f b) => UncurryFields after (Tagged s a -> f) b where +instance (IsSymbol s, Row.Cons s a before after, Row.Lacks s before, UncurryFields before f b) => UncurryFields after (Tagged s a -> f) b where uncurryFields r f = let arg = (Record.get (Proxy :: Proxy s) r) diff --git a/src/Network/Ethereum/Web3/Solidity.purs b/src/Network/Ethereum/Web3/Solidity.purs index 21f73f1..2a0e5dd 100644 --- a/src/Network/Ethereum/Web3/Solidity.purs +++ b/src/Network/Ethereum/Web3/Solidity.purs @@ -17,7 +17,7 @@ import Network.Ethereum.Web3.Solidity.AbiEncoding (class ABIDecodableValue, clas import Network.Ethereum.Web3.Solidity.Bytes (BytesN, unBytesN, proxyBytesN, update, fromByteString) import Network.Ethereum.Web3.Solidity.Event (class DecodeEvent, decodeEvent, class IndexedEvent, isAnonymous) import Network.Ethereum.Web3.Solidity.Int (IntN, unIntN, intNFromBigNumber) -import Network.Ethereum.Web3.Solidity.Internal (class ArgsToRowListProxy, class RecordFieldsIso, toRecordFields, fromRecordFields, genericToRecordFields, genericFromRecordFields) +import Network.Ethereum.Web3.Solidity.Internal (class GRecordFieldsIso, toRecord, fromRecord) import Network.Ethereum.Web3.Solidity.Tuple (Tuple0(..), Tuple1(..), unTuple1, uncurry1, curry1, Tuple2(..), uncurry2, curry2, Tuple3(..), uncurry3, curry3, Tuple4(..), uncurry4, curry4, Tuple5(..), uncurry5, curry5, Tuple6(..), uncurry6, curry6, Tuple7(..), uncurry7, curry7, Tuple8(..), uncurry8, curry8, Tuple9(..), uncurry9, curry9, Tuple10(..), uncurry10, curry10, Tuple11(..), uncurry11, curry11, Tuple12(..), uncurry12, curry12, Tuple13(..), uncurry13, curry13, Tuple14(..), uncurry14, curry14, Tuple15(..), uncurry15, curry15, Tuple16(..), uncurry16, curry16) import Network.Ethereum.Web3.Solidity.UInt (UIntN, unUIntN, uIntNFromBigNumber) import Network.Ethereum.Web3.Solidity.Vector (Vector, unVector, nilVector, vCons, (:<), vectorLength, toVector) diff --git a/src/Network/Ethereum/Web3/Solidity/Event.purs b/src/Network/Ethereum/Web3/Solidity/Event.purs index 5e69e1b..5f0fa63 100644 --- a/src/Network/Ethereum/Web3/Solidity/Event.purs +++ b/src/Network/Ethereum/Web3/Solidity/Event.purs @@ -16,13 +16,12 @@ import Data.Array (uncons) import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), to) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, wrap) -import Data.Symbol (class IsSymbol) import Network.Ethereum.Types (HexString) import Network.Ethereum.Web3.Solidity.AbiEncoding (class ABIDecodableValue, class GenericABIDecode, abiDecode, parseABIValue) -import Network.Ethereum.Web3.Solidity.Internal (class RecordFieldsIso, genericToRecordFields) +import Network.Ethereum.Web3.Solidity.Internal (class GRecordFieldsIso, toRecord) import Network.Ethereum.Web3.Types (Change(..)) import Prim.Row as Row -import Record.Builder (build, merge) +import Record (disjointUnion) import Type.Proxy (Proxy(..)) -------------------------------------------------------------------------------- @@ -76,35 +75,35 @@ parseChange (Change change) anonymous = do pure $ Event a b combineChange - :: forall aargs afields al (a :: Type) aname bargs bfields bl (b :: Type) bname c cfields cfieldsRes - . RecordFieldsIso aargs afields al - => Generic a (Constructor aname aargs) - => RecordFieldsIso bargs bfields bl - => Generic b (Constructor bname bargs) + :: forall afields al a arep bfields bl b brep c cfields + . Generic a arep + => Generic b brep + => GRecordFieldsIso arep afields al + => GRecordFieldsIso brep bfields bl => Row.Union afields bfields cfields - => Row.Nub cfields cfieldsRes - => Newtype c (Record cfieldsRes) + => Row.Nub cfields cfields + => Newtype c (Record cfields) => Event a b -> c -combineChange (Event a b) = wrap $ build (merge (genericToRecordFields a)) (genericToRecordFields b) +combineChange (Event a b) = + wrap $ disjointUnion (toRecord a) (toRecord b) class IndexedEvent :: forall k1 k2 k3. k1 -> k2 -> k3 -> Constraint class IndexedEvent a b c | c -> a b where isAnonymous :: Proxy c -> Boolean decodeEventDef - :: forall aargs afields al a aname bargs bfields bl b bname c cfields cfieldsRes - . ArrayParser aargs - => RecordFieldsIso aargs afields al - => Generic a (Constructor aname aargs) - => IsSymbol aname - => IsSymbol bname - => RecordFieldsIso bargs bfields bl - => Generic b (Constructor bname bargs) - => GenericABIDecode bargs + :: forall afields al a arep bfields bl b brep c cfields + . Generic a arep + => GRecordFieldsIso arep afields al + => GenericABIDecode arep + => ArrayParser arep + => GRecordFieldsIso brep bfields bl + => Generic b brep + => GenericABIDecode brep => Row.Union afields bfields cfields - => Row.Nub cfields cfieldsRes - => Newtype c (Record cfieldsRes) + => Row.Nub cfields cfields + => Newtype c (Record cfields) => IndexedEvent a b c => Change -> Maybe c @@ -121,18 +120,17 @@ class | c -> a b where decodeEvent :: Change -> Maybe c -instance defaultInstance :: - ( ArrayParser aargs - , RecordFieldsIso aargs afields al - , Generic a (Constructor aname aargs) - , RecordFieldsIso bargs bfields bl - , Generic b (Constructor bname bargs) - , GenericABIDecode bargs +instance + ( ArrayParser arep + , GRecordFieldsIso arep afields al + , Generic a arep + , GenericABIDecode arep + , GRecordFieldsIso brep bfields bl + , Generic b brep + , GenericABIDecode brep , Row.Union afields bfields cfields - , Row.Nub cfields cfieldsRes - , Newtype c (Record cfieldsRes) - , IsSymbol aname - , IsSymbol bname + , Row.Nub cfields cfields + , Newtype c (Record cfields) , IndexedEvent a b c ) => DecodeEvent a b c where diff --git a/src/Network/Ethereum/Web3/Solidity/Internal.purs b/src/Network/Ethereum/Web3/Solidity/Internal.purs index 93b8e91..389e288 100644 --- a/src/Network/Ethereum/Web3/Solidity/Internal.purs +++ b/src/Network/Ethereum/Web3/Solidity/Internal.purs @@ -1,4 +1,10 @@ -module Network.Ethereum.Web3.Solidity.Internal where +module Network.Ethereum.Web3.Solidity.Internal + ( class GRecordFieldsIso + , gToRecordFields + , gFromRecordFields + , toRecord + , fromRecord + ) where import Prelude @@ -8,74 +14,51 @@ import Data.Symbol (class IsSymbol) import Prim.Row as Row import Record as Record import Type.Proxy (Proxy(..)) -import Type.RowList (class ListToRow, Cons, Nil, RowList) +import Type.RowList (class RowListAppend, Cons, Nil) +import Unsafe.Coerce (unsafeCoerce) -class ArgsToRowListProxy :: forall k. k -> RowList Type -> Constraint -class ArgsToRowListProxy args l | args -> l, l -> args where - argsToRowListProxy :: Proxy args -> Proxy l +class GRecordFieldsIso :: forall k1. Type -> Row Type -> k1 -> Constraint +class GRecordFieldsIso rep fields k | rep -> k, k -> rep fields where + gToRecordFields :: Proxy k -> rep -> Record fields + gFromRecordFields :: Proxy k -> Record fields -> rep -instance argsToRowListProxyBaseNull :: ArgsToRowListProxy NoArguments Nil where - argsToRowListProxy _ = Proxy +instance GRecordFieldsIso NoArguments () Nil where + gToRecordFields _ _ = {} + gFromRecordFields _ _ = NoArguments -instance argsToRowListProxyBase :: ArgsToRowListProxy (Argument (Tagged (Proxy s) a)) (Cons s a Nil) where - argsToRowListProxy _ = Proxy -else instance argsToRowListProxyInductive :: ArgsToRowListProxy as l => ArgsToRowListProxy (Product (Argument (Tagged (Proxy s) a)) as) (Cons s a l) where - argsToRowListProxy _ = Proxy - -class RecordFieldsIso args fields (rowList :: RowList Type) | args -> rowList, rowList -> args fields where - toRecordFields :: forall proxy. proxy rowList -> args -> Record fields - fromRecordFields :: forall proxy. proxy rowList -> Record fields -> args - -instance isoRecordBase :: +else instance ( IsSymbol s , Row.Cons s a () r , Row.Lacks s () ) => - RecordFieldsIso (Argument (Tagged s a)) r (Cons s a Nil) where - toRecordFields _ (Argument a) = Record.insert (Proxy :: Proxy s) (untagged a) {} - fromRecordFields _ r = Argument (tagged $ Record.get (Proxy :: Proxy s) r) + GRecordFieldsIso (Argument (Tagged s a)) r (Cons s a Nil) where + gToRecordFields _ (Argument a) = Record.insert (Proxy @s) (untagged a) {} + gFromRecordFields _ r = Argument (tagged $ Record.get (Proxy @s) r) -instance isoRecordBaseNull :: RecordFieldsIso NoArguments () Nil where - toRecordFields _ _ = {} - fromRecordFields _ _ = NoArguments - -instance isoRecordInductive :: - ( RecordFieldsIso as r1 (Cons ls la ll) - , Row.Cons s a r1 r2 - , Row.Lacks s r1 - , IsSymbol s - , ListToRow (Cons ls la ll) r1 +else instance + ( GRecordFieldsIso as ra rla + , GRecordFieldsIso bs rb rlb + , RowListAppend rla rlb rl + , Row.Union ra rb r + , Row.Nub r r ) => - RecordFieldsIso (Product (Argument (Tagged s a)) as) r2 (Cons s a (Cons ls la ll)) where - toRecordFields _ (Product (Argument a) as) = Record.insert (Proxy :: Proxy s) (untagged a) rest - where - rest = (toRecordFields (Proxy :: Proxy (Cons ls la ll)) as :: Record r1) - fromRecordFields _ r = - let - a = Argument (tagged $ Record.get (Proxy :: Proxy s) r) + GRecordFieldsIso (Product as bs) r rl where + gToRecordFields _ (Product as bs) = + Record.merge (gToRecordFields (Proxy @rla) as) (gToRecordFields (Proxy @rlb) bs) - before = Record.delete (Proxy :: Proxy s) r :: Record r1 - - rest = fromRecordFields (Proxy :: Proxy (Cons ls la ll)) before + gFromRecordFields _ r = + let + as = gFromRecordFields (Proxy @rla) (unsafeCoerce r) + bs = gFromRecordFields (Proxy @rlb) (unsafeCoerce r) in - Product a rest + Product as bs + +else instance GRecordFieldsIso a r rl => GRecordFieldsIso (Constructor name a) r (Cons name rl Nil) where + gToRecordFields _ (Constructor a) = gToRecordFields (Proxy @rl) a + gFromRecordFields _ r = Constructor (gFromRecordFields (Proxy @rl) r) -genericToRecordFields - :: forall args fields l a name - . RecordFieldsIso args fields l - => Generic a (Constructor name args) - => a - -> Record fields -genericToRecordFields a = - let - Constructor row = from a - in - toRecordFields (Proxy :: Proxy l) row +toRecord :: forall a rep fields l. Generic a rep => GRecordFieldsIso rep fields l => a -> Record fields +toRecord a = gToRecordFields (Proxy :: Proxy l) (from a) -genericFromRecordFields - :: forall args fields l a name - . RecordFieldsIso args fields l - => Generic a (Constructor name args) - => Record fields - -> a -genericFromRecordFields r = to $ Constructor $ fromRecordFields (Proxy :: Proxy l) r +fromRecord :: forall a rep fields l. Generic a rep => GRecordFieldsIso rep fields l => Record fields -> a +fromRecord a = to $ gFromRecordFields (Proxy :: Proxy l) a diff --git a/test/web3/Web3Spec/Encoding/DataSpec.purs b/test/web3/Web3Spec/Encoding/DataSpec.purs index 2a77bb2..b87d56c 100644 --- a/test/web3/Web3Spec/Encoding/DataSpec.purs +++ b/test/web3/Web3Spec/Encoding/DataSpec.purs @@ -9,7 +9,7 @@ import Network.Ethereum.Core.Signatures as Address import Network.Ethereum.Web3.Contract (sendTx, mkDataField) import Network.Ethereum.Web3.Solidity (Tuple2, UIntN) import Network.Ethereum.Web3.Solidity.AbiEncoding (encodeABIValue) -import Network.Ethereum.Web3.Solidity.Internal (genericFromRecordFields) +import Network.Ethereum.Web3.Solidity.Internal (fromRecord) import Network.Ethereum.Web3.Solidity.UInt as UIntN import Network.Ethereum.Web3.Types (Address, HexString, NoPay, TransactionOptions, Web3) import Test.QuickCheck (quickCheckGen, (===)) @@ -33,4 +33,4 @@ spec = type ApproveFn = Tagged "approve(address,uint256)" (Tuple2 (Tagged "_spender" Address) (Tagged "_value" (UIntN 256))) approve :: TransactionOptions NoPay -> { _spender :: Address, _value :: (UIntN 256) } -> Web3 HexString -approve txOpts r = sendTx txOpts (tagged (genericFromRecordFields r) :: ApproveFn) +approve txOpts r = sendTx txOpts (tagged (fromRecord r) :: ApproveFn) diff --git a/test/web3/Web3Spec/Encoding/GenericSpec.purs b/test/web3/Web3Spec/Encoding/GenericSpec.purs index 7303423..cb4aba1 100644 --- a/test/web3/Web3Spec/Encoding/GenericSpec.purs +++ b/test/web3/Web3Spec/Encoding/GenericSpec.purs @@ -6,7 +6,8 @@ import Data.Functor.Tagged (Tagged, tagged) import Data.Generic.Rep (class Generic) import Effect.Class (liftEffect) import Network.Ethereum.Web3.Solidity (Tuple2(..), Tuple3(..)) -import Network.Ethereum.Web3.Solidity.Internal (genericToRecordFields) +import Network.Ethereum.Web3.Solidity.Internal (toRecord) +import Record (disjointUnion) import Record.Builder (build, merge) import Test.QuickCheck (quickCheck, (===)) import Test.Spec (Spec, describe, it) @@ -24,8 +25,9 @@ toRecordFieldsSpec = let as = Tuple2 (tagged x.a) (tagged x.b) :: Tuple2 (Tagged "a" Int) (Tagged "b" Int) bs = Tuple2 (tagged x.c) (tagged x.d) :: Tuple2 (Tagged "c" String) (Tagged "d" String) + in - (build (merge (genericToRecordFields as)) (genericToRecordFields bs)) + disjointUnion (toRecord as) (toRecord bs) === { a: x.a , b: x.b @@ -38,7 +40,7 @@ toRecordFieldsSpec = let as = Tuple3 (tagged x.a) (tagged x.d) (tagged x.e) :: Tuple3 (Tagged "a" Int) (Tagged "d" String) (Tagged "e" Char) in - WeirdTuple (genericToRecordFields as) + WeirdTuple (toRecord as) === WeirdTuple { a: x.a @@ -53,7 +55,7 @@ toRecordFieldsSpec = as' = Tuple2 (tagged x.b) (tagged x.c) :: Tuple2 (Tagged "b" Int) (Tagged "c" String) - c = CombinedTuple $ build (merge (genericToRecordFields as)) (genericToRecordFields as') + c = CombinedTuple $ build (merge (toRecord as)) (toRecord as') in c === CombinedTuple x