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

Move GetT to Qd.Utils.GetT to implement `lookupInsert`

parent b6572b26
No related branches found
No related tags found
No related merge requests found
...@@ -10,10 +10,9 @@ module Qd.Observable.ObservableMap ( ...@@ -10,10 +10,9 @@ module Qd.Observable.ObservableMap (
) where ) where
import Qd.Observable import Qd.Observable
import Qd.Utils.GetT
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Data.Bifunctor
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Unique import Data.Unique
import Prelude hiding (lookup, lookupDelete) import Prelude hiding (lookup, lookupDelete)
...@@ -25,14 +24,6 @@ data ObservableValue v = ObservableValue { ...@@ -25,14 +24,6 @@ data ObservableValue v = ObservableValue {
subscribers :: (HM.HashMap Unique (ObservableMessage v -> IO ())) subscribers :: (HM.HashMap Unique (ObservableMessage v -> IO ()))
} }
newtype GetT s m r = GetT {
runGetT :: m (r, s)
}
instance Functor m => Functor (GetT s m) where
fmap :: (a -> b) -> (GetT s m) a -> (GetT s m) b
fmap fn = GetT . fmap (first fn) . runGetT
modifyValue :: forall k v a. (Eq k, Hashable k) => (ObservableValue v -> IO (ObservableValue v, a)) -> k -> ObservableMap k v -> IO a modifyValue :: forall k v a. (Eq k, Hashable k) => (ObservableValue v -> IO (ObservableValue v, a)) -> k -> ObservableMap k v -> IO a
modifyValue f k (ObservableMap mvar) = modifyMVar mvar $ \hashmap -> runGetT (HM.alterF update k hashmap) modifyValue f k (ObservableMap mvar) = modifyMVar mvar $ \hashmap -> runGetT (HM.alterF update k hashmap)
where where
......
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