{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Morley.Michelson.Typed.Contract
(
ContractInp1
, ContractInp
, ContractOut1
, ContractOut
, ContractCode' (..)
, mkContractCode
, Contract' (..)
, IsNotInView
, giveNotInView
, defaultContract
, mapContractCode
, mapContractCodeBlock
, mapContractViewBlocks
, mapEntriesOrdered
) where
import Data.Constraint (Dict(..))
import Data.Default (Default(..))
import GHC.TypeLits (TypeError, pattern Text)
import Unsafe.Coerce (unsafeCoerce)
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 ]
newtype ContractCode' instr cp st =
ContractCode { forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
ContractCode' instr cp st
-> instr (ContractInp cp st) (ContractOut st)
unContractCode :: instr (ContractInp cp st) (ContractOut st) }
deriving stock instance Show (instr (ContractInp cp st) (ContractOut st))
=> Show (ContractCode' instr cp st)
deriving stock instance Eq (instr (ContractInp cp st) (ContractOut st))
=> Eq (ContractCode' instr cp st)
deriving newtype instance NFData (instr (ContractInp cp st) (ContractOut st))
=> NFData (ContractCode' instr cp st)
mkContractCode
:: (IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> ContractCode' instr cp st
mkContractCode :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> ContractCode' instr cp st
mkContractCode IsNotInView => instr (ContractInp cp st) (ContractOut st)
x = instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
ContractCode (instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st)
-> instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
forall a b. (a -> b) -> a -> b
$ (IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> instr (ContractInp cp st) (ContractOut st)
forall r. (IsNotInView => r) -> r
giveNotInView IsNotInView => instr (ContractInp cp st) (ContractOut st)
x
class IsNotInView
instance TypeError ('Text "Not allowed on the top level of a view") => IsNotInView
class FakeClass
instance FakeClass
FakeClass
giveNotInView :: (IsNotInView => r) -> r
giveNotInView :: forall r. (IsNotInView => r) -> r
giveNotInView = Dict IsNotInView -> (IsNotInView => r) -> r
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Dict FakeClass -> Dict IsNotInView
forall a b. a -> b
unsafeCoerce (Dict FakeClass
forall (a :: Constraint). a => Dict a
Dict :: Dict FakeClass) :: Dict IsNotInView)
data Contract' instr cp st = (ParameterScope cp, StorageScope st) => Contract
{ forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cCode :: ContractCode' instr cp st
, forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
cParamNotes :: ParamNotes cp
, forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
cStoreNotes :: Notes st
, forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cViews :: ViewsSet' instr st
, forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
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)
=> (IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st
defaultContract :: forall (cp :: T) (st :: T) (instr :: [T] -> [T] -> *).
(ParameterScope cp, StorageScope st) =>
(IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st
defaultContract IsNotInView => instr (ContractInp cp st) (ContractOut 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 = (IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> ContractCode' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> ContractCode' instr cp st
mkContractCode IsNotInView => instr (ContractInp cp st) (ContractOut 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
:: (instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st
-> Contract' instr cp st
mapContractCodeBlock :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st -> Contract' instr cp st
mapContractCodeBlock instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut st)
f Contract' instr cp st
contract = Contract' instr cp st
contract { cCode :: ContractCode' instr cp st
cCode =
case 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 of
ContractCode instr (ContractInp cp st) (ContractOut st)
c -> instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
ContractCode (instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st)
-> instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
forall a b. (a -> b) -> a -> b
$ instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut st)
f instr (ContractInp cp st) (ContractOut st)
c }
mapContractViewBlocks
:: (forall arg ret. ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
-> Contract' instr cp st
-> Contract' instr cp st
mapContractViewBlocks :: 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 (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 (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(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 =
(instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st -> Contract' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st -> Contract' instr cp st
mapContractCodeBlock instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut 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 :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T) a.
Contract' instr cp st
-> (ParamNotes cp -> a)
-> (Notes st -> a)
-> (ContractCode' instr cp st -> a)
-> [a]
mapEntriesOrdered Contract{EntriesOrder
Notes st
ViewsSet' instr st
ParamNotes cp
ContractCode' instr cp st
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