From 16654475e7b609506a9bb7d597c6534d3b299452 Mon Sep 17 00:00:00 2001
From: Norfair <>
Date: Thu, 21 May 2020 16:27:00 +0200
Subject: version 0.3.0.0


diff --git a/ChangeLog.md b/ChangeLog.md
index 3fd8101..8e53d9c 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -2,6 +2,18 @@
 
 ## Unreleased changes
 
+## [0.3.0.0] - 2020-05-21
+
+### Added
+
+* mergeSyncResponseCustom
+* emptySyncResponse: in case you want to do the sync response creation yourself
+
+### Changed
+
+* Another parameter: the ClientId, so that you can use an sqlid as your client id
+  This likely means that none of your code from mergeless-0.2 still compiles but it's easy to fix.
+
 ## [0.2.0.1] - 2020-02-13
 
 * Fixed the benchmarks
diff --git a/mergeless.cabal b/mergeless.cabal
index 59e0112..f3dbb44 100644
--- a/mergeless.cabal
+++ b/mergeless.cabal
@@ -4,16 +4,16 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1f6863bf51a407e32135695c2be4fd727c6474cfe30e5543ca7974cf89827b54
+-- hash: 5f5e451a78c312ccbef6cc567464e0983bc9a8fbba6a7f428016c9f186aeebcb
 
 name:           mergeless
-version:        0.2.0.2
+version:        0.3.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:
@@ -33,6 +33,7 @@ library
       Paths_mergeless
   hs-source-dirs:
       src
+  ghc-options: -Wall -fwarn-redundant-constraints
   build-depends:
       aeson
     , base >=4.11 && <5
diff --git a/src/Data/Mergeless.hs b/src/Data/Mergeless.hs
index 2f3ae3b..3b68b46 100644
--- a/src/Data/Mergeless.hs
+++ b/src/Data/Mergeless.hs
@@ -1,5 +1,6 @@
 module Data.Mergeless
-  ( module Data.Mergeless.Collection
-  ) where
+  ( module Data.Mergeless.Collection,
+  )
+where
 
 import Data.Mergeless.Collection
diff --git a/src/Data/Mergeless/Collection.hs b/src/Data/Mergeless/Collection.hs
index 7937eaf..69c4d00 100644
--- a/src/Data/Mergeless/Collection.hs
+++ b/src/Data/Mergeless/Collection.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -11,9 +12,10 @@
 --
 -- * Items must be immutable.
 -- * Items must allow for a centrally unique identifier.
--- * Identifiers for items must be generatable in such a way that they are certainly unique.
+-- * Items must allow for a client-side unique identifier.
+-- * Identifiers for items must be generated in such a way that they are certainly unique.
 --
--- Should mutation be a requirement, then it can be build such that it entails deleting the old version and creating a new version that is the modification of the old version.
+-- Should mutation be a requirement, then there is another library: 'mergeful' for exactly this purpose.
 --
 --
 -- There are a few obvious candidates for identifiers:
@@ -42,113 +44,125 @@
 -- * The client sends that request to the central server and gets a 'SyncResponse'.
 -- * The client then updates its local store with 'mergeSyncResponse'.
 module Data.Mergeless.Collection
-  ( ClientId(..)
-  , ClientStore(..)
-  , emptyClientStore
-  , storeSize
-  , addItemToClientStore
-  , deleteUnsyncedFromClientStore
-  , deleteSyncedFromClientStore
-  , SyncRequest(..)
-  , SyncResponse(..)
-  , emptySyncResponse
+  ( ClientStore (..),
+    SyncRequest (..),
+    SyncResponse (..),
+
     -- * Client-side Synchronisation
-  , makeSyncRequest
-  , mergeSyncResponse
-  , addRemotelyAddedItems
-  , addAddedItems
-  , deleteItemsToBeDeletedLocally
-  , deleteLocalUndeletedItems
+
+    -- ** General
+    ClientSyncProcessor (..),
+    mergeSyncResponseCustom,
+
+    -- ** Pure
+    emptyClientStore,
+    ClientId (..),
+    storeSize,
+    addItemToClientStore,
+    deleteUnsyncedFromClientStore,
+    deleteSyncedFromClientStore,
+    emptySyncRequest,
+    makeSyncRequest,
+    mergeSyncResponse,
+    pureClientSyncProcessor,
+
     -- * Server-side Synchronisation
-    -- ** General synchronisation
-  , ServerSyncProcessor(..)
-  , processServerSyncCustom
-    -- ** Synchronisation with a simple central store
-  , ServerStore(..)
-  , emptyServerStore
-  , processServerSync
-  ) where
 
-import GHC.Generics (Generic)
+    -- ** General synchronisation
+    ServerSyncProcessor (..),
+    processServerSyncCustom,
 
-import Data.Validity
-import Data.Validity.Containers ()
+    -- ** Synchronisation with a simple central store
+    ServerStore (..),
+    emptyServerStore,
+    emptySyncResponse,
+    processServerSync,
+  )
+where
 
+import Control.DeepSeq
+import Control.Monad.State.Strict
 import Data.Aeson
 import Data.List
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import Data.Set (Set)
+import Data.Validity
+import Data.Validity.Containers ()
 import Data.Word
-
-import Control.DeepSeq
-import Control.Monad.State.Strict
+import GHC.Generics (Generic)
 
 {-# ANN module ("HLint: ignore Use lambda-case" :: String) #-}
 
--- | A Client-side identifier for items.
+-- | A Client-side identifier for items for use with pure client stores
 --
 -- These only need to be unique at the client.
-newtype ClientId =
-  ClientId
-    { unClientId :: Word64
-    }
+newtype ClientId
+  = ClientId
+      { unClientId :: Word64
+      }
   deriving (Show, Eq, Ord, Enum, Bounded, Generic, ToJSON, ToJSONKey, FromJSON, FromJSONKey)
 
 instance Validity ClientId
 
 instance NFData ClientId
 
--- | A client-side store of items with Id's of type @i@ and values of type @a@
-data ClientStore i a =
-  ClientStore
-    { clientStoreAdded :: !(Map ClientId a)
-    , clientStoreSynced :: !(Map i a)
-    , clientStoreDeleted :: !(Set i)
-    }
+-- | A client-side store of items with Client Id's of type @ci@, Server Id's of type @i@ and values of type @a@
+data ClientStore ci si a
+  = ClientStore
+      { clientStoreAdded :: !(Map ci a),
+        clientStoreSynced :: !(Map si a),
+        clientStoreDeleted :: !(Set si)
+      }
   deriving (Show, Eq, Ord, Generic)
 
-instance (NFData i, NFData a) => NFData (ClientStore i a)
+instance (NFData ci, NFData si, NFData a) => NFData (ClientStore ci si a)
 
-instance (Validity i, Validity a, Show i, Show a, Ord i, Ord a) => Validity (ClientStore i a) where
+instance (Validity ci, Validity si, Validity a, Show ci, Show si, Ord ci, Ord si) => Validity (ClientStore ci si a) where
   validate cs@ClientStore {..} =
     mconcat
-      [ genericValidate cs
-      , declare "the store items have distinct ids" $
-        distinct $ M.keys clientStoreSynced ++ S.toList clientStoreDeleted
+      [ genericValidate cs,
+        declare "the store items have distinct ids"
+          $ distinct
+          $ M.keys clientStoreSynced ++ S.toList clientStoreDeleted
       ]
 
-instance (Ord i, FromJSON i, FromJSONKey i, FromJSON a) => FromJSON (ClientStore i a) where
+instance (Ord ci, FromJSON ci, FromJSONKey ci, Ord si, FromJSON si, FromJSONKey si, FromJSON a) => FromJSON (ClientStore ci si a) where
   parseJSON =
     withObject "ClientStore" $ \o ->
-      ClientStore <$> o .:? "added" .!= M.empty <*> o .:? "synced" .!= M.empty <*>
-      o .:? "deleted" .!= S.empty
+      ClientStore <$> o .:? "added" .!= M.empty <*> o .:? "synced" .!= M.empty
+        <*> o .:? "deleted" .!= S.empty
 
-instance (Ord i, ToJSON i, ToJSONKey i, ToJSON a) => ToJSON (ClientStore i a) where
+instance (Ord ci, ToJSON ci, ToJSONKey ci, Ord si, ToJSON si, ToJSONKey si, ToJSON a) => ToJSON (ClientStore ci si a) where
   toJSON ClientStore {..} =
     object
       ["added" .= clientStoreAdded, "synced" .= clientStoreSynced, "deleted" .= clientStoreDeleted]
 
--- | The store with no items.
-emptyClientStore :: ClientStore i a
+-- | The client store with no items.
+emptyClientStore :: ClientStore ci si a
 emptyClientStore =
   ClientStore
-    {clientStoreAdded = M.empty, clientStoreSynced = M.empty, clientStoreDeleted = S.empty}
+    { clientStoreAdded = M.empty,
+      clientStoreSynced = M.empty,
+      clientStoreDeleted = S.empty
+    }
 
 -- | The number of items in a store
 --
 -- This does not count the deleted items, so that those really look deleted.
-storeSize :: ClientStore i a -> Int
+storeSize :: ClientStore ci si a -> Int
 storeSize ClientStore {..} = M.size clientStoreAdded + M.size clientStoreSynced
 
-clientStoreIds :: Ord i => ClientStore i a -> Set i
+clientStoreIds :: Ord si => ClientStore ci si a -> Set si
 clientStoreIds ClientStore {..} = M.keysSet clientStoreSynced `S.union` clientStoreDeleted
 
 -- | Add an item to a client store as an added item.
 --
--- This will take care of the uniqueness constraint of the 'ClientId's in the map.
-addItemToClientStore :: (Ord i, Ord a) => a -> ClientStore i a -> ClientStore i a
+-- This will take care of the uniqueness constraint of the 'ci's in the map.
+--
+-- The values wrap around when reaching 'maxBound'.
+addItemToClientStore :: (Enum ci, Bounded ci, Ord ci) => a -> ClientStore ci si a -> ClientStore ci si a
 addItemToClientStore a cs =
   let oldAddedItems = clientStoreAdded cs
       newAddedItems =
@@ -159,276 +173,269 @@ addItemToClientStore a cs =
 -- | Find a free client id to use
 --
 -- You shouldn't need this function, 'addItemToClientStore' takes care of this.
-findFreeSpot :: Map ClientId a -> ClientId
+--
+-- The values wrap around when reaching 'maxBound'.
+findFreeSpot :: (Ord ci, Enum ci, Bounded ci) => Map ci a -> ci
 findFreeSpot m =
   if M.null m
-    then ClientId 0
-    else let (i, _) = M.findMax m
-          in go (next i)
+    then minBound
+    else
+      let (i, _) = M.findMax m
+       in go (next i)
   where
     go i =
       if M.member i m
         then go (next i)
         else i
-    next (ClientId w)
-      | w == maxBound = ClientId 0
-      | otherwise = ClientId $ succ w
+    next ci
+      | ci == maxBound = minBound
+      | otherwise = succ ci
 
-deleteUnsyncedFromClientStore :: (Ord i, Ord a) => ClientId -> ClientStore i a -> ClientStore i a
+deleteUnsyncedFromClientStore :: Ord ci => ci -> ClientStore ci si a -> ClientStore ci si a
 deleteUnsyncedFromClientStore cid cs = cs {clientStoreAdded = M.delete cid $ clientStoreAdded cs}
 
-deleteSyncedFromClientStore :: (Ord i, Ord a) => i -> ClientStore i a -> ClientStore i a
+deleteSyncedFromClientStore :: Ord si => si -> ClientStore ci si a -> ClientStore ci si a
 deleteSyncedFromClientStore i cs =
   let syncedBefore = clientStoreSynced cs
    in case M.lookup i syncedBefore of
         Nothing -> cs
         Just _ ->
           cs
-            { clientStoreSynced = M.delete i syncedBefore
-            , clientStoreDeleted = S.insert i $ clientStoreDeleted cs
+            { clientStoreSynced = M.delete i syncedBefore,
+              clientStoreDeleted = S.insert i $ clientStoreDeleted cs
             }
 
--- | A synchronisation request for items with identifiers of type @i@ and values of type @a@
-data SyncRequest i a =
-  SyncRequest
-    { syncRequestAdded :: !(Map ClientId a)
-    , syncRequestSynced :: !(Set i)
-    , syncRequestDeleted :: !(Set i)
-    }
+-- | A synchronisation request for items with Client Id's of type @ci@, Server Id's of type @i@ and values of type @a@
+data SyncRequest ci si a
+  = SyncRequest
+      { syncRequestAdded :: !(Map ci a),
+        syncRequestSynced :: !(Set si),
+        syncRequestDeleted :: !(Set si)
+      }
   deriving (Show, Eq, Ord, Generic)
 
-instance (NFData i, NFData a) => NFData (SyncRequest i a)
+instance (NFData ci, NFData si, NFData a) => NFData (SyncRequest ci si a)
 
-instance (Validity i, Validity a, Ord i, Ord a) => Validity (SyncRequest i a) where
+instance (Validity ci, Validity si, Validity a, Ord ci, Ord si, Show ci) => Validity (SyncRequest ci si a) where
   validate sr@SyncRequest {..} =
     mconcat
-      [ genericValidate sr
-      , declare "the sync request items have distinct ids" $
-        distinct $ S.toList syncRequestSynced ++ S.toList syncRequestDeleted
+      [ genericValidate sr,
+        declare "the sync request items have distinct ids"
+          $ distinct
+          $ S.toList syncRequestSynced ++ S.toList syncRequestDeleted
       ]
 
-instance (FromJSON i, FromJSON a, Ord i, Ord a) => FromJSON (SyncRequest i a) where
+instance (FromJSON ci, FromJSON si, FromJSON a, FromJSONKey ci, Ord ci, Ord si, Ord a) => FromJSON (SyncRequest ci si a) where
   parseJSON =
     withObject "SyncRequest" $ \o ->
-      SyncRequest <$> o .: "added" <*> o .: "synced" <*> o .: "undeleted"
+      SyncRequest <$> o .: "added" <*> o .: "synced" <*> o .: "deleted"
 
-instance (ToJSON i, ToJSON a) => ToJSON (SyncRequest i a) where
+instance (ToJSON ci, ToJSON si, ToJSON a, ToJSONKey ci) => ToJSON (SyncRequest ci si a) where
   toJSON SyncRequest {..} =
     object
-      [ "added" .= syncRequestAdded
-      , "synced" .= syncRequestSynced
-      , "undeleted" .= syncRequestDeleted
+      [ "added" .= syncRequestAdded,
+        "synced" .= syncRequestSynced,
+        "deleted" .= syncRequestDeleted
       ]
 
+emptySyncRequest :: SyncRequest ci si a
+emptySyncRequest =
+  SyncRequest
+    { syncRequestAdded = M.empty,
+      syncRequestSynced = S.empty,
+      syncRequestDeleted = S.empty
+    }
+
 -- | Produce a synchronisation request for a client-side store.
 --
 -- This request can then be sent to a central store for synchronisation.
-makeSyncRequest :: (Ord i, Ord a) => ClientStore i a -> SyncRequest i a
+makeSyncRequest :: ClientStore ci si a -> SyncRequest ci si a
 makeSyncRequest ClientStore {..} =
   SyncRequest
-    { syncRequestAdded = clientStoreAdded
-    , syncRequestSynced = M.keysSet clientStoreSynced
-    , syncRequestDeleted = clientStoreDeleted
+    { syncRequestAdded = clientStoreAdded,
+      syncRequestSynced = M.keysSet clientStoreSynced,
+      syncRequestDeleted = clientStoreDeleted
     }
 
 -- | A synchronisation response for items with identifiers of type @i@ and values of type @a@
-data SyncResponse i a =
-  SyncResponse
-    { syncResponseClientAdded :: !(Map ClientId i)
-    , syncResponseClientDeleted :: !(Set i)
-    , syncResponseServerAdded :: !(Map i a)
-    , syncResponseServerDeleted :: !(Set i)
-    }
+data SyncResponse ci si a
+  = SyncResponse
+      { syncResponseClientAdded :: !(Map ci si),
+        syncResponseClientDeleted :: !(Set si),
+        syncResponseServerAdded :: !(Map si a),
+        syncResponseServerDeleted :: !(Set si)
+      }
   deriving (Show, Eq, Ord, Generic)
 
-instance (NFData i, NFData a) => NFData (SyncResponse i a)
+instance (NFData ci, NFData si, NFData a) => NFData (SyncResponse ci si a)
 
-instance (Validity i, Validity a, Show i, Show a, Ord i, Ord a) => Validity (SyncResponse i a) where
+instance (Validity ci, Validity si, Validity a, Show ci, Show si, Ord ci, Ord si) => Validity (SyncResponse ci si a) where
   validate sr@SyncResponse {..} =
     mconcat
-      [ genericValidate sr
-      , declare "the sync response items have distinct uuids" $
-        distinct $
-        concat
-          [ M.elems syncResponseClientAdded
-          , S.toList syncResponseClientDeleted
-          , M.keys syncResponseServerAdded
-          , S.toList syncResponseServerDeleted
-          ]
+      [ genericValidate sr,
+        declare "the sync response items have distinct uuids"
+          $ distinct
+          $ concat
+            [ M.elems syncResponseClientAdded,
+              S.toList syncResponseClientDeleted,
+              M.keys syncResponseServerAdded,
+              S.toList syncResponseServerDeleted
+            ]
       ]
 
-instance (Ord i, FromJSON i, FromJSONKey i, Ord a, FromJSON a) => FromJSON (SyncResponse i a) where
+instance (Ord ci, Ord si, FromJSON ci, FromJSON si, FromJSONKey ci, FromJSONKey si, Ord a, FromJSON a) => FromJSON (SyncResponse ci si a) where
   parseJSON =
     withObject "SyncResponse" $ \o ->
-      SyncResponse <$> o .: "client-added" <*> o .: "client-deleted" <*> o .: "server-added" <*>
-      o .: "server-deleted"
+      SyncResponse <$> o .: "client-added" <*> o .: "client-deleted" <*> o .: "server-added"
+        <*> o
+        .: "server-deleted"
 
-instance (ToJSON i, ToJSONKey i, ToJSON a) => ToJSON (SyncResponse i a) where
+instance (ToJSON ci, ToJSON si, ToJSONKey ci, ToJSONKey si, ToJSON a) => ToJSON (SyncResponse ci si a) where
   toJSON SyncResponse {..} =
     object
-      [ "client-added" .= syncResponseClientAdded
-      , "client-deleted" .= syncResponseClientDeleted
-      , "server-added" .= syncResponseServerAdded
-      , "server-deleted" .= syncResponseServerDeleted
+      [ "client-added" .= syncResponseClientAdded,
+        "client-deleted" .= syncResponseClientDeleted,
+        "server-added" .= syncResponseServerAdded,
+        "server-deleted" .= syncResponseServerDeleted
       ]
 
-emptySyncResponse :: SyncResponse i ia
+emptySyncResponse :: SyncResponse ci si a
 emptySyncResponse =
   SyncResponse
-    { syncResponseClientAdded = M.empty
-    , syncResponseClientDeleted = S.empty
-    , syncResponseServerAdded = M.empty
-    , syncResponseServerDeleted = S.empty
+    { syncResponseClientAdded = M.empty,
+      syncResponseClientDeleted = S.empty,
+      syncResponseServerAdded = M.empty,
+      syncResponseServerDeleted = S.empty
     }
 
 -- | Merge a synchronisation response back into a client-side store.
 mergeSyncResponse ::
-     forall i a. (Ord i, Ord a)
-  => ClientStore i a
-  -> SyncResponse i a
-  -> ClientStore i a
-mergeSyncResponse s SyncResponse {..} =
-  addRemotelyAddedItems syncResponseServerAdded .
-  addAddedItems syncResponseClientAdded .
-  deleteItemsToBeDeletedLocally syncResponseServerDeleted .
-  deleteLocalUndeletedItems syncResponseClientDeleted $
-  s
-
-addRemotelyAddedItems :: (Ord i, Ord a) => Map i a -> ClientStore i a -> ClientStore i a
-addRemotelyAddedItems m cs =
-  cs {clientStoreSynced = M.union (clientStoreSynced cs) (m `diffSet` clientStoreIds cs)}
-
-addAddedItems ::
-     forall i a. (Ord i, Ord a)
-  => Map ClientId i
-  -> ClientStore i a
-  -> ClientStore i a
-addAddedItems addedItems cs =
-  let oldAdded = clientStoreAdded cs
-      oldSynced = clientStoreSynced cs
-      go :: (Map ClientId a, Map i a) -> ClientId -> i -> (Map ClientId a, Map i a)
-      go (added, synced) cid i =
-        case M.lookup cid added of
-          Nothing -> (added, synced)
-          Just a -> (M.delete cid added, M.insert i a synced)
-      (newAdded, newSynced) = M.foldlWithKey go (oldAdded, oldSynced) addedItems
-   in cs {clientStoreAdded = newAdded, clientStoreSynced = newSynced}
-
-deleteItemsToBeDeletedLocally :: (Ord i, Ord a) => Set i -> ClientStore i a -> ClientStore i a
-deleteItemsToBeDeletedLocally toBeDeletedLocally cs =
-  cs {clientStoreSynced = clientStoreSynced cs `diffSet` toBeDeletedLocally}
-
-deleteLocalUndeletedItems :: (Ord i, Ord a) => Set i -> ClientStore i a -> ClientStore i a
-deleteLocalUndeletedItems cd cs = cs {clientStoreDeleted = clientStoreDeleted cs `S.difference` cd}
+  forall ci si a.
+  (Ord ci, Ord si) =>
+  ClientStore ci si a ->
+  SyncResponse ci si a ->
+  ClientStore ci si a
+mergeSyncResponse s sr =
+  flip execState s $
+    mergeSyncResponseCustom
+      pureClientSyncProcessor
+      sr
+
+pureClientSyncProcessor :: forall ci si a. (Ord ci, Ord si) => ClientSyncProcessor ci si a (State (ClientStore ci si a))
+pureClientSyncProcessor =
+  ClientSyncProcessor
+    { clientSyncProcessorSyncServerAdded = \m -> modify $ \cs ->
+        cs {clientStoreSynced = M.union (clientStoreSynced cs) (m `diffSet` clientStoreIds cs)},
+      clientSyncProcessorSyncClientAdded = \addedItems -> modify $ \cs ->
+        let oldAdded = clientStoreAdded cs
+            oldSynced = clientStoreSynced cs
+            go :: (Map ci a, Map si a) -> ci -> si -> (Map ci a, Map si a)
+            go (added, synced) cid i =
+              case M.lookup cid added of
+                Nothing -> (added, synced)
+                Just a -> (M.delete cid added, M.insert i a synced)
+            (newAdded, newSynced) = M.foldlWithKey go (oldAdded, oldSynced) addedItems
+         in cs {clientStoreAdded = newAdded, clientStoreSynced = newSynced},
+      clientSyncProcessorSyncServerDeleted = \toBeDeletedLocally -> modify $ \cs ->
+        cs {clientStoreSynced = clientStoreSynced cs `diffSet` toBeDeletedLocally},
+      clientSyncProcessorSyncClientDeleted = \cd -> modify $ \cs ->
+        cs {clientStoreDeleted = clientStoreDeleted cs `S.difference` cd}
+    }
+
+data ClientSyncProcessor ci si a m
+  = ClientSyncProcessor
+      { clientSyncProcessorSyncServerAdded :: Map si a -> m (),
+        clientSyncProcessorSyncClientAdded :: Map ci si -> m (),
+        clientSyncProcessorSyncServerDeleted :: Set si -> m (),
+        clientSyncProcessorSyncClientDeleted :: Set si -> m ()
+      }
+  deriving (Generic)
+
+mergeSyncResponseCustom :: Monad m => ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
+mergeSyncResponseCustom ClientSyncProcessor {..} SyncResponse {..} = do
+  -- The order here matters!
+  clientSyncProcessorSyncServerAdded syncResponseServerAdded
+  clientSyncProcessorSyncServerDeleted syncResponseServerDeleted
+  clientSyncProcessorSyncClientDeleted syncResponseClientDeleted
+  clientSyncProcessorSyncClientAdded syncResponseClientAdded
 
 -- | A record of the basic operations that are necessary to build a synchronisation processor.
-data ServerSyncProcessor i a m =
-  ServerSyncProcessor
-    { serverSyncProcessorDeleteMany :: Set i -> m (Set i)
-      -- ^ Delete the items with an identifier in the given set, return the set that was indeed deleted or did not exist.
-      -- In particular, return the identifiers of the items that the client should forget about.
-    , serverSyncProcessorQueryNoLongerSynced :: Set i -> m (Set i) -- ^ Query the identifiers of the items that are in the given set but not in the store.
-    , serverSyncProcessorQueryNewRemote :: Set i -> m (Map i a) -- ^ Query the items that are in store, but not in the given set.
-    , serverSyncProcessorInsertMany :: Map ClientId a -> m (Map ClientId i) -- ^ Insert a set of items into the store.
-    }
+data ServerSyncProcessor ci si a m
+  = ServerSyncProcessor
+      { serverSyncProcessorRead :: m (Map si a),
+        serverSyncProcessorAddItems :: Map ci a -> m (Map ci si),
+        serverSyncProcessorDeleteItems :: Set si -> m (Set si)
+      }
   deriving (Generic)
 
--- | Process a server-side synchronisation request using a custom synchronisation processor
---
--- WARNING: The identifier generation function must produce newly unique identifiers such that each new item gets a unique identifier.
---
--- You can use this function with deterministically-random identifiers or incrementing identifiers.
 processServerSyncCustom ::
-     forall i a m. (Ord i, Ord a, Monad m)
-  => ServerSyncProcessor i a m
-  -> SyncRequest i a
-  -> m (SyncResponse i a)
+  forall ci si a m.
+  (Ord si, Monad m) =>
+  ServerSyncProcessor ci si a m ->
+  SyncRequest ci si a ->
+  m (SyncResponse ci si a)
 processServerSyncCustom ServerSyncProcessor {..} SyncRequest {..} = do
-  deletedFromClient <- deleteUndeleted
-        -- First we delete the items that were deleted locally but not yet remotely.
-        -- Then we find the items that have been deleted remotely but not locally
-  deletedRemotely <- syncItemsToBeDeletedLocally
-        -- Then we find the items that have appeared remotely but aren't known locally
-  newRemoteItems <- syncNewRemoteItems
-        -- Then we add the items that should be added.
-  newLocalItems <- syncAddedItems
-  pure
-    SyncResponse
-      { syncResponseClientAdded = newLocalItems
-      , syncResponseClientDeleted = deletedFromClient
-      , syncResponseServerAdded = newRemoteItems
-      , syncResponseServerDeleted = deletedRemotely
-      }
-  where
-    deleteUndeleted :: m (Set i)
-    deleteUndeleted = serverSyncProcessorDeleteMany syncRequestDeleted
-    syncItemsToBeDeletedLocally :: m (Set i)
-    syncItemsToBeDeletedLocally = serverSyncProcessorQueryNoLongerSynced syncRequestSynced
-    syncNewRemoteItems :: m (Map i a)
-    syncNewRemoteItems = serverSyncProcessorQueryNewRemote syncRequestSynced
-    syncAddedItems :: m (Map ClientId i)
-    syncAddedItems = serverSyncProcessorInsertMany syncRequestAdded
+  serverItems <- serverSyncProcessorRead
+  let syncResponseServerAdded = serverItems `M.difference` toMap (syncRequestSynced `S.union` syncRequestDeleted)
+  let syncResponseServerDeleted = syncRequestSynced `S.difference` M.keysSet serverItems
+  syncResponseClientDeleted <- serverSyncProcessorDeleteItems syncRequestDeleted
+  syncResponseClientAdded <- serverSyncProcessorAddItems syncRequestAdded
+  pure SyncResponse {..}
 
 -- | A central store of items with identifiers of type @i@ and values of type @a@
-newtype ServerStore i a =
-  ServerStore
-    { serverStoreItems :: Map i a
-    }
+newtype ServerStore si a
+  = ServerStore
+      { serverStoreItems :: Map si a
+      }
   deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
 
-instance (NFData i, NFData a) => NFData (ServerStore i a)
+instance (NFData si, NFData a) => NFData (ServerStore si a)
 
-instance (Validity i, Validity a, Show i, Show a, Ord i, Ord a) => Validity (ServerStore i a)
+instance (Validity si, Validity a, Show si, Show a, Ord si) => Validity (ServerStore si a)
 
 -- | An empty central store to start with
-emptyServerStore :: ServerStore i a
+emptyServerStore :: ServerStore si a
 emptyServerStore = ServerStore {serverStoreItems = M.empty}
 
--- | Process a server-side synchronisation request using @getCurrentTime@
+-- | Process a server-side synchronisation request using a server id generator
 --
 -- see 'processSyncCustom'
 processServerSync ::
-     forall m i a. (Ord i, Ord a, Monad m)
-  => m i
-  -> ServerStore i a
-  -> SyncRequest i a
-  -> m (SyncResponse i a, ServerStore i a)
+  forall m ci si a.
+  (Ord si, Monad m) =>
+  m si ->
+  ServerStore si a ->
+  SyncRequest ci si a ->
+  m (SyncResponse ci si a, ServerStore si a)
 processServerSync genUuid cs sr =
   flip runStateT cs $
-  processServerSyncCustom
-    ServerSyncProcessor
-      { serverSyncProcessorDeleteMany = deleteMany
-      , serverSyncProcessorQueryNoLongerSynced = queryNoLongerSynced
-      , serverSyncProcessorQueryNewRemote = queryNewRemote
-      , serverSyncProcessorInsertMany = insertMany
-      }
-    sr
+    processServerSyncCustom
+      ServerSyncProcessor
+        { serverSyncProcessorRead = gets serverStoreItems,
+          serverSyncProcessorDeleteItems = deleteMany,
+          serverSyncProcessorAddItems = insertMany
+        }
+      sr
   where
-    deleteMany :: Set i -> StateT (ServerStore i a) m (Set i)
+    deleteMany :: Set si -> StateT (ServerStore si a) m (Set si)
     deleteMany s = do
       modC (`diffSet` s)
       pure s
-    queryNoLongerSynced :: Set i -> StateT (ServerStore i a) m (Set i)
-    queryNoLongerSynced s = query ((s `S.difference`) . M.keysSet)
-    queryNewRemote :: Set i -> StateT (ServerStore i a) m (Map i a)
-    queryNewRemote s = query (`diffSet` s)
-    query :: (Map i a -> b) -> StateT (ServerStore i a) m b
-    query func = gets $ func . serverStoreItems
-    insertMany :: Map ClientId a -> StateT (ServerStore i a) m (Map ClientId i)
+    insertMany :: Map ci a -> StateT (ServerStore si a) m (Map ci si)
     insertMany =
       traverse $ \a -> do
         u <- lift genUuid
         ins u a
         pure u
-    ins :: i -> a -> StateT (ServerStore i a) m ()
+    ins :: si -> a -> StateT (ServerStore si a) m ()
     ins i val = modC $ M.insert i val
-    modC :: (Map i a -> Map i a) -> StateT (ServerStore i a) m ()
+    modC :: (Map si a -> Map si a) -> StateT (ServerStore si a) m ()
     modC func = modify (\(ServerStore m) -> ServerStore $ func m)
 
-diffSet :: Ord i => Map i a -> Set i -> Map i a
+diffSet :: Ord si => Map si a -> Set si -> Map si a
 diffSet m s = m `M.difference` toMap s
 
-toMap :: Set i -> Map i ()
+toMap :: Set si -> Map si ()
 toMap = M.fromSet (const ())
 
 distinct :: Ord a => [a] -> Bool
diff --git a/src/Data/Mergeless/Item.hs b/src/Data/Mergeless/Item.hs
index bda97c0..5be4654 100644
--- a/src/Data/Mergeless/Item.hs
+++ b/src/Data/Mergeless/Item.hs
@@ -117,32 +117,32 @@ processServerItemSync si sr =
   case si of
     ServerItemEmpty ->
       case sr of
-        ItemSyncRequestPoll
+        ItemSyncRequestPoll ->
           -- Both the client and the server think the item is empty, fine.
-         -> (ItemSyncResponseInSyncEmpty, si)
-        ItemSyncRequestNew a
+          (ItemSyncResponseInSyncEmpty, si)
+        ItemSyncRequestNew a ->
           -- The client has a new item and the server has space for it, add it.
-         -> (ItemSyncResponseClientAdded, ServerItemFull a)
-        ItemSyncRequestKnown
+          (ItemSyncResponseClientAdded, ServerItemFull a)
+        ItemSyncRequestKnown ->
           -- The client has an item that the server doesn't, so the server must have
           -- deleted it when another client asked to do that.
           -- Leave it deleted.
-         -> (ItemSyncResponseServerDeleted, si)
-        ItemSyncRequestDeleted
+          (ItemSyncResponseServerDeleted, si)
+        ItemSyncRequestDeleted ->
           -- The server has deleted an item but the current client hasn't been made aware of that
           -- AND this server also deleted that item in the meantime.
           -- Just leave it deleted.
-         -> (ItemSyncResponseClientDeleted, si)
+          (ItemSyncResponseClientDeleted, si)
     ServerItemFull s ->
       case sr of
-        ItemSyncRequestPoll
+        ItemSyncRequestPoll ->
           -- The server has an item that the client doesn't, send it to the client.
-         -> (ItemSyncResponseServerAdded s, si)
-        ItemSyncRequestNew _
+          (ItemSyncResponseServerAdded s, si)
+        ItemSyncRequestNew _ ->
           -- The client wants to add an item that the server already has.
           -- That means that another client has added that same item in the meantime.
           -- This wouldn't happen if the items were named.
           -- In this case, for completeness sake,
-         -> (ItemSyncResponseServerAdded s, si)
+          (ItemSyncResponseServerAdded s, si)
         ItemSyncRequestKnown -> (ItemSyncResponseInSyncFull, si)
         ItemSyncRequestDeleted -> (ItemSyncResponseClientDeleted, ServerItemEmpty)
-- 
cgit v0.10.2