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

{-# LANGUAGE QuantifiedConstraints #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Morley.Michelson.Typed.Existential
  ( -- * SomeConstrainedValue and derivatives
    Constrained (SomeConstrainedValue, SomeValue, SomeConstant, SomeStorage, SomePackedVal)
  , SomeConstrainedValue
  , SomeConstant
  , SomeValue
  , SomeStorage
  , SomePackedVal
    -- * Other existentials
  , SomeContract (..)
  , SomeContractAndStorage (..)
  , SomeIsoValue (..)
  , SomeVBigMap(..)
  ) where

import Morley.Michelson.Printer.Util (RenderDoc(..))
import Morley.Michelson.Typed.Aliases
import Morley.Michelson.Typed.Convert ()
import Morley.Michelson.Typed.Haskell.Value (KnownIsoT)
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Typed.T (T(..))
import Morley.Util.Constrained

----------------------------------------------------------------------------
-- SomeConstrainedValue
----------------------------------------------------------------------------

type SomeConstrainedValue c = Constrained c Value

pattern SomeConstrainedValue :: forall c. () => forall a. c a => Value a -> SomeConstrainedValue c
pattern $bSomeConstrainedValue :: forall (c :: T -> Constraint) (a :: T).
c a =>
Value a -> SomeConstrainedValue c
$mSomeConstrainedValue :: forall {r} {c :: T -> Constraint}.
SomeConstrainedValue c
-> (forall {a :: T}. c a => Value a -> r) -> (Void# -> r) -> r
SomeConstrainedValue v = Constrained v
{-# COMPLETE SomeConstrainedValue #-}

instance (forall t. cs t => HasNoOp t) => RenderDoc (SomeConstrainedValue cs) where
  renderDoc :: RenderContext -> SomeConstrainedValue cs -> Doc
renderDoc RenderContext
pn (Constrained Value a
v) = RenderContext -> Value a -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn Value a
v

----------------------------------------------------------------------------
-- SomeConstrainedValue synonyms
----------------------------------------------------------------------------

type SomeValue = SomeConstrainedValue SingI
pattern SomeValue :: () => SingI t => Value t -> SomeValue
pattern $bSomeValue :: forall (t :: T). SingI t => Value t -> SomeValue
$mSomeValue :: forall {r}.
SomeValue
-> (forall {t :: T}. SingI t => Value t -> r) -> (Void# -> r) -> r
SomeValue x = Constrained x
{-# COMPLETE SomeValue #-}

type SomeConstant = SomeConstrainedValue ConstantScope
pattern SomeConstant :: () => ConstantScope t => Value t -> SomeConstant
pattern $bSomeConstant :: forall (t :: T). ConstantScope t => Value t -> SomeConstant
$mSomeConstant :: forall {r}.
SomeConstant
-> (forall {t :: T}. ConstantScope t => Value t -> r)
-> (Void# -> r)
-> r
SomeConstant x = Constrained x
{-# COMPLETE SomeConstant #-}

type SomeStorage = SomeConstrainedValue StorageScope
pattern SomeStorage :: () => StorageScope t => Value t -> SomeStorage
pattern $bSomeStorage :: forall (t :: T). StorageScope t => Value t -> SomeStorage
$mSomeStorage :: forall {r}.
SomeStorage
-> (forall {t :: T}. StorageScope t => Value t -> r)
-> (Void# -> r)
-> r
SomeStorage x = Constrained x
{-# COMPLETE SomeStorage #-}

type SomePackedVal = SomeConstrainedValue PackedValScope
pattern SomePackedVal :: () => PackedValScope t => Value t -> SomePackedVal
pattern $bSomePackedVal :: forall (t :: T). PackedValScope t => Value t -> SomePackedVal
$mSomePackedVal :: forall {r}.
SomePackedVal
-> (forall {t :: T}. PackedValScope t => Value t -> r)
-> (Void# -> r)
-> r
SomePackedVal x = Constrained x
{-# COMPLETE SomePackedVal #-}

-- other synonyms should be easy to add by analogy, if needed.

----------------------------------------------------------------------------
-- Other existentials
----------------------------------------------------------------------------

-- | Hides some Haskell value put in line with Michelson 'Value'.
data SomeIsoValue where
  SomeIsoValue :: KnownIsoT a => a -> SomeIsoValue

data SomeContract where
  SomeContract :: Contract cp st -> SomeContract

instance NFData SomeContract where
  rnf :: SomeContract -> ()
rnf (SomeContract Contract cp st
c) = Contract cp st -> ()
forall a. NFData a => a -> ()
rnf Contract cp st
c

deriving stock instance Show SomeContract

-- | Represents a typed contract & a storage value of the type expected by the contract.
data SomeContractAndStorage where
  SomeContractAndStorage
    :: forall cp st.
       (StorageScope st, ParameterScope cp)
       => Contract cp st
       -> Value st
       -> SomeContractAndStorage

deriving stock instance Show SomeContractAndStorage

data SomeVBigMap where
  SomeVBigMap :: forall k v. Value ('TBigMap k v) -> SomeVBigMap