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

Rename IsObservable to Observable

parent 0931ef14
No related branches found
No related tags found
No related merge requests found
module Qd.Observable (
SomeObservable(..),
IsObservable(..),
Observable(..),
subscribe',
SubscriptionHandle(..),
Callback,
......@@ -36,20 +36,20 @@ mapObservableMessage f (r, s) = (r, ) <$> mapObservableState f s
newtype SubscriptionHandle = SubscriptionHandle { unsubscribe :: IO () }
class IsObservable v o | o -> v where
class Observable v o | o -> v where
getValue :: o -> IO (ObservableState v)
subscribe :: o -> (ObservableMessage v -> IO ()) -> IO SubscriptionHandle
mapObservable :: (v -> IO a) -> o -> SomeObservable a
mapObservable f = SomeObservable . MappedObservable f
subscribe' :: IsObservable 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)
type Callback v = ObservableMessage v -> IO ()
-- | Existential quantification wrapper for the Observable type class.
data SomeObservable v = forall o. IsObservable v o => SomeObservable o
instance IsObservable v (SomeObservable v) where
data SomeObservable v = forall o. Observable v o => SomeObservable o
instance Observable v (SomeObservable v) where
getValue (SomeObservable o) = getValue o
subscribe (SomeObservable o) = subscribe o
mapObservable f (SomeObservable o) = mapObservable f o
......@@ -57,15 +57,15 @@ instance IsObservable v (SomeObservable v) where
instance Functor SomeObservable where
fmap f = mapObservable (return . f)
data MappedObservable b = forall a o. IsObservable a o => MappedObservable (a -> IO b) o
instance IsObservable v (MappedObservable v) where
data MappedObservable b = forall a o. Observable a o => MappedObservable (a -> IO b) o
instance Observable v (MappedObservable v) where
getValue (MappedObservable f observable) = mapObservableState f =<< getValue observable
subscribe (MappedObservable f observable) callback = subscribe observable (callback <=< mapObservableMessage f)
mapObservable f1 (MappedObservable f2 upstream) = SomeObservable $ MappedObservable (f1 <=< f2) upstream
newtype BasicObservable v = BasicObservable (MVar (ObservableState v, HM.HashMap Unique (Callback v)))
instance IsObservable v (BasicObservable v) where
instance Observable v (BasicObservable v) where
getValue (BasicObservable mvar) = fst <$> readMVar mvar
subscribe (BasicObservable mvar) callback = do
key <- newUnique
......
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