genvalidity-mergeless 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+287/−247 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• bench/Bench.hs +12/−21
• genvalidity-mergeless.cabal +3/−3
• src/Data/GenValidity/Mergeless.hs +3/−2
• src/Data/GenValidity/Mergeless/Collection.hs +52/−35
• src/Data/GenValidity/Mergeless/Item.hs +0/−1
• test/Data/Mergeless/CollectionSpec.hs +184/−160
• test/Data/Mergeless/ItemSpec.hs +33/−25

@@ -1,14 +1,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Main where  import Criterion.Main as Criterion- import Data.GenValidity.Criterion import Data.GenValidity.Mergeless ()- import Data.Mergeless.Collection import Data.Mergeless.Item @@ -16,25 +14,18 @@ main =   Criterion.defaultMain     [ bgroup-        "Utils"-        [ genValidBench @(Added Bool)-        , genValidBench @(Synced Bool)-        , genValidBench @(ClientAddition Int)-        ]-    , bgroup         "Item"-        [ genValidBench @(ClientItem Bool)-        , genValidBench @(ItemSyncRequest Bool)-        , genValidBench @(ItemSyncResponse Bool)-        , genValidBench @(ServerItem Bool)-        ]-    , bgroup+        [ genValidBench @(ClientItem Bool),+          genValidBench @(ItemSyncRequest Bool),+          genValidBench @(ItemSyncResponse Bool),+          genValidBench @(ServerItem Bool)+        ],+      bgroup         "Collection"-        [ genValidBench @ClientId-        , genValidBench @(ClientStore Int Bool)-        , genValidBench @(SyncRequest Int Bool)-        , genValidBench @(ClientAddition Int)-        , genValidBench @(SyncResponse Int Bool)-        , genValidBench @(ServerStore Int Bool)+        [ genValidBench @ClientId,+          genValidBench @(ClientStore ClientId Int Bool),+          genValidBench @(SyncRequest ClientId Int Bool),+          genValidBench @(SyncResponse ClientId Int Bool),+          genValidBench @(ServerStore Int Bool)         ]     ]

@@ -4,16 +4,16 @@ -- -- see: https://github.com/sol/hpack ----- hash: 13b8526e5aa6ded49e51ebf12a1008ee6f2e8f428b081a7766bfc17ddeef7848+-- hash: 0fb32a64505d66389249b91ab33990a95c7b3f63032e84f0dc094e1439aec358  name:           genvalidity-mergeless-version:        0.1.0.0+version:        0.2.0.0 description:    Please see the README on GitHub at <https://github.com/NorfairKing/mergeless#readme> homepage:       https://github.com/NorfairKing/mergeless#readme bug-reports:    https://github.com/NorfairKing/mergeless/issues author:         Tom Sydney Kerckhove maintainer:     syd.kerckhove@gmail.com-copyright:      Copyright: (c) 2018 Tom Sydney Kerckhove+copyright:      Copyright: (c) 2018-2020 Tom Sydney Kerckhove license:        MIT build-type:     Simple extra-source-files:

@@ -1,7 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Data.GenValidity.Mergeless-  ( module Data.GenValidity.Mergeless.Collection-  ) where+  ( module Data.GenValidity.Mergeless.Collection,+  )+where  import Data.GenValidity.Mergeless.Collection

@@ -4,20 +4,17 @@  module Data.GenValidity.Mergeless.Collection where -import qualified Data.Map as M-import Data.Map (Map)-import qualified Data.Set as S-import Data.Set (Set)- import Control.Monad- import Data.GenValidity import Data.GenValidity.Containers ()-import Data.GenValidity.Time ()-import Test.QuickCheck- import Data.GenValidity.Mergeless.Item ()+import Data.GenValidity.Time ()+import qualified Data.Map as M+import Data.Map (Map) import Data.Mergeless+import qualified Data.Set as S+import Data.Set (Set)+import Test.QuickCheck  instance GenUnchecked ClientId @@ -25,10 +22,11 @@   genValid = genValidStructurallyWithoutExtraChecking   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering -instance (GenUnchecked i, GenUnchecked a, Show i, Show a, Ord i, Ord a) =>-         GenUnchecked (ClientStore i a)+instance+  (GenUnchecked ci, GenUnchecked si, GenUnchecked a, Show ci, Show si, Show a, Ord ci, Ord si, Ord a) =>+  GenUnchecked (ClientStore ci si a) -instance (GenValid i, GenValid a, Show i, Show a, Ord i, Ord a) => GenValid (ClientStore i a) where+instance (GenValid ci, GenValid si, GenValid a, Show ci, Show si, Show a, Ord ci, Ord si, Ord a) => GenValid (ClientStore ci si a) where   genValid =     sized $ \n -> do       (a, b, c) <- genSplit3 n@@ -39,13 +37,15 @@       pure ClientStore {..}   shrinkValid = shrinkValidStructurally -instance (GenUnchecked i, GenUnchecked a, Show i, Show a, GenInvalid i, GenInvalid a, Ord i, Ord a) =>-         GenInvalid (ClientStore i a)+instance+  (GenUnchecked ci, GenUnchecked si, GenUnchecked a, Show ci, Show si, Show a, GenInvalid ci, GenInvalid si, GenInvalid a, Ord ci, Ord si, Ord a) =>+  GenInvalid (ClientStore ci si a) -instance (GenUnchecked i, GenUnchecked a, Show i, Show a, Ord i, Ord a) =>-         GenUnchecked (SyncRequest i a)+instance+  (GenUnchecked ci, GenUnchecked si, GenUnchecked a, Show ci, Show si, Show a, Ord ci, Ord si, Ord a) =>+  GenUnchecked (SyncRequest ci si a) -instance (GenValid i, GenValid a, Show i, Show a, Ord i, Ord a) => GenValid (SyncRequest i a) where+instance (GenValid ci, GenValid si, GenValid a, Show ci, Show si, Show a, Ord ci, Ord si, Ord a) => GenValid (SyncRequest ci si a) where   genValid =     sized $ \n -> do       (a, b, c) <- genSplit3 n@@ -56,22 +56,25 @@       pure SyncRequest {..}   shrinkValid = shrinkValidStructurally -instance (GenUnchecked i, GenUnchecked a, Show i, Show a, GenInvalid i, GenInvalid a, Ord i, Ord a) =>-         GenInvalid (SyncRequest i a)+instance+  (GenUnchecked ci, GenUnchecked si, GenUnchecked a, Show ci, Show si, Show a, GenInvalid ci, GenInvalid si, GenInvalid a, Ord ci, Ord si, Ord a) =>+  GenInvalid (SyncRequest ci si a) -instance (GenUnchecked i, GenUnchecked a, Show i, Show a, Ord i, Ord a) =>-         GenUnchecked (SyncResponse i a)+instance+  (GenUnchecked ci, GenUnchecked si, GenUnchecked a, Show ci, Show si, Show a, Ord ci, Ord si, Ord a) =>+  GenUnchecked (SyncResponse ci si a) -instance (GenValid i, GenValid a, Show i, Show a, Ord i, Ord a) => GenValid (SyncResponse i a) where+instance (GenValid ci, GenValid si, GenValid a, Show ci, Show si, Show a, Ord ci, Ord si, Ord a) => GenValid (SyncResponse ci si a) where   genValid = do     (s1, s2) <- genValid >>= splitSet     (s3, s4) <- splitSet s1     (s5, s6) <- splitSet s2     syncResponseClientAdded <--      fmap M.fromList $-      forM (S.toList s3) $ \i -> do-        cid <- genValid -- TODO maybe we can find a way to not generate duplicate client ids and speed up this generator, but it's fine for now.-        pure (cid, i)+      fmap M.fromList+        $ forM (S.toList s3)+        $ \i -> do+          cid <- genValid -- TODO maybe we can find a way to not generate duplicate client ids and speed up this generator, but it's fine for now.+          pure (cid, i)     let syncResponseClientDeleted = s4     syncResponseServerAdded <- mapWithIds s5     let syncResponseServerDeleted = s6@@ -87,23 +90,37 @@       pure $ S.split a s  mapWithIds :: (Ord i, GenValid a) => Set i -> Gen (Map i a)-mapWithIds s = fmap M.fromList $ forM (S.toList s) $ \i -> (,) i <$> genValid+mapWithIds = traverse id . M.fromSet (const genValid) -instance (GenUnchecked i, GenUnchecked a, Show i, Show a, GenInvalid i, GenInvalid a, Ord i, Ord a) =>-         GenInvalid (SyncResponse i a)+instance+  (GenUnchecked ci, GenUnchecked si, GenUnchecked a, Show ci, Show si, Show a, GenInvalid ci, GenInvalid si, GenInvalid a, Ord ci, Ord si, Ord a) =>+  GenInvalid (SyncResponse ci si a) -instance (GenUnchecked i, GenUnchecked a, Ord i, Ord a) => GenUnchecked (ServerStore i a)+instance (GenUnchecked si, GenUnchecked a, Ord si, Ord a) => GenUnchecked (ServerStore si a) -instance (GenValid i, GenValid a, Show i, Show a, Ord i, Ord a) => GenValid (ServerStore i a) where+instance (GenValid si, GenValid a, Show si, Show a, Ord si, Ord a) => GenValid (ServerStore si a) where   genValid = genValidStructurallyWithoutExtraChecking   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering -instance (GenUnchecked i, GenUnchecked a, Show i, Show a, GenInvalid i, GenInvalid a, Ord i, Ord a) =>-         GenInvalid (ServerStore i a)+instance+  (GenUnchecked si, GenUnchecked a, Show si, Show a, GenInvalid si, GenInvalid a, Ord si, Ord a) =>+  GenInvalid (ServerStore si a) +genServerStoreFromSet :: (Ord si, GenValid v) => Set si -> Gen (ServerStore si v)+genServerStoreFromSet s = ServerStore <$> mapWithIds s+ genUnsyncedStore ::-     forall i a. (Ord i, Ord a, GenValid i, GenValid a)-  => Gen (ClientStore i a)+  forall ci si a.+  (Show ci, Ord ci, Ord si, Ord a, GenValid ci, GenValid si, GenValid a) =>+  Gen (ClientStore ci si a) genUnsyncedStore = do   as <- genValid   pure $ emptyClientStore {clientStoreAdded = as}++genClientStoreFromSet :: (Show ci, Ord ci, Ord si, GenValid ci, GenValid v) => Set si -> Gen (ClientStore ci si v)+genClientStoreFromSet s = do+  (s1, s2) <- splitSet s+  clientStoreAdded <- genValid+  clientStoreSynced <- mapWithIds s1+  let clientStoreDeleted = s2+  pure ClientStore {..}

@@ -6,7 +6,6 @@ import Data.GenValidity import Data.GenValidity.Containers () import Data.GenValidity.Time ()- import Data.Mergeless.Item  instance GenUnchecked a => GenUnchecked (ClientItem a)

@@ -5,108 +5,122 @@ {-# LANGUAGE TypeApplications #-}  module Data.Mergeless.CollectionSpec-  ( spec-  ) where+  ( spec,+  )+where +import Control.Monad.State+import Data.GenValidity.Mergeless.Collection ()+import Data.GenValidity.UUID () import Data.Int (Int) import Data.List import qualified Data.Map.Strict as M+import Data.Mergeless.Collection import Data.Ord import qualified Data.Set as S+import Data.UUID import GHC.Generics (Generic) import System.Random--import Control.Monad.State- import Test.Hspec import Test.QuickCheck import Test.Validity import Test.Validity.Aeson -import Data.GenValidity.Mergeless.Collection ()-import Data.GenValidity.UUID ()-import Data.Mergeless.Collection-import Data.UUID- {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}  spec :: Spec spec = do-  genValidSpec @(ClientStore Int Int)-  jsonSpecOnValid @(ClientStore Int Int)-  genValidSpec @(SyncRequest Int Int)-  jsonSpecOnValid @(SyncRequest Int Int)-  genValidSpec @(SyncResponse Int Int)-  jsonSpecOnValid @(SyncResponse Int Int)+  genValidSpec @(ClientStore ClientId Int Int)+  jsonSpecOnValid @(ClientStore ClientId Int Int)+  genValidSpec @(SyncRequest ClientId Int Int)+  jsonSpecOnValid @(SyncRequest ClientId Int Int)+  genValidSpec @(SyncResponse ClientId Int Int)+  jsonSpecOnValid @(SyncResponse ClientId Int Int)   genValidSpec @(ServerStore Int Int)   jsonSpecOnValid @(ServerStore Int Int)-  describe "emptyStore" $ it "is valid" $ shouldBeValid (emptyClientStore @Int @Int)+  describe "emptyStore" $ it "is valid" $ shouldBeValid (emptyClientStore @Int @Int @Int)   describe "storeSize" $ do-    it "does not crash" $ producesValidsOnValids (storeSize @Int @Int)-    specify "adding an item makes the store bigger" $-      forAllValid $ \store ->+    it "does not crash" $ producesValidsOnValids (storeSize @Int @Int @Int)+    specify "adding an item makes the store bigger"+      $ forAllValid+      $ \store ->         forAllValid $ \added -> do-          let size1 = storeSize (store :: ClientStore Int Int)+          let size1 = storeSize (store :: ClientStore Int Int Int)           let store' = addItemToClientStore added store           let size2 = storeSize store'           size2 `shouldBe` (size1 + 1)-    specify "deleting an unsynced item after adding it leaves the store with the original size" $-      forAllValid $ \store ->+    specify "deleting an unsynced item after adding it leaves the store with the original size"+      $ forAllValid+      $ \store ->         forAllValid $ \added ->-          let size1 = storeSize (store :: ClientStore Int Int)+          let size1 = storeSize (store :: ClientStore Int Int Int)               store' = addItemToClientStore added store            in case sortOn (Down . fst) $ M.toList (clientStoreAdded store') of                 [] -> expectationFailure "Expected a nonempty list"-                (i, _):_ ->+                (i, _) : _ ->                   let store'' = deleteUnsyncedFromClientStore i store'                       size2 = storeSize store''                    in size2 `shouldBe` size1-    specify "deleting a synced item after adding it leaves the store with the original size" $-      forAllValid $ \store ->+    specify "deleting a synced item after adding it leaves the store with the original size"+      $ forAllValid+      $ \store ->         forAll (genValid `suchThat` (\uuid -> not $ M.member uuid $ clientStoreSynced store)) $ \uuid ->           forAllValid $ \synced ->-            let size1 = storeSize (store :: ClientStore Int Int)+            let size1 = storeSize (store :: ClientStore Int Int Int)                 store' = store {clientStoreSynced = M.insert uuid synced $ clientStoreSynced store}                 store'' = deleteSyncedFromClientStore uuid store'                 size2 = storeSize store''              in size2 `shouldBe` size1-  describe "addItemToClientStore" $-    it "produces valid stores" $ producesValidsOnValids2 (addItemToClientStore @Int @Int)-  describe "deleteUnsyncedFromClientStore" $-    it "produces valid stores" $ producesValidsOnValids2 (deleteUnsyncedFromClientStore @Int @Int)-  describe "deleteSyncedFromClientStore" $-    it "produces valid stores" $ producesValidsOnValids2 (deleteSyncedFromClientStore @Int @Int)-  describe "makeSyncRequest" $-    it "produces valid sync requests" $ producesValidsOnValids (makeSyncRequest @Int @Int)+  describe "addItemToClientStore"+    $ it "produces valid stores"+    $ producesValidsOnValids2 (addItemToClientStore @Int @Int @Int)+  describe "deleteUnsyncedFromClientStore"+    $ it "produces valid stores"+    $ producesValidsOnValids2 (deleteUnsyncedFromClientStore @Int @Int @Int)+  describe "deleteSyncedFromClientStore"+    $ it "produces valid stores"+    $ producesValidsOnValids2 (deleteSyncedFromClientStore @Int @Int @Int)+  describe "emptySyncRequest"+    $ it "is valid"+    $ shouldBeValid (emptySyncRequest @Int @Int @Int)+  describe "makeSyncRequest"+    $ it "produces valid sync requests"+    $ producesValidsOnValids (makeSyncRequest @Int @Int @Int)   describe "mergeSyncResponse" $ do-    it "produces valid sync stores" $ producesValidsOnValids2 (mergeSyncResponse @Int @Int)-    it "adds the single item that the server tells it to add to an empty client store" $-      forAllValid $ \cid ->+    it "produces valid sync stores" $ producesValidsOnValids2 (mergeSyncResponse @Int @Int @Int)+    it "adds the single item that the server tells it to add to an empty client store"+      $ forAllValid+      $ \cid ->         forAllValid $ \a ->           forAllValid $ \u -> do-            let cstore1 = emptyClientStore {clientStoreAdded = M.singleton cid (a :: Int)}+            let cstore1 = emptyClientStore {clientStoreAdded = M.singleton (cid :: ClientId) (a :: Int)}                 resp = emptySyncResponse {syncResponseClientAdded = M.singleton cid (u :: Int)}                 cstore2 = mergeSyncResponse cstore1 resp             clientStoreSynced cstore2 `shouldBe` M.singleton u a-    it "deletes items that the server instructed to be deleted" $-      forAllValid $ \cs ->+    it "deletes items that the server instructed to be deleted"+      $ forAllValid+      $ \cs ->         forAllValid $ \sr -> do-          let cs' = mergeSyncResponse @Int @Int cs sr-          clientStoreDeleted cs' `shouldBe`-            (clientStoreDeleted cs `S.difference` syncResponseClientDeleted sr)-  describe "processServerSync" $-    describe "deterministic UUIDs" $ serverSyncSpec @Int evalDM $ processServerSync genD+          let cs' = mergeSyncResponse @ClientId @Int @Int cs sr+          clientStoreDeleted cs'+            `shouldBe` (clientStoreDeleted cs `S.difference` syncResponseClientDeleted sr)+  describe "processServerSync"+    $ describe "deterministic UUIDs"+    $ serverSyncSpec @Int evalDM+    $ processServerSync genD  serverSyncSpec ::-     forall a i m. (Show i, Ord i, GenValid i, Show a, Ord a, GenValid a, MonadIO m)-  => (forall r. m r -> IO r)-  -> (ServerStore i a -> SyncRequest i a -> m (SyncResponse i a, ServerStore i a))-  -> Spec+  forall a si m.+  (Show si, Ord si, GenValid si, Show a, Ord a, GenValid a, MonadIO m) =>+  (forall r. m r -> IO r) ->+  (ServerStore si a -> SyncRequest ClientId si a -> m (SyncResponse ClientId si a, ServerStore si a)) ->+  Spec serverSyncSpec eval func = do   describe "Single client" $ do     describe "Single-item" $ do-      it "succesfully downloads a single item from the server for an empty client" $-        forAllValid $ \u ->+      it "succesfully downloads a single item from the server for an empty client"+        $ forAllValid+        $ \u ->           forAllValid $ \i ->             eval $ do               let sstore1 = emptyServerStore {serverStoreItems = M.singleton u i}@@ -117,8 +131,9 @@               liftIO $ do                 sstore2 `shouldBe` sstore1                 clientStoreSynced cstore2 `shouldBe` serverStoreItems sstore2-      it "succesfully uploads a single item to the server for an empty server" $-        forAllValid $ \c ->+      it "succesfully uploads a single item to the server for an empty server"+        $ forAllValid+        $ \c ->           forAllValid $ \i ->             eval $ do               let cstore1 = emptyClientStore {clientStoreAdded = M.singleton c i}@@ -128,11 +143,12 @@               let cstore2 = mergeSyncResponse cstore1 resp               liftIO $ do                 clientStoreSynced cstore2 `shouldBe` serverStoreItems sstore2-                sort (M.elems (clientStoreSynced cstore2)) `shouldBe`-                  sort (M.elems $ M.singleton c i)+                sort (M.elems (clientStoreSynced cstore2))+                  `shouldBe` sort (M.elems $ M.singleton c i)     describe "Multi-item" $ do-      it "succesfully downloads everything from the server for an empty client" $-        forAllValid $ \sstore1 ->+      it "succesfully downloads everything from the server for an empty client"+        $ forAllValid+        $ \sstore1 ->           eval $ do             let cstore1 = emptyClientStore             let req = makeSyncRequest cstore1@@ -141,8 +157,9 @@             liftIO $ do               sstore2 `shouldBe` sstore1               clientStoreSynced cstore2 `shouldBe` serverStoreItems sstore2-      it "succesfully uploads everything to the server for an empty server" $-        forAllValid $ \items ->+      it "succesfully uploads everything to the server for an empty server"+        $ forAllValid+        $ \items ->           eval $ do             let cstore1 = emptyClientStore {clientStoreAdded = items}             let sstore1 = emptyServerStore@@ -152,8 +169,9 @@             liftIO $ do               clientStoreSynced cstore2 `shouldBe` serverStoreItems sstore2               sort (M.elems (clientStoreSynced cstore2)) `shouldBe` sort (M.elems items)-      it "is idempotent with one client" $-        forAllValid $ \cstore1 ->+      it "is idempotent with one client"+        $ forAllValid+        $ \cstore1 ->           forAllValid $ \sstore1 ->             eval $ do               let req1 = makeSyncRequest cstore1@@ -167,227 +185,236 @@                 sstore2 `shouldBe` sstore3   describe "Multiple clients" $ do     describe "Single-item" $ do-      it "successfully syncs an addition accross to a second client" $-        forAllValid $ \i ->+      it "successfully syncs an addition accross to a second client"+        $ forAllValid+        $ \i ->           eval $ do             let cAstore1 = emptyClientStore {clientStoreAdded = M.singleton (ClientId 0) i}-              -- Client B is empty+            -- Client B is empty             let cBstore1 = emptyClientStore-              -- The server is empty+            -- The server is empty             let sstore1 = emptyServerStore-              -- Client A makes sync request 1+            -- Client A makes sync request 1             let req1 = makeSyncRequest cAstore1-              -- The server processes sync request 1+            -- The server processes sync request 1             (resp1, sstore2) <- func sstore1 req1             let addedItems = syncResponseClientAdded resp1             case M.toList addedItems of               [(ClientId 0, clientAdditionId)] -> do                 let items = M.singleton clientAdditionId i                 liftIO $ sstore2 `shouldBe` (ServerStore {serverStoreItems = items})-                  -- Client A merges the response+                -- Client A merges the response                 let cAstore2 = mergeSyncResponse cAstore1 resp1                 liftIO $ cAstore2 `shouldBe` (emptyClientStore {clientStoreSynced = items})-                  -- Client B makes sync request 2+                -- Client B makes sync request 2                 let req2 = makeSyncRequest cBstore1-                  -- The server processes sync request 2+                -- The server processes sync request 2                 (resp2, sstore3) <- func sstore2 req2                 liftIO $ do                   resp2 `shouldBe` (emptySyncResponse {syncResponseServerAdded = items})                   sstore3 `shouldBe` sstore2                 --  pPrint cBstore2-                  -- Client B merges the response+                -- Client B merges the response                 let cBstore2 = mergeSyncResponse cBstore1 resp2                 liftIO $ cBstore2 `shouldBe` (emptyClientStore {clientStoreSynced = items})-                  -- Client A and Client B now have the same store+                -- Client A and Client B now have the same store                 liftIO $ cAstore2 `shouldBe` cBstore2               _ -> liftIO $ expectationFailure "Should have found exactly one added item."-      it "succesfully syncs a deletion across to a second client" $-        forAllValid $ \uuid ->+      it "succesfully syncs a deletion across to a second client"+        $ forAllValid+        $ \uuid ->           forAllValid $ \i ->             eval $ do               let cAstore1 = emptyClientStore {clientStoreSynced = M.singleton uuid i}-                  -- Client A has a synced item.-                  -- Client B had synced that same item, but has since deleted it.+              -- Client A has a synced item.+              -- Client B had synced that same item, but has since deleted it.               let cBstore1 = emptyClientStore {clientStoreDeleted = S.singleton uuid}-                  -- The server still has the undeleted item+              -- The server still has the undeleted item               let sstore1 = ServerStore {serverStoreItems = M.singleton uuid i}-                  -- Client B makes sync request 1+              -- Client B makes sync request 1               let req1 = makeSyncRequest cBstore1-                  -- The server processes sync request 1+              -- The server processes sync request 1               (resp1, sstore2) <- func sstore1 req1               liftIO $ do                 resp1 `shouldBe` emptySyncResponse {syncResponseClientDeleted = S.singleton uuid}                 sstore2 `shouldBe` emptyServerStore-                  -- Client B merges the response+              -- Client B merges the response               let cBstore2 = mergeSyncResponse cBstore1 resp1               liftIO $ cBstore2 `shouldBe` emptyClientStore-                  -- Client A makes sync request 2+              -- Client A makes sync request 2               let req2 = makeSyncRequest cAstore1-                  -- The server processes sync request 2+              -- The server processes sync request 2               (resp2, sstore3) <- func sstore2 req2               liftIO $ do                 resp2 `shouldBe` emptySyncResponse {syncResponseServerDeleted = S.singleton uuid}                 sstore3 `shouldBe` sstore2-                  -- Client A merges the response+              -- Client A merges the response               let cAstore2 = mergeSyncResponse cAstore1 resp2               liftIO $ cAstore2 `shouldBe` emptyClientStore-                  -- Client A and Client B now have the same store+              -- Client A and Client B now have the same store               liftIO $ cAstore2 `shouldBe` cBstore2-      it "does not run into a conflict if two clients both try to sync a deletion" $-        forAllValid $ \uuid ->+      it "does not run into a conflict if two clients both try to sync a deletion"+        $ forAllValid+        $ \uuid ->           forAllValid $ \i ->             eval $ do               let cAstore1 = emptyClientStore {clientStoreDeleted = S.singleton uuid}-                  -- Both client a and client b delete an item.+              -- Both client a and client b delete an item.               let cBstore1 = emptyClientStore {clientStoreDeleted = S.singleton uuid}-                  -- The server still has the undeleted item+              -- The server still has the undeleted item               let sstore1 = ServerStore {serverStoreItems = M.singleton uuid i}-                  -- Client A makes sync request 1+              -- Client A makes sync request 1               let req1 = makeSyncRequest cAstore1-                  -- The server processes sync request 1+              -- The server processes sync request 1               (resp1, sstore2) <- func sstore1 req1               liftIO $ do                 resp1 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = S.singleton uuid})                 sstore2 `shouldBe` (ServerStore {serverStoreItems = M.empty})-                  -- Client A merges the response+              -- Client A merges the response               let cAstore2 = mergeSyncResponse cAstore1 resp1               liftIO $ cAstore2 `shouldBe` emptyClientStore-                  -- Client B makes sync request 2+              -- Client B makes sync request 2               let req2 = makeSyncRequest cBstore1-                  -- The server processes sync request 2+              -- The server processes sync request 2               (resp2, sstore3) <- func sstore2 req2               liftIO $ do                 resp2 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = S.singleton uuid})                 sstore3 `shouldBe` sstore2-                  -- Client B merges the response+              -- Client B merges the response               let cBstore2 = mergeSyncResponse cBstore1 resp2               liftIO $ do                 cBstore2 `shouldBe` emptyClientStore-                    -- Client A and Client B now have the same store+                -- Client A and Client B now have the same store                 cAstore2 `shouldBe` cBstore2     describe "Multiple items" $ do       it-        "makes no change if the sync request reflects the same local state with an empty sync response" $-        forAllValid $ \sis -> do+        "makes no change if the sync request reflects the same local state with an empty sync response"+        $ forAllValid+        $ \sis -> do           let cs = ServerStore sis           (sr, cs') <--            eval $-            func cs $-            SyncRequest-              { syncRequestAdded = M.empty-              , syncRequestSynced = M.keysSet sis-              , syncRequestDeleted = S.empty-              }+            eval+              $ func cs+              $ SyncRequest+                { syncRequestAdded = M.empty,+                  syncRequestSynced = M.keysSet sis,+                  syncRequestDeleted = S.empty+                }           cs' `shouldBe` cs-          sr `shouldBe`-            SyncResponse-              { syncResponseClientAdded = M.empty-              , syncResponseClientDeleted = S.empty-              , syncResponseServerAdded = M.empty-              , syncResponseServerDeleted = S.empty+          sr+            `shouldBe` SyncResponse+              { syncResponseClientAdded = M.empty,+                syncResponseClientDeleted = S.empty,+                syncResponseServerAdded = M.empty,+                syncResponseServerDeleted = S.empty               }-      it "successfully syncs additions accross to a second client" $-        forAllValid $ \is ->+      it "successfully syncs additions accross to a second client"+        $ forAllValid+        $ \is ->           eval $ do             let cAstore1 = emptyClientStore {clientStoreAdded = is}-              -- Client B is empty+            -- Client B is empty             let cBstore1 = emptyClientStore-              -- The server is empty+            -- The server is empty             let sstore1 = emptyServerStore-              -- Client A makes sync request 1+            -- Client A makes sync request 1             let req1 = makeSyncRequest cAstore1-              -- The server processes sync request 1+            -- The server processes sync request 1             (resp1, sstore2) <- func sstore1 req1-              -- Client A merges the response+            -- Client A merges the response             let cAstore2 = mergeSyncResponse cAstore1 resp1             let items = clientStoreSynced cAstore2             liftIO $ do               clientStoreAdded cAstore2 `shouldBe` M.empty               sstore2 `shouldBe` (ServerStore {serverStoreItems = items})             liftIO $ cAstore2 `shouldBe` (emptyClientStore {clientStoreSynced = items})-              -- Client B makes sync request 2+            -- Client B makes sync request 2             let req2 = makeSyncRequest cBstore1-              -- The server processes sync request 2+            -- The server processes sync request 2             (resp2, sstore3) <- func sstore2 req2             liftIO $ do               resp2 `shouldBe` (emptySyncResponse {syncResponseServerAdded = items})               sstore3 `shouldBe` sstore2-              -- Client B merges the response+            -- Client B merges the response             let cBstore2 = mergeSyncResponse cBstore1 resp2             liftIO $ cBstore2 `shouldBe` (emptyClientStore {clientStoreSynced = items})-              -- Client A and Client B now have the same store+            -- Client A and Client B now have the same store             liftIO $ cAstore2 `shouldBe` cBstore2-      it "succesfully syncs deletions across to a second client" $-        forAllValid $ \syncedItems ->+      it "succesfully syncs deletions across to a second client"+        $ forAllValid+        $ \syncedItems ->           eval $ do             let itemIds = M.keysSet syncedItems             let cAstore1 = emptyClientStore {clientStoreSynced = syncedItems}-                -- Client A has synced items-                -- Client B had synced the same items, but has since deleted them.+            -- Client A has synced items+            -- Client B had synced the same items, but has since deleted them.             let cBstore1 = emptyClientStore {clientStoreDeleted = itemIds}-                -- The server still has the undeleted item+            -- The server still has the undeleted item             let sstore1 = ServerStore {serverStoreItems = syncedItems}-                -- Client B makes sync request 1+            -- Client B makes sync request 1             let req1 = makeSyncRequest cBstore1-                -- The server processes sync request 1+            -- The server processes sync request 1             (resp1, sstore2) <- func sstore1 req1             liftIO $ do               resp1 `shouldBe` emptySyncResponse {syncResponseClientDeleted = itemIds}               sstore2 `shouldBe` emptyServerStore-                -- Client B merges the response+            -- Client B merges the response             let cBstore2 = mergeSyncResponse cBstore1 resp1             liftIO $ cBstore2 `shouldBe` emptyClientStore-                -- Client A makes sync request 2+            -- Client A makes sync request 2             let req2 = makeSyncRequest cAstore1-                -- The server processes sync request 2+            -- The server processes sync request 2             (resp2, sstore3) <- func sstore2 req2             liftIO $ do               resp2 `shouldBe` emptySyncResponse {syncResponseServerDeleted = itemIds}               sstore3 `shouldBe` sstore2-                -- Client A merges the response+            -- Client A merges the response             let cAstore2 = mergeSyncResponse cAstore1 resp2             liftIO $ cAstore2 `shouldBe` emptyClientStore-                -- Client A and Client B now have the same store+            -- Client A and Client B now have the same store             liftIO $ cAstore2 `shouldBe` cBstore2-      it "does not run into a conflict if two clients both try to sync a deletion" $-        forAllValid $ \items ->+      it "does not run into a conflict if two clients both try to sync a deletion"+        $ forAllValid+        $ \items ->           eval $ do             let cAstore1 = emptyClientStore {clientStoreDeleted = M.keysSet items}-                -- Both client a and client b delete their items.+            -- Both client a and client b delete their items.             let cBstore1 = emptyClientStore {clientStoreDeleted = M.keysSet items}-                -- The server still has the undeleted items+            -- The server still has the undeleted items             let sstore1 = ServerStore {serverStoreItems = items}-                -- Client A makes sync request 1+            -- Client A makes sync request 1             let req1 = makeSyncRequest cAstore1-                -- The server processes sync request 1+            -- The server processes sync request 1             (resp1, sstore2) <- func sstore1 req1             liftIO $ do               resp1 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = M.keysSet items})               sstore2 `shouldBe` (ServerStore {serverStoreItems = M.empty}) -- TODO will probably need some sort of tombstoning.-                -- Client A merges the response+                    -- Client A merges the response             let cAstore2 = mergeSyncResponse cAstore1 resp1             liftIO $ cAstore2 `shouldBe` emptyClientStore-                -- Client B makes sync request 2+            -- Client B makes sync request 2             let req2 = makeSyncRequest cBstore1-                -- The server processes sync request 2+            -- The server processes sync request 2             (resp2, sstore3) <- func sstore2 req2             liftIO $ do               resp2 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = M.keysSet items})               sstore3 `shouldBe` sstore2-                -- Client B merges the response+            -- Client B merges the response             let cBstore2 = mergeSyncResponse cBstore1 resp2             liftIO $ do               cBstore2 `shouldBe` emptyClientStore-                  -- Client A and Client B now have the same store+              -- Client A and Client B now have the same store               cAstore2 `shouldBe` cBstore2   describe "General properties" $ do-    it "produces valid results" $-      forAllValid $ \cs ->+    it "produces valid results"+      $ forAllValid+      $ \cs ->         forAllValid $ \sr -> do           res <- eval $ func cs sr           shouldBeValid res-    it "successfully syncs two clients using a central store" $-      forAllValid $ \store1 ->+    it "successfully syncs two clients using a central store"+      $ forAllValid+      $ \store1 ->         eval $ do           let central = ServerStore M.empty           let store2 = emptyClientStore@@ -401,8 +428,9 @@           (sresp3, _) <- func central'' sreq3           let store1'' = mergeSyncResponse store1' sresp3           liftIO $ store1'' `shouldBe` store2'-    it "ensures that syncing is idempotent" $-      forAllValid $ \central1 ->+    it "ensures that syncing is idempotent"+      $ forAllValid+      $ \central1 ->         forAllValid $ \local1 ->           eval $ do             let sreq1 = makeSyncRequest local1@@ -415,16 +443,12 @@               local2 `shouldBe` local3               central2 `shouldBe` central3 -newtype D m a =-  D-    { unD :: StateT StdGen m a-    }+newtype D m a+  = D+      { unD :: StateT StdGen m a+      }   deriving (Generic, Functor, Applicative, Monad, MonadState StdGen, MonadTrans, MonadIO) --- evalD :: D Identity a -> a--- evalD = runIdentity . evalDM--- runD :: D Identity a -> StdGen -> (a, StdGen)--- runD = runState . unD evalDM :: Functor m => D m a -> m a evalDM d = fst <$> runDM d (mkStdGen 42) 

@@ -1,19 +1,18 @@ {-# LANGUAGE TypeApplications #-}  module Data.Mergeless.ItemSpec-  ( spec-  ) where+  ( spec,+  )+where +import Data.GenValidity.Mergeless.Item ()+import Data.GenValidity.UUID () import Data.Int (Int)-+import Data.Mergeless.Item import Test.Hspec import Test.Validity import Test.Validity.Aeson -import Data.GenValidity.Mergeless.Item ()-import Data.GenValidity.UUID ()-import Data.Mergeless.Item- {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}  spec :: Spec@@ -30,12 +29,15 @@   eqSpecOnValid @(ServerItem Int)   genValidSpec @(ServerItem Int)   jsonSpecOnValid @(ServerItem Int)-  describe "makeItemSyncrequest" $-    it "produces valid requests" $ producesValidsOnValids (makeItemSyncRequest @Int)-  describe "mergeItemSyncResponse" $-    it "produces valid client items" $ producesValidsOnValids2 (mergeItemSyncResponse @Int)-  describe "processItemSync" $-    it "produces valid tuples" $ producesValidsOnValids2 (processServerItemSync @Int)+  describe "makeItemSyncrequest"+    $ it "produces valid requests"+    $ producesValidsOnValids (makeItemSyncRequest @Int)+  describe "mergeItemSyncResponse"+    $ it "produces valid client items"+    $ producesValidsOnValids2 (mergeItemSyncResponse @Int)+  describe "processItemSync"+    $ it "produces valid tuples"+    $ producesValidsOnValids2 (processServerItemSync @Int)   describe "processItemSync" $ do     describe "Interaction" $ do       it "makes no changes if the sync request reflects the state of the empty server" $ do@@ -44,31 +46,35 @@         let (resp, store2) = processServerItemSync @Int store1 req         store2 `shouldBe` store1         resp `shouldBe` ItemSyncResponseInSyncEmpty-      it "makes no changes if the sync request reflects the state of the full server" $-        forAllValid $ \s -> do+      it "makes no changes if the sync request reflects the state of the full server"+        $ forAllValid+        $ \s -> do           let store1 = ServerItemFull s               req = ItemSyncRequestKnown           let (resp, store2) = processServerItemSync @Int store1 req           store2 `shouldBe` store1           resp `shouldBe` ItemSyncResponseInSyncFull     describe "Client changes" $ do-      it "adds the item that the client tells the server to add" $-        forAllValid $ \a -> do+      it "adds the item that the client tells the server to add"+        $ forAllValid+        $ \a -> do           let store1 = ServerItemEmpty               req = ItemSyncRequestNew a           let (resp, store2) = processServerItemSync @Int store1 req           store2 `shouldBe` ServerItemFull a           resp `shouldBe` ItemSyncResponseClientAdded-      it "deletes the item that the client tells the server to delete" $-        forAllValid $ \s -> do+      it "deletes the item that the client tells the server to delete"+        $ forAllValid+        $ \s -> do           let store1 = ServerItemFull s               req = ItemSyncRequestDeleted           let (resp, store2) = processServerItemSync @Int store1 req           store2 `shouldBe` ServerItemEmpty           resp `shouldBe` ItemSyncResponseClientDeleted     describe "Server changes" $ do-      it "tells the client that there is a new item at the server side" $-        forAllValid $ \s -> do+      it "tells the client that there is a new item at the server side"+        $ forAllValid+        $ \s -> do           let store1 = ServerItemFull s               req = ItemSyncRequestPoll           let (resp, store2) = processServerItemSync @Int store1 req@@ -81,8 +87,9 @@         store2 `shouldBe` store1         resp `shouldBe` ItemSyncResponseServerDeleted     describe "High level properties" $ do-      it "it always possible to add an item from scratch" $-        forAllValid $ \a -> do+      it "it always possible to add an item from scratch"+        $ forAllValid+        $ \a -> do           let cstore1 = ClientAdded (a :: Int)           let sstore1 = ServerItemEmpty           let req1 = makeItemSyncRequest cstore1@@ -91,8 +98,9 @@           resp1 `shouldBe` ItemSyncResponseClientAdded           sstore2 `shouldBe` ServerItemFull a           cstore2 `shouldBe` ClientSynced a-      it "is idempotent with one client" $-        forAllValid $ \si1 ->+      it "is idempotent with one client"+        $ forAllValid+        $ \si1 ->           forAllValid $ \ci1 -> do             let req1 = makeItemSyncRequest @Int ci1                 (resp1, si2) = processServerItemSync si1 req1