summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-08-05 20:18:49 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-08-05 20:18:49 +0200
commitfef17af2437a8584d0435c94d85b9619b5264219 (patch)
tree31f4e63f69c5660544560be9f3c45a5635ad1824 /src
parent102acebc7c09af60851344ea64b4df5b6b6a9807 (diff)
Use MonadStorage for storeSetAdd
Changelog: API: `Set.storeSetAdd` uses `MonadStorage` instead explicit `Storage` parameter
Diffstat (limited to 'src')
-rw-r--r--src/Erebos/Chatroom.hs6
-rw-r--r--src/Erebos/Contact.hs10
-rw-r--r--src/Erebos/Set.hs9
3 files changed, 10 insertions, 15 deletions
diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs
index 579d530..f9bf545 100644
--- a/src/Erebos/Chatroom.hs
+++ b/src/Erebos/Chatroom.hs
@@ -295,8 +295,7 @@ createChatroom rdName rdDescription = do
}
updateLocalState $ updateSharedState $ \rooms -> do
- st <- getStorage
- (, cstate) <$> storeSetAdd st cstate rooms
+ (, cstate) <$> storeSetAdd cstate rooms
findAndUpdateChatroomState
:: (MonadStorage m, MonadHead LocalState m)
@@ -310,8 +309,7 @@ findAndUpdateChatroomState f = do
upd <- act
if roomStateData orig /= roomStateData upd
then do
- st <- getStorage
- roomSet' <- storeSetAdd st upd roomSet
+ roomSet' <- storeSetAdd upd roomSet
return (roomSet', Just upd)
else do
return (roomSet, Just upd)
diff --git a/src/Erebos/Contact.hs b/src/Erebos/Contact.hs
index 88e6c44..b081ddb 100644
--- a/src/Erebos/Contact.hs
+++ b/src/Erebos/Contact.hs
@@ -83,13 +83,12 @@ contactName c = fromJust $ msum
contactSetName :: MonadHead LocalState m => Contact -> Text -> Set Contact -> m (Set Contact)
contactSetName contact name set = do
- st <- getStorage
- cdata <- wrappedStore st ContactData
+ cdata <- mstore ContactData
{ cdPrev = toComponents contact
, cdIdentity = []
, cdName = Just name
}
- storeSetAdd st (mergeSorted @Contact [cdata]) set
+ storeSetAdd (mergeSorted @Contact [cdata]) set
type ContactService = PairingService ContactAccepted
@@ -166,10 +165,9 @@ contactReject = pairingReject @ContactAccepted Proxy
finalizeContact :: MonadHead LocalState m => UnifiedIdentity -> m ()
finalizeContact identity = updateLocalState_ $ updateSharedState_ $ \contacts -> do
- st <- getStorage
- cdata <- wrappedStore st ContactData
+ cdata <- mstore ContactData
{ cdPrev = []
, cdIdentity = idExtDataF $ finalOwner identity
, cdName = Nothing
}
- storeSetAdd st (mergeSorted @Contact [cdata]) contacts
+ storeSetAdd (mergeSorted @Contact [cdata]) contacts
diff --git a/src/Erebos/Set.hs b/src/Erebos/Set.hs
index 270c0ba..7453be4 100644
--- a/src/Erebos/Set.hs
+++ b/src/Erebos/Set.hs
@@ -10,7 +10,6 @@ module Erebos.Set (
) where
import Control.Arrow
-import Control.Monad.IO.Class
import Data.Function
import Data.List
@@ -53,14 +52,14 @@ emptySet = Set []
loadSet :: Mergeable a => Ref -> Set a
loadSet = mergeSorted . (:[]) . wrappedLoad
-storeSetAdd :: (Mergeable a, MonadIO m) => Storage -> a -> Set a -> m (Set a)
-storeSetAdd st x (Set prev) = Set . (:[]) <$> wrappedStore st SetItem
+storeSetAdd :: (Mergeable a, MonadStorage m) => a -> Set a -> m (Set a)
+storeSetAdd x (Set prev) = Set . (: []) <$> mstore SetItem
{ siPrev = prev
, siItem = toComponents x
}
-storeSetAddComponent :: (Mergeable a, MonadStorage m, MonadIO m) => Stored (Component a) -> Set a -> m (Set a)
-storeSetAddComponent component (Set prev) = Set . (:[]) <$> mstore SetItem
+storeSetAddComponent :: (Mergeable a, MonadStorage m) => Stored (Component a) -> Set a -> m (Set a)
+storeSetAddComponent component (Set prev) = Set . (: []) <$> mstore SetItem
{ siPrev = prev
, siItem = [ component ]
}