From 78a2173ff4b53ac5e7862f06bd285913e0c078c1 Mon Sep 17 00:00:00 2001 From: Jens Nolte <git@queezle.net> Date: Sun, 18 Jul 2021 04:06:02 +0200 Subject: [PATCH] Rename getValue to retrieve Co-authored-by: Jan Beinke <git@janbeinke.com> --- src/Quasar/Observable.hs | 56 +++++++++---------- src/Quasar/Observable/Delta.hs | 8 +-- src/Quasar/Observable/ObservableHashMap.hs | 4 +- src/Quasar/Observable/ObservablePriority.hs | 4 +- .../Observable/ObservableHashMapSpec.hs | 14 ++--- .../Observable/ObservablePrioritySpec.hs | 10 ++-- test/Quasar/ObservableSpec.hs | 4 +- 7 files changed, 50 insertions(+), 50 deletions(-) diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs index 7bb0e23..01ff67b 100644 --- a/src/Quasar/Observable.hs +++ b/src/Quasar/Observable.hs @@ -2,8 +2,8 @@ module Quasar.Observable ( Observable(..), - IsGettable(..), - getBlocking, + IsRetrievable(..), + retrieveIO, IsObservable(..), unsafeGetBlocking, subscribe', @@ -49,14 +49,14 @@ mapObservableMessage :: (a -> b) -> ObservableMessage a -> ObservableMessage b mapObservableMessage f (reason, x) = (reason, f x) -class IsGettable v a | a -> v where - getValue :: a -> AsyncIO v +class IsRetrievable v a | a -> v where + retrieve :: a -> AsyncIO v -getBlocking :: IsGettable v a => a -> IO v -getBlocking = runAsyncIO . getValue +retrieveIO :: IsRetrievable v a => a -> IO v +retrieveIO = runAsyncIO . retrieve -class IsGettable v o => IsObservable v o | o -> v where +class IsRetrievable v o => IsObservable v o | o -> v where subscribe :: o -> (ObservableMessage v -> IO ()) -> IO Disposable toObservable :: o -> Observable v @@ -65,9 +65,9 @@ class IsGettable v o => IsObservable v o | o -> v where mapObservable :: (v -> a) -> o -> Observable a mapObservable f = Observable . MappedObservable f --- | Variant of `getBlocking` that throws exceptions instead of returning them. +-- | Variant of `retrieveIO` that throws exceptions instead of returning them. unsafeGetBlocking :: (Exception e, IsObservable (Either e v) o) => o -> IO v -unsafeGetBlocking = either throwIO pure <=< getBlocking +unsafeGetBlocking = either throwIO pure <=< retrieveIO -- | A variant of `subscribe` that passes the `Disposable` to the callback. subscribe' :: IsObservable v o => o -> (Disposable -> ObservableMessage v -> IO ()) -> IO Disposable @@ -76,9 +76,9 @@ subscribe' observable callback = mfix $ \subscription -> subscribe observable (c type ObservableCallback v = ObservableMessage v -> IO () -instance IsGettable v o => IsGettable v (IO o) where - getValue :: IO o -> AsyncIO v - getValue = getValue <=< liftIO +instance IsRetrievable v o => IsRetrievable v (IO o) where + retrieve :: IO o -> AsyncIO v + retrieve = retrieve <=< liftIO instance IsObservable v o => IsObservable v (IO o) where subscribe :: IO o -> (ObservableMessage v -> IO ()) -> IO Disposable @@ -93,8 +93,8 @@ class IsSettable v a | a -> v where -- | Existential quantification wrapper for the IsObservable type class. data Observable v = forall o. IsObservable v o => Observable o -instance IsGettable v (Observable v) where - getValue (Observable o) = getValue o +instance IsRetrievable v (Observable v) where + retrieve (Observable o) = retrieve o instance IsObservable v (Observable v) where subscribe (Observable o) = subscribe o toObservable = id @@ -113,16 +113,16 @@ instance Monad Observable where data MappedObservable b = forall a o. IsObservable a o => MappedObservable (a -> b) o -instance IsGettable v (MappedObservable v) where - getValue (MappedObservable f observable) = f <$> getValue observable +instance IsRetrievable v (MappedObservable v) where + retrieve (MappedObservable f observable) = f <$> retrieve observable instance IsObservable v (MappedObservable v) where subscribe (MappedObservable f observable) callback = subscribe observable (callback . mapObservableMessage f) mapObservable f1 (MappedObservable f2 upstream) = Observable $ MappedObservable (f1 . f2) upstream newtype ObservableVar v = ObservableVar (MVar (v, HM.HashMap Unique (ObservableCallback v))) -instance IsGettable v (ObservableVar v) where - getValue (ObservableVar mvar) = liftIO $ fst <$> readMVar mvar +instance IsRetrievable v (ObservableVar v) where + retrieve (ObservableVar mvar) = liftIO $ fst <$> readMVar mvar instance IsObservable v (ObservableVar v) where subscribe (ObservableVar mvar) callback = do key <- newUnique @@ -170,9 +170,9 @@ bindObservable x fy = joinObservable $ mapObservable fy x newtype JoinedObservable o = JoinedObservable o -instance forall o i v. (IsGettable i o, IsGettable v i) => IsGettable v (JoinedObservable o) where - getValue :: JoinedObservable o -> AsyncIO v - getValue (JoinedObservable outer) = getValue =<< getValue outer +instance forall o i v. (IsRetrievable i o, IsRetrievable v i) => IsRetrievable v (JoinedObservable o) where + retrieve :: JoinedObservable o -> AsyncIO v + retrieve (JoinedObservable outer) = retrieve =<< retrieve outer instance forall o i v. (IsObservable i o, IsObservable v i) => IsObservable v (JoinedObservable o) where subscribe :: (JoinedObservable o) -> (ObservableMessage v -> IO ()) -> IO Disposable subscribe (JoinedObservable outer) callback = do @@ -212,8 +212,8 @@ joinObservableEither' = runExceptT . join . fmap (ExceptT . toObservable) . Exce data MergedObservable o0 v0 o1 v1 r = MergedObservable (v0 -> v1 -> r) o0 o1 -instance forall o0 v0 o1 v1 r. (IsGettable v0 o0, IsGettable v1 o1) => IsGettable r (MergedObservable o0 v0 o1 v1 r) where - getValue (MergedObservable merge obs0 obs1) = merge <$> getValue obs0 <*> getValue obs1 +instance forall o0 v0 o1 v1 r. (IsRetrievable v0 o0, IsRetrievable v1 o1) => IsRetrievable r (MergedObservable o0 v0 o1 v1 r) where + retrieve (MergedObservable merge obs0 obs1) = merge <$> retrieve obs0 <*> retrieve obs1 instance forall o0 v0 o1 v1 r. (IsObservable v0 o0, IsObservable v1 o1) => IsObservable r (MergedObservable o0 v0 o1 v1 r) where subscribe (MergedObservable merge obs0 obs1) callback = do currentValuesTupleRef <- newIORef (Nothing, Nothing) @@ -243,13 +243,13 @@ mergeObservableMaybe :: (IsObservable (Maybe v0) o0, IsObservable (Maybe v1) o1) mergeObservableMaybe merge x y = Observable $ MergedObservable (liftA2 merge) x y --- | Data type that can be used as an implementation for the `IsObservable` interface that works by directly providing functions for `getValue` and `subscribe`. +-- | Data type that can be used as an implementation for the `IsObservable` interface that works by directly providing functions for `retrieve` and `subscribe`. data FnObservable v = FnObservable { getValueFn :: AsyncIO v, subscribeFn :: (ObservableMessage v -> IO ()) -> IO Disposable } -instance IsGettable v (FnObservable v) where - getValue o = getValueFn o +instance IsRetrievable v (FnObservable v) where + retrieve o = getValueFn o instance IsObservable v (FnObservable v) where subscribe o = subscribeFn o mapObservable f FnObservable{getValueFn, subscribeFn} = Observable $ FnObservable { @@ -259,8 +259,8 @@ instance IsObservable v (FnObservable v) where newtype ConstObservable a = ConstObservable a -instance IsGettable a (ConstObservable a) where - getValue (ConstObservable x) = pure x +instance IsRetrievable a (ConstObservable a) where + retrieve (ConstObservable x) = pure x instance IsObservable a (ConstObservable a) where subscribe (ConstObservable x) callback = do callback (Current, x) diff --git a/src/Quasar/Observable/Delta.hs b/src/Quasar/Observable/Delta.hs index f924800..c2862b2 100644 --- a/src/Quasar/Observable/Delta.hs +++ b/src/Quasar/Observable/Delta.hs @@ -46,8 +46,8 @@ class IsObservable (HM.HashMap k v) o => IsDeltaObservable k v o | o -> k, o -> data DeltaObservable k v = forall o. IsDeltaObservable k v o => DeltaObservable o -instance IsGettable (HM.HashMap k v) (DeltaObservable k v) where - getValue (DeltaObservable o) = getValue o +instance IsRetrievable (HM.HashMap k v) (DeltaObservable k v) where + retrieve (DeltaObservable o) = retrieve o instance IsObservable (HM.HashMap k v) (DeltaObservable k v) where subscribe (DeltaObservable o) = subscribe o instance IsDeltaObservable k v (DeltaObservable k v) where @@ -57,8 +57,8 @@ instance Functor (DeltaObservable k) where data MappedDeltaObservable k b = forall a o. IsDeltaObservable k a o => MappedDeltaObservable (a -> b) o -instance IsGettable (HM.HashMap k b) (MappedDeltaObservable k b) where - getValue (MappedDeltaObservable f o) = f <<$>> getValue o +instance IsRetrievable (HM.HashMap k b) (MappedDeltaObservable k b) where + retrieve (MappedDeltaObservable f o) = f <<$>> retrieve o instance IsObservable (HM.HashMap k b) (MappedDeltaObservable k b) where subscribe (MappedDeltaObservable f o) callback = subscribe o (callback . fmap (fmap f)) instance IsDeltaObservable k b (MappedDeltaObservable k b) where diff --git a/src/Quasar/Observable/ObservableHashMap.hs b/src/Quasar/Observable/ObservableHashMap.hs index 7ac394a..b013f03 100644 --- a/src/Quasar/Observable/ObservableHashMap.hs +++ b/src/Quasar/Observable/ObservableHashMap.hs @@ -36,8 +36,8 @@ data KeyHandle v = KeyHandle { makeLensesWith (lensField .~ (\_ _ -> pure . TopName . mkName . ("_" <>) . nameBase) $ lensRules) ''Handle makeLensesWith (lensField .~ (\_ _ -> pure . TopName . mkName . ("_" <>) . nameBase) $ lensRules) ''KeyHandle -instance IsGettable (HM.HashMap k v) (ObservableHashMap k v) where - getValue (ObservableHashMap mvar) = liftIO $ HM.mapMaybe value . keyHandles <$> readMVar mvar +instance IsRetrievable (HM.HashMap k v) (ObservableHashMap k v) where + retrieve (ObservableHashMap mvar) = liftIO $ HM.mapMaybe value . keyHandles <$> readMVar mvar instance IsObservable (HM.HashMap k v) (ObservableHashMap k v) where subscribe ohm callback = modifyHandle update ohm where diff --git a/src/Quasar/Observable/ObservablePriority.hs b/src/Quasar/Observable/ObservablePriority.hs index 5a09cd1..7c926e3 100644 --- a/src/Quasar/Observable/ObservablePriority.hs +++ b/src/Quasar/Observable/ObservablePriority.hs @@ -18,8 +18,8 @@ type Entry v = (Unique, v) -- | Mutable data structure that stores values of type "v" with an assiciated priority "p". The `IsObservable` instance can be used to get or observe the value with the highest priority. newtype ObservablePriority p v = ObservablePriority (MVar (Internals p v)) -instance IsGettable (Maybe v) (ObservablePriority p v) where - getValue (ObservablePriority mvar) = liftIO $ getValueFromInternals <$> readMVar mvar +instance IsRetrievable (Maybe v) (ObservablePriority p v) where + retrieve (ObservablePriority mvar) = liftIO $ getValueFromInternals <$> readMVar mvar where getValueFromInternals :: Internals p v -> Maybe v getValueFromInternals Internals{current=Nothing} = Nothing diff --git a/test/Quasar/Observable/ObservableHashMapSpec.hs b/test/Quasar/Observable/ObservableHashMapSpec.hs index b26e134..9884802 100644 --- a/test/Quasar/Observable/ObservableHashMapSpec.hs +++ b/test/Quasar/Observable/ObservableHashMapSpec.hs @@ -13,15 +13,15 @@ import Test.Hspec spec :: Spec spec = parallel $ do - describe "getBlocking" $ do + describe "retrieveIO" $ do it "returns the contents of the map" $ do om <- OM.new :: IO (OM.ObservableHashMap String String) - getBlocking om `shouldReturn` HM.empty + retrieveIO om `shouldReturn` HM.empty -- Evaluate unit for coverage () <- OM.insert "key" "value" om - getBlocking om `shouldReturn` HM.singleton "key" "value" + retrieveIO om `shouldReturn` HM.singleton "key" "value" OM.insert "key2" "value2" om - getBlocking om `shouldReturn` HM.fromList [("key", "value"), ("key2", "value2")] + retrieveIO om `shouldReturn` HM.fromList [("key", "value"), ("key2", "value2")] describe "subscribe" $ do it "calls the callback with the contents of the map" $ do @@ -74,7 +74,7 @@ spec = parallel $ do OM.lookupDelete "key" om `shouldReturn` Just "changed" lastDeltaShouldBe $ Delete "key" - getBlocking om `shouldReturn` HM.singleton "key3" "value3" + retrieveIO om `shouldReturn` HM.singleton "key3" "value3" describe "observeKey" $ do it "calls key callbacks with the correct value" $ do @@ -113,7 +113,7 @@ spec = parallel $ do v1ShouldBe $ (Update, Nothing) v2ShouldBe $ (Update, Just "changed") - getBlocking om `shouldReturn` HM.singleton "key2" "changed" + retrieveIO om `shouldReturn` HM.singleton "key2" "changed" disposeIO handle2 OM.lookupDelete "key2" om `shouldReturn` (Just "changed") @@ -124,4 +124,4 @@ spec = parallel $ do OM.lookupDelete "key1" om `shouldReturn` Nothing v1ShouldBe $ (Update, Nothing) - getBlocking om `shouldReturn` HM.empty + retrieveIO om `shouldReturn` HM.empty diff --git a/test/Quasar/Observable/ObservablePrioritySpec.hs b/test/Quasar/Observable/ObservablePrioritySpec.hs index 762f67e..4278a3b 100644 --- a/test/Quasar/Observable/ObservablePrioritySpec.hs +++ b/test/Quasar/Observable/ObservablePrioritySpec.hs @@ -16,16 +16,16 @@ spec = do describe "ObservablePriority" $ parallel $ do it "can be created" $ do void $ OP.create - specify "getBlocking returns the value with the highest priority" $ do + specify "retrieveIO returns the value with the highest priority" $ do (op :: ObservablePriority Int String) <- OP.create p2 <- OP.insertValue op 2 "p2" - getBlocking op `shouldReturn` Just "p2" + retrieveIO op `shouldReturn` Just "p2" p1 <- OP.insertValue op 1 "p1" - getBlocking op `shouldReturn` Just "p2" + retrieveIO op `shouldReturn` Just "p2" disposeIO p2 - getBlocking op `shouldReturn` Just "p1" + retrieveIO op `shouldReturn` Just "p1" disposeIO p1 - getBlocking op `shouldReturn` Nothing + retrieveIO op `shouldReturn` Nothing it "sends updates when its value changes" $ do result <- newIORef [] let mostRecentShouldBe = (head <$> readIORef result `shouldReturn`) diff --git a/test/Quasar/ObservableSpec.hs b/test/Quasar/ObservableSpec.hs index cbc5cfa..707a288 100644 --- a/test/Quasar/ObservableSpec.hs +++ b/test/Quasar/ObservableSpec.hs @@ -15,12 +15,12 @@ spec = do mergeObservableSpec :: Spec mergeObservableSpec = do describe "mergeObservable" $ parallel $ do - it "merges correctly using getBlocking" $ do + it "merges correctly using retrieveIO" $ do a <- newObservableVar "" b <- newObservableVar "" let mergedObservable = mergeObservable (,) a b - let latestShouldBe = (getBlocking mergedObservable `shouldReturn`) + let latestShouldBe = (retrieveIO mergedObservable `shouldReturn`) testSequence a b latestShouldBe -- GitLab