-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Morley.Client.Types
  ( ToJSONObject
  , OperationInfoDescriptor (..)
  , OperationInfo (..)
  , _OpTransfer
  , _OpOriginate
  , _OpReveal
  , _OpDelegation
  ) where

import Control.Lens (makePrisms)
import Data.Aeson (ToJSON(..))

-- | Designates types whose 'ToJSON' instance produces only 'Data.Aeson.Object's.
class ToJSON a => ToJSONObject a

class OperationInfoDescriptor (i :: Type) where
  type family TransferInfo i :: Type
  type family OriginationInfo i :: Type
  type family RevealInfo i :: Type
  type family DelegationInfo i :: Type

data OperationInfo i
  = OpTransfer (TransferInfo i)
  | OpOriginate (OriginationInfo i)
  | OpReveal (RevealInfo i)
  | OpDelegation (DelegationInfo i)

-- Requiring 'ToJSONObject' in superclass as those different types of operation
-- must be distinguishable and that is usually done by a special field
instance
  Each '[ToJSONObject] [TransferInfo i, OriginationInfo i, RevealInfo i, DelegationInfo i] =>
  ToJSON (OperationInfo i) where
  toJSON :: OperationInfo i -> Value
toJSON = \case
    OpTransfer TransferInfo i
op -> TransferInfo i -> Value
forall a. ToJSON a => a -> Value
toJSON TransferInfo i
op
    OpOriginate OriginationInfo i
op -> OriginationInfo i -> Value
forall a. ToJSON a => a -> Value
toJSON OriginationInfo i
op
    OpReveal RevealInfo i
op -> RevealInfo i -> Value
forall a. ToJSON a => a -> Value
toJSON RevealInfo i
op
    OpDelegation DelegationInfo i
op -> DelegationInfo i -> Value
forall a. ToJSON a => a -> Value
toJSON DelegationInfo i
op
instance ToJSON (OperationInfo i) => ToJSONObject (OperationInfo i)

makePrisms ''OperationInfo