{-# LANGUAGE DeriveAnyClass, DerivingStrategies #-}

-- | Re-exports typed Value, CValue, some core types, some helpers and
-- defines aliases for constructors of typed values.

module Lorentz.Value
  ( Value
  , IsoValue (..)
  , IsoCValue (..)
  , CValue (..)

    -- * Primitive types
  , Integer
  , Natural
  , MText
  , Bool (..)
  , ByteString
  , Address
  , EpAddress (..)
  , Mutez
  , Timestamp
  , ChainId
  , KeyHash
  , PublicKey
  , Signature
  , Set
  , Map
  , M.BigMap (..)
  , M.Operation
  , Maybe (..)
  , List
  , ContractRef (..)
  , FutureContract (..)

  , EntryPointCall
  , SomeEntryPointCall

    -- * Constructors
  , toMutez
  , mt
  , timestampFromSeconds
  , timestampFromUTCTime
  , timestampQuote

    -- * Conversions
  , M.coerceContractRef
  , embodyFutureContract
  , ToAddress (..)
  , ToContractRef (..)
  , FromContractRef (..)
  , convertContractRef

    -- * Misc
  , Default (..)
  ) where

import Data.Default (Default(..))
import Data.Kind as Kind

import Lorentz.Constraints
import Michelson.Text
import Michelson.Typed
  (ContractRef(..), EntryPointCall, IsoCValue(..), IsoValue(..), SomeEntryPointCall, Value)
import qualified Michelson.Typed as M
import Michelson.Typed.CValue (CValue(..))
import Michelson.Typed.EntryPoints (EpAddress(..))
import Tezos.Address (Address)
import Tezos.Core
  (ChainId, Mutez, Timestamp, timestampFromSeconds, timestampFromUTCTime, timestampQuote, toMutez)
import Tezos.Crypto (KeyHash, PublicKey, Signature)

type List = []

-- | Address associated with the contract of given type.
--
-- Places where 'ContractAddr' can appear are now severely limited,
-- this type gives you type-safety of 'ContractAddr' but still can be used everywhere.
--
-- This may be refer to specific entrypoint of the contract, in such case
-- type parameter @p@ stands for argument of that entrypoint like in
-- 'ContractAddr'.
--
-- You still cannot be sure that the referred contract exists though.
newtype FutureContract p = FutureContract { futureContractAddress :: EpAddress }
  deriving stock Generic
  deriving anyclass IsoValue

-- | Turn future contract into actual @contract@.
embodyFutureContract
  :: forall arg.
     (NiceParameter arg, HasCallStack)
  => FutureContract arg -> ContractRef arg
embodyFutureContract (FutureContract (EpAddress addr M.NoEpName)) =
  withDict (niceParameterEvi @arg) $ ContractRef addr def
embodyFutureContract _ =
  -- TODO [TM-280]: implement
  error "not implemented for specific entrypoints"

-- | Convert something to 'Address' in /Haskell/ world.
--
-- Use this when you want to access state of the contract and are not interested
-- in calling it.
class ToAddress a where
  toAddress :: a -> Address

instance ToAddress Address where
  toAddress = id

instance ToAddress EpAddress where
  toAddress = eaAddress

instance ToAddress (FutureContract cp) where
  toAddress = toAddress . futureContractAddress

instance ToAddress (ContractRef cp) where
  toAddress = crAddress

-- | Convert something to 'ContractRef' in /Haskell/ world.
class ToContractRef (cp :: Kind.Type) (contract :: Kind.Type) where
  toContractRef :: HasCallStack => contract -> ContractRef cp

instance (cp ~ cp') => ToContractRef cp (ContractRef cp') where
  toContractRef = id

instance (NiceParameter cp, cp ~ cp') => ToContractRef cp (FutureContract cp') where
  toContractRef = embodyFutureContract

instance (NiceParameter cp) => ToContractRef cp EpAddress where
  toContractRef = embodyFutureContract . FutureContract

-- | Make contract ref calling the default entrypoint.
instance (NiceParameter cp) => ToContractRef cp Address where
  toContractRef addr = toContractRef $ EpAddress addr def

-- | Convert something from 'ContractAddr' in /Haskell/ world.
class FromContractRef (cp :: Kind.Type) (contract :: Kind.Type) where
  fromContractAddr :: ContractRef cp -> contract

instance (cp ~ cp') => FromContractRef cp (ContractRef cp') where
  fromContractAddr = id

instance (cp ~ cp') => FromContractRef cp (FutureContract cp') where
  fromContractAddr = FutureContract . fromContractAddr

instance FromContractRef cp EpAddress where
  fromContractAddr (ContractRef addr sepc) = EpAddress addr (M.sepcName sepc)

instance FromContractRef cp Address where
  fromContractAddr = eaAddress . fromContractAddr

convertContractRef
  :: forall cp contract2 contract1.
     (ToContractRef cp contract1, FromContractRef cp contract2)
  => contract1 -> contract2
convertContractRef = fromContractAddr @cp . toContractRef