From 4cf576af326b878fe7dc6d01b6b56696f2133cde Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 8 Nov 2020 01:37:38 +0100
Subject: [PATCH] Implement some MVar-like helpers for ObservableVar
---
src/lib/Qd/Observable.hs | 16 ++++++++++++++--
src/lib/Qd/Observable/ObservableHashMap.hs | 6 ++++++
2 files changed, 20 insertions(+), 2 deletions(-)
diff --git a/src/lib/Qd/Observable.hs b/src/lib/Qd/Observable.hs
index eb216fc..2fc1a01 100644
--- a/src/lib/Qd/Observable.hs
+++ b/src/lib/Qd/Observable.hs
@@ -15,7 +15,9 @@ module Qd.Observable (
MessageReason(..),
ObservableVar,
newObservableVar,
+ withObservableVar,
modifyObservableVar,
+ modifyObservableVar_,
joinObservable,
joinObservableMaybe,
joinObservableMaybe',
@@ -145,13 +147,23 @@ newObservableVar initialValue = do
ObservableVar <$> newMVar (initialValue, HM.empty)
-modifyObservableVar :: ObservableVar v -> (v -> v) -> IO ()
+modifyObservableVar :: ObservableVar v -> (v -> IO (v, a)) -> IO a
modifyObservableVar (ObservableVar mvar) f =
+ modifyMVar mvar $ \(oldState, subscribers) -> do
+ (newState, result) <- f oldState
+ mapM_ (\callback -> callback (Update, newState)) subscribers
+ return ((newState, subscribers), result)
+
+modifyObservableVar_ :: ObservableVar v -> (v -> IO v) -> IO ()
+modifyObservableVar_ (ObservableVar mvar) f =
modifyMVar_ mvar $ \(oldState, subscribers) -> do
- let newState = f oldState
+ newState <- f oldState
mapM_ (\callback -> callback (Update, newState)) subscribers
return (newState, subscribers)
+withObservableVar :: ObservableVar a -> (a -> IO b) -> IO b
+withObservableVar (ObservableVar mvar) f = withMVar mvar (f . fst)
+
newtype JoinedObservable o = JoinedObservable o
instance forall o i v. (Gettable i o, Gettable v i) => Gettable v (JoinedObservable o) where
diff --git a/src/lib/Qd/Observable/ObservableHashMap.hs b/src/lib/Qd/Observable/ObservableHashMap.hs
index c484ab6..6d93416 100644
--- a/src/lib/Qd/Observable/ObservableHashMap.hs
+++ b/src/lib/Qd/Observable/ObservableHashMap.hs
@@ -6,6 +6,7 @@ module Qd.Observable.ObservableHashMap (
observeKey,
insert,
delete,
+ lookup,
lookupDelete,
) where
@@ -153,6 +154,11 @@ delete key = modifyKeyHandleNotifying_ fn key
let delta = if isJust oldValue then Just (Delete key) else Nothing
return (keyHandle{value=Nothing}, delta)
+lookup :: forall k v. (Eq k, Hashable k) => k -> ObservableHashMap k v -> IO (Maybe v)
+lookup key (ObservableHashMap mvar) = do
+ Handle{keyHandles} <- readMVar mvar
+ return $ join $ value <$> HM.lookup key keyHandles
+
lookupDelete :: forall k v. (Eq k, Hashable k) => k -> ObservableHashMap k v -> IO (Maybe v)
lookupDelete key = modifyKeyHandleNotifying fn key
where
--
GitLab