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

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

-- | Conversion between 'UStore' in Haskell and Michelson representation.
module Lorentz.UStore.Haskell
  ( mkUStore
  , MkUStoreTW
  , ustoreDecompose
  , ustoreDecomposeFull
  , DecomposeUStoreTW
  , fillUStore
  , migrateFillUStore
  , fillUStoreMigrationBlock
  , FillUStoreTW
  ) where

import qualified Unsafe

import Control.Monad.Except (runExcept, throwError)
import qualified Data.List as L
import qualified Data.Map as Map
import Data.Singletons (demote)
import Fcf (type (=<<), Eval, Pure2)
import qualified Fcf
import Fmt ((+|), (+||), (|+), (||+))

import Lorentz.Base
import Lorentz.Coercions
import Lorentz.Constraints
import qualified Lorentz.Instr as L
import Lorentz.Pack
import Lorentz.UStore.Migration
import Lorentz.UStore.Migration.Diff
import Lorentz.UStore.Traversal
import Lorentz.UStore.Types
import Michelson.Text
import Michelson.Typed.Haskell.Value
import Util.Type

-- | 'UStore' content represented as key-value pairs.
type UStoreContent = [(ByteString, ByteString)]

-- | Make 'UStore' from separate @big_map@s and fields.
mkUStore
  :: (UStoreTraversable MkUStoreTW template)
  => template -> UStore template
mkUStore :: template -> UStore template
mkUStore = BigMap ByteString ByteString -> UStore template
forall a. BigMap ByteString ByteString -> UStore a
UStore (BigMap ByteString ByteString -> UStore template)
-> (template -> BigMap ByteString ByteString)
-> template
-> UStore template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString ByteString -> BigMap ByteString ByteString
forall k v. Map k v -> BigMap k v
BigMap (Map ByteString ByteString -> BigMap ByteString ByteString)
-> (template -> Map ByteString ByteString)
-> template
-> BigMap ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. template -> Map ByteString ByteString
forall template.
UStoreTraversable MkUStoreTW template =>
template -> Map ByteString ByteString
mkUStoreInternal

-- | Decompose 'UStore' into separate @big_map@s and fields.
--
-- Since this function needs to @UNPACK@ content of @UStore@ to actual
-- keys and values, you have to provide 'UnpackEnv'.
--
-- Along with resulting value, you get a list of @UStore@ entries which
-- were not recognized as belonging to any submap or field according to
-- @UStore@'s template - this should be empty unless @UStore@ invariants
-- were violated.
ustoreDecompose
  :: forall template.
     (UStoreTraversable DecomposeUStoreTW template)
  => UStore template -> Either Text (UStoreContent, template)
ustoreDecompose :: UStore template -> Either Text (UStoreContent, template)
ustoreDecompose = UStoreContent -> Either Text (UStoreContent, template)
forall template.
UStoreTraversable DecomposeUStoreTW template =>
UStoreContent -> Either Text (UStoreContent, template)
storeDecomposeInternal (UStoreContent -> Either Text (UStoreContent, template))
-> (UStore template -> UStoreContent)
-> UStore template
-> Either Text (UStoreContent, template)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString ByteString -> UStoreContent
forall k a. Map k a -> [(k, a)]
Map.toList (Map ByteString ByteString -> UStoreContent)
-> (UStore template -> Map ByteString ByteString)
-> UStore template
-> UStoreContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigMap ByteString ByteString -> Map ByteString ByteString
forall k v. BigMap k v -> Map k v
unBigMap (BigMap ByteString ByteString -> Map ByteString ByteString)
-> (UStore template -> BigMap ByteString ByteString)
-> UStore template
-> Map ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UStore template -> BigMap ByteString ByteString
forall a. UStore a -> BigMap ByteString ByteString
unUStore

-- | Like 'ustoreDecompose', but requires all entries from @UStore@ to be
-- recognized.
ustoreDecomposeFull
  :: forall template.
     (UStoreTraversable DecomposeUStoreTW template)
  => UStore template -> Either Text template
ustoreDecomposeFull :: UStore template -> Either Text template
ustoreDecomposeFull ustore :: UStore template
ustore = do
  (remained :: UStoreContent
remained, res :: template
res) <- UStore template -> Either Text (UStoreContent, template)
forall template.
UStoreTraversable DecomposeUStoreTW template =>
UStore template -> Either Text (UStoreContent, template)
ustoreDecompose UStore template
ustore
  Bool -> Either Text () -> Either Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UStoreContent -> Bool
forall t. Container t => t -> Bool
null UStoreContent
remained) (Either Text () -> Either Text ())
-> Either Text () -> Either Text ()
forall a b. (a -> b) -> a -> b
$
    Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$ "Unrecognized entries in UStore: " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+|| UStoreContent
remained UStoreContent -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+ ""
  return template
res

-- | Make migration script which initializes 'UStore' from scratch.
fillUStore
  :: (UStoreTraversable FillUStoreTW template)
  => template -> UStoreMigration () template
fillUStore :: template -> UStoreMigration () template
fillUStore v :: template
v = [MigrationAtom] -> UStoreMigration () template
forall oldTempl newTempl.
[MigrationAtom] -> UStoreMigration oldTempl newTempl
UStoreMigration ([MigrationAtom] -> UStoreMigration () template)
-> [MigrationAtom] -> UStoreMigration () template
forall a b. (a -> b) -> a -> b
$ template -> [MigrationAtom]
forall template.
UStoreTraversable FillUStoreTW template =>
template -> [MigrationAtom]
fillUStoreInternal template
v

-- | Version of 'migrateFillUStore' for batched migrations.
--
-- Each field write will be placed to a separate batch.
fillUStoreMigrationBlock
  :: ( UStoreTraversable FillUStoreTW template
     , allFieldsExp ~ AllUStoreFieldsF template
     , newDiff ~ FillingNewDiff template diff
     , newTouched ~ FillingNewTouched template touched
     , PatternMatchL newDiff, PatternMatchL newTouched
     )
  => template
  -> MigrationBlocks oldTempl newTempl diff touched newDiff newTouched
fillUStoreMigrationBlock :: template
-> MigrationBlocks
     oldTempl newTempl diff touched newDiff newTouched
fillUStoreMigrationBlock v :: template
v = [MigrationAtom]
-> MigrationBlocks
     oldTempl newTempl diff touched newDiff newTouched
forall oldTemplate newTemplate (preRemDiff :: [DiffItem])
       (preTouched :: [Symbol]) (postRemDiff :: [DiffItem])
       (postTouched :: [Symbol]).
[MigrationAtom]
-> MigrationBlocks
     oldTemplate
     newTemplate
     preRemDiff
     preTouched
     postRemDiff
     postTouched
MigrationBlocks ([MigrationAtom]
 -> MigrationBlocks
      oldTempl newTempl diff touched newDiff newTouched)
-> [MigrationAtom]
-> MigrationBlocks
     oldTempl newTempl diff touched newDiff newTouched
forall a b. (a -> b) -> a -> b
$ template -> [MigrationAtom]
forall template.
UStoreTraversable FillUStoreTW template =>
template -> [MigrationAtom]
fillUStoreInternal template
v

-- | Fill 'UStore' with entries from the given template as part of simple
-- migration.
--
-- Sometimes you already have some fields initialized and 'fillUStore' does not
-- suit, then in case if your UStore template is a nested structure you can use
-- sub-templates to initialize the corresponding parts of UStore.
--
-- For batched migrations see 'fillUStoreMigrationBlock'.
migrateFillUStore
  :: ( UStoreTraversable FillUStoreTW template
     , allFieldsExp ~ AllUStoreFieldsF template
     , newDiff ~ FillingNewDiff template diff
     , newTouched ~ FillingNewTouched template touched
     , PatternMatchL newDiff, PatternMatchL newTouched
     )
  => template
  -> Lambda
       (MUStore oldTempl newTempl diff touched)
       (MUStore oldTempl newTempl newDiff newTouched)
migrateFillUStore :: template
-> Lambda
     (MUStore oldTempl newTempl diff touched)
     (MUStore oldTempl newTempl newDiff newTouched)
migrateFillUStore v :: template
v =
  let atoms :: [MigrationAtom]
atoms = template -> [MigrationAtom]
forall template.
UStoreTraversable FillUStoreTW template =>
template -> [MigrationAtom]
fillUStoreInternal template
v
      script :: Lambda UStore_ UStore_
script = (Element [MigrationAtom] -> Lambda UStore_ UStore_)
-> [MigrationAtom] -> Lambda UStore_ UStore_
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap (MigrationScript SomeUTemplate SomeUTemplate
-> Lambda UStore_ UStore_
forall oldStore newStore.
MigrationScript oldStore newStore -> Lambda UStore_ UStore_
unMigrationScript (MigrationScript SomeUTemplate SomeUTemplate
 -> Lambda UStore_ UStore_)
-> (MigrationAtom -> MigrationScript SomeUTemplate SomeUTemplate)
-> MigrationAtom
-> Lambda UStore_ UStore_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrationAtom -> MigrationScript SomeUTemplate SomeUTemplate
maScript) [MigrationAtom]
atoms
  in (MUStore oldTempl newTempl diff touched & '[]) :-> (UStore_ & '[])
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a & s) :-> (b & s)
forcedCoerce_ ((MUStore oldTempl newTempl diff touched & '[])
 :-> (UStore_ & '[]))
-> Lambda UStore_ UStore_
-> (MUStore oldTempl newTempl diff touched & '[])
   :-> (UStore_ & '[])
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Lambda UStore_ UStore_
script ((MUStore oldTempl newTempl diff touched & '[])
 :-> (UStore_ & '[]))
-> ((UStore_ & '[])
    :-> (MUStore oldTempl newTempl newDiff newTouched & '[]))
-> Lambda
     (MUStore oldTempl newTempl diff touched)
     (MUStore oldTempl newTempl newDiff newTouched)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (UStore_ & '[])
:-> (MUStore oldTempl newTempl newDiff newTouched & '[])
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a & s) :-> (b & s)
forcedCoerce_

type FillingNewDiff template diff =
  CoverDiffMany diff
    (Eval (Fcf.Map (Pure2 '(,) 'DcAdd) =<< LinearizeUStoreF template))

type FillingNewTouched template touched =
  Eval (AllUStoreFieldsF template) ++ touched

-- Implementation
----------------------------------------------------------------------------

-- | Internal helper for 'mkUStore'.
mkUStoreInternal
  :: (UStoreTraversable MkUStoreTW template)
  => template -> Map ByteString ByteString
mkUStoreInternal :: template -> Map ByteString ByteString
mkUStoreInternal = MkUStoreTW -> template -> Map ByteString ByteString
forall way template res.
(UStoreTraversable way template,
 UStoreTraversalArgumentWrapper way ~ Identity,
 UStoreTraversalMonad way ~ Const res) =>
way -> template -> res
foldUStore MkUStoreTW
MkUStoreTW

-- | Internal helper for 'ustoreDecompose'.
storeDecomposeInternal
  :: forall template.
     (UStoreTraversable DecomposeUStoreTW template)
  => UStoreContent -> Either Text (UStoreContent, template)
storeDecomposeInternal :: UStoreContent -> Either Text (UStoreContent, template)
storeDecomposeInternal =
  Except Text (UStoreContent, template)
-> Either Text (UStoreContent, template)
forall e a. Except e a -> Either e a
runExcept (Except Text (UStoreContent, template)
 -> Either Text (UStoreContent, template))
-> (UStoreContent -> Except Text (UStoreContent, template))
-> UStoreContent
-> Either Text (UStoreContent, template)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((template, UStoreContent) -> (UStoreContent, template))
-> ExceptT Text Identity (template, UStoreContent)
-> Except Text (UStoreContent, template)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (template, UStoreContent) -> (UStoreContent, template)
forall a b. (a, b) -> (b, a)
swap (ExceptT Text Identity (template, UStoreContent)
 -> Except Text (UStoreContent, template))
-> (UStoreContent
    -> ExceptT Text Identity (template, UStoreContent))
-> UStoreContent
-> Except Text (UStoreContent, template)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT UStoreContent (ExceptT Text Identity) template
-> UStoreContent -> ExceptT Text Identity (template, UStoreContent)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (DecomposeUStoreTW
-> UStoreTraversalMonad DecomposeUStoreTW template
forall way template.
(UStoreTraversable way template,
 UStoreTraversalArgumentWrapper way ~ Const ()) =>
way -> UStoreTraversalMonad way template
genUStore DecomposeUStoreTW
DecomposeUStoreTW)

-- | Internal helper for 'fillUStore'.
fillUStoreInternal
  :: (UStoreTraversable FillUStoreTW template)
  => template
  -> [MigrationAtom]
fillUStoreInternal :: template -> [MigrationAtom]
fillUStoreInternal a :: template
a = Endo [MigrationAtom] -> [MigrationAtom] -> [MigrationAtom]
forall a. Endo a -> a -> a
appEndo (FillUStoreTW -> template -> Endo [MigrationAtom]
forall way template res.
(UStoreTraversable way template,
 UStoreTraversalArgumentWrapper way ~ Identity,
 UStoreTraversalMonad way ~ Const res) =>
way -> template -> res
foldUStore FillUStoreTW
FillUStoreTW template
a) []

-- | Declares handlers for UStore creation from template.
data MkUStoreTW = MkUStoreTW

instance UStoreTraversalWay MkUStoreTW where
  type UStoreTraversalArgumentWrapper MkUStoreTW = Identity
  type UStoreTraversalMonad MkUStoreTW = Const (Map ByteString ByteString)

instance (NicePackedValue val) =>
         UStoreTraversalFieldHandler MkUStoreTW marker val where
  ustoreTraversalFieldHandler :: MkUStoreTW
-> Label name
-> UStoreTraversalArgumentWrapper MkUStoreTW val
-> UStoreTraversalMonad MkUStoreTW val
ustoreTraversalFieldHandler MkUStoreTW fieldName :: Label name
fieldName (Identity val) =
    Map ByteString ByteString -> UStoreTraversalMonad MkUStoreTW val
forall k a (b :: k). a -> Const a b
Const (Map ByteString ByteString -> UStoreTraversalMonad MkUStoreTW val)
-> Map ByteString ByteString -> UStoreTraversalMonad MkUStoreTW val
forall a b. (a -> b) -> a -> b
$
    OneItem (Map ByteString ByteString) -> Map ByteString ByteString
forall x. One x => OneItem x -> x
one ( Label name -> ByteString
forall (marker :: UStoreMarkerType) (field :: Symbol).
KnownUStoreMarker marker =>
Label field -> ByteString
mkFieldMarkerUKeyL @marker Label name
fieldName
        , val -> ByteString
forall a. NicePackedValue a => a -> ByteString
lPackValue val
val
        )

instance (NicePackedValue k, NicePackedValue v) =>
         UStoreTraversalSubmapHandler MkUStoreTW k v where
  ustoreTraversalSubmapHandler :: MkUStoreTW
-> Label name
-> UStoreTraversalArgumentWrapper MkUStoreTW (Map k v)
-> UStoreTraversalMonad MkUStoreTW (Map k v)
ustoreTraversalSubmapHandler MkUStoreTW fieldName :: Label name
fieldName (Identity m) =
    Map ByteString ByteString
-> UStoreTraversalMonad MkUStoreTW (Map k v)
forall k a (b :: k). a -> Const a b
Const (Map ByteString ByteString
 -> UStoreTraversalMonad MkUStoreTW (Map k v))
-> Map ByteString ByteString
-> UStoreTraversalMonad MkUStoreTW (Map k v)
forall a b. (a -> b) -> a -> b
$
    [Map ByteString ByteString] -> Map ByteString ByteString
forall a. Monoid a => [a] -> a
mconcat
      [ OneItem (Map ByteString ByteString) -> Map ByteString ByteString
forall x. One x => OneItem x -> x
one ( (MText, k) -> ByteString
forall a. NicePackedValue a => a -> ByteString
lPackValue (Label name -> MText
forall (name :: Symbol). Label name -> MText
labelToMText Label name
fieldName, k
k)
            , v -> ByteString
forall a. NicePackedValue a => a -> ByteString
lPackValue v
v
            )
      | (k :: k
k, v :: v
v) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m
      ]

-- | Declares handlers for UStore conversion to template.
data DecomposeUStoreTW = DecomposeUStoreTW

instance UStoreTraversalWay DecomposeUStoreTW where
  type UStoreTraversalArgumentWrapper DecomposeUStoreTW = Const ()
  type UStoreTraversalMonad DecomposeUStoreTW =
    StateT UStoreContent (ExceptT Text Identity)

instance (NiceUnpackedValue val) =>
         UStoreTraversalFieldHandler DecomposeUStoreTW marker val where
  ustoreTraversalFieldHandler :: DecomposeUStoreTW
-> Label name
-> UStoreTraversalArgumentWrapper DecomposeUStoreTW val
-> UStoreTraversalMonad DecomposeUStoreTW val
ustoreTraversalFieldHandler DecomposeUStoreTW fieldName :: Label name
fieldName (Const ()) = do
    let expectedKey :: ByteString
expectedKey = MText -> ByteString
forall (marker :: UStoreMarkerType).
KnownUStoreMarker marker =>
MText -> ByteString
mkFieldMarkerUKey @marker (Label name -> MText
forall (name :: Symbol). Label name -> MText
labelToMText Label name
fieldName)
    [val]
allMatched <- ((ByteString, ByteString)
 -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) val)
-> StateT UStoreContent (ExceptT Text Identity) [val]
forall a b (m :: * -> *).
MonadState [a] m =>
(a -> MaybeT m b) -> m [b]
mapMaybesState (((ByteString, ByteString)
  -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) val)
 -> StateT UStoreContent (ExceptT Text Identity) [val])
-> ((ByteString, ByteString)
    -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) val)
-> StateT UStoreContent (ExceptT Text Identity) [val]
forall a b. (a -> b) -> a -> b
$ \(key :: ByteString
key, value :: ByteString
value) -> do
      Bool
-> MaybeT (StateT UStoreContent (ExceptT Text Identity)) ()
-> MaybeT (StateT UStoreContent (ExceptT Text Identity)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
key ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
expectedKey) MaybeT (StateT UStoreContent (ExceptT Text Identity)) ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      case ByteString -> Either UnpackError val
forall a. NiceUnpackedValue a => ByteString -> Either UnpackError a
lUnpackValue ByteString
value of
        Left err :: UnpackError
err -> Text -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) val
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) val)
-> Text
-> MaybeT (StateT UStoreContent (ExceptT Text Identity)) val
forall a b. (a -> b) -> a -> b
$
          "Failed to parse UStore value for field " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+|
          (SingKind T, SingI (ToT val)) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @(ToT val) T -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ": " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| UnpackError
err UnpackError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
        Right valValue :: val
valValue ->
          val -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) val
forall (f :: * -> *) a. Applicative f => a -> f a
pure val
valValue
    case [val]
allMatched of
        [] -> Text -> StateT UStoreContent (ExceptT Text Identity) val
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> StateT UStoreContent (ExceptT Text Identity) val)
-> Text -> StateT UStoreContent (ExceptT Text Identity) val
forall a b. (a -> b) -> a -> b
$
          "Failed to find field in UStore: " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Label name -> MText
forall (name :: Symbol). Label name -> MText
labelToMText Label name
fieldName MText -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
        [matched :: val
matched] ->
          val -> StateT UStoreContent (ExceptT Text Identity) val
forall (f :: * -> *) a. Applicative f => a -> f a
pure val
matched
        (_ : _ : _) ->
          Text -> StateT UStoreContent (ExceptT Text Identity) val
forall a. HasCallStack => Text -> a
error "UStore content contained multiple entries with the same key"

instance (Ord k, NiceUnpackedValue k, NiceUnpackedValue v) =>
         UStoreTraversalSubmapHandler DecomposeUStoreTW k v where
  ustoreTraversalSubmapHandler :: DecomposeUStoreTW
-> Label name
-> UStoreTraversalArgumentWrapper DecomposeUStoreTW (Map k v)
-> UStoreTraversalMonad DecomposeUStoreTW (Map k v)
ustoreTraversalSubmapHandler _ fieldName :: Label name
fieldName (Const ()) =
    ([(k, v)] -> Map k v)
-> StateT UStoreContent (ExceptT Text Identity) [(k, v)]
-> StateT UStoreContent (ExceptT Text Identity) (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (StateT UStoreContent (ExceptT Text Identity) [(k, v)]
 -> UStoreTraversalMonad DecomposeUStoreTW (Map k v))
-> StateT UStoreContent (ExceptT Text Identity) [(k, v)]
-> UStoreTraversalMonad DecomposeUStoreTW (Map k v)
forall a b. (a -> b) -> a -> b
$
    ((ByteString, ByteString)
 -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v))
-> StateT UStoreContent (ExceptT Text Identity) [(k, v)]
forall a b (m :: * -> *).
MonadState [a] m =>
(a -> MaybeT m b) -> m [b]
mapMaybesState (((ByteString, ByteString)
  -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v))
 -> StateT UStoreContent (ExceptT Text Identity) [(k, v)])
-> ((ByteString, ByteString)
    -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v))
-> StateT UStoreContent (ExceptT Text Identity) [(k, v)]
forall a b. (a -> b) -> a -> b
$ \(key :: ByteString
key, value :: ByteString
value) ->
      case ByteString -> Either UnpackError (UStoreSubmapKey k)
forall a. NiceUnpackedValue a => ByteString -> Either UnpackError a
lUnpackValue @(UStoreSubmapKey k) ByteString
key of
        Left _ -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
        Right (MText
name :: MText, k
keyValue :: k)
          | MText
name MText -> MText -> Bool
forall a. Eq a => a -> a -> Bool
/= Label name -> MText
forall (name :: Symbol). Label name -> MText
labelToMText Label name
fieldName ->
              MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          | Bool
otherwise ->
            case ByteString -> Either UnpackError v
forall a. NiceUnpackedValue a => ByteString -> Either UnpackError a
lUnpackValue ByteString
value of
              Left err :: UnpackError
err -> Text
-> MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text
 -> MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v))
-> Text
-> MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v)
forall a b. (a -> b) -> a -> b
$
                "Failed to parse UStore value for " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+|
                (SingKind T, SingI (ToT k)) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @(ToT k) T -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " |~> " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| (SingKind T, SingI (ToT v)) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @(ToT v) T -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
                ": " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| UnpackError
err UnpackError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
              Right valValue :: v
valValue ->
                (k, v)
-> MaybeT (StateT UStoreContent (ExceptT Text Identity)) (k, v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
keyValue, v
valValue)

-- | Declares handlers for UStore filling via lambda.
data FillUStoreTW = FillUStoreTW

instance UStoreTraversalWay FillUStoreTW where
  type UStoreTraversalArgumentWrapper FillUStoreTW = Identity
  type UStoreTraversalMonad FillUStoreTW = Const (Endo [MigrationAtom])

instance (NiceConstant v) =>
         UStoreTraversalFieldHandler FillUStoreTW marker v where
  ustoreTraversalFieldHandler :: FillUStoreTW
-> Label name
-> UStoreTraversalArgumentWrapper FillUStoreTW v
-> UStoreTraversalMonad FillUStoreTW v
ustoreTraversalFieldHandler FillUStoreTW fieldName :: Label name
fieldName (Identity val) =
    Endo [MigrationAtom] -> UStoreTraversalMonad FillUStoreTW v
forall k a (b :: k). a -> Const a b
Const (Endo [MigrationAtom] -> UStoreTraversalMonad FillUStoreTW v)
-> Endo [MigrationAtom] -> UStoreTraversalMonad FillUStoreTW v
forall a b. (a -> b) -> a -> b
$
    ([MigrationAtom] -> [MigrationAtom]) -> Endo [MigrationAtom]
forall a. (a -> a) -> Endo a
Endo (([MigrationAtom] -> [MigrationAtom]) -> Endo [MigrationAtom])
-> (Lambda UStore_ UStore_ -> [MigrationAtom] -> [MigrationAtom])
-> Lambda UStore_ UStore_
-> Endo [MigrationAtom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (MigrationAtom -> [MigrationAtom] -> [MigrationAtom])
-> (Lambda UStore_ UStore_ -> MigrationAtom)
-> Lambda UStore_ UStore_
-> [MigrationAtom]
-> [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_ -> Endo [MigrationAtom])
-> Lambda UStore_ UStore_ -> Endo [MigrationAtom]
forall a b. (a -> b) -> a -> b
$
      DMigrationActionType
-> Label name -> Proxy v -> Lambda UStore_ UStore_
forall fieldTy (fieldName :: Symbol) (s :: [*]).
SingI (ToT fieldTy) =>
DMigrationActionType -> Label fieldName -> Proxy fieldTy -> s :-> s
attachMigrationActionName (Text -> DMigrationActionType
DAddAction "init field") Label name
fieldName (Proxy v
forall k (t :: k). Proxy t
Proxy @v) Lambda UStore_ UStore_
-> ((UStore_ & '[]) :-> (v & (UStore_ & '[])))
-> (UStore_ & '[]) :-> (v & (UStore_ & '[]))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      -- Not pushing already packed value (which would be more efficient) because
      -- analyzers cannot work with packed values.
      -- TODO: make optimizer compress this to @push (Just $ lPackValue val)@
      v -> (UStore_ & '[]) :-> (v & (UStore_ & '[]))
forall t (s :: [*]). NiceConstant t => t -> s :-> (t & s)
L.push v
val ((UStore_ & '[]) :-> (v & (UStore_ & '[])))
-> ((v & (UStore_ & '[])) :-> (ByteString & (UStore_ & '[])))
-> (UStore_ & '[]) :-> (ByteString & (UStore_ & '[]))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (v & (UStore_ & '[])) :-> (ByteString & (UStore_ & '[]))
forall a (s :: [*]).
NicePackedValue a =>
(a & s) :-> (ByteString & s)
L.pack ((UStore_ & '[]) :-> (ByteString & (UStore_ & '[])))
-> ((ByteString & (UStore_ & '[]))
    :-> (Maybe ByteString & (UStore_ & '[])))
-> (UStore_ & '[]) :-> (Maybe ByteString & (UStore_ & '[]))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (ByteString & (UStore_ & '[]))
:-> (Maybe ByteString & (UStore_ & '[]))
forall a (s :: [*]). (a & s) :-> (Maybe a & s)
L.some ((UStore_ & '[]) :-> (Maybe ByteString & (UStore_ & '[])))
-> ((Maybe ByteString & (UStore_ & '[]))
    :-> (ByteString & (Maybe ByteString & (UStore_ & '[]))))
-> (UStore_ & '[])
   :-> (ByteString & (Maybe ByteString & (UStore_ & '[])))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#

      ByteString
-> (Maybe ByteString & (UStore_ & '[]))
   :-> (ByteString & (Maybe ByteString & (UStore_ & '[])))
forall t (s :: [*]). NiceConstant t => t -> s :-> (t & s)
L.push (Label name -> ByteString
forall (marker :: UStoreMarkerType) (field :: Symbol).
KnownUStoreMarker marker =>
Label field -> ByteString
mkFieldMarkerUKeyL @marker Label name
fieldName) ((UStore_ & '[])
 :-> (ByteString & (Maybe ByteString & (UStore_ & '[]))))
-> ((ByteString & (Maybe ByteString & (UStore_ & '[])))
    :-> (UStore_ & '[]))
-> Lambda UStore_ UStore_
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      (ByteString & (Maybe ByteString & (UStore_ & '[])))
:-> (UStore_ & '[])
forall c (s :: [*]).
UpdOpHs c =>
(UpdOpKeyHs c & (UpdOpParamsHs c & (c & s))) :-> (c & s)
L.update

instance (NiceConstant k, NiceConstant v) =>
         UStoreTraversalSubmapHandler FillUStoreTW k v where
  ustoreTraversalSubmapHandler :: FillUStoreTW
-> Label name
-> UStoreTraversalArgumentWrapper FillUStoreTW (Map k v)
-> UStoreTraversalMonad FillUStoreTW (Map k v)
ustoreTraversalSubmapHandler _ fieldName :: Label name
fieldName (Identity m) =
    Endo [MigrationAtom] -> UStoreTraversalMonad FillUStoreTW (Map k v)
forall k a (b :: k). a -> Const a b
Const (Endo [MigrationAtom]
 -> UStoreTraversalMonad FillUStoreTW (Map k v))
-> Endo [MigrationAtom]
-> UStoreTraversalMonad FillUStoreTW (Map k v)
forall a b. (a -> b) -> a -> b
$
    ([MigrationAtom] -> [MigrationAtom]) -> Endo [MigrationAtom]
forall a. (a -> a) -> Endo a
Endo (([MigrationAtom] -> [MigrationAtom]) -> Endo [MigrationAtom])
-> ([MigrationAtom] -> [MigrationAtom] -> [MigrationAtom])
-> [MigrationAtom]
-> Endo [MigrationAtom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MigrationAtom] -> [MigrationAtom] -> [MigrationAtom]
forall a. Semigroup a => a -> a -> a
(<>) ([MigrationAtom] -> Endo [MigrationAtom])
-> [MigrationAtom] -> Endo [MigrationAtom]
forall a b. (a -> b) -> a -> b
$
    Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m [(k, v)] -> ((k, v) -> MigrationAtom) -> [MigrationAtom]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(k :: k
k, v :: v
v) ->
    Maybe Text -> Lambda UStore_ UStore_ -> MigrationAtom
formMigrationAtom Maybe Text
forall a. Maybe a
Nothing (Lambda UStore_ UStore_ -> MigrationAtom)
-> Lambda UStore_ UStore_ -> MigrationAtom
forall a b. (a -> b) -> a -> b
$
      DMigrationActionType
-> Label name -> Proxy v -> Lambda UStore_ UStore_
forall fieldTy (fieldName :: Symbol) (s :: [*]).
SingI (ToT fieldTy) =>
DMigrationActionType -> Label fieldName -> Proxy fieldTy -> s :-> s
attachMigrationActionName (Text -> DMigrationActionType
DAddAction "init submap") Label name
fieldName (Proxy v
forall k (t :: k). Proxy t
Proxy @v) Lambda UStore_ UStore_
-> ((UStore_ & '[]) :-> (v & (UStore_ & '[])))
-> (UStore_ & '[]) :-> (v & (UStore_ & '[]))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      -- @PUSH + PACK@ will be merged by optimizer, but there is still place
      -- for further improvement both or value and key pushing.
      -- We cannot push already packed value because that would break code
      -- analyzers and transformers, consider adding necessary rules to
      -- optimizer.
      -- TODO [TM-379]: consider improving this case
      -- or
      -- TODO: add necessary rules to optimizer
      v -> (UStore_ & '[]) :-> (v & (UStore_ & '[]))
forall t (s :: [*]). NiceConstant t => t -> s :-> (t & s)
L.push v
v ((UStore_ & '[]) :-> (v & (UStore_ & '[])))
-> ((v & (UStore_ & '[])) :-> (ByteString & (UStore_ & '[])))
-> (UStore_ & '[]) :-> (ByteString & (UStore_ & '[]))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (v & (UStore_ & '[])) :-> (ByteString & (UStore_ & '[]))
forall a (s :: [*]).
NicePackedValue a =>
(a & s) :-> (ByteString & s)
L.pack ((UStore_ & '[]) :-> (ByteString & (UStore_ & '[])))
-> ((ByteString & (UStore_ & '[]))
    :-> (Maybe ByteString & (UStore_ & '[])))
-> (UStore_ & '[]) :-> (Maybe ByteString & (UStore_ & '[]))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (ByteString & (UStore_ & '[]))
:-> (Maybe ByteString & (UStore_ & '[]))
forall a (s :: [*]). (a & s) :-> (Maybe a & s)
L.some ((UStore_ & '[]) :-> (Maybe ByteString & (UStore_ & '[])))
-> ((Maybe ByteString & (UStore_ & '[]))
    :-> (k & (Maybe ByteString & (UStore_ & '[]))))
-> (UStore_ & '[]) :-> (k & (Maybe ByteString & (UStore_ & '[])))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      k
-> (Maybe ByteString & (UStore_ & '[]))
   :-> (k & (Maybe ByteString & (UStore_ & '[])))
forall t (s :: [*]). NiceConstant t => t -> s :-> (t & s)
L.push k
k ((UStore_ & '[]) :-> (k & (Maybe ByteString & (UStore_ & '[]))))
-> ((k & (Maybe ByteString & (UStore_ & '[])))
    :-> (MText & (k & (Maybe ByteString & (UStore_ & '[])))))
-> (UStore_ & '[])
   :-> (MText & (k & (Maybe ByteString & (UStore_ & '[]))))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# MText
-> (k & (Maybe ByteString & (UStore_ & '[])))
   :-> (MText & (k & (Maybe ByteString & (UStore_ & '[]))))
forall t (s :: [*]). NiceConstant t => t -> s :-> (t & s)
L.push (Label name -> MText
forall (name :: Symbol). Label name -> MText
labelToMText Label name
fieldName) ((UStore_ & '[])
 :-> (MText & (k & (Maybe ByteString & (UStore_ & '[])))))
-> ((MText & (k & (Maybe ByteString & (UStore_ & '[]))))
    :-> ((MText, k) & (Maybe ByteString & (UStore_ & '[]))))
-> (UStore_ & '[])
   :-> ((MText, k) & (Maybe ByteString & (UStore_ & '[])))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (MText & (k & (Maybe ByteString & (UStore_ & '[]))))
:-> ((MText, k) & (Maybe ByteString & (UStore_ & '[])))
forall a b (s :: [*]). (a & (b & s)) :-> ((a, b) & s)
L.pair ((UStore_ & '[])
 :-> ((MText, k) & (Maybe ByteString & (UStore_ & '[]))))
-> (((MText, k) & (Maybe ByteString & (UStore_ & '[])))
    :-> (ByteString & (Maybe ByteString & (UStore_ & '[]))))
-> (UStore_ & '[])
   :-> (ByteString & (Maybe ByteString & (UStore_ & '[])))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      forall (s :: [*]).
NicePackedValue (MText, k) =>
((MText, k) & s) :-> (ByteString & s)
forall a (s :: [*]).
NicePackedValue a =>
(a & s) :-> (ByteString & s)
L.pack @(UStoreSubmapKey _) ((UStore_ & '[])
 :-> (ByteString & (Maybe ByteString & (UStore_ & '[]))))
-> ((ByteString & (Maybe ByteString & (UStore_ & '[])))
    :-> (UStore_ & '[]))
-> Lambda UStore_ UStore_
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      (ByteString & (Maybe ByteString & (UStore_ & '[])))
:-> (UStore_ & '[])
forall c (s :: [*]).
UpdOpHs c =>
(UpdOpKeyHs c & (UpdOpParamsHs c & (c & s))) :-> (c & s)
L.update

-- | Tries to map all items in the state and returns those which were mapped
-- successfully; others are retained in the state.
mapMaybesState :: forall a b m. MonadState [a] m => (a -> MaybeT m b) -> m [b]
mapMaybesState :: (a -> MaybeT m b) -> m [b]
mapMaybesState mapper :: a -> MaybeT m b
mapper =
  m [a]
forall s (m :: * -> *). MonadState s m => m s
get m [a] -> ([a] -> m [b]) -> m [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \st :: [a]
st -> do
    [(a, Maybe b)]
mapped <- (a -> m (a, Maybe b)) -> [a] -> m [(a, Maybe b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\a :: a
a -> (a
a, ) (Maybe b -> (a, Maybe b)) -> m (Maybe b) -> m (a, Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (a -> MaybeT m b
mapper a
a)) [a]
st
    let
      (passed :: [b]
passed, failed :: [a]
failed) =
        ([(a, Maybe b)] -> [b])
-> ([(a, Maybe b)] -> [a])
-> ([(a, Maybe b)], [(a, Maybe b)])
-> ([b], [a])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (((a, Maybe b) -> b) -> [(a, Maybe b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Maybe b -> b
forall a. HasCallStack => Maybe a -> a
Unsafe.fromJust (Maybe b -> b) -> ((a, Maybe b) -> Maybe b) -> (a, Maybe b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Maybe b) -> Maybe b
forall a b. (a, b) -> b
snd)) (((a, Maybe b) -> a) -> [(a, Maybe b)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (a, Maybe b) -> a
forall a b. (a, b) -> a
fst) (([(a, Maybe b)], [(a, Maybe b)]) -> ([b], [a]))
-> ([(a, Maybe b)], [(a, Maybe b)]) -> ([b], [a])
forall a b. (a -> b) -> a -> b
$
        ((a, Maybe b) -> Bool)
-> [(a, Maybe b)] -> ([(a, Maybe b)], [(a, Maybe b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition @(a, Maybe b) (Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (Maybe b -> Bool)
-> ((a, Maybe b) -> Maybe b) -> (a, Maybe b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Maybe b) -> Maybe b
forall a b. (a, b) -> b
snd) ([(a, Maybe b)] -> ([(a, Maybe b)], [(a, Maybe b)]))
-> [(a, Maybe b)] -> ([(a, Maybe b)], [(a, Maybe b)])
forall a b. (a -> b) -> a -> b
$
        [(a, Maybe b)]
mapped
    [a] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [a]
failed
    return [b]
passed

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

data MyStoreTemplate = MyStoreTemplate
  { MyStoreTemplate -> Integer |~> ()
ints :: Integer |~> ()
  , MyStoreTemplate -> UStoreField Bool
flag :: UStoreField Bool
  }
  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)

data MyStoreTemplateBig = MyStoreTemplateBig
  { MyStoreTemplateBig -> MyStoreTemplate
templ :: MyStoreTemplate
  , MyStoreTemplateBig -> ByteString |~> ByteString
bytes :: ByteString |~> ByteString
  }
  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)

_storeSample :: UStore MyStoreTemplate
_storeSample :: UStore MyStoreTemplate
_storeSample = MyStoreTemplate -> UStore MyStoreTemplate
forall template.
UStoreTraversable MkUStoreTW template =>
template -> UStore template
mkUStore
  $WMyStoreTemplate :: (Integer |~> ()) -> UStoreField Bool -> MyStoreTemplate
MyStoreTemplate
  { ints :: Integer |~> ()
ints = Map Integer () -> Integer |~> ()
forall k v. Map k v -> k |~> v
UStoreSubMap (Map Integer () -> Integer |~> ())
-> Map Integer () -> Integer |~> ()
forall a b. (a -> b) -> a -> b
$ OneItem (Map Integer ()) -> Map Integer ()
forall x. One x => OneItem x -> x
one (1, ())
  , flag :: UStoreField Bool
flag = Bool -> UStoreField Bool
forall (m :: UStoreMarkerType) v. v -> UStoreFieldExt m v
UStoreField Bool
False
  }

_storeSampleBig :: UStore MyStoreTemplateBig
_storeSampleBig :: UStore MyStoreTemplateBig
_storeSampleBig = MyStoreTemplateBig -> UStore MyStoreTemplateBig
forall template.
UStoreTraversable MkUStoreTW template =>
template -> UStore template
mkUStore (MyStoreTemplateBig -> UStore MyStoreTemplateBig)
-> MyStoreTemplateBig -> UStore MyStoreTemplateBig
forall a b. (a -> b) -> a -> b
$
  MyStoreTemplate
-> (ByteString |~> ByteString) -> MyStoreTemplateBig
MyStoreTemplateBig
    $WMyStoreTemplate :: (Integer |~> ()) -> UStoreField Bool -> MyStoreTemplate
MyStoreTemplate
      { ints :: Integer |~> ()
ints = Map Integer () -> Integer |~> ()
forall k v. Map k v -> k |~> v
UStoreSubMap (Map Integer () -> Integer |~> ())
-> Map Integer () -> Integer |~> ()
forall a b. (a -> b) -> a -> b
$ OneItem (Map Integer ()) -> Map Integer ()
forall x. One x => OneItem x -> x
one (1, ())
      , flag :: UStoreField Bool
flag = Bool -> UStoreField Bool
forall (m :: UStoreMarkerType) v. v -> UStoreFieldExt m v
UStoreField Bool
False
      }
    (Map ByteString ByteString -> ByteString |~> ByteString
forall k v. Map k v -> k |~> v
UStoreSubMap (Map ByteString ByteString -> ByteString |~> ByteString)
-> Map ByteString ByteString -> ByteString |~> ByteString
forall a b. (a -> b) -> a -> b
$ OneItem (Map ByteString ByteString) -> Map ByteString ByteString
forall x. One x => OneItem x -> x
one ("a", "b"))