Skip to content
Snippets Groups Projects
Commit 33f8a586 authored by Jens Nolte's avatar Jens Nolte
Browse files

Update BasicObservable api

parent bf1b2d83
No related branches found
No related tags found
No related merge requests found
...@@ -5,13 +5,13 @@ module Qd.Observable ( ...@@ -5,13 +5,13 @@ module Qd.Observable (
Observable(..), Observable(..),
subscribe', subscribe',
SubscriptionHandle(..), SubscriptionHandle(..),
Callback,
RegistrationHandle(..), RegistrationHandle(..),
ObservableCallback,
ObservableState, ObservableState,
ObservableMessage, ObservableMessage,
MessageReason(..), MessageReason(..),
BasicObservable, BasicObservable,
mkBasicObservable, createBasicObservable,
setBasicObservable, setBasicObservable,
updateBasicObservable, updateBasicObservable,
joinObservable, joinObservable,
...@@ -52,7 +52,7 @@ class Observable v o | o -> v where ...@@ -52,7 +52,7 @@ class Observable v o | o -> v where
subscribe' :: Observable v o => o -> (SubscriptionHandle -> ObservableMessage v -> IO ()) -> IO SubscriptionHandle subscribe' :: Observable v o => o -> (SubscriptionHandle -> ObservableMessage v -> IO ()) -> IO SubscriptionHandle
subscribe' observable callback = mfix $ \subscription -> subscribe observable (callback subscription) subscribe' observable callback = mfix $ \subscription -> subscribe observable (callback subscription)
type Callback v = ObservableMessage v -> IO () type ObservableCallback v = ObservableMessage v -> IO ()
-- | Existential quantification wrapper for the Observable type class. -- | Existential quantification wrapper for the Observable type class.
...@@ -74,7 +74,7 @@ instance Observable v (MappedObservable v) where ...@@ -74,7 +74,7 @@ instance Observable v (MappedObservable v) where
mapObservable f1 (MappedObservable f2 upstream) = SomeObservable $ MappedObservable (f1 <=< f2) upstream mapObservable f1 (MappedObservable f2 upstream) = SomeObservable $ MappedObservable (f1 <=< f2) upstream
newtype BasicObservable v = BasicObservable (MVar (ObservableState v, HM.HashMap Unique (Callback v))) newtype BasicObservable v = BasicObservable (MVar (ObservableState v, HM.HashMap Unique (ObservableCallback v)))
instance Observable v (BasicObservable v) where instance Observable v (BasicObservable v) where
getValue (BasicObservable mvar) = fst <$> readMVar mvar getValue (BasicObservable mvar) = fst <$> readMVar mvar
subscribe (BasicObservable mvar) callback = do subscribe (BasicObservable mvar) callback = do
...@@ -88,16 +88,15 @@ instance Observable v (BasicObservable v) where ...@@ -88,16 +88,15 @@ instance Observable v (BasicObservable v) where
unsubscribe' :: Unique -> IO () unsubscribe' :: Unique -> IO ()
unsubscribe' key = modifyMVar_ mvar $ \(state, subscribers) -> return (state, HM.delete key subscribers) unsubscribe' key = modifyMVar_ mvar $ \(state, subscribers) -> return (state, HM.delete key subscribers)
mkBasicObservable :: Maybe v -> IO (BasicObservable v) createBasicObservable :: Maybe v -> IO (BasicObservable v)
mkBasicObservable defaultValue = do createBasicObservable defaultValue = do
BasicObservable <$> newMVar (defaultValue, HM.empty) BasicObservable <$> newMVar (defaultValue, HM.empty)
setBasicObservable :: BasicObservable v -> v -> IO () setBasicObservable :: BasicObservable v -> ObservableState v -> IO ()
setBasicObservable (BasicObservable mvar) value = do setBasicObservable (BasicObservable mvar) value = do
modifyMVar_ mvar $ \(_, subscribers) -> do modifyMVar_ mvar $ \(_, subscribers) -> do
let newState = Just value mapM_ (\callback -> callback (Update, value)) subscribers
mapM_ (\callback -> callback (Update, newState)) subscribers return (value, subscribers)
return (newState, subscribers)
updateBasicObservable :: BasicObservable v -> (v -> v) -> IO () updateBasicObservable :: BasicObservable v -> (v -> v) -> IO ()
updateBasicObservable (BasicObservable mvar) f = updateBasicObservable (BasicObservable mvar) f =
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment