diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2025-08-05 20:42:04 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-08-05 20:42:04 +0200 |
| commit | 1cab80953eda5547ee5ef2599a622fc8329e81ea (patch) | |
| tree | 4fe1b8b993bdf7376ce3d1243f6b126d1458d8d6 /src/Erebos/State.hs | |
| parent | fef17af2437a8584d0435c94d85b9619b5264219 (diff) | |
Use MonadStorage for makeSharedStateUpdate
Changelog: API: `State.makeSharedStateUpdate` uses `MonadStorage`
Diffstat (limited to 'src/Erebos/State.hs')
| -rw-r--r-- | src/Erebos/State.hs | 9 |
1 files changed, 4 insertions, 5 deletions
diff --git a/src/Erebos/State.hs b/src/Erebos/State.hs index 68b8b89..06e5c54 100644 --- a/src/Erebos/State.hs +++ b/src/Erebos/State.hs @@ -160,12 +160,11 @@ updateSharedState :: forall a b m. (SharedType a, MonadHead LocalState m) => (a updateSharedState f = \ls -> do let shared = lsShared $ fromStored ls val = lookupSharedValue shared - st <- getStorage (val', x) <- f val (,x) <$> if toComponents val' == toComponents val then return ls - else do shared' <- makeSharedStateUpdate st val' shared - wrappedStore st (fromStored ls) { lsShared = [shared'] } + else do shared' <- makeSharedStateUpdate val' shared + mstore (fromStored ls) { lsShared = [shared'] } lookupSharedValue :: forall a. SharedType a => [Stored SharedState] -> a lookupSharedValue = mergeSorted . filterAncestors . map wrappedLoad . concatMap (ssValue . fromStored) . filterAncestors . helper @@ -173,8 +172,8 @@ lookupSharedValue = mergeSorted . filterAncestors . map wrappedLoad . concatMap | otherwise = helper $ ssPrev (fromStored x) ++ xs helper [] = [] -makeSharedStateUpdate :: forall a m. MonadIO m => SharedType a => Storage -> a -> [Stored SharedState] -> m (Stored SharedState) -makeSharedStateUpdate st val prev = liftIO $ wrappedStore st SharedState +makeSharedStateUpdate :: forall a m. (SharedType a, MonadStorage m) => a -> [ Stored SharedState ] -> m (Stored SharedState) +makeSharedStateUpdate val prev = mstore SharedState { ssPrev = prev , ssType = Just $ sharedTypeID @a Proxy , ssValue = storedRef <$> toComponents val |