diff --git a/src/lib/Qd/Observable.hs b/src/lib/Qd/Observable.hs index eb216fc345fa848e8bd04fc7d4994c701b771872..2fc1a016642e7eb1e01b9759c586a3519d6cc350 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 c484ab69a585dbf5e1ee848cb7106984c8010bee..6d934166624c11be37b6203f513bc8c6c8d4e479 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