-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Impementation of @Store@ - object incapsulating multiple 'BigMap's.
--
-- This module also provides template for the contract storage -
-- 'StorageSkeleton'.
--
-- We represent 'Store' as @big_map bytes (a | b | ...)@.
--
-- Key of this map is formed as @(index, orig_key)@, where @index@ is
-- zero-based index of emulated map, @orig_key@ is key of this emulated map.
--
-- Value of this map is just a union of emulated map's values.

{- Note on store inner representation (@martoon)

I see an alternative approach - representing store as
@big_map bytes (option a, option b, ...)@.

This would allow for saner implementation and more convenient interface.
An obvious shortcoming here is gas consumption. But this overhead seems
insignificant against the background of some other instructions.

-}
module Lorentz.Store
  {-# DEPRECATED "Contract storage can contain multiple big_maps starting from Michelson 005" #-}
  ( -- * Store and related type definitions
    Store (..)
  , type (|->)

    -- ** Type-lookup-by-name
  , GetStoreKey
  , GetStoreValue

    -- ** Instructions
  , storeMem
  , storeGet
  , storeUpdate
  , storeInsert
  , storeInsertNew
  , storeDelete

    -- ** Instruction constraints
  , StoreMemC
  , StoreGetC
  , StoreUpdateC
  , StoreInsertC
  , StoreDeleteC
  , HasStore
  , HasStoreForAllIn

    -- * Storage skeleton
  , StorageSkeleton (..)
  , storageUnpack
  , storagePack
  , storageMem
  , storageGet
  , storageInsert
  , storageInsertNew
  , storageDelete

    -- * Store management from Haskell
  , storePiece
  , storeKeyValueList
  , storeLookup

    -- ** Function constraints
  , StorePieceC
  ) where

import Data.Default (Default)
import qualified Data.Kind as Kind
import qualified Data.Map as Map
import Data.Type.Bool (If, type (||))
import Data.Type.Equality (type (==))
import GHC.Generics ((:+:))
import qualified GHC.Generics as G
import GHC.TypeLits (AppendSymbol, ErrorMessage(..), Symbol, TypeError)
import GHC.TypeNats (type (+), Nat)
import Type.Reflection ((:~:)(Refl))

import Lorentz.ADT
import Lorentz.Base
import Lorentz.Coercions
import Lorentz.Constraints
import Lorentz.Instr as L
import Lorentz.Macro
import Lorentz.Pack
import Lorentz.StoreClass
import Michelson.Typed.Haskell.Instr.Sum
import Michelson.Typed.Haskell.Value
import Michelson.Typed.Instr
import Util.Label (Label)

{-# ANN module ("HLint: ignore Use 'natVal' from Universum" :: Text) #-}

----------------------------------------------------------------------------
-- Store
----------------------------------------------------------------------------

-- | Gathers multple 'BigMap's under one object.
--
-- Type argument of this datatype stands for a "map template" -
-- a datatype with multiple constructors, each containing an object of
-- type '|->' and corresponding to single virtual 'BigMap'.
-- It's also possible to parameterize it with a larger type which is
-- a sum of types satisfying the above property.
--
-- Inside it keeps only one 'BigMap' thus not violating Michelson limitations.
--
-- See examples below.
newtype Store a = Store { Store a -> BigMap ByteString a
unStore :: BigMap ByteString a }
  deriving stock (Store a -> Store a -> Bool
(Store a -> Store a -> Bool)
-> (Store a -> Store a -> Bool) -> Eq (Store a)
forall a. Eq a => Store a -> Store a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Store a -> Store a -> Bool
$c/= :: forall a. Eq a => Store a -> Store a -> Bool
== :: Store a -> Store a -> Bool
$c== :: forall a. Eq a => Store a -> Store a -> Bool
Eq, Int -> Store a -> ShowS
[Store a] -> ShowS
Store a -> String
(Int -> Store a -> ShowS)
-> (Store a -> String) -> ([Store a] -> ShowS) -> Show (Store a)
forall a. Show a => Int -> Store a -> ShowS
forall a. Show a => [Store a] -> ShowS
forall a. Show a => Store a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Store a] -> ShowS
$cshowList :: forall a. Show a => [Store a] -> ShowS
show :: Store a -> String
$cshow :: forall a. Show a => Store a -> String
showsPrec :: Int -> Store a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Store a -> ShowS
Show)
  deriving newtype (Store a
Store a -> Default (Store a)
forall a. Store a
forall a. a -> Default a
def :: Store a
$cdef :: forall a. Store a
Default, b -> Store a -> Store a
NonEmpty (Store a) -> Store a
Store a -> Store a -> Store a
(Store a -> Store a -> Store a)
-> (NonEmpty (Store a) -> Store a)
-> (forall b. Integral b => b -> Store a -> Store a)
-> Semigroup (Store a)
forall b. Integral b => b -> Store a -> Store a
forall a. NonEmpty (Store a) -> Store a
forall a. Store a -> Store a -> Store a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> Store a -> Store a
stimes :: b -> Store a -> Store a
$cstimes :: forall a b. Integral b => b -> Store a -> Store a
sconcat :: NonEmpty (Store a) -> Store a
$csconcat :: forall a. NonEmpty (Store a) -> Store a
<> :: Store a -> Store a -> Store a
$c<> :: forall a. Store a -> Store a -> Store a
Semigroup, Semigroup (Store a)
Store a
Semigroup (Store a) =>
Store a
-> (Store a -> Store a -> Store a)
-> ([Store a] -> Store a)
-> Monoid (Store a)
[Store a] -> Store a
Store a -> Store a -> Store a
forall a. Semigroup (Store a)
forall a. Store a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [Store a] -> Store a
forall a. Store a -> Store a -> Store a
mconcat :: [Store a] -> Store a
$cmconcat :: forall a. [Store a] -> Store a
mappend :: Store a -> Store a -> Store a
$cmappend :: forall a. Store a -> Store a -> Store a
mempty :: Store a
$cmempty :: forall a. Store a
$cp1Monoid :: forall a. Semigroup (Store a)
Monoid, WellTypedToT (Store a)
WellTypedToT (Store a) =>
(Store a -> Value (ToT (Store a)))
-> (Value (ToT (Store a)) -> Store a) -> IsoValue (Store a)
Value (ToT (Store a)) -> Store a
Store a -> Value (ToT (Store a))
forall a. IsoValue a => WellTypedToT (Store a)
forall a. IsoValue a => Value (ToT (Store a)) -> Store a
forall a. IsoValue a => Store a -> Value (ToT (Store a))
forall a.
WellTypedToT a =>
(a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
fromVal :: Value (ToT (Store a)) -> Store a
$cfromVal :: forall a. IsoValue a => Value (ToT (Store a)) -> Store a
toVal :: Store a -> Value (ToT (Store a))
$ctoVal :: forall a. IsoValue a => Store a -> Value (ToT (Store a))
$cp1IsoValue :: forall a. IsoValue a => WellTypedToT (Store a)
IsoValue)

-- | Describes one virtual big map.
data k |-> v = BigMapImage v
  deriving stock (forall x. (k |-> v) -> Rep (k |-> v) x)
-> (forall x. Rep (k |-> v) x -> k |-> v) -> Generic (k |-> v)
forall x. Rep (k |-> v) x -> k |-> v
forall x. (k |-> v) -> Rep (k |-> v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (k :: k) v x. Rep (k |-> v) x -> k |-> v
forall k (k :: k) v x. (k |-> v) -> Rep (k |-> v) x
$cto :: forall k (k :: k) v x. Rep (k |-> v) x -> k |-> v
$cfrom :: forall k (k :: k) v x. (k |-> v) -> Rep (k |-> v) x
Generic
  deriving anyclass WellTypedToT (k |-> v)
WellTypedToT (k |-> v) =>
((k |-> v) -> Value (ToT (k |-> v)))
-> (Value (ToT (k |-> v)) -> k |-> v) -> IsoValue (k |-> v)
Value (ToT (k |-> v)) -> k |-> v
(k |-> v) -> Value (ToT (k |-> v))
forall a.
WellTypedToT a =>
(a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall k (k :: k) v. IsoValue v => WellTypedToT (k |-> v)
forall k (k :: k) v. IsoValue v => Value (ToT (k |-> v)) -> k |-> v
forall k (k :: k) v.
IsoValue v =>
(k |-> v) -> Value (ToT (k |-> v))
fromVal :: Value (ToT (k |-> v)) -> k |-> v
$cfromVal :: forall k (k :: k) v. IsoValue v => Value (ToT (k |-> v)) -> k |-> v
toVal :: (k |-> v) -> Value (ToT (k |-> v))
$ctoVal :: forall k (k :: k) v.
IsoValue v =>
(k |-> v) -> Value (ToT (k |-> v))
$cp1IsoValue :: forall k (k :: k) v. IsoValue v => WellTypedToT (k |-> v)
IsoValue

{- Again we use generic magic to implement methods for 'Store'
(and thus 'Store' type constructor accepts a datatype, not a type-level list).

There are two reasons for this:

1. This gives us expected balanced tree of 'Or's for free.

2. This allows us selecting a map by constructor name, not by
e.g. type of map value. This is subjective, but looks like a good thing
for me (@martoon). On the other hand, it prevents us from sharing the
same interface between maps and 'Store'.

-}

-- | Position of a constructor in the corresponding datatype declaration.
type CtorIdx = Nat

-- | Number of datatype constructors.
type CtorsNum = Nat

-- | Type arguments of '|->'.
data MapSignature = MapSignature Kind.Type Kind.Type CtorIdx

-- Again, we will use these getters instead of binding types within
-- 'MapSignature' using type equality because getters does not produce extra
-- compile errors on "field not found" cases.
type family MSKey ms where
  MSKey ('MapSignature k _ _) = k
type family MSValue ms where
  MSValue ('MapSignature _ v _) = v
type family MSCtorIdx ms where
  MSCtorIdx ('MapSignature _ _ ci) = ci

-- | Get map signature from the constructor with a given name.
type GetStore name a = MSRequireFound name a (GLookupStore name (G.Rep a))

data MapLookupRes
  = MapFound MapSignature
  | MapAbsent CtorsNum

type family MSRequireFound
  (name :: Symbol)
  (a :: Kind.Type)
  (mlr :: MapLookupRes)
    :: MapSignature where
  MSRequireFound _ _ ('MapFound ms) = ms
  MSRequireFound name a ('MapAbsent _) = TypeError
    ('Text "Failed to find store template: datatype " ':<>: 'ShowType a ':<>:
     'Text " has no constructor " ':<>: 'ShowType name)

-- | Prepend a constructor name with a lower-case character so that you
-- could make a label with @OverloadedLabels@ extension matching
-- resulting thing.
type CtorNameToLabel name = "c" `AppendSymbol` name

type family GLookupStore (name :: Symbol) (x :: Kind.Type -> Kind.Type)
              :: MapLookupRes where
  GLookupStore name (G.D1 _ x) = GLookupStore name x
  GLookupStore name (x :+: y) = LSMergeFound name (GLookupStore name x)
                                                  (GLookupStore name y)
  -- When we encounter a constructor there are two cases we are interested in:
  -- 1. This constructor has one field with type `|->`. Then we check its name
  -- and return 'MapFound' if it matches and 'MapAbsent' otherwise (storing
  -- information that we've found one constructor).
  -- 2. This constructor has one field with a different type. Then we expect
  -- this field to store '|->' somewhere deeper and try to find it there.
  GLookupStore name (G.C1 ('G.MetaCons ctorName _ _) x) =
    If (IsLeafCtor x)
      (If (name == ctorName || name == CtorNameToLabel ctorName)
         ('MapFound $ GExtractMapSignature ctorName x)
         ('MapAbsent 1)
      )
      (GLookupStoreDeeper name x)
  GLookupStore _ G.V1 = 'MapAbsent 0

-- Helper type family to check whether ADT constructor has one field
-- with type `|->`.
type family IsLeafCtor (x :: Kind.Type -> Kind.Type) :: Bool where
  IsLeafCtor (G.S1 _ (G.Rec0 (_ |-> _))) = 'True
  IsLeafCtor _ = 'False

-- Helper type family to go deeper during type-level store lookup.
type family GLookupStoreDeeper (name :: Symbol) (x :: Kind.Type -> Kind.Type)
              :: MapLookupRes where
  GLookupStoreDeeper name (G.S1 _ (G.Rec0 y))  = GLookupStore name (G.Rep y)
  GLookupStoreDeeper name _ = TypeError
    ('Text "Attempt to go deeper failed while looking for" ':<>: 'ShowType name
    ':$$:
    'Text "Make sure that all constructors have exactly one field inside.")

type family LSMergeFound (name :: Symbol)
  (f1 :: MapLookupRes) (f2 :: MapLookupRes)
  :: MapLookupRes where
  LSMergeFound _ ('MapAbsent n1) ('MapAbsent n2) = 'MapAbsent (n1 + n2)
  LSMergeFound _ ('MapFound ms) ('MapAbsent _) = 'MapFound ms
  LSMergeFound _ ('MapAbsent n) ('MapFound ('MapSignature k v i)) =
    'MapFound ('MapSignature k v (n + i))
  -- It's possible that there are two constructors with the same name,
  -- because main template pattern may be a sum of smaller template
  -- patterns with same constructor names.
  LSMergeFound ctor ('MapFound _) ('MapFound _) = TypeError
    ('Text "Found more than one constructor matching " ':<>: 'ShowType ctor)

type family GExtractMapSignature (ctor :: Symbol) (x :: Kind.Type -> Kind.Type)
             :: MapSignature where
  GExtractMapSignature _ (G.S1 _ (G.Rec0 (k |-> v))) = 'MapSignature k v 0
  GExtractMapSignature ctor _ = TypeError
    ('Text "Expected exactly one field of type `k |-> v`" ':$$:
     'Text "In constructor " ':<>: 'ShowType ctor)

type GetStoreKey store name = MSKey (GetStore name store)
type GetStoreValue store name = MSValue (GetStore name store)

packKey
  :: forall (idx :: CtorIdx) a s.
     (KnownNat idx, NicePackedValue a)
  => (a : s) :-> (ByteString : s)
packKey :: (a : s) :-> (ByteString : s)
packKey =
  ((KnownValue a,
  (SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a)),
   FailOnBigMapFound (ContainsBigMap (ToT a))))
 :- PackedValScope (ToT a))
-> (PackedValScope (ToT a) => (a : s) :-> (ByteString : s))
-> (a : s) :-> (ByteString : s)
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue a,
 (SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a)),
  FailOnBigMapFound (ContainsBigMap (ToT a))))
:- PackedValScope (ToT a)
forall a. NicePackedValue a :- PackedValScope (ToT a)
nicePackedValueEvi @a) ((PackedValScope (ToT a) => (a : s) :-> (ByteString : s))
 -> (a : s) :-> (ByteString : s))
-> (PackedValScope (ToT a) => (a : s) :-> (ByteString : s))
-> (a : s) :-> (ByteString : s)
forall a b. (a -> b) -> a -> b
$
    Natural -> (a : s) :-> (Natural & (a : s))
forall t (s :: [*]). NiceConstant t => t -> s :-> (t & s)
push (Proxy idx -> Natural
forall (n :: CtorIdx) (proxy :: CtorIdx -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy idx -> Natural) -> Proxy idx -> Natural
forall a b. (a -> b) -> a -> b
$ Proxy idx
forall k (t :: k). Proxy t
Proxy @idx) ((a : s) :-> (Natural & (a : s)))
-> ((Natural & (a : s)) :-> ((Natural, a) & s))
-> (a : s) :-> ((Natural, a) & s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
    forall (s :: [*]). (Natural & (a & s)) :-> ((Natural, a) & s)
forall a b (s :: [*]). (a & (b & s)) :-> ((a, b) & s)
pair @Natural @a ((a : s) :-> ((Natural, a) & s))
-> (((Natural, a) & s) :-> (ByteString : s))
-> (a : s) :-> (ByteString : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
    ((Natural, a) & s) :-> (ByteString : s)
forall a (s :: [*]).
NicePackedValue a =>
(a & s) :-> (ByteString & s)
pack

wrapBigMapImage :: (v : s) :-> ((k |-> v) : s)
wrapBigMapImage :: (v : s) :-> ((k |-> v) : s)
wrapBigMapImage = (v : s) :-> ((k |-> v) : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a & s) :-> (b & s)
forcedCoerce_

unwrapBigMapImage :: ((k |-> v) : s) :-> (v : s)
unwrapBigMapImage :: ((k |-> v) : s) :-> (v : s)
unwrapBigMapImage = ((k |-> v) : s) :-> (v : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a & s) :-> (b & s)
forcedCoerce_

type StoreOpC store name =
  ( NicePackedValue (MSKey (GetStore name store))
  , KnownNat (MSCtorIdx (GetStore name store))
  )

{- Note on store initialization:

It's not possible to create an empty store, because Michelson provides no way
to create a new empty @big_map@.
-}

storeMem
  :: forall store name s.
     (StoreMemC store name)
  => Label name
  -> GetStoreKey store name : Store store : s :-> Bool : s
storeMem :: Label name
-> (GetStoreKey store name : Store store : s) :-> (Bool : s)
storeMem _ =
  forall a (s :: [*]).
(KnownNat (MSCtorIdx (GetStore name store)), NicePackedValue a) =>
(a : s) :-> (ByteString : s)
forall (idx :: CtorIdx) a (s :: [*]).
(KnownNat idx, NicePackedValue a) =>
(a : s) :-> (ByteString : s)
packKey @(MSCtorIdx (GetStore name store)) ((GetStoreKey store name : Store store : s)
 :-> (ByteString : Store store : s))
-> ((ByteString : Store store : s) :-> (Bool : s))
-> (GetStoreKey store name : Store store : s) :-> (Bool : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  Instr (ToTs (ByteString : Store store : s)) (ToTs (Bool : s))
-> (ByteString : Store store : s) :-> (Bool : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr (ToTs (ByteString : Store store : s)) (ToTs (Bool : s))
forall (c :: T) (s :: [T]).
MemOp c =>
Instr (MemOpKey c : c : s) ('TBool : s)
MEM

type StoreMemC store name = StoreOpC store name

storeGet
  :: forall store name s.
     StoreGetC store name
  => Label name
  -> GetStoreKey store name : Store store : s
       :-> Maybe (GetStoreValue store name) : s
storeGet :: Label name
-> (GetStoreKey store name : Store store : s)
   :-> (Maybe (GetStoreValue store name) : s)
storeGet label :: Label name
label =
  forall a (s :: [*]).
(KnownNat (MSCtorIdx (GetStore name store)), NicePackedValue a) =>
(a : s) :-> (ByteString : s)
forall (idx :: CtorIdx) a (s :: [*]).
(KnownNat idx, NicePackedValue a) =>
(a : s) :-> (ByteString : s)
packKey @(MSCtorIdx (GetStore name store)) ((GetStoreKey store name : Store store : s)
 :-> (ByteString : Store store : s))
-> ((ByteString : Store store : s) :-> (Maybe store & s))
-> (GetStoreKey store name : Store store : s) :-> (Maybe store & s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  Instr
  (ToTs (ByteString : Store store : s)) (ToTs (Maybe store & s))
-> (ByteString : Store store : s) :-> (Maybe store & s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr
  (ToTs (ByteString : Store store : s)) (ToTs (Maybe store & s))
forall (c :: T) (s :: [T]).
(GetOp c, KnownT (GetOpVal c)) =>
Instr (GetOpKey c : c : s) ('TOption (GetOpVal c) : s)
GET ((GetStoreKey store name : Store store : s) :-> (Maybe store & s))
-> ((Maybe store & s) :-> (Maybe (GetStoreValue store name) : s))
-> (GetStoreKey store name : Store store : s)
   :-> (Maybe (GetStoreValue store name) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  (s :-> (Maybe (GetStoreValue store name) : s))
-> ((store & s) :-> (Maybe (GetStoreValue store name) : s))
-> (Maybe store & s) :-> (Maybe (GetStoreValue store name) : s)
forall (s :: [*]) (s' :: [*]) a.
(s :-> s') -> ((a & s) :-> s') -> (Maybe a & s) :-> s'
ifNone s :-> (Maybe (GetStoreValue store name) : s)
forall a (s :: [*]). KnownValue a => s :-> (Maybe a & s)
none (Label name -> (store & s) :-> (CtorOnlyField name store : s)
forall dt (name :: Symbol) (st :: [*]).
InstrUnwrapC dt name =>
Label name -> (dt & st) :-> (CtorOnlyField name dt : st)
unwrapUnsafe_ @store Label name
label ((store & s)
 :-> ((GetStoreKey store name |-> GetStoreValue store name) : s))
-> (((GetStoreKey store name |-> GetStoreValue store name) : s)
    :-> (GetStoreValue store name : s))
-> (store & s) :-> (GetStoreValue store name : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((GetStoreKey store name |-> GetStoreValue store name) : s)
:-> (GetStoreValue store name : s)
forall k (k :: k) v (s :: [*]). ((k |-> v) : s) :-> (v : s)
unwrapBigMapImage ((store & s) :-> (GetStoreValue store name : s))
-> ((GetStoreValue store name : s)
    :-> (Maybe (GetStoreValue store name) : s))
-> (store & s) :-> (Maybe (GetStoreValue store name) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (GetStoreValue store name : s)
:-> (Maybe (GetStoreValue store name) : s)
forall a (s :: [*]). (a & s) :-> (Maybe a & s)
L.some)

type StoreGetC store name =
  ( StoreOpC store name
  , InstrUnwrapC store name
  , KnownValue (GetStoreValue store name)
  , CtorHasOnlyField name store
      (GetStoreKey store name |-> GetStoreValue store name)
  )

storeUpdate
  :: forall store name s.
     StoreUpdateC store name
  => Label name
  -> GetStoreKey store name
      : Maybe (GetStoreValue store name)
      : Store store
      : s
  :-> Store store : s
storeUpdate :: Label name
-> (GetStoreKey store name
      : Maybe (GetStoreValue store name) : Store store : s)
   :-> (Store store : s)
storeUpdate label :: Label name
label =
  forall a (s :: [*]).
(KnownNat (MSCtorIdx (GetStore name store)), NicePackedValue a) =>
(a : s) :-> (ByteString : s)
forall (idx :: CtorIdx) a (s :: [*]).
(KnownNat idx, NicePackedValue a) =>
(a : s) :-> (ByteString : s)
packKey @(MSCtorIdx (GetStore name store)) ((GetStoreKey store name
    : Maybe (GetStoreValue store name) : Store store : s)
 :-> (ByteString
        : Maybe (GetStoreValue store name) : Store store : s))
-> ((ByteString
       : Maybe (GetStoreValue store name) : Store store : s)
    :-> (ByteString & (Maybe store & (Store store : s))))
-> (GetStoreKey store name
      : Maybe (GetStoreValue store name) : Store store : s)
   :-> (ByteString & (Maybe store & (Store store : s)))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  ((Maybe (GetStoreValue store name) : Store store : s)
 :-> (Maybe store & (Store store : s)))
-> (ByteString
      : Maybe (GetStoreValue store name) : Store store : s)
   :-> (ByteString & (Maybe store & (Store store : s)))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip (((Store store : s) :-> (Maybe store & (Store store : s)))
-> ((GetStoreValue store name & (Store store : s))
    :-> (Maybe store & (Store store : s)))
-> (Maybe (GetStoreValue store name) : Store store : s)
   :-> (Maybe store & (Store store : s))
forall (s :: [*]) (s' :: [*]) a.
(s :-> s') -> ((a & s) :-> s') -> (Maybe a & s) :-> s'
ifNone (Store store : s) :-> (Maybe store & (Store store : s))
forall a (s :: [*]). KnownValue a => s :-> (Maybe a & s)
none ((GetStoreValue store name & (Store store : s))
:-> ((GetStoreKey store name |-> GetStoreValue store name)
       : Store store : s)
forall k v (s :: [*]) (k :: k). (v : s) :-> ((k |-> v) : s)
wrapBigMapImage ((GetStoreValue store name & (Store store : s))
 :-> ((GetStoreKey store name |-> GetStoreValue store name)
        : Store store : s))
-> (((GetStoreKey store name |-> GetStoreValue store name)
       : Store store : s)
    :-> (store & (Store store : s)))
-> (GetStoreValue store name & (Store store : s))
   :-> (store & (Store store : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label name
-> AppendCtorField (GetCtorField store name) (Store store : s)
   :-> (store & (Store store : s))
forall dt (name :: Symbol) (st :: [*]).
InstrWrapC dt name =>
Label name
-> AppendCtorField (GetCtorField dt name) st :-> (dt & st)
wrap_ @store Label name
label ((GetStoreValue store name & (Store store : s))
 :-> (store & (Store store : s)))
-> ((store & (Store store : s))
    :-> (Maybe store & (Store store : s)))
-> (GetStoreValue store name & (Store store : s))
   :-> (Maybe store & (Store store : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (store & (Store store : s)) :-> (Maybe store & (Store store : s))
forall a (s :: [*]). (a & s) :-> (Maybe a & s)
L.some)) ((GetStoreKey store name
    : Maybe (GetStoreValue store name) : Store store : s)
 :-> (ByteString & (Maybe store & (Store store : s))))
-> ((ByteString & (Maybe store & (Store store : s)))
    :-> (Store store : s))
-> (GetStoreKey store name
      : Maybe (GetStoreValue store name) : Store store : s)
   :-> (Store store : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  Instr
  (ToTs (ByteString & (Maybe store & (Store store : s))))
  (ToTs (Store store : s))
-> (ByteString & (Maybe store & (Store store : s)))
   :-> (Store store : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr
  (ToTs (ByteString & (Maybe store & (Store store : s))))
  (ToTs (Store store : s))
forall (c :: T) (s :: [T]).
UpdOp c =>
Instr (UpdOpKey c : UpdOpParams c : c : s) (c : s)
UPDATE

type StoreUpdateC store name =
  ( KnownValue store
  , StoreOpC store name
  , InstrWrapC store name
  , CtorHasOnlyField name store
      (GetStoreKey store name |-> GetStoreValue store name)
  )

storeInsert
  :: forall store name s.
     StoreInsertC store name
  => Label name
  -> GetStoreKey store name
      : GetStoreValue store name
      : Store store
      : s
  :-> Store store : s
storeInsert :: Label name
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsert label :: Label name
label =
  forall a (s :: [*]).
(KnownNat (MSCtorIdx (GetStore name store)), NicePackedValue a) =>
(a : s) :-> (ByteString : s)
forall (idx :: CtorIdx) a (s :: [*]).
(KnownNat idx, NicePackedValue a) =>
(a : s) :-> (ByteString : s)
packKey @(MSCtorIdx (GetStore name store)) ((GetStoreKey store name
    : GetStoreValue store name : Store store : s)
 :-> (ByteString : GetStoreValue store name : Store store : s))
-> ((ByteString : GetStoreValue store name : Store store : s)
    :-> (ByteString & (Maybe store & (Store store : s))))
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (ByteString & (Maybe store & (Store store : s)))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  ((GetStoreValue store name : Store store : s)
 :-> (Maybe store & (Store store : s)))
-> (ByteString : GetStoreValue store name : Store store : s)
   :-> (ByteString & (Maybe store & (Store store : s)))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((GetStoreValue store name : Store store : s)
:-> ((GetStoreKey store name |-> GetStoreValue store name)
       : Store store : s)
forall k v (s :: [*]) (k :: k). (v : s) :-> ((k |-> v) : s)
wrapBigMapImage ((GetStoreValue store name : Store store : s)
 :-> ((GetStoreKey store name |-> GetStoreValue store name)
        : Store store : s))
-> (((GetStoreKey store name |-> GetStoreValue store name)
       : Store store : s)
    :-> (store & (Store store : s)))
-> (GetStoreValue store name : Store store : s)
   :-> (store & (Store store : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label name
-> AppendCtorField (GetCtorField store name) (Store store : s)
   :-> (store & (Store store : s))
forall dt (name :: Symbol) (st :: [*]).
InstrWrapC dt name =>
Label name
-> AppendCtorField (GetCtorField dt name) st :-> (dt & st)
wrap_ @store Label name
label ((GetStoreValue store name : Store store : s)
 :-> (store & (Store store : s)))
-> ((store & (Store store : s))
    :-> (Maybe store & (Store store : s)))
-> (GetStoreValue store name : Store store : s)
   :-> (Maybe store & (Store store : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (store & (Store store : s)) :-> (Maybe store & (Store store : s))
forall a (s :: [*]). (a & s) :-> (Maybe a & s)
L.some) ((GetStoreKey store name
    : GetStoreValue store name : Store store : s)
 :-> (ByteString & (Maybe store & (Store store : s))))
-> ((ByteString & (Maybe store & (Store store : s)))
    :-> (Store store : s))
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  Instr
  (ToTs (ByteString & (Maybe store & (Store store : s))))
  (ToTs (Store store : s))
-> (ByteString & (Maybe store & (Store store : s)))
   :-> (Store store : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr
  (ToTs (ByteString & (Maybe store & (Store store : s))))
  (ToTs (Store store : s))
forall (c :: T) (s :: [T]).
UpdOp c =>
Instr (UpdOpKey c : UpdOpParams c : c : s) (c : s)
UPDATE

type StoreInsertC store name =
  ( StoreOpC store name
  , InstrWrapC store name
  , CtorHasOnlyField name store
      (GetStoreKey store name |-> GetStoreValue store name)
  )

-- | Insert a key-value pair, but fail if it will overwrite some existing entry.
storeInsertNew
  :: forall store name s.
     StoreInsertC store name
  => Label name
  -> (forall s0 any. GetStoreKey store name : s0 :-> any)
  -> GetStoreKey store name
      : GetStoreValue store name
      : Store store
      : s
  :-> Store store : s
storeInsertNew :: Label name
-> (forall (s0 :: [*]) (any :: [*]).
    (GetStoreKey store name : s0) :-> any)
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsertNew label :: Label name
label doFail :: forall (s0 :: [*]) (any :: [*]).
(GetStoreKey store name : s0) :-> any
doFail =
  forall a (s :: [*]) (s1 :: [*]) (tail :: [*]).
(ConstraintDuupXLorentz (ToPeano (3 - 1)) s a s1 tail,
 DuupX (ToPeano 3) s a s1 tail) =>
s :-> (a : s)
forall (n :: CtorIdx) a (s :: [*]) (s1 :: [*]) (tail :: [*]).
(ConstraintDuupXLorentz (ToPeano (n - 1)) s a s1 tail,
 DuupX (ToPeano n) s a s1 tail) =>
s :-> (a : s)
duupX @3 ((GetStoreKey store name
    : GetStoreValue store name : Store store : s)
 :-> (Store store
        : GetStoreKey store name : GetStoreValue store name : Store store
        : s))
-> ((Store store
       : GetStoreKey store name : GetStoreValue store name : Store store
       : s)
    :-> (GetStoreKey store name
           : Store store : GetStoreKey store name : GetStoreValue store name
           : Store store : s))
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (GetStoreKey store name
          : Store store : GetStoreKey store name : GetStoreValue store name
          : Store store : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# forall a (s :: [*]) (s1 :: [*]) (tail :: [*]).
(ConstraintDuupXLorentz (ToPeano (2 - 1)) s a s1 tail,
 DuupX (ToPeano 2) s a s1 tail) =>
s :-> (a : s)
forall (n :: CtorIdx) a (s :: [*]) (s1 :: [*]) (tail :: [*]).
(ConstraintDuupXLorentz (ToPeano (n - 1)) s a s1 tail,
 DuupX (ToPeano n) s a s1 tail) =>
s :-> (a : s)
duupX @2 ((GetStoreKey store name
    : GetStoreValue store name : Store store : s)
 :-> (GetStoreKey store name
        : Store store : GetStoreKey store name : GetStoreValue store name
        : Store store : s))
-> ((GetStoreKey store name
       : Store store : GetStoreKey store name : GetStoreValue store name
       : Store store : s)
    :-> (Bool
           : GetStoreKey store name : GetStoreValue store name : Store store
           : s))
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Bool
          : GetStoreKey store name : GetStoreValue store name : Store store
          : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label name
-> (GetStoreKey store name
      : Store store : GetStoreKey store name : GetStoreValue store name
      : Store store : s)
   :-> (Bool
          : GetStoreKey store name : GetStoreValue store name : Store store
          : s)
forall store (name :: Symbol) (s :: [*]).
StoreMemC store name =>
Label name
-> (GetStoreKey store name : Store store : s) :-> (Bool : s)
storeMem Label name
label ((GetStoreKey store name
    : GetStoreValue store name : Store store : s)
 :-> (Bool
        : GetStoreKey store name : GetStoreValue store name : Store store
        : s))
-> ((Bool
       : GetStoreKey store name : GetStoreValue store name : Store store
       : s)
    :-> (Store store : s))
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  ((GetStoreKey store name
    : GetStoreValue store name : Store store : s)
 :-> (Store store : s))
-> ((GetStoreKey store name
       : GetStoreValue store name : Store store : s)
    :-> (Store store : s))
-> (Bool
      : GetStoreKey store name : GetStoreValue store name : Store store
      : s)
   :-> (Store store : s)
forall (s :: [*]) (s' :: [*]).
(s :-> s') -> (s :-> s') -> (Bool & s) :-> s'
if_ (GetStoreKey store name
   : GetStoreValue store name : Store store : s)
:-> (Store store : s)
forall (s0 :: [*]) (any :: [*]).
(GetStoreKey store name : s0) :-> any
doFail
      (Label name
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
forall store (name :: Symbol) (s :: [*]).
StoreInsertC store name =>
Label name
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsert Label name
label)

storeDelete
  :: forall store name s.
     ( StoreDeleteC store name
     )
  => Label name
  -> GetStoreKey store name : Store store : s
     :-> Store store : s
storeDelete :: Label name
-> (GetStoreKey store name : Store store : s) :-> (Store store : s)
storeDelete _ =
  forall a (s :: [*]).
(KnownNat (MSCtorIdx (GetStore name store)), NicePackedValue a) =>
(a : s) :-> (ByteString : s)
forall (idx :: CtorIdx) a (s :: [*]).
(KnownNat idx, NicePackedValue a) =>
(a : s) :-> (ByteString : s)
packKey @(MSCtorIdx (GetStore name store)) ((GetStoreKey store name : Store store : s)
 :-> (ByteString : Store store : s))
-> ((ByteString : Store store : s)
    :-> (ByteString & (Maybe store & (Store store : s))))
-> (GetStoreKey store name : Store store : s)
   :-> (ByteString & (Maybe store & (Store store : s)))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  ((Store store : s) :-> (Maybe store & (Store store : s)))
-> (ByteString : Store store : s)
   :-> (ByteString & (Maybe store & (Store store : s)))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip (forall (s :: [*]). KnownValue store => s :-> (Maybe store & s)
forall a (s :: [*]). KnownValue a => s :-> (Maybe a & s)
none @store) ((GetStoreKey store name : Store store : s)
 :-> (ByteString & (Maybe store & (Store store : s))))
-> ((ByteString & (Maybe store & (Store store : s)))
    :-> (Store store : s))
-> (GetStoreKey store name : Store store : s) :-> (Store store : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  Instr
  (ToTs (ByteString & (Maybe store & (Store store : s))))
  (ToTs (Store store : s))
-> (ByteString & (Maybe store & (Store store : s)))
   :-> (Store store : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr
  (ToTs (ByteString & (Maybe store & (Store store : s))))
  (ToTs (Store store : s))
forall (c :: T) (s :: [T]).
UpdOp c =>
Instr (UpdOpKey c : UpdOpParams c : c : s) (c : s)
UPDATE

type StoreDeleteC store name =
  ( StoreOpC store name
  , KnownValue store
  )

-- | This constraint can be used if a function needs to work with
-- /big/ store, but needs to know only about some part(s) of it.
--
-- It can use all Store operations for a particular name, key and
-- value without knowing whole template.
type HasStore name key value store =
   ( StoreGetC store name
   , StoreInsertC store name
   , StoreDeleteC store name
   , GetStoreKey store name ~ key
   , GetStoreValue store name ~ value
   , StorePieceC store name key value
   )

-- | Write down all sensisble constraints which given @store@ satisfies
-- and apply them to @constrained@.
--
-- This store should have '|->' datatype in its immediate fields,
-- no deep inspection is performed.
type HasStoreForAllIn store constrained =
  GForAllHasStore constrained (G.Rep store)

type family GForAllHasStore (store :: Kind.Type) (x :: Kind.Type -> Kind.Type)
            :: Constraint where
  GForAllHasStore store (G.D1 _ x) = GForAllHasStore store x
  GForAllHasStore store (x :+: y) = ( GForAllHasStore store x
                                    , GForAllHasStore store y )
  GForAllHasStore store (G.C1 ('G.MetaCons ctorName _ _)
                          (G.S1 _ (G.Rec0 (key |-> value)))) =
    HasStore (CtorNameToLabel ctorName) key value store
  GForAllHasStore _ (G.C1 _ _) = ()
  GForAllHasStore _ G.V1 = ()

-- Instances
----------------------------------------------------------------------------

instance ( StoreMemC store name, StoreGetC store name
         , StoreUpdateC store name
         , key ~ GetStoreKey store name, value ~ GetStoreValue store name
         ) =>
         StoreHasSubmap (Store store) name key value where
  storeSubmapOps :: StoreSubmapOps (Store store) name key value
storeSubmapOps = $WStoreSubmapOps :: forall store (mname :: Symbol) key value.
(forall (s :: [*]).
 Label mname -> (key : store : s) :-> (Bool : s))
-> (forall (s :: [*]).
    KnownValue value =>
    Label mname -> (key : store : s) :-> (Maybe value : s))
-> (forall (s :: [*]).
    Label mname -> (key : Maybe value : store : s) :-> (store : s))
-> (forall (s :: [*]).
    Maybe (Label mname -> (key : store : s) :-> (store : s)))
-> (forall (s :: [*]).
    Maybe (Label mname -> (key : value : store : s) :-> (store : s)))
-> StoreSubmapOps store mname key value
StoreSubmapOps
    { sopMem :: forall (s :: [*]).
Label name -> (key : Store store : s) :-> (Bool : s)
sopMem = forall (s :: [*]).
Label name -> (key : Store store : s) :-> (Bool : s)
forall store (name :: Symbol) (s :: [*]).
StoreMemC store name =>
Label name
-> (GetStoreKey store name : Store store : s) :-> (Bool : s)
storeMem
    , sopGet :: forall (s :: [*]).
KnownValue value =>
Label name -> (key : Store store : s) :-> (Maybe value : s)
sopGet = forall (s :: [*]).
KnownValue value =>
Label name -> (key : Store store : s) :-> (Maybe value : s)
forall store (name :: Symbol) (s :: [*]).
StoreGetC store name =>
Label name
-> (GetStoreKey store name : Store store : s)
   :-> (Maybe (GetStoreValue store name) : s)
storeGet
    , sopUpdate :: forall (s :: [*]).
Label name
-> (key : Maybe value : Store store : s) :-> (Store store : s)
sopUpdate = forall (s :: [*]).
Label name
-> (key : Maybe value : Store store : s) :-> (Store store : s)
forall store (name :: Symbol) (s :: [*]).
StoreUpdateC store name =>
Label name
-> (GetStoreKey store name
      : Maybe (GetStoreValue store name) : Store store : s)
   :-> (Store store : s)
storeUpdate
    , sopDelete :: forall (s :: [*]).
Maybe (Label name -> (key : Store store : s) :-> (Store store : s))
sopDelete = (Label name -> (key : Store store : s) :-> (Store store : s))
-> Maybe
     (Label name -> (key : Store store : s) :-> (Store store : s))
forall a. a -> Maybe a
Just Label name -> (key : Store store : s) :-> (Store store : s)
forall store (name :: Symbol) (s :: [*]).
StoreDeleteC store name =>
Label name
-> (GetStoreKey store name : Store store : s) :-> (Store store : s)
storeDelete
    , sopInsert :: forall (s :: [*]).
Maybe
  (Label name
   -> (key : value : Store store : s) :-> (Store store : s))
sopInsert = (Label name
 -> (key : value : Store store : s) :-> (Store store : s))
-> Maybe
     (Label name
      -> (key : value : Store store : s) :-> (Store store : s))
forall a. a -> Maybe a
Just Label name -> (key : value : Store store : s) :-> (Store store : s)
forall store (name :: Symbol) (s :: [*]).
StoreInsertC store name =>
Label name
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsert
    }

-- Examples
----------------------------------------------------------------------------

data MyStoreTemplate
  = IntsStore (Integer |-> ())
  | BytesStore (ByteString |-> ByteString)
  deriving stock (forall x. MyStoreTemplate -> Rep MyStoreTemplate x)
-> (forall x. Rep MyStoreTemplate x -> MyStoreTemplate)
-> Generic MyStoreTemplate
forall x. Rep MyStoreTemplate x -> MyStoreTemplate
forall x. MyStoreTemplate -> Rep MyStoreTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MyStoreTemplate x -> MyStoreTemplate
$cfrom :: forall x. MyStoreTemplate -> Rep MyStoreTemplate x
Generic
  deriving anyclass WellTypedToT MyStoreTemplate
WellTypedToT MyStoreTemplate =>
(MyStoreTemplate -> Value (ToT MyStoreTemplate))
-> (Value (ToT MyStoreTemplate) -> MyStoreTemplate)
-> IsoValue MyStoreTemplate
Value (ToT MyStoreTemplate) -> MyStoreTemplate
MyStoreTemplate -> Value (ToT MyStoreTemplate)
forall a.
WellTypedToT a =>
(a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
fromVal :: Value (ToT MyStoreTemplate) -> MyStoreTemplate
$cfromVal :: Value (ToT MyStoreTemplate) -> MyStoreTemplate
toVal :: MyStoreTemplate -> Value (ToT MyStoreTemplate)
$ctoVal :: MyStoreTemplate -> Value (ToT MyStoreTemplate)
$cp1IsoValue :: WellTypedToT MyStoreTemplate
IsoValue

type MyStore = Store MyStoreTemplate

_sample1 :: Integer : MyStore : s :-> MyStore : s
_sample1 :: (Integer : MyStore : s) :-> (MyStore : s)
_sample1 = Label "cIntsStore"
-> (GetStoreKey MyStoreTemplate "cIntsStore" : MyStore : s)
   :-> (MyStore : s)
forall store (name :: Symbol) (s :: [*]).
StoreDeleteC store name =>
Label name
-> (GetStoreKey store name : Store store : s) :-> (Store store : s)
storeDelete @MyStoreTemplate IsLabel "cIntsStore" (Label "cIntsStore")
Label "cIntsStore"
#cIntsStore

_sample2 :: ByteString : ByteString : MyStore : s :-> MyStore : s
_sample2 :: (ByteString : ByteString : MyStore : s) :-> (MyStore : s)
_sample2 = Label "cBytesStore"
-> (GetStoreKey MyStoreTemplate "cBytesStore"
      : GetStoreValue MyStoreTemplate "cBytesStore" : MyStore : s)
   :-> (MyStore : s)
forall store (name :: Symbol) (s :: [*]).
StoreInsertC store name =>
Label name
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsert @MyStoreTemplate IsLabel "cBytesStore" (Label "cBytesStore")
Label "cBytesStore"
#cBytesStore

data MyStoreTemplate2
  = BoolsStore (Bool |-> Bool)
  | IntsStore2 (Integer |-> Integer)
  | IntsStore3 (Integer |-> Bool)
  deriving stock (forall x. MyStoreTemplate2 -> Rep MyStoreTemplate2 x)
-> (forall x. Rep MyStoreTemplate2 x -> MyStoreTemplate2)
-> Generic MyStoreTemplate2
forall x. Rep MyStoreTemplate2 x -> MyStoreTemplate2
forall x. MyStoreTemplate2 -> Rep MyStoreTemplate2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MyStoreTemplate2 x -> MyStoreTemplate2
$cfrom :: forall x. MyStoreTemplate2 -> Rep MyStoreTemplate2 x
Generic
  deriving anyclass WellTypedToT MyStoreTemplate2
WellTypedToT MyStoreTemplate2 =>
(MyStoreTemplate2 -> Value (ToT MyStoreTemplate2))
-> (Value (ToT MyStoreTemplate2) -> MyStoreTemplate2)
-> IsoValue MyStoreTemplate2
Value (ToT MyStoreTemplate2) -> MyStoreTemplate2
MyStoreTemplate2 -> Value (ToT MyStoreTemplate2)
forall a.
WellTypedToT a =>
(a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
fromVal :: Value (ToT MyStoreTemplate2) -> MyStoreTemplate2
$cfromVal :: Value (ToT MyStoreTemplate2) -> MyStoreTemplate2
toVal :: MyStoreTemplate2 -> Value (ToT MyStoreTemplate2)
$ctoVal :: MyStoreTemplate2 -> Value (ToT MyStoreTemplate2)
$cp1IsoValue :: WellTypedToT MyStoreTemplate2
IsoValue

-- You must derive 'Generic' instance for all custom types, even
-- newtypes.
newtype MyNatural = MyNatural Natural
  deriving stock (forall x. MyNatural -> Rep MyNatural x)
-> (forall x. Rep MyNatural x -> MyNatural) -> Generic MyNatural
forall x. Rep MyNatural x -> MyNatural
forall x. MyNatural -> Rep MyNatural x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MyNatural x -> MyNatural
$cfrom :: forall x. MyNatural -> Rep MyNatural x
Generic
  deriving newtype (WellTypedToT MyNatural
WellTypedToT MyNatural =>
(MyNatural -> Value (ToT MyNatural))
-> (Value (ToT MyNatural) -> MyNatural) -> IsoValue MyNatural
Value (ToT MyNatural) -> MyNatural
MyNatural -> Value (ToT MyNatural)
forall a.
WellTypedToT a =>
(a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
fromVal :: Value (ToT MyNatural) -> MyNatural
$cfromVal :: Value (ToT MyNatural) -> MyNatural
toVal :: MyNatural -> Value (ToT MyNatural)
$ctoVal :: MyNatural -> Value (ToT MyNatural)
$cp1IsoValue :: WellTypedToT MyNatural
IsoValue)

data MyStoreTemplate3 = MyStoreTemplate3 (Natural |-> MyNatural)
  deriving stock (forall x. MyStoreTemplate3 -> Rep MyStoreTemplate3 x)
-> (forall x. Rep MyStoreTemplate3 x -> MyStoreTemplate3)
-> Generic MyStoreTemplate3
forall x. Rep MyStoreTemplate3 x -> MyStoreTemplate3
forall x. MyStoreTemplate3 -> Rep MyStoreTemplate3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MyStoreTemplate3 x -> MyStoreTemplate3
$cfrom :: forall x. MyStoreTemplate3 -> Rep MyStoreTemplate3 x
Generic
  deriving anyclass WellTypedToT MyStoreTemplate3
WellTypedToT MyStoreTemplate3 =>
(MyStoreTemplate3 -> Value (ToT MyStoreTemplate3))
-> (Value (ToT MyStoreTemplate3) -> MyStoreTemplate3)
-> IsoValue MyStoreTemplate3
Value (ToT MyStoreTemplate3) -> MyStoreTemplate3
MyStoreTemplate3 -> Value (ToT MyStoreTemplate3)
forall a.
WellTypedToT a =>
(a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
fromVal :: Value (ToT MyStoreTemplate3) -> MyStoreTemplate3
$cfromVal :: Value (ToT MyStoreTemplate3) -> MyStoreTemplate3
toVal :: MyStoreTemplate3 -> Value (ToT MyStoreTemplate3)
$ctoVal :: MyStoreTemplate3 -> Value (ToT MyStoreTemplate3)
$cp1IsoValue :: WellTypedToT MyStoreTemplate3
IsoValue

data MyStoreTemplateBig
  = BigTemplatePart1 MyStoreTemplate
  | BigTemplatePart2 MyStoreTemplate2
  | BigTemplatePart3 MyStoreTemplate3
  deriving stock (forall x. MyStoreTemplateBig -> Rep MyStoreTemplateBig x)
-> (forall x. Rep MyStoreTemplateBig x -> MyStoreTemplateBig)
-> Generic MyStoreTemplateBig
forall x. Rep MyStoreTemplateBig x -> MyStoreTemplateBig
forall x. MyStoreTemplateBig -> Rep MyStoreTemplateBig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MyStoreTemplateBig x -> MyStoreTemplateBig
$cfrom :: forall x. MyStoreTemplateBig -> Rep MyStoreTemplateBig x
Generic
  deriving anyclass WellTypedToT MyStoreTemplateBig
WellTypedToT MyStoreTemplateBig =>
(MyStoreTemplateBig -> Value (ToT MyStoreTemplateBig))
-> (Value (ToT MyStoreTemplateBig) -> MyStoreTemplateBig)
-> IsoValue MyStoreTemplateBig
Value (ToT MyStoreTemplateBig) -> MyStoreTemplateBig
MyStoreTemplateBig -> Value (ToT MyStoreTemplateBig)
forall a.
WellTypedToT a =>
(a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
fromVal :: Value (ToT MyStoreTemplateBig) -> MyStoreTemplateBig
$cfromVal :: Value (ToT MyStoreTemplateBig) -> MyStoreTemplateBig
toVal :: MyStoreTemplateBig -> Value (ToT MyStoreTemplateBig)
$ctoVal :: MyStoreTemplateBig -> Value (ToT MyStoreTemplateBig)
$cp1IsoValue :: WellTypedToT MyStoreTemplateBig
IsoValue

_MyStoreTemplateBigTextsStore ::
  GetStore "cBytesStore" MyStoreTemplateBig :~: 'MapSignature ByteString ByteString 1
_MyStoreTemplateBigTextsStore :: GetStore "cBytesStore" MyStoreTemplateBig
:~: 'MapSignature ByteString ByteString 1
_MyStoreTemplateBigTextsStore = GetStore "cBytesStore" MyStoreTemplateBig
:~: 'MapSignature ByteString ByteString 1
forall k (a :: k). a :~: a
Refl

_MyStoreTemplateBigBoolsStore ::
  GetStore "cBoolsStore" MyStoreTemplateBig :~: 'MapSignature Bool Bool 2
_MyStoreTemplateBigBoolsStore :: GetStore "cBoolsStore" MyStoreTemplateBig
:~: 'MapSignature Bool Bool 2
_MyStoreTemplateBigBoolsStore = GetStore "cBoolsStore" MyStoreTemplateBig
:~: 'MapSignature Bool Bool 2
forall k (a :: k). a :~: a
Refl

_MyStoreTemplateBigMyStoreTemplate3 ::
  GetStore "cMyStoreTemplate3" MyStoreTemplateBig :~: 'MapSignature Natural MyNatural 5
_MyStoreTemplateBigMyStoreTemplate3 :: GetStore "cMyStoreTemplate3" MyStoreTemplateBig
:~: 'MapSignature Natural MyNatural 5
_MyStoreTemplateBigMyStoreTemplate3 = GetStore "cMyStoreTemplate3" MyStoreTemplateBig
:~: 'MapSignature Natural MyNatural 5
forall k (a :: k). a :~: a
Refl

_MyStoreBigHasAllStores
  :: HasStoreForAllIn MyStoreTemplate store
  => Dict ( HasStore "cIntsStore" Integer () store
          , HasStore "cBytesStore" ByteString ByteString store
          )
_MyStoreBigHasAllStores :: Dict
  (HasStore "cIntsStore" Integer () store,
   HasStore "cBytesStore" ByteString ByteString store)
_MyStoreBigHasAllStores = Dict
  (HasStore "cIntsStore" Integer () store,
   HasStore "cBytesStore" ByteString ByteString store)
forall (a :: Constraint). a => Dict a
Dict

type MyStoreBig = Store MyStoreTemplateBig

_sample3 :: Integer : MyStoreBig : s :-> MyStoreBig : s
_sample3 :: (Integer : MyStoreBig : s) :-> (MyStoreBig : s)
_sample3 = Label "cIntsStore2"
-> (GetStoreKey MyStoreTemplateBig "cIntsStore2" : MyStoreBig : s)
   :-> (MyStoreBig : s)
forall store (name :: Symbol) (s :: [*]).
StoreDeleteC store name =>
Label name
-> (GetStoreKey store name : Store store : s) :-> (Store store : s)
storeDelete @MyStoreTemplateBig IsLabel "cIntsStore2" (Label "cIntsStore2")
Label "cIntsStore2"
#cIntsStore2

_sample4 :: ByteString : MyStoreBig : s :-> Bool : s
_sample4 :: (ByteString : MyStoreBig : s) :-> (Bool : s)
_sample4 = Label "cBytesStore"
-> (GetStoreKey MyStoreTemplateBig "cBytesStore" : MyStoreBig : s)
   :-> (Bool : s)
forall store (name :: Symbol) (s :: [*]).
StoreMemC store name =>
Label name
-> (GetStoreKey store name : Store store : s) :-> (Bool : s)
storeMem @MyStoreTemplateBig IsLabel "cBytesStore" (Label "cBytesStore")
Label "cBytesStore"
#cBytesStore

_sample5 :: Natural : MyNatural : MyStoreBig : s :-> MyStoreBig : s
_sample5 :: (Natural : MyNatural : MyStoreBig : s) :-> (MyStoreBig : s)
_sample5 = Label "cMyStoreTemplate3"
-> (GetStoreKey MyStoreTemplateBig "cMyStoreTemplate3"
      : GetStoreValue MyStoreTemplateBig "cMyStoreTemplate3" : MyStoreBig
      : s)
   :-> (MyStoreBig : s)
forall store (name :: Symbol) (s :: [*]).
StoreInsertC store name =>
Label name
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsert @MyStoreTemplateBig IsLabel "cMyStoreTemplate3" (Label "cMyStoreTemplate3")
Label "cMyStoreTemplate3"
#cMyStoreTemplate3

-- Example of 'HasStoreForAllIn' use.
-- This function will work with any @store@ which has 'MyStoreTemplate3' inside.
_sample6
  :: forall store s.
      HasStoreForAllIn MyStoreTemplate3 store
  => Natural : MyNatural : Store store : s :-> Store store : s
_sample6 :: (Natural : MyNatural : Store store : s) :-> (Store store : s)
_sample6 = Label "cMyStoreTemplate3"
-> (GetStoreKey store "cMyStoreTemplate3"
      : GetStoreValue store "cMyStoreTemplate3" : Store store : s)
   :-> (Store store : s)
forall store (name :: Symbol) (s :: [*]).
StoreInsertC store name =>
Label name
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsert @store IsLabel "cMyStoreTemplate3" (Label "cMyStoreTemplate3")
Label "cMyStoreTemplate3"
#cMyStoreTemplate3

-- For instance, 'sample6' works for 'MyStoreBig'.
_sample6' :: Natural : MyNatural : MyStoreBig : s :-> MyStoreBig : s
_sample6' :: (Natural : MyNatural : MyStoreBig : s) :-> (MyStoreBig : s)
_sample6' = (Natural : MyNatural : MyStoreBig : s) :-> (MyStoreBig : s)
forall store (s :: [*]).
HasStoreForAllIn MyStoreTemplate3 store =>
(Natural : MyNatural : Store store : s) :-> (Store store : s)
_sample6

----------------------------------------------------------------------------
-- Storage skeleton
----------------------------------------------------------------------------

-- | Contract storage with @big_map@.
--
-- Due to Michelson constraints it is the only possible layout containing
-- @big_map@.
data StorageSkeleton storeTemplate other = StorageSkeleton
  { StorageSkeleton storeTemplate other -> Store storeTemplate
sMap :: Store storeTemplate
  , StorageSkeleton storeTemplate other -> other
sFields :: other
  } deriving stock (StorageSkeleton storeTemplate other
-> StorageSkeleton storeTemplate other -> Bool
(StorageSkeleton storeTemplate other
 -> StorageSkeleton storeTemplate other -> Bool)
-> (StorageSkeleton storeTemplate other
    -> StorageSkeleton storeTemplate other -> Bool)
-> Eq (StorageSkeleton storeTemplate other)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall storeTemplate other.
(Eq storeTemplate, Eq other) =>
StorageSkeleton storeTemplate other
-> StorageSkeleton storeTemplate other -> Bool
/= :: StorageSkeleton storeTemplate other
-> StorageSkeleton storeTemplate other -> Bool
$c/= :: forall storeTemplate other.
(Eq storeTemplate, Eq other) =>
StorageSkeleton storeTemplate other
-> StorageSkeleton storeTemplate other -> Bool
== :: StorageSkeleton storeTemplate other
-> StorageSkeleton storeTemplate other -> Bool
$c== :: forall storeTemplate other.
(Eq storeTemplate, Eq other) =>
StorageSkeleton storeTemplate other
-> StorageSkeleton storeTemplate other -> Bool
Eq, Int -> StorageSkeleton storeTemplate other -> ShowS
[StorageSkeleton storeTemplate other] -> ShowS
StorageSkeleton storeTemplate other -> String
(Int -> StorageSkeleton storeTemplate other -> ShowS)
-> (StorageSkeleton storeTemplate other -> String)
-> ([StorageSkeleton storeTemplate other] -> ShowS)
-> Show (StorageSkeleton storeTemplate other)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall storeTemplate other.
(Show storeTemplate, Show other) =>
Int -> StorageSkeleton storeTemplate other -> ShowS
forall storeTemplate other.
(Show storeTemplate, Show other) =>
[StorageSkeleton storeTemplate other] -> ShowS
forall storeTemplate other.
(Show storeTemplate, Show other) =>
StorageSkeleton storeTemplate other -> String
showList :: [StorageSkeleton storeTemplate other] -> ShowS
$cshowList :: forall storeTemplate other.
(Show storeTemplate, Show other) =>
[StorageSkeleton storeTemplate other] -> ShowS
show :: StorageSkeleton storeTemplate other -> String
$cshow :: forall storeTemplate other.
(Show storeTemplate, Show other) =>
StorageSkeleton storeTemplate other -> String
showsPrec :: Int -> StorageSkeleton storeTemplate other -> ShowS
$cshowsPrec :: forall storeTemplate other.
(Show storeTemplate, Show other) =>
Int -> StorageSkeleton storeTemplate other -> ShowS
Show, (forall x.
 StorageSkeleton storeTemplate other
 -> Rep (StorageSkeleton storeTemplate other) x)
-> (forall x.
    Rep (StorageSkeleton storeTemplate other) x
    -> StorageSkeleton storeTemplate other)
-> Generic (StorageSkeleton storeTemplate other)
forall x.
Rep (StorageSkeleton storeTemplate other) x
-> StorageSkeleton storeTemplate other
forall x.
StorageSkeleton storeTemplate other
-> Rep (StorageSkeleton storeTemplate other) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall storeTemplate other x.
Rep (StorageSkeleton storeTemplate other) x
-> StorageSkeleton storeTemplate other
forall storeTemplate other x.
StorageSkeleton storeTemplate other
-> Rep (StorageSkeleton storeTemplate other) x
$cto :: forall storeTemplate other x.
Rep (StorageSkeleton storeTemplate other) x
-> StorageSkeleton storeTemplate other
$cfrom :: forall storeTemplate other x.
StorageSkeleton storeTemplate other
-> Rep (StorageSkeleton storeTemplate other) x
Generic)
    deriving anyclass StorageSkeleton storeTemplate other
StorageSkeleton storeTemplate other
-> Default (StorageSkeleton storeTemplate other)
forall a. a -> Default a
forall storeTemplate other.
Default other =>
StorageSkeleton storeTemplate other
def :: StorageSkeleton storeTemplate other
$cdef :: forall storeTemplate other.
Default other =>
StorageSkeleton storeTemplate other
Default

deriving anyclass instance (WellTypedIsoValue st, WellTypedIsoValue o) => IsoValue (StorageSkeleton st o)

-- | Unpack 'StorageSkeleton' into a pair.
storageUnpack :: StorageSkeleton store fields : s :-> (Store store, fields) : s
storageUnpack :: (StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
storageUnpack = (StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a & s) :-> (b & s)
forcedCoerce_

-- | Pack a pair into 'StorageSkeleton'.
storagePack :: (Store store, fields) : s :-> StorageSkeleton store fields : s
storagePack :: ((Store store, fields) : s) :-> (StorageSkeleton store fields : s)
storagePack = ((Store store, fields) : s) :-> (StorageSkeleton store fields : s)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a & s) :-> (b & s)
forcedCoerce_

storageMem
  :: forall store name fields s.
     (StoreMemC store name)
  => Label name
  -> GetStoreKey store name : StorageSkeleton store fields : s :-> Bool : s
storageMem :: Label name
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (Bool : s)
storageMem label :: Label name
label = ((StorageSkeleton store fields : s) :-> (Store store & s))
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (GetStoreKey store name & (Store store & s))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
forall store fields (s :: [*]).
(StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
storageUnpack ((StorageSkeleton store fields : s)
 :-> ((Store store, fields) : s))
-> (((Store store, fields) : s) :-> (Store store & s))
-> (StorageSkeleton store fields : s) :-> (Store store & s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) : s) :-> (Store store & s)
forall a b (s :: [*]). ((a, b) & s) :-> (a & s)
car) ((GetStoreKey store name : StorageSkeleton store fields : s)
 :-> (GetStoreKey store name & (Store store & s)))
-> ((GetStoreKey store name & (Store store & s)) :-> (Bool : s))
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (Bool : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label name
-> (GetStoreKey store name & (Store store & s)) :-> (Bool : s)
forall store (name :: Symbol) (s :: [*]).
StoreMemC store name =>
Label name
-> (GetStoreKey store name : Store store : s) :-> (Bool : s)
storeMem Label name
label

storageGet
  :: forall store name fields s.
     StoreGetC store name
  => Label name
  -> GetStoreKey store name : StorageSkeleton store fields : s
       :-> Maybe (GetStoreValue store name) : s
storageGet :: Label name
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (Maybe (GetStoreValue store name) : s)
storageGet label :: Label name
label = ((StorageSkeleton store fields : s) :-> (Store store & s))
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (GetStoreKey store name & (Store store & s))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
forall store fields (s :: [*]).
(StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
storageUnpack ((StorageSkeleton store fields : s)
 :-> ((Store store, fields) : s))
-> (((Store store, fields) : s) :-> (Store store & s))
-> (StorageSkeleton store fields : s) :-> (Store store & s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) : s) :-> (Store store & s)
forall a b (s :: [*]). ((a, b) & s) :-> (a & s)
car) ((GetStoreKey store name : StorageSkeleton store fields : s)
 :-> (GetStoreKey store name & (Store store & s)))
-> ((GetStoreKey store name & (Store store & s))
    :-> (Maybe (GetStoreValue store name) : s))
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (Maybe (GetStoreValue store name) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label name
-> (GetStoreKey store name & (Store store & s))
   :-> (Maybe (GetStoreValue store name) : s)
forall store (name :: Symbol) (s :: [*]).
StoreGetC store name =>
Label name
-> (GetStoreKey store name : Store store : s)
   :-> (Maybe (GetStoreValue store name) : s)
storeGet Label name
label

storageInsert
  :: forall store name fields s.
     StoreInsertC store name
  => Label name
  -> GetStoreKey store name
      : GetStoreValue store name
      : StorageSkeleton store fields
      : s
  :-> StorageSkeleton store fields : s
storageInsert :: Label name
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (StorageSkeleton store fields : s)
storageInsert label :: Label name
label =
  ((GetStoreValue store name : StorageSkeleton store fields : s)
 :-> (GetStoreValue store name & (Store store & (fields & s))))
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (GetStoreKey store name
        & (GetStoreValue store name & (Store store & (fields & s))))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip (((StorageSkeleton store fields : s)
 :-> (Store store & (fields & s)))
-> (GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (GetStoreValue store name & (Store store & (fields & s)))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
forall store fields (s :: [*]).
(StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
storageUnpack ((StorageSkeleton store fields : s)
 :-> ((Store store, fields) : s))
-> (((Store store, fields) : s)
    :-> ((Store store, fields) & ((Store store, fields) : s)))
-> (StorageSkeleton store fields : s)
   :-> ((Store store, fields) & ((Store store, fields) : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) : s)
:-> ((Store store, fields) & ((Store store, fields) : s))
forall a (s :: [*]). (a & s) :-> (a & (a & s))
dup ((StorageSkeleton store fields : s)
 :-> ((Store store, fields) & ((Store store, fields) : s)))
-> (((Store store, fields) & ((Store store, fields) : s))
    :-> (Store store & ((Store store, fields) : s)))
-> (StorageSkeleton store fields : s)
   :-> (Store store & ((Store store, fields) : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) & ((Store store, fields) : s))
:-> (Store store & ((Store store, fields) : s))
forall a b (s :: [*]). ((a, b) & s) :-> (a & s)
car ((StorageSkeleton store fields : s)
 :-> (Store store & ((Store store, fields) : s)))
-> ((Store store & ((Store store, fields) : s))
    :-> (Store store & (fields & s)))
-> (StorageSkeleton store fields : s)
   :-> (Store store & (fields & s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (((Store store, fields) : s) :-> (fields & s))
-> (Store store & ((Store store, fields) : s))
   :-> (Store store & (fields & s))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((Store store, fields) : s) :-> (fields & s)
forall a b (s :: [*]). ((a, b) & s) :-> (b & s)
cdr)) ((GetStoreKey store name
    : GetStoreValue store name : StorageSkeleton store fields : s)
 :-> (GetStoreKey store name
      & (GetStoreValue store name & (Store store & (fields & s)))))
-> ((GetStoreKey store name
     & (GetStoreValue store name & (Store store & (fields & s))))
    :-> (Store store & (fields & s)))
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (Store store & (fields & s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  Label name
-> (GetStoreKey store name
    & (GetStoreValue store name & (Store store & (fields & s))))
   :-> (Store store & (fields & s))
forall store (name :: Symbol) (s :: [*]).
StoreInsertC store name =>
Label name
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsert Label name
label ((GetStoreKey store name
    : GetStoreValue store name : StorageSkeleton store fields : s)
 :-> (Store store & (fields & s)))
-> ((Store store & (fields & s)) :-> ((Store store, fields) : s))
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> ((Store store, fields) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  (Store store & (fields & s)) :-> ((Store store, fields) : s)
forall a b (s :: [*]). (a & (b & s)) :-> ((a, b) & s)
pair ((GetStoreKey store name
    : GetStoreValue store name : StorageSkeleton store fields : s)
 :-> ((Store store, fields) : s))
-> (((Store store, fields) : s)
    :-> (StorageSkeleton store fields : s))
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (StorageSkeleton store fields : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) : s) :-> (StorageSkeleton store fields : s)
forall store fields (s :: [*]).
((Store store, fields) : s) :-> (StorageSkeleton store fields : s)
storagePack

-- | Insert a key-value pair, but fail if it will overwrite some existing entry.
storageInsertNew
  :: forall store name fields s.
     StoreInsertC store name
  => Label name
  -> (forall s0 any. GetStoreKey store name : s0 :-> any)
  -> GetStoreKey store name
      : GetStoreValue store name
      : StorageSkeleton store fields
      : s
  :-> StorageSkeleton store fields : s
storageInsertNew :: Label name
-> (forall (s0 :: [*]) (any :: [*]).
    (GetStoreKey store name : s0) :-> any)
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (StorageSkeleton store fields : s)
storageInsertNew label :: Label name
label doFail :: forall (s0 :: [*]) (any :: [*]).
(GetStoreKey store name : s0) :-> any
doFail =
  ((GetStoreValue store name : StorageSkeleton store fields : s)
 :-> (GetStoreValue store name & (Store store & (fields & s))))
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (GetStoreKey store name
        & (GetStoreValue store name & (Store store & (fields & s))))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip (((StorageSkeleton store fields : s)
 :-> (Store store & (fields & s)))
-> (GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (GetStoreValue store name & (Store store & (fields & s)))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
forall store fields (s :: [*]).
(StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
storageUnpack ((StorageSkeleton store fields : s)
 :-> ((Store store, fields) : s))
-> (((Store store, fields) : s)
    :-> ((Store store, fields) & ((Store store, fields) : s)))
-> (StorageSkeleton store fields : s)
   :-> ((Store store, fields) & ((Store store, fields) : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) : s)
:-> ((Store store, fields) & ((Store store, fields) : s))
forall a (s :: [*]). (a & s) :-> (a & (a & s))
dup ((StorageSkeleton store fields : s)
 :-> ((Store store, fields) & ((Store store, fields) : s)))
-> (((Store store, fields) & ((Store store, fields) : s))
    :-> (Store store & ((Store store, fields) : s)))
-> (StorageSkeleton store fields : s)
   :-> (Store store & ((Store store, fields) : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) & ((Store store, fields) : s))
:-> (Store store & ((Store store, fields) : s))
forall a b (s :: [*]). ((a, b) & s) :-> (a & s)
car ((StorageSkeleton store fields : s)
 :-> (Store store & ((Store store, fields) : s)))
-> ((Store store & ((Store store, fields) : s))
    :-> (Store store & (fields & s)))
-> (StorageSkeleton store fields : s)
   :-> (Store store & (fields & s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (((Store store, fields) : s) :-> (fields & s))
-> (Store store & ((Store store, fields) : s))
   :-> (Store store & (fields & s))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((Store store, fields) : s) :-> (fields & s)
forall a b (s :: [*]). ((a, b) & s) :-> (b & s)
cdr)) ((GetStoreKey store name
    : GetStoreValue store name : StorageSkeleton store fields : s)
 :-> (GetStoreKey store name
      & (GetStoreValue store name & (Store store & (fields & s)))))
-> ((GetStoreKey store name
     & (GetStoreValue store name & (Store store & (fields & s))))
    :-> (Store store & (fields & s)))
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (Store store & (fields & s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  Label name
-> (forall (s0 :: [*]) (any :: [*]).
    (GetStoreKey store name : s0) :-> any)
-> (GetStoreKey store name
    & (GetStoreValue store name & (Store store & (fields & s))))
   :-> (Store store & (fields & s))
forall store (name :: Symbol) (s :: [*]).
StoreInsertC store name =>
Label name
-> (forall (s0 :: [*]) (any :: [*]).
    (GetStoreKey store name : s0) :-> any)
-> (GetStoreKey store name
      : GetStoreValue store name : Store store : s)
   :-> (Store store : s)
storeInsertNew Label name
label forall (s0 :: [*]) (any :: [*]).
(GetStoreKey store name : s0) :-> any
doFail ((GetStoreKey store name
    : GetStoreValue store name : StorageSkeleton store fields : s)
 :-> (Store store & (fields & s)))
-> ((Store store & (fields & s)) :-> ((Store store, fields) : s))
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> ((Store store, fields) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  (Store store & (fields & s)) :-> ((Store store, fields) : s)
forall a b (s :: [*]). (a & (b & s)) :-> ((a, b) & s)
pair ((GetStoreKey store name
    : GetStoreValue store name : StorageSkeleton store fields : s)
 :-> ((Store store, fields) : s))
-> (((Store store, fields) : s)
    :-> (StorageSkeleton store fields : s))
-> (GetStoreKey store name
      : GetStoreValue store name : StorageSkeleton store fields : s)
   :-> (StorageSkeleton store fields : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) : s) :-> (StorageSkeleton store fields : s)
forall store fields (s :: [*]).
((Store store, fields) : s) :-> (StorageSkeleton store fields : s)
storagePack

storageDelete
  :: forall store name fields s.
     ( StoreDeleteC store name
     )
  => Label name
  -> GetStoreKey store name : StorageSkeleton store fields : s
     :-> StorageSkeleton store fields : s
storageDelete :: Label name
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (StorageSkeleton store fields : s)
storageDelete label :: Label name
label =
  ((StorageSkeleton store fields : s)
 :-> (Store store & (fields & s)))
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (GetStoreKey store name & (Store store & (fields & s)))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
forall store fields (s :: [*]).
(StorageSkeleton store fields : s) :-> ((Store store, fields) : s)
storageUnpack ((StorageSkeleton store fields : s)
 :-> ((Store store, fields) : s))
-> (((Store store, fields) : s)
    :-> ((Store store, fields) & ((Store store, fields) : s)))
-> (StorageSkeleton store fields : s)
   :-> ((Store store, fields) & ((Store store, fields) : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) : s)
:-> ((Store store, fields) & ((Store store, fields) : s))
forall a (s :: [*]). (a & s) :-> (a & (a & s))
dup ((StorageSkeleton store fields : s)
 :-> ((Store store, fields) & ((Store store, fields) : s)))
-> (((Store store, fields) & ((Store store, fields) : s))
    :-> (Store store & ((Store store, fields) : s)))
-> (StorageSkeleton store fields : s)
   :-> (Store store & ((Store store, fields) : s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) & ((Store store, fields) : s))
:-> (Store store & ((Store store, fields) : s))
forall a b (s :: [*]). ((a, b) & s) :-> (a & s)
car ((StorageSkeleton store fields : s)
 :-> (Store store & ((Store store, fields) : s)))
-> ((Store store & ((Store store, fields) : s))
    :-> (Store store & (fields & s)))
-> (StorageSkeleton store fields : s)
   :-> (Store store & (fields & s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (((Store store, fields) : s) :-> (fields & s))
-> (Store store & ((Store store, fields) : s))
   :-> (Store store & (fields & s))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
dip ((Store store, fields) : s) :-> (fields & s)
forall a b (s :: [*]). ((a, b) & s) :-> (b & s)
cdr) ((GetStoreKey store name : StorageSkeleton store fields : s)
 :-> (GetStoreKey store name & (Store store & (fields & s))))
-> ((GetStoreKey store name & (Store store & (fields & s)))
    :-> (Store store & (fields & s)))
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (Store store & (fields & s))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  Label name
-> (GetStoreKey store name & (Store store & (fields & s)))
   :-> (Store store & (fields & s))
forall store (name :: Symbol) (s :: [*]).
StoreDeleteC store name =>
Label name
-> (GetStoreKey store name : Store store : s) :-> (Store store : s)
storeDelete Label name
label ((GetStoreKey store name : StorageSkeleton store fields : s)
 :-> (Store store & (fields & s)))
-> ((Store store & (fields & s)) :-> ((Store store, fields) : s))
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> ((Store store, fields) : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  (Store store & (fields & s)) :-> ((Store store, fields) : s)
forall a b (s :: [*]). (a & (b & s)) :-> ((a, b) & s)
pair ((GetStoreKey store name : StorageSkeleton store fields : s)
 :-> ((Store store, fields) : s))
-> (((Store store, fields) : s)
    :-> (StorageSkeleton store fields : s))
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (StorageSkeleton store fields : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Store store, fields) : s) :-> (StorageSkeleton store fields : s)
forall store fields (s :: [*]).
((Store store, fields) : s) :-> (StorageSkeleton store fields : s)
storagePack

-- Instances
----------------------------------------------------------------------------

instance (StoreHasField other fname ftype, IsoValue store, IsoValue other) =>
         StoreHasField (StorageSkeleton store other) fname ftype where
  storeFieldOps :: StoreFieldOps (StorageSkeleton store other) fname ftype
storeFieldOps = Label "sFields"
-> StoreFieldOps (StorageSkeleton store other) fname ftype
forall storage (fieldsPartName :: Symbol) fields (fname :: Symbol)
       ftype.
(HasFieldOfType storage fieldsPartName fields,
 StoreHasField fields fname ftype) =>
Label fieldsPartName -> StoreFieldOps storage fname ftype
storeFieldOpsDeeper IsLabel "sFields" (Label "sFields")
Label "sFields"
#sFields

instance ( StoreMemC store name, StoreGetC store name
         , StoreUpdateC store name
         , key ~ GetStoreKey store name, value ~ GetStoreValue store name
         , IsoValue other
         ) =>
         StoreHasSubmap (StorageSkeleton store other) name key value where
  storeSubmapOps :: StoreSubmapOps (StorageSkeleton store other) name key value
storeSubmapOps = Label "sMap"
-> StoreSubmapOps (StorageSkeleton store other) name key value
forall storage (bigMapPartName :: Symbol) fields (mname :: Symbol)
       key value.
(HasFieldOfType storage bigMapPartName fields,
 StoreHasSubmap fields mname key value) =>
Label bigMapPartName -> StoreSubmapOps storage mname key value
storeSubmapOpsDeeper IsLabel "sMap" (Label "sMap")
Label "sMap"
#sMap

-- Examples
----------------------------------------------------------------------------

type MyStorage = StorageSkeleton MyStoreTemplate (Integer, ByteString)

-- You can access both Store...
_storageSample1 :: Integer : MyStorage : s :-> MyStorage : s
_storageSample1 :: (Integer : MyStorage : s) :-> (MyStorage : s)
_storageSample1 = Label "cIntsStore"
-> (GetStoreKey MyStoreTemplate "cIntsStore" : MyStorage : s)
   :-> (MyStorage : s)
forall store (name :: Symbol) fields (s :: [*]).
StoreDeleteC store name =>
Label name
-> (GetStoreKey store name : StorageSkeleton store fields : s)
   :-> (StorageSkeleton store fields : s)
storageDelete @MyStoreTemplate IsLabel "cIntsStore" (Label "cIntsStore")
Label "cIntsStore"
#cIntsStore

-- and other fields of the storage created with 'StorageSkeleton'.
_storageSample2 :: MyStorage : s :-> Integer : s
_storageSample2 :: (MyStorage : s) :-> (Integer : s)
_storageSample2 = Label "sFields"
-> (MyStorage : s) :-> (GetFieldType MyStorage "sFields" & s)
forall dt (name :: Symbol) (st :: [*]).
InstrGetFieldC dt name =>
Label name -> (dt & st) :-> (GetFieldType dt name & st)
toField IsLabel "sFields" (Label "sFields")
Label "sFields"
#sFields ((MyStorage : s) :-> ((Integer, ByteString) : s))
-> (((Integer, ByteString) : s) :-> (Integer : s))
-> (MyStorage : s) :-> (Integer : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((Integer, ByteString) : s) :-> (Integer : s)
forall a b (s :: [*]). ((a, b) & s) :-> (a & s)
car

----------------------------------------------------------------------------
-- Store construction from Haskell
----------------------------------------------------------------------------

packHsKey
  :: forall ctorIdx key.
     (NicePackedValue key, KnownNat ctorIdx)
  => key -> ByteString
packHsKey :: key -> ByteString
packHsKey key :: key
key =
  (Natural, key) -> ByteString
forall a. NicePackedValue a => a -> ByteString
lPackValue (Proxy ctorIdx -> Natural
forall (n :: CtorIdx) (proxy :: CtorIdx -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy ctorIdx
forall k (t :: k). Proxy t
Proxy @ctorIdx), key
key)

-- | Lift a key-value pair to 'Store'.
--
-- Further you can use 'Monoid' instance of @Store@ to make up large stores.
storePiece
  :: forall name store key value.
     StorePieceC store name key value
  => Label name
  -> key
  -> value
  -> Store store
storePiece :: Label name -> key -> value -> Store store
storePiece label :: Label name
label key :: key
key val :: value
val =
  BigMap ByteString store -> Store store
forall a. BigMap ByteString a -> Store a
Store (BigMap ByteString store -> Store store)
-> (Map ByteString store -> BigMap ByteString store)
-> Map ByteString store
-> Store store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString store -> BigMap ByteString store
forall k v. Map k v -> BigMap k v
BigMap (Map ByteString store -> Store store)
-> Map ByteString store -> Store store
forall a b. (a -> b) -> a -> b
$ OneItem (Map ByteString store) -> Map ByteString store
forall x. One x => OneItem x -> x
one
    ( key -> ByteString
forall (ctorIdx :: CtorIdx) key.
(NicePackedValue key, KnownNat ctorIdx) =>
key -> ByteString
packHsKey @(MSCtorIdx (GetStore name store)) key
key
    , Label name -> ExtractCtorField (GetCtorField store name) -> store
forall dt (name :: Symbol).
InstrWrapC dt name =>
Label name -> ExtractCtorField (GetCtorField dt name) -> dt
hsWrap @store Label name
label (value -> key |-> value
forall k (k :: k) v. v -> k |-> v
BigMapImage value
val)
    )

storeKeyValueList
  :: forall name store key value.
     StorePieceC store name key value
  => Label name
  -> [(key, value)]
  -> Store store
storeKeyValueList :: Label name -> [(key, value)] -> Store store
storeKeyValueList label :: Label name
label keyValues :: [(key, value)]
keyValues =
  BigMap ByteString store -> Store store
forall a. BigMap ByteString a -> Store a
Store (BigMap ByteString store -> Store store)
-> ([(ByteString, store)] -> BigMap ByteString store)
-> [(ByteString, store)]
-> Store store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString store -> BigMap ByteString store
forall k v. Map k v -> BigMap k v
BigMap (Map ByteString store -> BigMap ByteString store)
-> ([(ByteString, store)] -> Map ByteString store)
-> [(ByteString, store)]
-> BigMap ByteString store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, store)] -> Map ByteString store
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByteString, store)] -> Store store)
-> [(ByteString, store)] -> Store store
forall a b. (a -> b) -> a -> b
$
  ((key, value) -> (ByteString, store))
-> [(key, value)] -> [(ByteString, store)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.map (\(key :: key
key, val :: value
val) ->
                 ( key -> ByteString
forall (ctorIdx :: CtorIdx) key.
(NicePackedValue key, KnownNat ctorIdx) =>
key -> ByteString
packHsKey @(MSCtorIdx (GetStore name store)) key
key
                 , Label name -> ExtractCtorField (GetCtorField store name) -> store
forall dt (name :: Symbol).
InstrWrapC dt name =>
Label name -> ExtractCtorField (GetCtorField dt name) -> dt
hsWrap @store Label name
label (value -> key |-> value
forall k (k :: k) v. v -> k |-> v
BigMapImage value
val)
                 )) [(key, value)]
keyValues

type StorePieceC store name key value =
  ( key ~ GetStoreKey store name
  , value ~ GetStoreValue store name
  , NicePackedValue key
  , KnownNat (MSCtorIdx (GetStore name store))
  , InstrWrapC store name, Generic store
  , ExtractCtorField (GetCtorField store name) ~ (key |-> value)
  )

-- | Get a value from store by key.
--
-- It expects map to be consistent, otherwise call to this function fails
-- with error.
storeLookup
  :: forall name store key value ctorIdx.
     ( key ~ GetStoreKey store name
     , value ~ GetStoreValue store name
     , ctorIdx ~ MSCtorIdx (GetStore name store)
     , NicePackedValue key
     , KnownNat ctorIdx
     , InstrUnwrapC store name, Generic store
     , CtorOnlyField name store ~ (key |-> value)
     )
  => Label name
  -> key
  -> Store store
  -> Maybe value
storeLookup :: Label name -> key -> Store store -> Maybe value
storeLookup label :: Label name
label key :: key
key (Store (BigMap m :: Map ByteString store
m)) =
  ByteString -> Map ByteString store -> Maybe store
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (key -> ByteString
forall (ctorIdx :: CtorIdx) key.
(NicePackedValue key, KnownNat ctorIdx) =>
key -> ByteString
packHsKey @ctorIdx key
key) Map ByteString store
m Maybe store -> (store -> value) -> Maybe value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \val :: store
val ->
    case Label name -> store -> Maybe (CtorOnlyField name store)
forall dt (name :: Symbol).
InstrUnwrapC dt name =>
Label name -> dt -> Maybe (CtorOnlyField name dt)
hsUnwrap Label name
label store
val of
      Nothing -> Text -> value
forall a. HasCallStack => Text -> a
error "Invalid store, keys and values types \
                       \correspondence is violated"
      Just (BigMapImage x) -> value
x

-- Examples
----------------------------------------------------------------------------

_storeSample :: Store MyStoreTemplate
_storeSample :: MyStore
_storeSample = [MyStore] -> MyStore
forall a. Monoid a => [a] -> a
mconcat
  [ Label "cIntsStore" -> Integer -> () -> MyStore
forall (name :: Symbol) store key value.
StorePieceC store name key value =>
Label name -> key -> value -> Store store
storePiece IsLabel "cIntsStore" (Label "cIntsStore")
Label "cIntsStore"
#cIntsStore 1 ()
  , Label "cBytesStore" -> ByteString -> ByteString -> MyStore
forall (name :: Symbol) store key value.
StorePieceC store name key value =>
Label name -> key -> value -> Store store
storePiece IsLabel "cBytesStore" (Label "cBytesStore")
Label "cBytesStore"
#cBytesStore "a" "b"
  ]

_lookupSample :: Maybe ByteString
_lookupSample :: Maybe ByteString
_lookupSample = Label "cBytesStore" -> ByteString -> MyStore -> Maybe ByteString
forall (name :: Symbol) store key value (ctorIdx :: CtorIdx).
(key ~ GetStoreKey store name, value ~ GetStoreValue store name,
 ctorIdx ~ MSCtorIdx (GetStore name store), NicePackedValue key,
 KnownNat ctorIdx, InstrUnwrapC store name, Generic store,
 CtorOnlyField name store ~ (key |-> value)) =>
Label name -> key -> Store store -> Maybe value
storeLookup IsLabel "cBytesStore" (Label "cBytesStore")
Label "cBytesStore"
#cBytesStore "a" MyStore
_storeSample

_storeSampleBig :: Store MyStoreTemplateBig
_storeSampleBig :: MyStoreBig
_storeSampleBig = [MyStoreBig] -> MyStoreBig
forall a. Monoid a => [a] -> a
mconcat
  [ Label "cIntsStore" -> Integer -> () -> MyStoreBig
forall (name :: Symbol) store key value.
StorePieceC store name key value =>
Label name -> key -> value -> Store store
storePiece IsLabel "cIntsStore" (Label "cIntsStore")
Label "cIntsStore"
#cIntsStore 1 ()
  , Label "cBoolsStore" -> Bool -> Bool -> MyStoreBig
forall (name :: Symbol) store key value.
StorePieceC store name key value =>
Label name -> key -> value -> Store store
storePiece IsLabel "cBoolsStore" (Label "cBoolsStore")
Label "cBoolsStore"
#cBoolsStore Bool
True Bool
True
  , Label "cIntsStore3" -> Integer -> Bool -> MyStoreBig
forall (name :: Symbol) store key value.
StorePieceC store name key value =>
Label name -> key -> value -> Store store
storePiece IsLabel "cIntsStore3" (Label "cIntsStore3")
Label "cIntsStore3"
#cIntsStore3 2 Bool
False
  ]

_lookupSampleBig :: Maybe Bool
_lookupSampleBig :: Maybe Bool
_lookupSampleBig = Label "cIntsStore3" -> Integer -> MyStoreBig -> Maybe Bool
forall (name :: Symbol) store key value (ctorIdx :: CtorIdx).
(key ~ GetStoreKey store name, value ~ GetStoreValue store name,
 ctorIdx ~ MSCtorIdx (GetStore name store), NicePackedValue key,
 KnownNat ctorIdx, InstrUnwrapC store name, Generic store,
 CtorOnlyField name store ~ (key |-> value)) =>
Label name -> key -> Store store -> Maybe value
storeLookup IsLabel "cIntsStore3" (Label "cIntsStore3")
Label "cIntsStore3"
#cIntsStore3 2 MyStoreBig
_storeSampleBig