{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      :  Data.Solidity.Prim.Tagged
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  noportable
--
-- Ethereum Abi tagged types.
--

module Data.Solidity.Prim.Tagged
    (
    -- * The @Tagged@ type
      Tagged
    ) where

import           Data.Proxy        (Proxy (..))
import           Data.Tagged       (Tagged (..))
import           Generics.SOP      (Generic)

import           Data.Solidity.Abi (AbiGet (..), AbiPut (..), AbiType (..))

instance AbiType a => AbiType (Tagged t a) where
    isDynamic :: Proxy (Tagged t a) -> Bool
isDynamic Proxy (Tagged t a)
_ = Proxy a -> Bool
forall a. AbiType a => Proxy a -> Bool
isDynamic (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance AbiPut a => AbiPut (Tagged t a) where
    abiPut :: Putter (Tagged t a)
abiPut (Tagged a
a) = Putter a
forall a. AbiPut a => Putter a
abiPut a
a

instance AbiGet a => AbiGet (Tagged t a) where
    abiGet :: Get (Tagged t a)
abiGet = a -> Tagged t a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged t a) -> Get a -> Get (Tagged t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall a. AbiGet a => Get a
abiGet

instance Generic a => Generic (Tagged t a)