Implement some MVar-like helpers for ObservableVar

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

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