{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Lorentz.UStore.Migration.Blocks
(
mustoreToOld
, MigrationFinishCheckPosition (..)
, migrateCoerceUnsafe
, migrateGetField
, migrateAddField
, migrateRemoveField
, migrateExtractField
, migrateOverwriteField
, migrateModifyField
, muBlock
, muBlockNamed
, (<-->)
, ($:)
) where
import Prelude
import Lorentz.Base
import Lorentz.Coercions
import Lorentz.Instr (dip)
import Lorentz.UStore.Instr
import Lorentz.UStore.Migration.Base
import Lorentz.UStore.Migration.Diff
import Lorentz.UStore.Types
import Util.Label (Label)
import Util.Type
import Util.TypeLits
type family RequireBeInitial (touched :: [Symbol]) :: Constraint where
RequireBeInitial '[] = ()
RequireBeInitial _ =
TypeError ('Text "Migration has already been started over this store")
type family RequireUntouched (field :: Symbol) (wasTouched :: Bool)
:: Constraint where
RequireUntouched _ 'False = ()
RequireUntouched field 'True = TypeError
('Text ("Field `" `AppendSymbol` field `AppendSymbol` "` has already been \
\migrated and cannot be read")
)
migrateCoerceUnsafe
:: forall field oldTempl newTempl diff touched newDiff newDiff0 _1 _2 s.
( '(_1, newDiff0) ~ CoverDiff 'DcRemove field diff
, '(_2, newDiff) ~ CoverDiff 'DcAdd field newDiff0
)
=> Label field
-> MUStore oldTempl newTempl diff touched : s
:-> MUStore oldTempl newTempl newDiff touched : s
migrateCoerceUnsafe :: Label field
-> (MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff touched : s)
migrateCoerceUnsafe Label field
_ =
(MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff touched : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
migrateGetField
:: forall field oldTempl newTempl diff touched fieldTy s.
( HasUField field fieldTy oldTempl
, RequireUntouched field (field `IsElem` touched)
)
=> Label field
-> MUStore oldTempl newTempl diff touched : s
:-> fieldTy : MUStore oldTempl newTempl diff touched : s
migrateGetField :: Label field
-> (MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
migrateGetField Label field
label =
forall (s :: [*]).
MichelsonCoercible
(MUStore oldTempl newTempl diff touched) (UStore oldTempl) =>
(MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_ @_ @(UStore oldTempl) ((MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s))
-> ((UStore oldTempl : s) :-> (fieldTy : UStore oldTempl : s))
-> (MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore oldTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label field
-> (UStore oldTempl : s)
:-> (GetUStoreField oldTempl field : UStore oldTempl : s)
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (UStore store : s)
:-> (GetUStoreField store name : UStore store : s)
ustoreGetField Label field
label ((MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore oldTempl : s))
-> ((fieldTy : UStore oldTempl : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s))
-> (MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((UStore oldTempl : s)
:-> (MUStore oldTempl newTempl diff touched : s))
-> (fieldTy : UStore oldTempl : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (UStore oldTempl : s)
:-> (MUStore oldTempl newTempl diff touched : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
migrateAddField
:: forall field oldTempl newTempl diff touched fieldTy newDiff marker s.
( '(UStoreFieldExt marker fieldTy, newDiff) ~ CoverDiff 'DcAdd field diff
, HasUField field fieldTy newTempl
)
=> Label field
-> fieldTy : MUStore oldTempl newTempl diff touched : s
:-> MUStore oldTempl newTempl newDiff (field ': touched) : s
migrateAddField :: Label field
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
migrateAddField Label field
label =
DMigrationActionType
-> Label field
-> Proxy fieldTy
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
forall fieldTy (fieldName :: Symbol) (s :: [*]).
SingI (ToT fieldTy) =>
DMigrationActionType -> Label fieldName -> Proxy fieldTy -> s :-> s
attachMigrationActionName (Text -> DMigrationActionType
DAddAction Text
"add") Label field
label (Proxy fieldTy
forall k (t :: k). Proxy t
Proxy @fieldTy) ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s))
-> ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore newTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore newTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((MUStore oldTempl newTempl diff touched : s)
:-> (UStore newTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore newTempl : s)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (forall (s :: [*]).
MichelsonCoercible
(MUStore oldTempl newTempl diff touched) (UStore newTempl) =>
(MUStore oldTempl newTempl diff touched : s)
:-> (UStore newTempl : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_ @_ @(UStore newTempl)) ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore newTempl : s))
-> ((fieldTy : UStore newTempl : s) :-> (UStore newTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (UStore newTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label field
-> (GetUStoreField newTempl field : UStore newTempl : s)
:-> (UStore newTempl : s)
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (GetUStoreField store name : UStore store : s)
:-> (UStore store : s)
ustoreSetField Label field
label ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (UStore newTempl : s))
-> ((UStore newTempl : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (UStore newTempl : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
migrateRemoveField
:: forall field oldTempl newTempl diff touched fieldTy newDiff marker s.
( '(UStoreFieldExt marker fieldTy, newDiff) ~ CoverDiff 'DcRemove field diff
, HasUField field fieldTy oldTempl
)
=> Label field
-> MUStore oldTempl newTempl diff touched : s
:-> MUStore oldTempl newTempl newDiff (field ': touched) : s
migrateRemoveField :: Label field
-> (MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
migrateRemoveField Label field
label =
DMigrationActionType
-> Label field
-> Proxy fieldTy
-> (MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl diff touched : s)
forall fieldTy (fieldName :: Symbol) (s :: [*]).
SingI (ToT fieldTy) =>
DMigrationActionType -> Label fieldName -> Proxy fieldTy -> s :-> s
attachMigrationActionName DMigrationActionType
DDelAction Label field
label (Proxy fieldTy
forall k (t :: k). Proxy t
Proxy @fieldTy) ((MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl diff touched : s))
-> ((MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s))
-> (MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
forall (s :: [*]).
MichelsonCoercible
(MUStore oldTempl newTempl diff touched) (UStore oldTempl) =>
(MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_ @_ @(UStore oldTempl) ((MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s))
-> ((UStore oldTempl : s) :-> (UStore oldTempl : s))
-> (MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label field -> (UStore oldTempl : s) :-> (UStore oldTempl : s)
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name -> (UStore store : s) :-> (UStore store : s)
ustoreRemoveFieldUnsafe Label field
label ((MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s))
-> ((UStore oldTempl : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s))
-> (MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (UStore oldTempl : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
migrateExtractField
:: forall field oldTempl newTempl diff touched fieldTy newDiff marker s.
( '(UStoreFieldExt marker fieldTy, newDiff) ~ CoverDiff 'DcRemove field diff
, HasUField field fieldTy oldTempl
, RequireUntouched field (field `IsElem` touched)
)
=> Label field
-> MUStore oldTempl newTempl diff touched : s
:-> fieldTy : MUStore oldTempl newTempl newDiff (field ': touched) : s
Label field
label =
DMigrationActionType
-> Label field
-> Proxy fieldTy
-> (MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl diff touched : s)
forall fieldTy (fieldName :: Symbol) (s :: [*]).
SingI (ToT fieldTy) =>
DMigrationActionType -> Label fieldName -> Proxy fieldTy -> s :-> s
attachMigrationActionName DMigrationActionType
DDelAction Label field
label (Proxy fieldTy
forall k (t :: k). Proxy t
Proxy @fieldTy) ((MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl diff touched : s))
-> ((MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s))
-> (MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
Label field
-> (MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
forall (field :: Symbol) oldTempl newTempl (diff :: [DiffItem])
(touched :: [Symbol]) fieldTy (s :: [*]).
(HasUField field fieldTy oldTempl,
RequireUntouched field (IsElem field touched)) =>
Label field
-> (MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
migrateGetField Label field
label ((MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s))
-> ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy
: MUStore oldTempl newTempl newDiff (field : touched) : s))
-> (MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy
: MUStore oldTempl newTempl newDiff (field : touched) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy
: MUStore oldTempl newTempl newDiff (field : touched) : s)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (Label field
-> (MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
forall (field :: Symbol) oldTempl newTempl (diff :: [DiffItem])
(touched :: [Symbol]) fieldTy (newDiff :: [DiffItem])
(marker :: UStoreMarkerType) (s :: [*]).
('(UStoreFieldExt marker fieldTy, newDiff)
~ CoverDiff 'DcRemove field diff,
HasUField field fieldTy oldTempl) =>
Label field
-> (MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
migrateRemoveField Label field
label)
migrateOverwriteField
:: forall field oldTempl newTempl diff touched fieldTy oldFieldTy
marker oldMarker newDiff newDiff0 s.
( '(UStoreFieldExt oldMarker oldFieldTy, newDiff0) ~ CoverDiff 'DcRemove field diff
, '(UStoreFieldExt marker fieldTy, newDiff) ~ CoverDiff 'DcAdd field newDiff0
, HasUField field fieldTy newTempl
)
=> Label field
-> fieldTy : MUStore oldTempl newTempl diff touched : s
:-> MUStore oldTempl newTempl newDiff (field ': touched) : s
migrateOverwriteField :: Label field
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
migrateOverwriteField Label field
label =
DMigrationActionType
-> Label field
-> Proxy fieldTy
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
forall fieldTy (fieldName :: Symbol) (s :: [*]).
SingI (ToT fieldTy) =>
DMigrationActionType -> Label fieldName -> Proxy fieldTy -> s :-> s
attachMigrationActionName (Text -> DMigrationActionType
DAddAction Text
"overwrite") Label field
label (Proxy fieldTy
forall k (t :: k). Proxy t
Proxy @fieldTy) ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s))
-> ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore newTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore newTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((MUStore oldTempl newTempl diff touched : s)
:-> (UStore newTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore newTempl : s)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (forall (s :: [*]).
MichelsonCoercible
(MUStore oldTempl newTempl diff touched) (UStore newTempl) =>
(MUStore oldTempl newTempl diff touched : s)
:-> (UStore newTempl : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_ @_ @(UStore newTempl)) ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore newTempl : s))
-> ((fieldTy : UStore newTempl : s) :-> (UStore newTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (UStore newTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label field
-> (GetUStoreField newTempl field : UStore newTempl : s)
:-> (UStore newTempl : s)
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (GetUStoreField store name : UStore store : s)
:-> (UStore store : s)
ustoreSetField Label field
label ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (UStore newTempl : s))
-> ((UStore newTempl : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (UStore newTempl : s)
:-> (MUStore oldTempl newTempl newDiff (field : touched) : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
migrateModifyField
:: forall field oldTempl newTempl diff touched fieldTy s.
( HasUField field fieldTy oldTempl
, HasUField field fieldTy newTempl
)
=> Label field
-> fieldTy : MUStore oldTempl newTempl diff touched : s
:-> MUStore oldTempl newTempl diff touched : s
migrateModifyField :: Label field
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl diff touched : s)
migrateModifyField Label field
label =
DMigrationActionType
-> Label field
-> Proxy fieldTy
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
forall fieldTy (fieldName :: Symbol) (s :: [*]).
SingI (ToT fieldTy) =>
DMigrationActionType -> Label fieldName -> Proxy fieldTy -> s :-> s
attachMigrationActionName (Text -> DMigrationActionType
DAddAction Text
"modify") Label field
label (Proxy fieldTy
forall k (t :: k). Proxy t
Proxy @fieldTy) ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : MUStore oldTempl newTempl diff touched : s))
-> ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore oldTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore oldTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore oldTempl : s)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (forall (s :: [*]).
MichelsonCoercible
(MUStore oldTempl newTempl diff touched) (UStore oldTempl) =>
(MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_ @_ @(UStore oldTempl)) ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (fieldTy : UStore oldTempl : s))
-> ((fieldTy : UStore oldTempl : s) :-> (UStore oldTempl : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label field
-> (GetUStoreField oldTempl field : UStore oldTempl : s)
:-> (UStore oldTempl : s)
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (GetUStoreField store name : UStore store : s)
:-> (UStore store : s)
ustoreSetField Label field
label ((fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (UStore oldTempl : s))
-> ((UStore oldTempl : s)
:-> (MUStore oldTempl newTempl diff touched : s))
-> (fieldTy : MUStore oldTempl newTempl diff touched : s)
:-> (MUStore oldTempl newTempl diff touched : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (UStore oldTempl : s)
:-> (MUStore oldTempl newTempl diff touched : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
muBlock
:: ('[MUStore o n d1 t1] :-> '[MUStore o n d2 t2])
-> MigrationBlocks o n d1 t1 d2 t2
muBlock :: ('[MUStore o n d1 t1] :-> '[MUStore o n d2 t2])
-> MigrationBlocks o n d1 t1 d2 t2
muBlock '[MUStore o n d1 t1] :-> '[MUStore o n d2 t2]
code =
[MigrationAtom] -> MigrationBlocks o n d1 t1 d2 t2
forall oldTemplate newTemplate (preRemDiff :: [DiffItem])
(preTouched :: [Symbol]) (postRemDiff :: [DiffItem])
(postTouched :: [Symbol]).
[MigrationAtom]
-> MigrationBlocks
oldTemplate
newTemplate
preRemDiff
preTouched
postRemDiff
postTouched
MigrationBlocks ([MigrationAtom] -> MigrationBlocks o n d1 t1 d2 t2)
-> (Lambda UStore_ UStore_ -> [MigrationAtom])
-> Lambda UStore_ UStore_
-> MigrationBlocks o n d1 t1 d2 t2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrationAtom -> [MigrationAtom]
forall x. One x => OneItem x -> x
one (MigrationAtom -> [MigrationAtom])
-> (Lambda UStore_ UStore_ -> MigrationAtom)
-> Lambda UStore_ UStore_
-> [MigrationAtom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Lambda UStore_ UStore_ -> MigrationAtom
formMigrationAtom Maybe Text
forall a. Maybe a
Nothing (Lambda UStore_ UStore_ -> MigrationBlocks o n d1 t1 d2 t2)
-> Lambda UStore_ UStore_ -> MigrationBlocks o n d1 t1 d2 t2
forall a b. (a -> b) -> a -> b
$
'[UStore_] :-> '[MUStore o n d1 t1]
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_ ('[UStore_] :-> '[MUStore o n d1 t1])
-> ('[MUStore o n d1 t1] :-> '[MUStore o n d2 t2])
-> '[UStore_] :-> '[MUStore o n d2 t2]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[MUStore o n d1 t1] :-> '[MUStore o n d2 t2]
code ('[UStore_] :-> '[MUStore o n d2 t2])
-> ('[MUStore o n d2 t2] :-> '[UStore_]) -> Lambda UStore_ UStore_
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[MUStore o n d2 t2] :-> '[UStore_]
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
muBlockNamed
:: Text
-> ('[MUStore o n d1 t1] :-> '[MUStore o n d2 t2])
-> MigrationBlocks o n d1 t1 d2 t2
muBlockNamed :: Text
-> ('[MUStore o n d1 t1] :-> '[MUStore o n d2 t2])
-> MigrationBlocks o n d1 t1 d2 t2
muBlockNamed Text
name '[MUStore o n d1 t1] :-> '[MUStore o n d2 t2]
code =
[MigrationAtom] -> MigrationBlocks o n d1 t1 d2 t2
forall oldTemplate newTemplate (preRemDiff :: [DiffItem])
(preTouched :: [Symbol]) (postRemDiff :: [DiffItem])
(postTouched :: [Symbol]).
[MigrationAtom]
-> MigrationBlocks
oldTemplate
newTemplate
preRemDiff
preTouched
postRemDiff
postTouched
MigrationBlocks ([MigrationAtom] -> MigrationBlocks o n d1 t1 d2 t2)
-> (Lambda UStore_ UStore_ -> [MigrationAtom])
-> Lambda UStore_ UStore_
-> MigrationBlocks o n d1 t1 d2 t2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrationAtom -> [MigrationAtom]
forall x. One x => OneItem x -> x
one (MigrationAtom -> [MigrationAtom])
-> (Lambda UStore_ UStore_ -> MigrationAtom)
-> Lambda UStore_ UStore_
-> [MigrationAtom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Lambda UStore_ UStore_ -> MigrationAtom
formMigrationAtom (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) (Lambda UStore_ UStore_ -> MigrationBlocks o n d1 t1 d2 t2)
-> Lambda UStore_ UStore_ -> MigrationBlocks o n d1 t1 d2 t2
forall a b. (a -> b) -> a -> b
$
'[UStore_] :-> '[MUStore o n d1 t1]
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_ ('[UStore_] :-> '[MUStore o n d1 t1])
-> ('[MUStore o n d1 t1] :-> '[MUStore o n d2 t2])
-> '[UStore_] :-> '[MUStore o n d2 t2]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[MUStore o n d1 t1] :-> '[MUStore o n d2 t2]
code ('[UStore_] :-> '[MUStore o n d2 t2])
-> ('[MUStore o n d2 t2] :-> '[UStore_]) -> Lambda UStore_ UStore_
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[MUStore o n d2 t2] :-> '[UStore_]
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
(<-->)
:: MigrationBlocks o n d1 t1 d2 t2
-> MigrationBlocks o n d2 t2 d3 t3
-> MigrationBlocks o n d1 t1 d3 t3
MigrationBlocks [MigrationAtom]
blocks1 <--> :: MigrationBlocks o n d1 t1 d2 t2
-> MigrationBlocks o n d2 t2 d3 t3
-> MigrationBlocks o n d1 t1 d3 t3
<--> MigrationBlocks [MigrationAtom]
blocks2 =
[MigrationAtom] -> MigrationBlocks o n d1 t1 d3 t3
forall oldTemplate newTemplate (preRemDiff :: [DiffItem])
(preTouched :: [Symbol]) (postRemDiff :: [DiffItem])
(postTouched :: [Symbol]).
[MigrationAtom]
-> MigrationBlocks
oldTemplate
newTemplate
preRemDiff
preTouched
postRemDiff
postTouched
MigrationBlocks ([MigrationAtom]
blocks1 [MigrationAtom] -> [MigrationAtom] -> [MigrationAtom]
forall a. Semigroup a => a -> a -> a
<> [MigrationAtom]
blocks2)
infixl 2 <-->
($:) :: (a -> b) -> a -> b
$: :: (a -> b) -> a -> b
($:) = (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
infixr 7 $:
mustoreToOld
:: RequireBeInitial touched
=> MUStore oldTemplate newTemplate remDiff touched : s
:-> UStore oldTemplate : s
mustoreToOld :: (MUStore oldTemplate newTemplate remDiff touched : s)
:-> (UStore oldTemplate : s)
mustoreToOld = (MUStore oldTemplate newTemplate remDiff touched : s)
:-> (UStore oldTemplate : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
class MigrationFinishCheckPosition a where
migrationFinish :: a
instance ( i ~ (MUStore oldTempl newTempl diff touched : s)
, o ~ (MUStore oldTempl newTempl '[] touched : s)
, RequireEmptyDiff diff
) =>
MigrationFinishCheckPosition (i :-> o) where
migrationFinish :: i :-> o
migrationFinish = i :-> o
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
instance (RequireEmptyDiff d1, t1 ~ t2) =>
MigrationFinishCheckPosition (MigrationBlocks o n d1 t1 '[] t2) where
migrationFinish :: MigrationBlocks o n d1 t1 '[] t2
migrationFinish = [MigrationAtom] -> MigrationBlocks o n d1 t1 '[] t2
forall oldTemplate newTemplate (preRemDiff :: [DiffItem])
(preTouched :: [Symbol]) (postRemDiff :: [DiffItem])
(postTouched :: [Symbol]).
[MigrationAtom]
-> MigrationBlocks
oldTemplate
newTemplate
preRemDiff
preTouched
postRemDiff
postTouched
MigrationBlocks []