From eaad17772d31bcd70250bdd526fcdeb7fd8d6a50 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Tue, 3 Nov 2020 19:58:53 +0100
Subject: [PATCH] Refactor Delta constructors

---
 src/lib/Qd/Observable/Delta.hs              | 14 ++++++--------
 src/lib/Qd/Observable/ObservableHashMap.hs  |  9 ++++-----
 test/Qd/Observable/ObservableHashMapSpec.hs | 14 +++++++-------
 3 files changed, 17 insertions(+), 20 deletions(-)

diff --git a/src/lib/Qd/Observable/Delta.hs b/src/lib/Qd/Observable/Delta.hs
index cbeb5e5..598d7a2 100644
--- a/src/lib/Qd/Observable/Delta.hs
+++ b/src/lib/Qd/Observable/Delta.hs
@@ -8,13 +8,12 @@ import qualified Data.HashMap.Strict as HM
 import Data.Binary (Binary(..))
 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)
 instance Functor (Delta k) where
   fmap f (Reset state) = Reset (f <$> state)
-  fmap f (Add key value) = Add key (f value)
-  fmap f (Change key value) = Add key (f value)
-  fmap _ (Remove key) = Remove key
+  fmap f (Insert key value) = Insert key (f value)
+  fmap _ (Delete key) = Delete key
 instance (Binary k, Binary v) => Binary (Delta k v) where
   get = undefined
   put = undefined
@@ -32,12 +31,11 @@ observeHashMapDefaultImpl o callback = do
   subscribeDelta o (deltaCallback hashMapRef)
   where
     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 (Reset state) = const state
-    applyDelta (Add key value) = HM.insert key value
-    applyDelta (Change key value) = HM.insert key value
-    applyDelta (Remove key) = HM.delete key
+    applyDelta (Insert key value) = HM.insert key value
+    applyDelta (Delete key) = HM.delete key
 
 
 data SomeDeltaObservable k v = forall o. DeltaObservable k v o => SomeDeltaObservable o
diff --git a/src/lib/Qd/Observable/ObservableHashMap.hs b/src/lib/Qd/Observable/ObservableHashMap.hs
index 7067fd9..c484ab6 100644
--- a/src/lib/Qd/Observable/ObservableHashMap.hs
+++ b/src/lib/Qd/Observable/ObservableHashMap.hs
@@ -140,10 +140,9 @@ insert :: forall k v. (Eq k, Hashable k) => k -> v -> ObservableHashMap k v -> I
 insert key value = modifyKeyHandleNotifying_ fn key
   where
     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
-      let delta = if isJust oldValue then Change key value else Add key value
-      return (keyHandle{value=Just value}, Just delta)
+      return (keyHandle{value=Just value}, Just (Insert key value))
 
 delete :: forall k v. (Eq k, Hashable k) => k -> ObservableHashMap k v -> IO ()
 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@KeyHandle{value=oldValue, keySubscribers} = do
       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)
 
 lookupDelete :: forall k v. (Eq k, Hashable k) => k -> ObservableHashMap k v -> IO (Maybe v)
@@ -160,5 +159,5 @@ lookupDelete key = modifyKeyHandleNotifying fn key
     fn :: KeyHandle v -> IO (KeyHandle v, (Maybe (Delta k v), Maybe v))
     fn keyHandle@KeyHandle{value=oldValue, keySubscribers} = do
       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))
diff --git a/test/Qd/Observable/ObservableHashMapSpec.hs b/test/Qd/Observable/ObservableHashMapSpec.hs
index 20ad5d7..c793603 100644
--- a/test/Qd/Observable/ObservableHashMapSpec.hs
+++ b/test/Qd/Observable/ObservableHashMapSpec.hs
@@ -52,26 +52,26 @@ spec = parallel $ do
 
       lastDeltaShouldBe $ Reset HM.empty
       OM.insert "key" "value" om
-      lastDeltaShouldBe $ Add "key" "value"
+      lastDeltaShouldBe $ Insert "key" "value"
       OM.insert "key" "changed" om
-      lastDeltaShouldBe $ Change "key" "changed"
+      lastDeltaShouldBe $ Insert "key" "changed"
       OM.insert "key2" "value2" om
-      lastDeltaShouldBe $ Add "key2" "value2"
+      lastDeltaShouldBe $ Insert "key2" "value2"
 
       dispose subscriptionHandle
-      lastDeltaShouldBe $ Add "key2" "value2"
+      lastDeltaShouldBe $ Insert "key2" "value2"
 
       OM.insert "key3" "value3" om
-      lastDeltaShouldBe $ Add "key2" "value2"
+      lastDeltaShouldBe $ Insert "key2" "value2"
 
       void $ subscribeDelta om $ writeIORef lastDelta
       lastDeltaShouldBe $ Reset $ HM.fromList [("key", "changed"), ("key2", "value2"), ("key3", "value3")]
 
       OM.delete "key2" om
-      lastDeltaShouldBe $ Remove "key2"
+      lastDeltaShouldBe $ Delete "key2"
 
       OM.lookupDelete "key" om `shouldReturn` Just "changed"
-      lastDeltaShouldBe $ Remove "key"
+      lastDeltaShouldBe $ Delete "key"
 
       getValue om `shouldReturn` HM.singleton "key3" "value3"
 
-- 
GitLab