{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Morley.Michelson.Typed.Contract
(
ContractInp1
, ContractInp
, ContractOut1
, ContractOut
, ContractCode'
, Contract' (..)
, defaultContract
, mapContractCode
, mapContractCodeBlock
, mapContractViewBlocks
, mapEntriesOrdered
) where
import Data.Default (Default(..))
import Morley.Michelson.Typed.Annotation
import Morley.Michelson.Typed.Entrypoints
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Typed.T (T(..))
import Morley.Michelson.Typed.View
import Morley.Michelson.Untyped.Contract (EntriesOrder, entriesOrderToInt)
type ContractInp1 param st = 'TPair param st
type ContractInp param st = '[ ContractInp1 param st ]
type ContractOut1 st = 'TPair ('TList 'TOperation) st
type ContractOut st = '[ ContractOut1 st ]
type ContractCode' instr cp st = instr (ContractInp cp st) (ContractOut st)
data Contract' instr cp st = (ParameterScope cp, StorageScope st) => Contract
{ Contract' instr cp st -> ContractCode' instr cp st
cCode :: ContractCode' instr cp st
, Contract' instr cp st -> ParamNotes cp
cParamNotes :: ParamNotes cp
, Contract' instr cp st -> Notes st
cStoreNotes :: Notes st
, Contract' instr cp st -> ViewsSet' instr st
cViews :: ViewsSet' instr st
, Contract' instr cp st -> EntriesOrder
cEntriesOrder :: EntriesOrder
}
deriving stock instance
(forall i o. Show (instr i o)) =>
Show (Contract' instr cp st)
deriving stock instance
(forall i o. Eq (instr i o)) =>
Eq (Contract' instr cp st)
instance
(forall i o. NFData (instr i o)) =>
NFData (Contract' instr cp st) where
rnf :: Contract' instr cp st -> ()
rnf (Contract ContractCode' instr cp st
a ParamNotes cp
b Notes st
c ViewsSet' instr st
d EntriesOrder
e) = (ContractCode' instr cp st, ParamNotes cp, Notes st,
ViewsSet' instr st, EntriesOrder)
-> ()
forall a. NFData a => a -> ()
rnf (ContractCode' instr cp st
a, ParamNotes cp
b, Notes st
c, ViewsSet' instr st
d, EntriesOrder
e)
defaultContract :: (ParameterScope cp, StorageScope st) => ContractCode' instr cp st -> Contract' instr cp st
defaultContract :: ContractCode' instr cp st -> Contract' instr cp st
defaultContract ContractCode' instr cp st
code = Contract :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
ContractCode' instr cp st
-> ParamNotes cp
-> Notes st
-> ViewsSet' instr st
-> EntriesOrder
-> Contract' instr cp st
Contract
{ cCode :: ContractCode' instr cp st
cCode = ContractCode' instr cp st
code
, cParamNotes :: ParamNotes cp
cParamNotes = ParamNotes cp
forall (t :: T). SingI t => ParamNotes t
starParamNotes
, cStoreNotes :: Notes st
cStoreNotes = Notes st
forall (t :: T). SingI t => Notes t
starNotes
, cEntriesOrder :: EntriesOrder
cEntriesOrder = EntriesOrder
forall a. Default a => a
def
, cViews :: ViewsSet' instr st
cViews = ViewsSet' instr st
forall a. Default a => a
def
}
mapContractCodeBlock
:: (ContractCode' instr cp st -> ContractCode' instr cp st)
-> Contract' instr cp st
-> Contract' instr cp st
mapContractCodeBlock :: (ContractCode' instr cp st -> ContractCode' instr cp st)
-> Contract' instr cp st -> Contract' instr cp st
mapContractCodeBlock ContractCode' instr cp st -> ContractCode' instr cp st
f Contract' instr cp st
contract = Contract' instr cp st
contract { cCode :: ContractCode' instr cp st
cCode = ContractCode' instr cp st -> ContractCode' instr cp st
f (ContractCode' instr cp st -> ContractCode' instr cp st)
-> ContractCode' instr cp st -> ContractCode' instr cp st
forall a b. (a -> b) -> a -> b
$ Contract' instr cp st -> ContractCode' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cCode Contract' instr cp st
contract }
mapContractViewBlocks
:: (forall arg ret. ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
-> Contract' instr cp st
-> Contract' instr cp st
mapContractViewBlocks :: (forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
-> Contract' instr cp st -> Contract' instr cp st
mapContractViewBlocks forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> ViewCode' instr arg st ret
f Contract' instr cp st
contract = Contract' instr cp st
contract
{ cViews :: ViewsSet' instr st
cViews = (Seq $ SomeView' instr st) -> ViewsSet' instr st
forall (instr :: [T] -> [T] -> *) (st :: T).
(Seq $ SomeView' instr st) -> ViewsSet' instr st
UnsafeViewsSet ((Seq $ SomeView' instr st) -> ViewsSet' instr st)
-> (Seq $ SomeView' instr st) -> ViewsSet' instr st
forall a b. (a -> b) -> a -> b
$
ViewsSet' instr st -> Seq $ SomeView' instr st
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Seq $ SomeView' instr st
unViewsSet (Contract' instr cp st -> ViewsSet' instr st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cViews Contract' instr cp st
contract) (Seq $ SomeView' instr st)
-> (SomeView' instr st -> SomeView' instr st)
-> Seq $ SomeView' instr st
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SomeView View' instr arg st ret
v) -> View' instr arg st ret -> SomeView' instr st
forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> SomeView' instr st
SomeView View' instr arg st ret
v{ vCode :: ViewCode' instr arg st ret
vCode = ViewCode' instr arg st ret -> ViewCode' instr arg st ret
forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> ViewCode' instr arg st ret
f (ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
-> ViewCode' instr arg st ret -> ViewCode' instr arg st ret
forall a b. (a -> b) -> a -> b
$ View' instr arg st ret -> ViewCode' instr arg st ret
forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewCode' instr arg st ret
vCode View' instr arg st ret
v }
}
mapContractCode
:: (forall i o. instr i o -> instr i o)
-> Contract' instr cp st
-> Contract' instr cp st
mapContractCode :: (forall (i :: [T]) (o :: [T]). instr i o -> instr i o)
-> Contract' instr cp st -> Contract' instr cp st
mapContractCode forall (i :: [T]) (o :: [T]). instr i o -> instr i o
f =
(ContractCode' instr cp st -> ContractCode' instr cp st)
-> Contract' instr cp st -> Contract' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(ContractCode' instr cp st -> ContractCode' instr cp st)
-> Contract' instr cp st -> Contract' instr cp st
mapContractCodeBlock ContractCode' instr cp st -> ContractCode' instr cp st
forall (i :: [T]) (o :: [T]). instr i o -> instr i o
f (Contract' instr cp st -> Contract' instr cp st)
-> (Contract' instr cp st -> Contract' instr cp st)
-> Contract' instr cp st
-> Contract' instr cp st
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
-> Contract' instr cp st -> Contract' instr cp st
forall (instr :: [T] -> [T] -> *) (st :: T) (cp :: T).
(forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
-> Contract' instr cp st -> Contract' instr cp st
mapContractViewBlocks forall (i :: [T]) (o :: [T]). instr i o -> instr i o
forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> ViewCode' instr arg st ret
f
mapEntriesOrdered
:: Contract' instr cp st
-> (ParamNotes cp -> a)
-> (Notes st -> a)
-> (ContractCode' instr cp st -> a)
-> [a]
mapEntriesOrdered :: Contract' instr cp st
-> (ParamNotes cp -> a)
-> (Notes st -> a)
-> (ContractCode' instr cp st -> a)
-> [a]
mapEntriesOrdered Contract{ContractCode' instr cp st
EntriesOrder
Notes st
ViewsSet' instr st
ParamNotes cp
cEntriesOrder :: EntriesOrder
cViews :: ViewsSet' instr st
cStoreNotes :: Notes st
cParamNotes :: ParamNotes cp
cCode :: ContractCode' instr cp st
cEntriesOrder :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> EntriesOrder
cViews :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cStoreNotes :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
cParamNotes :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
cCode :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
..} ParamNotes cp -> a
fParam Notes st -> a
fStorage ContractCode' instr cp st -> a
fCode =
((Int, a) -> a) -> [(Int, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, a) -> a
forall a b. (a, b) -> b
snd
([(Int, a)] -> [a]) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> Int) -> [(Int, a)] -> [(Int, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Int, a) -> Int
forall a b. (a, b) -> a
fst
[ (Int
paramPos, ParamNotes cp -> a
fParam ParamNotes cp
cParamNotes)
, (Int
storagePos, Notes st -> a
fStorage Notes st
cStoreNotes)
, (Int
codePos, ContractCode' instr cp st -> a
fCode ContractCode' instr cp st
cCode)
]
where
(Int
paramPos, Int
storagePos, Int
codePos) = EntriesOrder -> (Int, Int, Int)
entriesOrderToInt EntriesOrder
cEntriesOrder