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

-- | Basic types for the test framework.
module Test.Cleveland.Lorentz.Types
  ( ContractHandle (..)
  , chNiceParameterEvi
  , chNiceStorageEvi

  , ToStorageType (..)

  , NiceParameter
  , NiceParameterFull
  , NiceStorage
  , NicePackedValue
  , NiceUnpackedValue

  , ToAddress
  , toAddress

  -- * Notes
  -- $noteTAddress
  ) where

import Data.Constraint (Dict(..), mapDict)
import Fmt (Buildable(..), (+|), (|+))

import Lorentz.Address
import Lorentz.Constraints
import Morley.Michelson.Typed qualified as T

-- | Handle to a contract.
--
-- This is what you get when originating a contract and that allows further
-- operations with the contract within the test framework.
--
-- Note that this is part of the testing framework and exists solely in Haskell
-- world, so it has no 'T.IsoValue' and related instances and cannot be used in
-- Lorentz code.
data ContractHandle (cp :: Type) (st :: Type) (vd :: Type) =
  (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd) =>
  ContractHandle
  { chContractName :: Text
  , chAddress :: Address
  }

deriving stock instance Show (ContractHandle cp st vd)

instance Buildable (ContractHandle cp st vd) where
  build (ContractHandle name addr) =
    "<handler to '" +| name |+ "' / " +| addr |+ ">"

instance ToAddress (ContractHandle cp st vd) where
  toAddress = chAddress

-- TODO [#577]: simplify this instance once fundep in ToTAddress is added
instance (cp' ~ cp, vd ~ vd') => ToTAddress cp' vd' (ContractHandle cp st vd) where
  toTAddress = toTAddress . toAddress

instance ToContractRef arg (TAddress cp vd) => ToContractRef arg (ContractHandle cp st vd) where
  toContractRef = toContractRef . toTAddress @cp

-- | Extract the evidence in typed Michelson that the parameter type is valid
-- for such scope.
chNiceParameterEvi :: forall param st vd. ContractHandle param st vd -> Dict (T.ParameterScope $ T.ToT st)
chNiceParameterEvi ContractHandle{} = mapDict (niceParameterEvi @st) Dict

-- | Extract the evidence in typed Michelson that the storage type is valid
-- for such scope.
chNiceStorageEvi :: forall param st vd. ContractHandle param st vd -> Dict (T.StorageScope $ T.ToT st)
chNiceStorageEvi ContractHandle{} = mapDict (niceStorageEvi @st) Dict

-- | Declares that @addr@ points to an entity with a storage.
--
-- @addr@ may fix storage type or may not - in the latter case the caller
-- has to specify the storage type explicitly via type annotation.
class ToAddress addr => ToStorageType st addr where
  -- | Pick proof of that storage type is valid.
  pickNiceStorage :: addr -> Dict (NiceStorage st)

instance NiceStorage st => ToStorageType st Address where
  pickNiceStorage _ = Dict

instance (st ~ st') => ToStorageType st' (ContractHandle cp st vd) where
  pickNiceStorage ContractHandle{} = Dict

{- $noteTAddress

  == A note on 'TAddress' instance for 'ToStorageType'

  'TAddress' isn't intended to be a part of the Cleveland API.
  In the absolute majority of cases, if one is interested in both parameter
  and storage, then they should use 'ContractHandle', as the storage type
  needs to be known either way. If one isn't interested in storage, they
  presumably wouldn't call functions to get storage. Hence, this instance
  wouldn't be particularly useful. Legacy code using 'TAddress' instead of
  'ContractHandle' should be preferably updated, if possible. If nothing
  else, 'toAddress' can be used as a stopgap measure.
-}