module Lorentz.Contracts.Upgradeable.EntrypointWise
( EntrypointImpl
, EpwFallback
, EpwContract (..)
, EpwCaseClause (..)
, mkEpwContract
, mkEpwContractT
, epwFallbackFail
, (/==>)
, removeEndpoint
, EpwDocumented (..)
, epwContractDoc
) where
import Lorentz
import Prelude (Typeable, fmap)
import Lorentz.Contracts.Upgradeable.Common
import Lorentz.UStore
import Michelson.Text
import Util.TypeLits
import Util.TypeTuple
data EpwContract ver = EpwContract
{ EpwContract ver -> UContractRouter ver
epwServe :: UContractRouter ver
, EpwContract ver
-> forall oldStore.
[MigrationScript oldStore (VerUStoreTemplate ver)]
epwCodeMigrations :: forall oldStore. [MigrationScript oldStore (VerUStoreTemplate ver)]
}
mkEpwContract
:: forall (ver :: VersionKind) (interface :: [EntrypointKind]) store.
( interface ~ VerInterface ver, store ~ VerUStoreTemplate ver
, CodeMigrations interface
, HasUStore "code" MText (EntrypointImpl store) store
, HasUField "fallback" (EpwFallback store) store
, Typeable store
)
=> Rec (EpwCaseClause store) interface
-> EpwFallback store
-> EpwContract ver
mkEpwContract :: Rec (EpwCaseClause store) interface
-> EpwFallback store -> EpwContract ver
mkEpwContract Rec (EpwCaseClause store) interface
entries EpwFallback store
fallback = EpwContract :: forall (ver :: VersionKind).
UContractRouter ver
-> (forall oldStore.
[MigrationScript oldStore (VerUStoreTemplate ver)])
-> EpwContract ver
EpwContract
{ epwServe :: UContractRouter ver
epwServe = ('[VerParam ver, VerUStore ver]
:-> '[([Operation], VerUStore ver)])
-> UContractRouter ver
forall (ver :: VersionKind).
('[VerParam ver, VerUStore ver]
:-> '[([Operation], VerUStore ver)])
-> UContractRouter ver
mkUContractRouter (('[VerParam ver, VerUStore ver]
:-> '[([Operation], VerUStore ver)])
-> UContractRouter ver)
-> ('[VerParam ver, VerUStore ver]
:-> '[([Operation], VerUStore ver)])
-> UContractRouter ver
forall a b. (a -> b) -> a -> b
$
(HasUStore "code" MText (EntrypointImpl store) store,
HasUField "fallback" (EpwFallback store) store) =>
'[UParam interface, UStore store]
:-> '[([Operation], UStore store)]
forall store (entries :: [EntrypointKind]).
(HasUStore "code" MText (EntrypointImpl store) store,
HasUField "fallback" (EpwFallback store) store) =>
'[UParam entries, UStore store] :-> '[([Operation], UStore store)]
caseUParamUnsafe' @store @interface
, epwCodeMigrations :: forall oldStore. [MigrationScript oldStore (VerUStoreTemplate ver)]
epwCodeMigrations =
(('[UStore store] :-> '[UStore store])
-> MigrationScript oldStore store)
-> ['[UStore store] :-> '[UStore store]]
-> [MigrationScript oldStore store]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lambda UStore_ UStore_ -> MigrationScript oldStore store
forall oldStore newStore.
Lambda UStore_ UStore_ -> MigrationScript oldStore newStore
MigrationScript (Lambda UStore_ UStore_ -> MigrationScript oldStore store)
-> (('[UStore store] :-> '[UStore store])
-> Lambda UStore_ UStore_)
-> ('[UStore store] :-> '[UStore store])
-> MigrationScript oldStore store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: [*]).
Coercible_ UStore_ (UStore store) =>
((UStore store : s) :-> (UStore store : s))
-> (UStore_ : s) :-> (UStore_ : s)
forall a b (s :: [*]).
Coercible_ a b =>
((b : s) :-> (b : s)) -> (a : s) :-> (a : s)
checkedCoercing_ @UStore_ @(UStore store)) (['[UStore store] :-> '[UStore store]]
-> [MigrationScript oldStore store])
-> ['[UStore store] :-> '[UStore store]]
-> [MigrationScript oldStore store]
forall a b. (a -> b) -> a -> b
$
(EpwFallback store
-> '[UStore store] :-> '[EpwFallback store, UStore store]
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push EpwFallback store
fallback ('[UStore store] :-> '[EpwFallback store, UStore store])
-> ('[EpwFallback store, UStore store] :-> '[UStore store])
-> '[UStore store] :-> '[UStore store]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label "fallback"
-> '[GetUStoreField store "fallback", UStore store]
:-> '[UStore store]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (GetUStoreField store name : UStore store : s)
:-> (UStore store : s)
ustoreSetField Label "fallback"
forall a. IsLabel "fallback" a => a
forall (x :: Symbol) a. IsLabel x a => a
#fallback) ('[UStore store] :-> '[UStore store])
-> ['[UStore store] :-> '[UStore store]]
-> ['[UStore store] :-> '[UStore store]]
forall a. a -> [a] -> [a]
: Rec (EpwCaseClause store) interface
-> ['[UStore store] :-> '[UStore store]]
forall (entries :: [EntrypointKind]) store.
(CodeMigrations entries, Typeable store,
GetUStoreKey store "code" ~ MText,
GetUStoreValue store "code" ~ EntrypointImpl store) =>
Rec (EpwCaseClause store) entries
-> ['[UStore store] :-> '[UStore store]]
mkMigrations Rec (EpwCaseClause store) interface
entries
}
mkEpwContractT
:: forall clauses ver (interface :: [EntrypointKind]) store.
( interface ~ VerInterface ver, store ~ VerUStoreTemplate ver
, clauses ~ Rec (EpwCaseClause store) interface
, RecFromTuple clauses
, CodeMigrations interface
, HasUStore "code" MText (EntrypointImpl store) store
, HasUField "fallback" (EpwFallback store) store
, Typeable store
)
=> IsoRecTuple clauses
-> EpwFallback store
-> EpwContract ver
mkEpwContractT :: IsoRecTuple clauses -> EpwFallback store -> EpwContract ver
mkEpwContractT IsoRecTuple clauses
clauses EpwFallback store
fallback = Rec (EpwCaseClause store) interface
-> EpwFallback store -> EpwContract ver
forall (ver :: VersionKind) (interface :: [EntrypointKind]) store.
(interface ~ VerInterface ver, store ~ VerUStoreTemplate ver,
CodeMigrations interface,
HasUStore "code" MText (EntrypointImpl store) store,
HasUField "fallback" (EpwFallback store) store, Typeable store) =>
Rec (EpwCaseClause store) interface
-> EpwFallback store -> EpwContract ver
mkEpwContract (IsoRecTuple (Rec (EpwCaseClause store) interface)
-> Rec (EpwCaseClause store) interface
forall r. RecFromTuple r => IsoRecTuple r -> r
recFromTuple IsoRecTuple clauses
IsoRecTuple (Rec (EpwCaseClause store) interface)
clauses) EpwFallback store
fallback
type TypedEntrypointImpl arg store =
Lambda (arg, UStore store) ([Operation], UStore store)
type EntrypointImpl store =
Lambda (ByteString, UStore store) ([Operation], UStore store)
type EpwFallback store =
Lambda ((MText, ByteString), UStore store) ([Operation], UStore store)
data EpwCaseClause store (entry :: EntrypointKind) where
EpwCaseClause
:: TypedEntrypointImpl arg store
-> EpwCaseClause store '(name, arg)
(/==>)
:: Label name
-> Lambda (arg, UStore store) ([Operation], UStore store)
-> EpwCaseClause store '(name, arg)
/==> :: Label name
-> Lambda (arg, UStore store) ([Operation], UStore store)
-> EpwCaseClause store '(name, arg)
(/==>) Label name
_ = Lambda (arg, UStore store) ([Operation], UStore store)
-> EpwCaseClause store '(name, arg)
forall arg store (name :: Symbol).
TypedEntrypointImpl arg store -> EpwCaseClause store '(name, arg)
EpwCaseClause
infixr 0 /==>
caseUParamUnsafe'
:: forall store (entries :: [EntrypointKind]).
( HasUStore "code" MText (EntrypointImpl store) store
, HasUField "fallback" (EpwFallback store) store
)
=> '[UParam entries, UStore store] :-> '[([Operation], UStore store)]
caseUParamUnsafe' :: '[UParam entries, UStore store] :-> '[([Operation], UStore store)]
caseUParamUnsafe' = do
'[UParam entries, UStore store]
:-> '[UParam entries, UParam entries, UStore store]
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup
'[UParam entries, UParam entries, UStore store]
:-> '[(MText, ByteString), UParam entries, UStore store]
forall (entries :: [EntrypointKind]) (s :: [*]).
(UParam entries : s) :-> ((MText, ByteString) : s)
unwrapUParam
'[(MText, ByteString), UParam entries, UStore store]
:-> '[MText, ByteString, UParam entries, UStore store]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair
('[ByteString, UParam entries, UStore store]
:-> '[UStore store, ByteString, UParam entries, UStore store])
-> '[MText, ByteString, UParam entries, UStore store]
:-> '[MText, UStore store, ByteString, UParam entries,
UStore store]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (forall (s :: [*]) (s' :: [*]) a.
ConstraintDUPNLorentz (ToPeano 3) s s' a =>
s :-> (a : s)
forall (n :: Nat) (s :: [*]) (s' :: [*]) a.
ConstraintDUPNLorentz (ToPeano n) s s' a =>
s :-> (a : s)
duupX @3)
Label "code"
-> '[GetUStoreKey store "code", UStore store, ByteString,
UParam entries, UStore store]
:-> '[Maybe (GetUStoreValue store "code"), ByteString,
UParam entries, UStore store]
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name : UStore store : s)
:-> (Maybe (GetUStoreValue store name) : s)
ustoreGet Label "code"
forall a. IsLabel "code" a => a
forall (x :: Symbol) a. IsLabel x a => a
#code
if Condition
'[Maybe (EntrypointImpl store), ByteString, UParam entries,
UStore store]
'[EntrypointImpl store, ByteString, UParam entries, UStore store]
'[ByteString, UParam entries, UStore store]
'[([Operation], UStore store)]
'[([Operation], UStore store)]
forall a (argr :: [*]) (outb :: [*]).
Condition (Maybe a : argr) (a : argr) argr outb outb
IsSome
then ('[ByteString, UParam entries, UStore store]
:-> '[(ByteString, UStore store)])
-> '[EntrypointImpl store, ByteString, UParam entries,
UStore store]
:-> '[EntrypointImpl store, (ByteString, UStore store)]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (('[UParam entries, UStore store] :-> '[UStore store])
-> '[ByteString, UParam entries, UStore store]
:-> '[ByteString, UStore store]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip ('[UParam entries, UStore store] :-> '[UStore store]
forall a (s :: [*]). (a : s) :-> s
drop) ('[ByteString, UParam entries, UStore store]
:-> '[ByteString, UStore store])
-> ('[ByteString, UStore store] :-> '[(ByteString, UStore store)])
-> '[ByteString, UParam entries, UStore store]
:-> '[(ByteString, UStore store)]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[ByteString, UStore store] :-> '[(ByteString, UStore store)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair) ('[EntrypointImpl store, ByteString, UParam entries, UStore store]
:-> '[EntrypointImpl store, (ByteString, UStore store)])
-> ('[EntrypointImpl store, (ByteString, UStore store)]
:-> '[(ByteString, UStore store), EntrypointImpl store])
-> '[EntrypointImpl store, ByteString, UParam entries,
UStore store]
:-> '[(ByteString, UStore store), EntrypointImpl store]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[EntrypointImpl store, (ByteString, UStore store)]
:-> '[(ByteString, UStore store), EntrypointImpl store]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap ('[EntrypointImpl store, ByteString, UParam entries, UStore store]
:-> '[(ByteString, UStore store), EntrypointImpl store])
-> ('[(ByteString, UStore store), EntrypointImpl store]
:-> '[([Operation], UStore store)])
-> '[EntrypointImpl store, ByteString, UParam entries,
UStore store]
:-> '[([Operation], UStore store)]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[(ByteString, UStore store), EntrypointImpl store]
:-> '[([Operation], UStore store)]
forall a b (s :: [*]). (a : Lambda a b : s) :-> (b : s)
exec
else do
'[ByteString, UParam entries, UStore store]
:-> '[UParam entries, UStore store]
forall a (s :: [*]). (a : s) :-> s
drop
('[UStore store]
:-> '[UStore store,
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)])
-> '[UParam entries, UStore store]
:-> '[UParam entries, UStore store,
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (Label "fallback"
-> '[UStore store]
:-> '[GetUStoreField store "fallback", UStore store]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (UStore store : s)
:-> (GetUStoreField store name : UStore store : s)
ustoreGetField Label "fallback"
forall a. IsLabel "fallback" a => a
forall (x :: Symbol) a. IsLabel x a => a
#fallback ('[UStore store]
:-> '[Lambda
((MText, ByteString), UStore store) ([Operation], UStore store),
UStore store])
-> ('[Lambda
((MText, ByteString), UStore store) ([Operation], UStore store),
UStore store]
:-> '[UStore store,
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)])
-> '[UStore store]
:-> '[UStore store,
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[Lambda
((MText, ByteString), UStore store) ([Operation], UStore store),
UStore store]
:-> '[UStore store,
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap)
'[UParam entries, UStore store,
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)]
:-> '[(MText, ByteString), UStore store,
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)]
forall (entries :: [EntrypointKind]) (s :: [*]).
(UParam entries : s) :-> ((MText, ByteString) : s)
unwrapUParam
'[(MText, ByteString), UStore store,
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)]
:-> '[((MText, ByteString), UStore store),
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair
'[((MText, ByteString), UStore store),
Lambda
((MText, ByteString), UStore store) ([Operation], UStore store)]
:-> '[([Operation], UStore store)]
forall a b (s :: [*]). (a : Lambda a b : s) :-> (b : s)
exec
epwFallbackFail :: EpwFallback store
epwFallbackFail :: EpwFallback store
epwFallbackFail =
'[((MText, ByteString), UStore store)] :-> '[(MText, ByteString)]
forall a b (s :: [*]). ((a, b) : s) :-> (a : s)
car ('[((MText, ByteString), UStore store)] :-> '[(MText, ByteString)])
-> ('[(MText, ByteString)] :-> '[MText])
-> '[((MText, ByteString), UStore store)] :-> '[MText]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[(MText, ByteString)] :-> '[MText]
forall a b (s :: [*]). ((a, b) : s) :-> (a : s)
car ('[((MText, ByteString), UStore store)] :-> '[MText])
-> ('[MText] :-> '[([Operation], UStore store)])
-> EpwFallback store
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label "uparamNoSuchEntrypoint"
-> '[MText] :-> '[([Operation], UStore store)]
forall (tag :: Symbol) err (s :: [*]) (any :: [*]).
(MustHaveErrorArg tag (MText, err), CustomErrorHasDoc tag,
KnownError err) =>
Label tag -> (err : s) :-> any
failCustom Label "uparamNoSuchEntrypoint"
forall a. IsLabel "uparamNoSuchEntrypoint" a => a
forall (x :: Symbol) a. IsLabel x a => a
#uparamNoSuchEntrypoint
class CodeMigrations (entries :: [EntrypointKind]) where
mkMigrations
:: forall store.
( Typeable store
, GetUStoreKey store "code" ~ MText
, GetUStoreValue store "code" ~ EntrypointImpl store
)
=> Rec (EpwCaseClause store) entries
-> ['[UStore store] :-> '[UStore store]]
instance
( CodeMigrations entries
, KnownSymbol name
, NiceUnpackedValue arg
)
=> CodeMigrations ((name ?: arg) ': entries) where
mkMigrations :: Rec (EpwCaseClause store) ((name ?: arg) : entries)
-> ['[UStore store] :-> '[UStore store]]
mkMigrations (EpwCaseClause TypedEntrypointImpl arg store
impl :& Rec (EpwCaseClause store) rs
clauses) =
(('[(ByteString, UStore store)] :-> '[([Operation], UStore store)])
-> '[UStore store]
:-> '['[(ByteString, UStore store)]
:-> '[([Operation], UStore store)],
UStore store]
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push '[(ByteString, UStore store)] :-> '[([Operation], UStore store)]
untypedLambda ('[UStore store]
:-> '['[(ByteString, UStore store)]
:-> '[([Operation], UStore store)],
UStore store])
-> ('['[(ByteString, UStore store)]
:-> '[([Operation], UStore store)],
UStore store]
:-> '[MText,
'[(ByteString, UStore store)] :-> '[([Operation], UStore store)],
UStore store])
-> '[UStore store]
:-> '[MText,
'[(ByteString, UStore store)] :-> '[([Operation], UStore store)],
UStore store]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# MText
-> '['[(ByteString, UStore store)]
:-> '[([Operation], UStore store)],
UStore store]
:-> '[MText,
'[(ByteString, UStore store)] :-> '[([Operation], UStore store)],
UStore store]
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push (KnownSymbol name => MText
forall (name :: Symbol). KnownSymbol name => MText
symbolToMText @name) ('[UStore store]
:-> '[MText,
'[(ByteString, UStore store)] :-> '[([Operation], UStore store)],
UStore store])
-> ('[MText,
'[(ByteString, UStore store)] :-> '[([Operation], UStore store)],
UStore store]
:-> '[UStore store])
-> '[UStore store] :-> '[UStore store]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label "code"
-> '[GetUStoreKey store "code", GetUStoreValue store "code",
UStore store]
:-> '[UStore store]
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name
: GetUStoreValue store name : UStore store : s)
:-> (UStore store : s)
ustoreInsert Label "code"
forall a. IsLabel "code" a => a
forall (x :: Symbol) a. IsLabel x a => a
#code)
('[UStore store] :-> '[UStore store])
-> ['[UStore store] :-> '[UStore store]]
-> ['[UStore store] :-> '[UStore store]]
forall a. a -> [a] -> [a]
: Rec (EpwCaseClause store) rs
-> ['[UStore store] :-> '[UStore store]]
forall (entries :: [EntrypointKind]) store.
(CodeMigrations entries, Typeable store,
GetUStoreKey store "code" ~ MText,
GetUStoreValue store "code" ~ EntrypointImpl store) =>
Rec (EpwCaseClause store) entries
-> ['[UStore store] :-> '[UStore store]]
mkMigrations Rec (EpwCaseClause store) rs
clauses
where
untypedLambda :: '[(ByteString, UStore store)] :-> '[([Operation], UStore store)]
untypedLambda = do
'[(ByteString, UStore store)] :-> '[ByteString, UStore store]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair
forall (s :: [*]).
NiceUnpackedValue arg =>
(ByteString : s) :-> (Maybe arg : s)
forall a (s :: [*]).
NiceUnpackedValue a =>
(ByteString : s) :-> (Maybe a : s)
unpackRaw @arg
('[arg, UStore store] :-> '[arg, UStore store])
-> ('[UStore store] :-> '[arg, UStore store])
-> '[Maybe arg, UStore store] :-> '[arg, UStore store]
forall a (s :: [*]) (s' :: [*]).
((a : s) :-> s') -> (s :-> s') -> (Maybe a : s) :-> s'
ifSome '[arg, UStore store] :-> '[arg, UStore store]
forall (s :: [*]). s :-> s
nop (('[UStore store] :-> '[arg, UStore store])
-> '[Maybe arg, UStore store] :-> '[arg, UStore store])
-> ('[UStore store] :-> '[arg, UStore store])
-> '[Maybe arg, UStore store] :-> '[arg, UStore store]
forall a b. (a -> b) -> a -> b
$ Label "uparamArgumentUnpackFailed"
-> '[UStore store] :-> '[arg, UStore store]
forall (tag :: Symbol) (s :: [*]) (any :: [*]).
(MustHaveErrorArg tag (MText, ()), CustomErrorHasDoc tag) =>
Label tag -> s :-> any
failCustom_ Label "uparamArgumentUnpackFailed"
forall a. IsLabel "uparamArgumentUnpackFailed" a => a
forall (x :: Symbol) a. IsLabel x a => a
#uparamArgumentUnpackFailed
'[arg, UStore store] :-> '[(arg, UStore store)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair
'[(arg, UStore store)] :-> '[([Operation], UStore store)]
TypedEntrypointImpl arg store
impl
instance CodeMigrations '[] where
mkMigrations :: Rec (EpwCaseClause store) '[]
-> ['[UStore store] :-> '[UStore store]]
mkMigrations Rec (EpwCaseClause store) '[]
_ = []
removeEndpoint
:: forall store name s.
GetUStoreKey store "code" ~ MText
=> Label name
-> UStore store ': s :-> UStore store ': s
removeEndpoint :: Label name -> (UStore store : s) :-> (UStore store : s)
removeEndpoint Label name
Label = do
MText -> (UStore store : s) :-> (MText : UStore store : s)
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push (MText -> (UStore store : s) :-> (MText : UStore store : s))
-> MText -> (UStore store : s) :-> (MText : UStore store : s)
forall a b. (a -> b) -> a -> b
$ KnownSymbol name => MText
forall (name :: Symbol). KnownSymbol name => MText
symbolToMText @name
Label "code"
-> (GetUStoreKey store "code" : UStore store : s)
:-> (UStore store : s)
forall store (name :: Symbol) (s :: [*]).
KeyAccessC store name =>
Label name
-> (GetUStoreKey store name : UStore store : s)
:-> (UStore store : s)
ustoreDelete Label "code"
forall a. IsLabel "code" a => a
forall (x :: Symbol) a. IsLabel x a => a
#code
class EpwDocumented (entries :: [EntrypointKind]) where
epwDocument
:: Rec (EpwCaseClause store) entries
-> Lambda () ()
instance EpwDocumented '[] where
epwDocument :: Rec (EpwCaseClause store) '[] -> Lambda () ()
epwDocument Rec (EpwCaseClause store) '[]
RNil = Lambda () ()
forall (s :: [*]). s :-> s
nop
instance (KnownSymbol name, EpwDocumented es) =>
EpwDocumented ('(name, a) ': es) where
epwDocument :: Rec (EpwCaseClause store) ('(name, a) : es) -> Lambda () ()
epwDocument (EpwCaseClause TypedEntrypointImpl arg store
code :& Rec (EpwCaseClause store) rs
es) =
let documentedCode :: TypedEntrypointImpl arg store
documentedCode = ParamBuildingStep
-> TypedEntrypointImpl arg store -> TypedEntrypointImpl arg store
forall (inp :: [*]) (out :: [*]).
ParamBuildingStep -> (inp :-> out) -> inp :-> out
clarifyParamBuildingSteps (KnownSymbol name => ParamBuildingStep
forall (ctorName :: Symbol).
KnownSymbol ctorName =>
ParamBuildingStep
pbsUParam @name) TypedEntrypointImpl arg store
code
in TypedEntrypointImpl arg store -> Lambda () ()
forall (inp :: [*]) (out :: [*]) (s :: [*]).
(inp :-> out) -> s :-> s
cutLorentzNonDoc TypedEntrypointImpl arg store
documentedCode Lambda () () -> Lambda () () -> Lambda () ()
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Rec (EpwCaseClause store) rs -> Lambda () ()
forall (entries :: [EntrypointKind]) store.
EpwDocumented entries =>
Rec (EpwCaseClause store) entries -> Lambda () ()
epwDocument Rec (EpwCaseClause store) rs
es
epwContractDoc
:: forall ver.
( NiceVersion ver
, KnownContractVersion ver
, EpwDocumented (VerInterface ver)
, PermConstraint ver
)
=> Rec (EpwCaseClause (VerUStoreTemplate ver)) (VerInterface ver)
-> PermanentImpl ver
-> Lambda () ()
epwContractDoc :: Rec (EpwCaseClause (VerUStoreTemplate ver)) (VerInterface ver)
-> PermanentImpl ver -> Lambda () ()
epwContractDoc Rec (EpwCaseClause (VerUStoreTemplate ver)) (VerInterface ver)
upgImpl PermanentImpl ver
permImpl =
((Parameter ver : Any) :-> Any) -> Lambda () ()
forall (s1 :: [*]) (s2 :: [*]) (s1' :: [*]) (s2' :: [*]).
(s1 :-> s2) -> s1' :-> s2'
fakeCoercing (((Parameter ver : Any) :-> Any) -> Lambda () ())
-> (((Parameter ver : Any) :-> Any)
-> (Parameter ver : Any) :-> Any)
-> ((Parameter ver : Any) :-> Any)
-> Lambda () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (inp :: [*]) (out :: [*]).
(NiceParameterFull (Parameter ver), RequireSumType (Parameter ver),
HasCallStack) =>
((Parameter ver : inp) :-> out) -> (Parameter ver : inp) :-> out
forall cp (inp :: [*]) (out :: [*]).
(NiceParameterFull cp, RequireSumType cp, HasCallStack) =>
((cp : inp) :-> out) -> (cp : inp) :-> out
finalizeParamCallingDoc @(Parameter ver) (((Parameter ver : Any) :-> Any) -> Lambda () ())
-> ((Parameter ver : Any) :-> Any) -> Lambda () ()
forall a b. (a -> b) -> a -> b
$ do
DVersion -> (Parameter ver : Any) :-> (Parameter ver : Any)
forall di (s :: [*]). DocItem di => di -> s :-> s
doc (DVersion -> (Parameter ver : Any) :-> (Parameter ver : Any))
-> DVersion -> (Parameter ver : Any) :-> (Parameter ver : Any)
forall a b. (a -> b) -> a -> b
$ Version -> DVersion
DVersion (Proxy ver -> Version
forall (v :: VersionKind).
KnownContractVersion v =>
Proxy v -> Version
contractVersion (Proxy ver
forall k (t :: k). Proxy t
Proxy @ver))
('[(Parameter ver, Storage ver)] :-> ContractOut (Storage ver))
-> (Parameter ver : Any) :-> Any
forall (s1 :: [*]) (s2 :: [*]) (s1' :: [*]) (s2' :: [*]).
(s1 :-> s2) -> s1' :-> s2'
fakeCoercing (('[(Parameter ver, Storage ver)] :-> ContractOut (Storage ver))
-> (Parameter ver : Any) :-> Any)
-> ('[(Parameter ver, Storage ver)] :-> ContractOut (Storage ver))
-> (Parameter ver : Any) :-> Any
forall a b. (a -> b) -> a -> b
$
Contract (Parameter ver) (Storage ver)
-> '[(Parameter ver, Storage ver)] :-> ContractOut (Storage ver)
forall cp st. Contract cp st -> ContractCode cp st
cCode (Contract (Parameter ver) (Storage ver)
-> '[(Parameter ver, Storage ver)] :-> ContractOut (Storage ver))
-> Contract (Parameter ver) (Storage ver)
-> '[(Parameter ver, Storage ver)] :-> ContractOut (Storage ver)
forall a b. (a -> b) -> a -> b
$ (NiceVersion ver, NiceParameterFull (Parameter ver)) =>
Contract (Parameter ver) (Storage ver)
forall (ver :: VersionKind).
(NiceVersion ver, NiceParameterFull (Parameter ver)) =>
UpgradeableContract ver
upgradeableContract @ver
Lambda () () -> Any :-> Any
forall (s1 :: [*]) (s2 :: [*]) (s1' :: [*]) (s2' :: [*]).
(s1 :-> s2) -> s1' :-> s2'
fakeCoercing (Lambda () () -> Any :-> Any) -> Lambda () () -> Any :-> Any
forall a b. (a -> b) -> a -> b
$
ParamBuildingStep -> Lambda () () -> Lambda () ()
forall (inp :: [*]) (out :: [*]).
ParamBuildingStep -> (inp :-> out) -> inp :-> out
clarifyParamBuildingSteps ParamBuildingStep
pbsContainedInRun (Lambda () () -> Lambda () ()) -> Lambda () () -> Lambda () ()
forall a b. (a -> b) -> a -> b
$
Rec (EpwCaseClause (VerUStoreTemplate ver)) (VerInterface ver)
-> Lambda () ()
forall (entries :: [EntrypointKind]) store.
EpwDocumented entries =>
Rec (EpwCaseClause store) entries -> Lambda () ()
epwDocument Rec (EpwCaseClause (VerUStoreTemplate ver)) (VerInterface ver)
upgImpl
('[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver)))
-> Any :-> Any
forall (s1 :: [*]) (s2 :: [*]) (s1' :: [*]) (s2' :: [*]).
(s1 :-> s2) -> s1' :-> s2'
fakeCoercing (('[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver)))
-> Any :-> Any)
-> ('[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver)))
-> Any :-> Any
forall a b. (a -> b) -> a -> b
$
ParamBuildingStep
-> ('[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver)))
-> '[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver))
forall (inp :: [*]) (out :: [*]).
ParamBuildingStep -> (inp :-> out) -> inp :-> out
clarifyParamBuildingSteps ParamBuildingStep
pbsContainedInRunPerm (('[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver)))
-> '[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver)))
-> ('[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver)))
-> '[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver))
forall a b. (a -> b) -> a -> b
$
PermanentImpl ver
-> '[VerPermanent ver, UStore (VerUStoreTemplate ver)]
:-> ContractOut (UStore (VerUStoreTemplate ver))
forall (ver :: VersionKind).
PermanentImpl ver -> Entrypoint (VerPermanent ver) (VerUStore ver)
unPermanentImpl PermanentImpl ver
permImpl