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

Refactor Delta constructors

parent c232bde3
No related branches found
No related tags found
No related merge requests found
...@@ -8,13 +8,12 @@ import qualified Data.HashMap.Strict as HM ...@@ -8,13 +8,12 @@ import qualified Data.HashMap.Strict as HM
import Data.Binary (Binary(..)) import Data.Binary (Binary(..))
import Data.IORef import Data.IORef
data Delta k v = Reset (HM.HashMap k v) | Add k v | Change k v | Remove k data Delta k v = Reset (HM.HashMap k v) | Insert k v | Delete k
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
instance Functor (Delta k) where instance Functor (Delta k) where
fmap f (Reset state) = Reset (f <$> state) fmap f (Reset state) = Reset (f <$> state)
fmap f (Add key value) = Add key (f value) fmap f (Insert key value) = Insert key (f value)
fmap f (Change key value) = Add key (f value) fmap _ (Delete key) = Delete key
fmap _ (Remove key) = Remove key
instance (Binary k, Binary v) => Binary (Delta k v) where instance (Binary k, Binary v) => Binary (Delta k v) where
get = undefined get = undefined
put = undefined put = undefined
...@@ -32,12 +31,11 @@ observeHashMapDefaultImpl o callback = do ...@@ -32,12 +31,11 @@ observeHashMapDefaultImpl o callback = do
subscribeDelta o (deltaCallback hashMapRef) subscribeDelta o (deltaCallback hashMapRef)
where where
deltaCallback :: IORef (HM.HashMap k v) -> Delta k v -> IO () deltaCallback :: IORef (HM.HashMap k v) -> Delta k v -> IO ()
deltaCallback hashMapRef delta = callback =<< atomicModifyIORef' hashMapRef ((\x->(x,x)) . (applyDelta delta)) deltaCallback hashMapRef delta = callback =<< atomicModifyIORef' hashMapRef (dup . (applyDelta delta))
applyDelta :: Delta k v -> HM.HashMap k v -> HM.HashMap k v applyDelta :: Delta k v -> HM.HashMap k v -> HM.HashMap k v
applyDelta (Reset state) = const state applyDelta (Reset state) = const state
applyDelta (Add key value) = HM.insert key value applyDelta (Insert key value) = HM.insert key value
applyDelta (Change key value) = HM.insert key value applyDelta (Delete key) = HM.delete key
applyDelta (Remove key) = HM.delete key
data SomeDeltaObservable k v = forall o. DeltaObservable k v o => SomeDeltaObservable o data SomeDeltaObservable k v = forall o. DeltaObservable k v o => SomeDeltaObservable o
......
...@@ -140,10 +140,9 @@ insert :: forall k v. (Eq k, Hashable k) => k -> v -> ObservableHashMap k v -> I ...@@ -140,10 +140,9 @@ insert :: forall k v. (Eq k, Hashable k) => k -> v -> ObservableHashMap k v -> I
insert key value = modifyKeyHandleNotifying_ fn key insert key value = modifyKeyHandleNotifying_ fn key
where where
fn :: KeyHandle v -> IO (KeyHandle v, Maybe (Delta k v)) fn :: KeyHandle v -> IO (KeyHandle v, Maybe (Delta k v))
fn keyHandle@KeyHandle{value=oldValue, keySubscribers} = do fn keyHandle@KeyHandle{keySubscribers} = do
mapM_ ($ (Update, Just value)) $ HM.elems keySubscribers mapM_ ($ (Update, Just value)) $ HM.elems keySubscribers
let delta = if isJust oldValue then Change key value else Add key value return (keyHandle{value=Just value}, Just (Insert key value))
return (keyHandle{value=Just value}, Just delta)
delete :: forall k v. (Eq k, Hashable k) => k -> ObservableHashMap k v -> IO () delete :: forall k v. (Eq k, Hashable k) => k -> ObservableHashMap k v -> IO ()
delete key = modifyKeyHandleNotifying_ fn key delete key = modifyKeyHandleNotifying_ fn key
...@@ -151,7 +150,7 @@ delete key = modifyKeyHandleNotifying_ fn key ...@@ -151,7 +150,7 @@ delete key = modifyKeyHandleNotifying_ fn key
fn :: KeyHandle v -> IO (KeyHandle v, Maybe (Delta k v)) fn :: KeyHandle v -> IO (KeyHandle v, Maybe (Delta k v))
fn keyHandle@KeyHandle{value=oldValue, keySubscribers} = do fn keyHandle@KeyHandle{value=oldValue, keySubscribers} = do
mapM_ ($ (Update, Nothing)) $ HM.elems keySubscribers mapM_ ($ (Update, Nothing)) $ HM.elems keySubscribers
let delta = if isJust oldValue then Just (Remove key) else Nothing let delta = if isJust oldValue then Just (Delete key) else Nothing
return (keyHandle{value=Nothing}, delta) return (keyHandle{value=Nothing}, delta)
lookupDelete :: forall k v. (Eq k, Hashable k) => k -> ObservableHashMap k v -> IO (Maybe v) lookupDelete :: forall k v. (Eq k, Hashable k) => k -> ObservableHashMap k v -> IO (Maybe v)
...@@ -160,5 +159,5 @@ lookupDelete key = modifyKeyHandleNotifying fn key ...@@ -160,5 +159,5 @@ lookupDelete key = modifyKeyHandleNotifying fn key
fn :: KeyHandle v -> IO (KeyHandle v, (Maybe (Delta k v), Maybe v)) fn :: KeyHandle v -> IO (KeyHandle v, (Maybe (Delta k v), Maybe v))
fn keyHandle@KeyHandle{value=oldValue, keySubscribers} = do fn keyHandle@KeyHandle{value=oldValue, keySubscribers} = do
mapM_ ($ (Update, Nothing)) $ HM.elems keySubscribers mapM_ ($ (Update, Nothing)) $ HM.elems keySubscribers
let delta = if isJust oldValue then Just (Remove key) else Nothing let delta = if isJust oldValue then Just (Delete key) else Nothing
return (keyHandle{value=Nothing}, (delta, oldValue)) return (keyHandle{value=Nothing}, (delta, oldValue))
...@@ -52,26 +52,26 @@ spec = parallel $ do ...@@ -52,26 +52,26 @@ spec = parallel $ do
lastDeltaShouldBe $ Reset HM.empty lastDeltaShouldBe $ Reset HM.empty
OM.insert "key" "value" om OM.insert "key" "value" om
lastDeltaShouldBe $ Add "key" "value" lastDeltaShouldBe $ Insert "key" "value"
OM.insert "key" "changed" om OM.insert "key" "changed" om
lastDeltaShouldBe $ Change "key" "changed" lastDeltaShouldBe $ Insert "key" "changed"
OM.insert "key2" "value2" om OM.insert "key2" "value2" om
lastDeltaShouldBe $ Add "key2" "value2" lastDeltaShouldBe $ Insert "key2" "value2"
dispose subscriptionHandle dispose subscriptionHandle
lastDeltaShouldBe $ Add "key2" "value2" lastDeltaShouldBe $ Insert "key2" "value2"
OM.insert "key3" "value3" om OM.insert "key3" "value3" om
lastDeltaShouldBe $ Add "key2" "value2" lastDeltaShouldBe $ Insert "key2" "value2"
void $ subscribeDelta om $ writeIORef lastDelta void $ subscribeDelta om $ writeIORef lastDelta
lastDeltaShouldBe $ Reset $ HM.fromList [("key", "changed"), ("key2", "value2"), ("key3", "value3")] lastDeltaShouldBe $ Reset $ HM.fromList [("key", "changed"), ("key2", "value2"), ("key3", "value3")]
OM.delete "key2" om OM.delete "key2" om
lastDeltaShouldBe $ Remove "key2" lastDeltaShouldBe $ Delete "key2"
OM.lookupDelete "key" om `shouldReturn` Just "changed" OM.lookupDelete "key" om `shouldReturn` Just "changed"
lastDeltaShouldBe $ Remove "key" lastDeltaShouldBe $ Delete "key"
getValue om `shouldReturn` HM.singleton "key3" "value3" getValue om `shouldReturn` HM.singleton "key3" "value3"
......
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