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

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

import Control.Lens (makePrisms)
import Data.Aeson (ToJSON(..))
import Fmt (Buildable(..), (+|), (|+))

import Lorentz (ToAddress(..), ToTAddress(..))
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds

-- | 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 TransferTicketInfo i :: Type
  type family OriginationInfo i :: Type
  type family RevealInfo i :: Type
  type family DelegationInfo i :: Type

data OperationInfo i
  = OpTransfer (TransferInfo i)
  | OpTransferTicket (TransferTicketInfo 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, TransferTicketInfo 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
    OpTransferTicket TransferTicketInfo i
op -> TransferTicketInfo i -> Value
forall a. ToJSON a => a -> Value
toJSON TransferTicketInfo 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

data AddressWithAlias kind = AddressWithAlias
  { forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress :: KindedAddress kind
  , forall (kind :: AddressKind). AddressWithAlias kind -> Alias kind
awaAlias :: Alias kind
  }
  deriving stock (Int -> AddressWithAlias kind -> ShowS
[AddressWithAlias kind] -> ShowS
AddressWithAlias kind -> String
(Int -> AddressWithAlias kind -> ShowS)
-> (AddressWithAlias kind -> String)
-> ([AddressWithAlias kind] -> ShowS)
-> Show (AddressWithAlias kind)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (kind :: AddressKind). Int -> AddressWithAlias kind -> ShowS
forall (kind :: AddressKind). [AddressWithAlias kind] -> ShowS
forall (kind :: AddressKind). AddressWithAlias kind -> String
showList :: [AddressWithAlias kind] -> ShowS
$cshowList :: forall (kind :: AddressKind). [AddressWithAlias kind] -> ShowS
show :: AddressWithAlias kind -> String
$cshow :: forall (kind :: AddressKind). AddressWithAlias kind -> String
showsPrec :: Int -> AddressWithAlias kind -> ShowS
$cshowsPrec :: forall (kind :: AddressKind). Int -> AddressWithAlias kind -> ShowS
Show, AddressWithAlias kind -> AddressWithAlias kind -> Bool
(AddressWithAlias kind -> AddressWithAlias kind -> Bool)
-> (AddressWithAlias kind -> AddressWithAlias kind -> Bool)
-> Eq (AddressWithAlias kind)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kind :: AddressKind).
AddressWithAlias kind -> AddressWithAlias kind -> Bool
/= :: AddressWithAlias kind -> AddressWithAlias kind -> Bool
$c/= :: forall (kind :: AddressKind).
AddressWithAlias kind -> AddressWithAlias kind -> Bool
== :: AddressWithAlias kind -> AddressWithAlias kind -> Bool
$c== :: forall (kind :: AddressKind).
AddressWithAlias kind -> AddressWithAlias kind -> Bool
Eq)

instance ToAddress (AddressWithAlias kind) where
  toAddress :: AddressWithAlias kind -> Address
toAddress = KindedAddress kind -> Address
forall a. ToAddress a => a -> Address
toAddress (KindedAddress kind -> Address)
-> (AddressWithAlias kind -> KindedAddress kind)
-> AddressWithAlias kind
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressWithAlias kind -> KindedAddress kind
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress

instance ToTAddress cp vd (KindedAddress kind) => ToTAddress cp vd (AddressWithAlias kind) where
  toTAddress :: AddressWithAlias kind -> TAddress cp vd
toTAddress = KindedAddress kind -> TAddress cp vd
forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
toTAddress (KindedAddress kind -> TAddress cp vd)
-> (AddressWithAlias kind -> KindedAddress kind)
-> AddressWithAlias kind
-> TAddress cp vd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressWithAlias kind -> KindedAddress kind
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress

instance Buildable (AddressWithAlias kind) where
  build :: AddressWithAlias kind -> Builder
build (AddressWithAlias KindedAddress kind
addr Alias kind
alias) = KindedAddress kind
addr KindedAddress kind -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias kind
alias Alias kind -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")"

type ImplicitAddressWithAlias = AddressWithAlias 'AddressKindImplicit
type ContractAddressWithAlias = AddressWithAlias 'AddressKindContract