version 0.2.0.00.2.0.0

5 files changed, 599 insertions, 505 deletions

diff --git a/ChangeLog.md b/ChangeLog.md
index 1acfce1..c97ebfe 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,7 @@
 # Changelog for mergeless
 
 ## Unreleased changes
+
+## [0.2.0.0] - 2020-02-12
+
+* Got rid of the UTCTimes. The client should take care of that.
diff --git a/mergeless.cabal b/mergeless.cabal
index 2a630c3..9c593ba 100644
--- a/mergeless.cabal
+++ b/mergeless.cabal
@@ -1,11 +1,13 @@
--- This file has been generated from package.yaml by hpack version 0.28.2.
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 749159cfb0e485429b445319f97126579e191fed759cadc0903f884e813159a7
+-- hash: 7b7549a7b1a7d5ca5767941adb11f773af2e6727a37c8fdceb9367c0147b4d91
 
 name:           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
@@ -14,10 +16,9 @@ maintainer:     syd.kerckhove@gmail.com
 copyright:      Copyright: (c) 2018 Tom Sydney Kerckhove
 license:        MIT
 build-type:     Simple
-cabal-version:  >= 1.10
 extra-source-files:
-    ChangeLog.md
     README.md
+    ChangeLog.md
 
 source-repository head
   type: git
@@ -26,6 +27,8 @@ source-repository head
 library
   exposed-modules:
       Data.Mergeless
+      Data.Mergeless.Collection
+      Data.Mergeless.Item
   other-modules:
       Paths_mergeless
   hs-source-dirs:
@@ -34,9 +37,8 @@ library
       aeson
     , base >=4.7 && <5
     , containers
+    , deepseq
     , mtl
-    , time
     , validity
     , validity-containers
-    , validity-time
   default-language: Haskell2010
diff --git a/src/Data/Mergeless.hs b/src/Data/Mergeless.hs
index 53f6763..2f3ae3b 100644
--- a/src/Data/Mergeless.hs
+++ b/src/Data/Mergeless.hs
@@ -1,500 +1,5 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
--- | A way to synchronise items without merge conflicts.
---
--- This concept has a few requirements:
---
--- * 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.
---
--- 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.
---
---
--- There are a few obvious candidates for identifiers:
---
--- * incremental identifiers
--- * universally unique identifiers (recommended).
---
---
---
--- The typical setup is as follows:
---
--- * A central server is set up to synchronise with
--- * Each client synchronises with the central server, but never with eachother
---
---
--- A central server should operate as follows:
---
--- * The server accepts a 'SyncRequest'.
--- * The server performs operations according to the functionality of 'processSync'.
--- * The server respons with a 'SyncResponse'.
---
---
--- A client should operate as follows:
---
--- * The client produces a 'SyncRequest' with 'makeSyncRequest'.
--- * 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
-    ( Added(..)
-    , Synced(..)
-    , StoreItem(..)
-    , Store(..)
-    , emptyStore
-    , storeSize
-    , addItemToStore
-    , deleteUnsynced
-    , deleteSynced
-    , SyncRequest(..)
-    , SyncResponse(..)
-    -- * Client-side Synchronisation
-    , makeSyncRequest
-    , mergeSyncResponse
-    -- * Server-side Synchronisation
-    -- ** General synchronisation
-    , SyncProcessor(..)
-    , processSyncCustom
-    -- ** Synchronisation with a simple central store
-    , CentralStore(..)
-    , CentralItem(..)
-    , processSyncWith
-    , processSync
-    ) where
-
-import Control.Applicative
-import Control.Monad.IO.Class
-import Control.Monad.State.Strict
-import Data.Aeson
-import Data.List
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-import Data.Maybe
-import qualified Data.Set as S
-import Data.Set (Set)
-import Data.Time
-import Data.Validity
-import Data.Validity.Containers ()
-import Data.Validity.Time ()
-import GHC.Generics (Generic)
-
-{-# ANN module ("HLint: ignore Use lambda-case" :: String) #-}
-
--- | A local item of type @a@ that has been added but not synchronised yet
-data Added a = Added
-    { addedValue :: !a
-    , addedCreated :: !UTCTime
-    } deriving (Show, Eq, Ord, Generic)
-
-instance Validity a => Validity (Added a)
-
-instance FromJSON a => FromJSON (Added a) where
-    parseJSON =
-        withObject "Added" $ \o -> Added <$> o .: "value" <*> o .: "added"
-
-instance ToJSON a => ToJSON (Added a) where
-    toJSON Added {..} = object ["value" .= addedValue, "added" .= addedCreated]
-
--- | A local item of type @a@ with an identifier of type @a@ that has been synchronised
-data Synced i a = Synced
-    { syncedUuid :: i
-    , syncedValue :: !a
-    , syncedCreated :: !UTCTime
-    , syncedSynced :: !UTCTime
-    } deriving (Show, Eq, Ord, Generic)
-
-instance (Validity i, Validity a) => Validity (Synced i a)
-
-instance (FromJSON i, FromJSON a) => FromJSON (Synced i a) where
-    parseJSON =
-        withObject "Synced" $ \o ->
-            Synced <$> o .: "id" <*> o .: "value" <*> o .: "created" <*>
-            o .: "synced"
-
-instance (ToJSON i, ToJSON a) => ToJSON (Synced i a) where
-    toJSON Synced {..} =
-        object
-            [ "id" .= syncedUuid
-            , "value" .= syncedValue
-            , "created" .= syncedCreated
-            , "synced" .= syncedSynced
-            ]
-
--- | A store item with an Id of type @i@ and a value of type @a@
-data StoreItem i a
-    = UnsyncedItem !(Added a) -- ^ A local item that has not been synchronised to the central store yet
-    | SyncedItem !(Synced i a) -- ^ A local item that has been synchronised to the central store already
-    | UndeletedItem !i -- ^ An item that has been synchronised to the central store, was subsequently deleted locally but this deletion has not been synchronised to the central store yet.
-    deriving (Show, Eq, Ord, Generic)
-
-instance (Validity i, Validity a) => Validity (StoreItem i a)
-
-instance (FromJSON i, FromJSON a) => FromJSON (StoreItem i a) where
-    parseJSON v =
-        (SyncedItem <$> parseJSON v) <|> (UnsyncedItem <$> parseJSON v) <|>
-        (UndeletedItem <$> parseJSON v)
-
-instance (ToJSON i, ToJSON a) => ToJSON (StoreItem i a) where
-    toJSON (UnsyncedItem a) = toJSON a
-    toJSON (SyncedItem a) = toJSON a
-    toJSON (UndeletedItem a) = toJSON a
-
--- | A client-side store of items with Id's of type @i@ and values of type @a@
-newtype Store i a = Store
-    { storeItems :: Set (StoreItem i a)
-    } deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
-
-instance (Validity i, Validity a, Ord i, Ord a) => Validity (Store i a) where
-    validate Store {..} =
-        mconcat
-            [ annotate storeItems "storeItems"
-            , declare "the store items have distinct uuids" $
-              distinct $
-              flip mapMaybe (S.toList storeItems) $ \case
-                  UnsyncedItem _ -> Nothing
-                  SyncedItem Synced {..} -> Just syncedUuid
-                  UndeletedItem u -> Just u
-            ]
-
--- | The store with no items.
-emptyStore :: Store i a
-emptyStore = Store S.empty
-
--- | The number of items in a store
-storeSize :: Store i a -> Int
-storeSize (Store s) =
-    S.size $
-    S.filter
-        (\si ->
-             case si of
-                 UndeletedItem _ -> False
-                 _ -> True)
-        s
-
--- | Add a new (unsynced) item to the store
-addItemToStore :: (Ord i, Ord a) => Added a -> Store i a -> Store i a
-addItemToStore a (Store s) = Store $ S.insert (UnsyncedItem a) s
-
-deleteUnsynced :: (Ord i, Ord a) => Added a -> Store i a -> Store i a
-deleteUnsynced a (Store s) =
-    Store $
-    flip mapSetMaybe s $ \si ->
-        case si of
-            UnsyncedItem i ->
-                if i == a
-                    then Nothing
-                    else Just si
-            SyncedItem _ -> Just si
-            UndeletedItem _ -> Just si
-
-deleteSynced :: (Ord i, Ord a) => Synced i a -> Store i a -> Store i a
-deleteSynced a (Store s) =
-    Store $
-    flip mapSetMaybe s $ \si ->
-        case si of
-            UnsyncedItem _ -> Just si
-            SyncedItem i ->
-                if i == a
-                    then Just $ UndeletedItem $ syncedUuid i
-                    else Just si
-            UndeletedItem _ -> Just si
-
--- | A synchronisation request for items with identifiers of type @i@ and values of type @a@
-data SyncRequest i a = SyncRequest
-    { syncRequestAddedItems :: !(Set (Added a))
-    , syncRequestSyncedItems :: !(Set i)
-    , syncRequestUndeletedItems :: !(Set i)
-    } deriving (Show, Eq, Ord, Generic)
-
-instance (Validity i, Validity a, Ord i, Ord a) =>
-         Validity (SyncRequest i a) where
-    validate SyncRequest {..} =
-        mconcat
-            [ annotate syncRequestAddedItems "syncRequestAddedItems"
-            , annotate syncRequestSyncedItems "syncRequestSyncedItems"
-            , annotate syncRequestUndeletedItems "syncRequestUndeletedItems"
-            , declare "the sync request items have distinct ids" $
-              distinct $
-              S.toList syncRequestSyncedItems ++
-              S.toList syncRequestUndeletedItems
-            ]
-
-instance (FromJSON i, FromJSON a, Ord i, Ord a) =>
-         FromJSON (SyncRequest i a) where
-    parseJSON =
-        withObject "SyncRequest" $ \o ->
-            SyncRequest <$> o .: "unsynced" <*> o .: "synced" <*>
-            o .: "undeleted"
-
-instance (ToJSON i, ToJSON a) => ToJSON (SyncRequest i a) where
-    toJSON SyncRequest {..} =
-        object
-            [ "unsynced" .= syncRequestAddedItems
-            , "synced" .= syncRequestSyncedItems
-            , "undeleted" .= syncRequestUndeletedItems
-            ]
-
--- | A synchronisation response for items with identifiers of type @i@ and values of type @a@
-data SyncResponse i a = SyncResponse
-    { syncResponseAddedItems :: !(Set (Synced i a))
-    , syncResponseNewRemoteItems :: !(Set (Synced i a))
-    , syncResponseItemsToBeDeletedLocally :: !(Set i)
-    } deriving (Show, Eq, Ord, Generic)
-
-instance (Validity i, Validity a, Ord i, Ord a) =>
-         Validity (SyncResponse i a) where
-    validate SyncResponse {..} =
-        mconcat
-            [ annotate syncResponseAddedItems "syncResponseAddedItems"
-            , annotate syncResponseNewRemoteItems "syncResponseNewRemoteItems"
-            , annotate
-                  syncResponseItemsToBeDeletedLocally
-                  "syncResponseItemsToBeDeletedLocally"
-            , declare "the sync response items have distinct uuids" $
-              distinct $
-              map
-                  syncedUuid
-                  (S.toList syncResponseAddedItems ++
-                   S.toList syncResponseNewRemoteItems) ++
-              S.toList syncResponseItemsToBeDeletedLocally
-            ]
-
-instance (FromJSON i, FromJSON a, Ord i, Ord a) =>
-         FromJSON (SyncResponse i a) where
-    parseJSON =
-        withObject "SyncResponse" $ \o ->
-            SyncResponse <$> o .: "added" <*> o .: "new" <*> o .: "deleted"
-
-instance (ToJSON i, ToJSON a) => ToJSON (SyncResponse i a) where
-    toJSON SyncResponse {..} =
-        object
-            [ "added" .= syncResponseAddedItems
-            , "new" .= syncResponseNewRemoteItems
-            , "deleted" .= syncResponseItemsToBeDeletedLocally
-            ]
-
--- | 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) => Store i a -> SyncRequest i a
-makeSyncRequest Store {..} =
-    SyncRequest
-        { syncRequestAddedItems =
-              flip mapSetMaybe storeItems $ \case
-                  UnsyncedItem a -> Just a
-                  _ -> Nothing
-        , syncRequestSyncedItems =
-              flip mapSetMaybe storeItems $ \case
-                  SyncedItem i -> Just $ syncedUuid i
-                  _ -> Nothing
-        , syncRequestUndeletedItems =
-              flip mapSetMaybe storeItems $ \case
-                  UndeletedItem uuid -> Just uuid
-                  _ -> Nothing
-        }
-
--- | Merge a synchronisation response back into a client-side store.
-mergeSyncResponse ::
-       (Ord i, Ord a) => Store i a -> SyncResponse i a -> Store i a
-mergeSyncResponse s SyncResponse {..} =
-    let withNewOwnItems =
-            flip mapSetMaybe (storeItems s) $ \si ->
-                case si of
-                    UnsyncedItem Added {..} ->
-                        case find
-                                 (\Synced {..} ->
-                                      syncedCreated == addedCreated &&
-                                      syncedValue == addedValue)
-                                 syncResponseAddedItems of
-                            Nothing -> Just si -- If it wasn't added (for whatever reason), just leave it as unsynced
-                            Just ii -> Just $ SyncedItem ii -- If it was added, then it becomes synced
-                    SyncedItem ii ->
-                        case find
-                                 (== syncedUuid ii)
-                                 syncResponseItemsToBeDeletedLocally of
-                            Nothing -> Just si -- If it wasn't deleted, don't delete it.
-                            Just _ -> Nothing -- If it was deleted, delete it here.
-                    UndeletedItem _ -> Nothing -- Delete all locally deleted items after sync
-     in Store
-            { storeItems =
-                  S.fromList .
-                  nubBy
-                      (\i1 i2 ->
-                           case (i1, i2) of
-                               (UnsyncedItem _, _) -> False
-                               (_, UnsyncedItem _) -> False
-                               (SyncedItem s1, SyncedItem s2) ->
-                                   syncedUuid s1 == syncedUuid s2
-                               (SyncedItem s1, UndeletedItem u2) ->
-                                   syncedUuid s1 == u2
-                               (UndeletedItem u1, SyncedItem s2) ->
-                                   u1 == syncedUuid s2
-                               (UndeletedItem u1, UndeletedItem u2) -> u1 == u2) .
-                  S.toList $
-                  S.map SyncedItem syncResponseNewRemoteItems `S.union`
-                  withNewOwnItems
-            }
-
--- | A record of the basic operations that are necessary to build a synchronisation processor.
-data SyncProcessor i a m = SyncProcessor
-    { syncProcessorDeleteMany :: Set i -> m () -- ^ Delete the items with an identifier in the given set.
-    , syncProcessorQuerySynced :: Set i -> m (Set i) -- ^ Query the identifiers of the items that are in store, of the given set.
-    , syncProcessorQueryNewRemote :: Set i -> m (Set (Synced i a)) -- ^ Query the items that are in store, but not in the given set.
-    , syncProcessorInsertMany :: Set (Synced i a) -> m () -- ^ Insert a set of items into the stor.
-    } 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.
-processSyncCustom ::
-       forall i a m. (Ord i, Ord a, Monad m)
-    => m i
-    -> UTCTime
-    -> SyncProcessor i a m
-    -> SyncRequest i a
-    -> m (SyncResponse i a)
-processSyncCustom genUuid now SyncProcessor {..} SyncRequest {..} = do
-    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
-            { syncResponseNewRemoteItems = newRemoteItems
-            , syncResponseAddedItems = newLocalItems
-            , syncResponseItemsToBeDeletedLocally = deletedRemotely
-            }
-  where
-    deleteUndeleted :: m ()
-    deleteUndeleted = syncProcessorDeleteMany syncRequestUndeletedItems
-    syncItemsToBeDeletedLocally :: m (Set i)
-    syncItemsToBeDeletedLocally = do
-        foundItems <- syncProcessorQuerySynced syncRequestSyncedItems
-        pure $ syncRequestSyncedItems `S.difference` foundItems
-    syncNewRemoteItems :: m (Set (Synced i a))
-    syncNewRemoteItems = syncProcessorQueryNewRemote syncRequestSyncedItems
-    syncAddedItems :: m (Set (Synced i a))
-    syncAddedItems = do
-        is <-
-            fmap S.fromList $
-            forM (S.toList syncRequestAddedItems) $ \Added {..} -> do
-                uuid <- genUuid
-                pure
-                    Synced
-                        { syncedUuid = uuid
-                        , syncedCreated = addedCreated
-                        , syncedSynced = now
-                        , syncedValue = addedValue
-                        }
-        syncProcessorInsertMany is
-        pure is
-
--- | An item in a central store with a value of type @a@
-data CentralItem a = CentralItem
-    { centralValue :: !a
-    , centralSynced :: !UTCTime
-    , centralCreated :: !UTCTime
-    } deriving (Show, Eq, Ord, Generic)
-
-instance Validity a => Validity (CentralItem a)
-
-instance FromJSON a => FromJSON (CentralItem a)
-
-instance ToJSON a => ToJSON (CentralItem a)
-
--- | A central store of items with identifiers of type @i@ and values of type @a@
-newtype CentralStore i a = CentralStore
-    { centralStoreItems :: Map i (CentralItem a)
-    } deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
-
-instance (Validity i, Validity a, Ord i, Ord a) =>
-         Validity (CentralStore i a)
-
--- | Process a server-side synchronisation request using @getCurrentTime@
---
--- see 'processSyncCustom'
-processSync ::
-       (Ord i, Ord a, MonadIO m)
-    => m i
-    -> CentralStore i a
-    -> SyncRequest i a
-    -> m (SyncResponse i a, CentralStore i a)
-processSync genId cs sr = do
-    now <- liftIO getCurrentTime
-    processSyncWith genId now cs sr
-
--- | Process a server-side synchronisation request using a time of syncing, and an identifier generation function.
---
--- see 'processSyncCustom'
-processSyncWith ::
-       forall i a m. (Ord i, Ord a, Monad m)
-    => m i
-    -> UTCTime
-    -> CentralStore i a
-    -> SyncRequest i a
-    -> m (SyncResponse i a, CentralStore i a)
-processSyncWith genUuid now cs sr =
-    flip runStateT cs $
-    processSyncCustom
-        (lift genUuid)
-        now
-        SyncProcessor
-            { syncProcessorDeleteMany = deleteMany
-            , syncProcessorQuerySynced = querySynced
-            , syncProcessorQueryNewRemote = queryNewRemote
-            , syncProcessorInsertMany = insertMany
-            }
-        sr
-  where
-    deleteMany :: Set i -> StateT (CentralStore i a) m ()
-    deleteMany s = modC (`M.withoutKeys` s)
-    querySynced :: Set i -> StateT (CentralStore i a) m (Set i)
-    querySynced s = M.keysSet <$> query (`M.restrictKeys` s)
-    queryNewRemote :: Set i -> StateT (CentralStore i a) m (Set (Synced i a))
-    queryNewRemote s = do
-        m <- query (`M.withoutKeys` s)
-        pure $
-            S.fromList $
-            flip map (M.toList m) $ \(i, CentralItem {..}) ->
-                Synced
-                    { syncedUuid = i
-                    , syncedCreated = centralCreated
-                    , syncedSynced = centralSynced
-                    , syncedValue = centralValue
-                    }
-    query :: (Map i (CentralItem a) -> b) -> StateT (CentralStore i a) m b
-    query func = gets $ func . centralStoreItems
-    insertMany :: Set (Synced i a) -> StateT (CentralStore i a) m ()
-    insertMany s =
-        forM_ (S.toList s) $ \Synced {..} ->
-            ins
-                syncedUuid
-                CentralItem
-                    { centralValue = syncedValue
-                    , centralCreated = syncedCreated
-                    , centralSynced = syncedSynced
-                    }
-    ins :: i -> CentralItem a -> StateT (CentralStore i a) m ()
-    ins i val = modC $ M.insert i val
-    modC ::
-           (Map i (CentralItem a) -> Map i (CentralItem a))
-        -> StateT (CentralStore i a) m ()
-    modC func = modify (\(CentralStore m) -> CentralStore $ func m)
-
-mapSetMaybe :: Ord b => (a -> Maybe b) -> Set a -> Set b
-mapSetMaybe func = S.map fromJust . S.filter isJust . S.map func
+  ( module Data.Mergeless.Collection
+  ) where
 
-distinct :: Ord a => [a] -> Bool
-distinct ls = sort ls == S.toAscList (S.fromList ls)
+import Data.Mergeless.Collection
diff --git a/src/Data/Mergeless/Collection.hs b/src/Data/Mergeless/Collection.hs
new file mode 100644
index 0000000..7937eaf
--- /dev/null
+++ b/src/Data/Mergeless/Collection.hs
@@ -0,0 +1,435 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | A way to synchronise items without merge conflicts.
+--
+-- This concept has a few requirements:
+--
+-- * 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.
+--
+-- 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.
+--
+--
+-- There are a few obvious candidates for identifiers:
+--
+-- * incremental identifiers
+-- * universally unique identifiers (recommended).
+--
+--
+--
+-- The typical setup is as follows:
+--
+-- * A central server is set up to synchronise with
+-- * Each client synchronises with the central server, but never with eachother
+--
+--
+-- A central server should operate as follows:
+--
+-- * The server accepts a 'SyncRequest'.
+-- * The server performs operations according to the functionality of 'processServerSync'.
+-- * The server respons with a 'SyncResponse'.
+--
+--
+-- A client should operate as follows:
+--
+-- * The client produces a 'SyncRequest' with 'makeSyncRequest'.
+-- * 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
+    -- * Client-side Synchronisation
+  , makeSyncRequest
+  , mergeSyncResponse
+  , addRemotelyAddedItems
+  , addAddedItems
+  , deleteItemsToBeDeletedLocally
+  , deleteLocalUndeletedItems
+    -- * Server-side Synchronisation
+    -- ** General synchronisation
+  , ServerSyncProcessor(..)
+  , processServerSyncCustom
+    -- ** Synchronisation with a simple central store
+  , ServerStore(..)
+  , emptyServerStore
+  , processServerSync
+  ) where
+
+import GHC.Generics (Generic)
+
+import Data.Validity
+import Data.Validity.Containers ()
+
+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.Word
+
+import Control.DeepSeq
+import Control.Monad.State.Strict
+
+{-# ANN module ("HLint: ignore Use lambda-case" :: String) #-}
+
+-- | A Client-side identifier for items.
+--
+-- These only need to be unique at the client.
+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)
+    }
+  deriving (Show, Eq, Ord, Generic)
+
+instance (NFData i, NFData a) => NFData (ClientStore i a)
+
+instance (Validity i, Validity a, Show i, Show a, Ord i, Ord a) => Validity (ClientStore i a) where
+  validate cs@ClientStore {..} =
+    mconcat
+      [ 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
+  parseJSON =
+    withObject "ClientStore" $ \o ->
+      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
+  toJSON ClientStore {..} =
+    object
+      ["added" .= clientStoreAdded, "synced" .= clientStoreSynced, "deleted" .= clientStoreDeleted]
+
+-- | The store with no items.
+emptyClientStore :: ClientStore i a
+emptyClientStore =
+  ClientStore
+    {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 {..} = M.size clientStoreAdded + M.size clientStoreSynced
+
+clientStoreIds :: Ord i => ClientStore i a -> Set i
+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
+addItemToClientStore a cs =
+  let oldAddedItems = clientStoreAdded cs
+      newAddedItems =
+        let newKey = findFreeSpot oldAddedItems
+         in M.insert newKey a oldAddedItems
+   in cs {clientStoreAdded = newAddedItems}
+
+-- | Find a free client id to use
+--
+-- You shouldn't need this function, 'addItemToClientStore' takes care of this.
+findFreeSpot :: Map ClientId a -> ClientId
+findFreeSpot m =
+  if M.null m
+    then ClientId 0
+    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
+
+deleteUnsyncedFromClientStore :: (Ord i, Ord a) => ClientId -> ClientStore i a -> ClientStore i a
+deleteUnsyncedFromClientStore cid cs = cs {clientStoreAdded = M.delete cid $ clientStoreAdded cs}
+
+deleteSyncedFromClientStore :: (Ord i, Ord a) => i -> ClientStore i a -> ClientStore i 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
+            }
+
+-- | 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)
+    }
+  deriving (Show, Eq, Ord, Generic)
+
+instance (NFData i, NFData a) => NFData (SyncRequest i a)
+
+instance (Validity i, Validity a, Ord i, Ord a) => Validity (SyncRequest i a) where
+  validate sr@SyncRequest {..} =
+    mconcat
+      [ 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
+  parseJSON =
+    withObject "SyncRequest" $ \o ->
+      SyncRequest <$> o .: "added" <*> o .: "synced" <*> o .: "undeleted"
+
+instance (ToJSON i, ToJSON a) => ToJSON (SyncRequest i a) where
+  toJSON SyncRequest {..} =
+    object
+      [ "added" .= syncRequestAdded
+      , "synced" .= syncRequestSynced
+      , "undeleted" .= syncRequestDeleted
+      ]
+
+-- | 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 {..} =
+  SyncRequest
+    { 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)
+    }
+  deriving (Show, Eq, Ord, Generic)
+
+instance (NFData i, NFData a) => NFData (SyncResponse i a)
+
+instance (Validity i, Validity a, Show i, Show a, Ord i, Ord a) => Validity (SyncResponse i 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
+          ]
+      ]
+
+instance (Ord i, FromJSON i, FromJSONKey i, Ord a, FromJSON a) => FromJSON (SyncResponse i a) where
+  parseJSON =
+    withObject "SyncResponse" $ \o ->
+      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
+  toJSON SyncResponse {..} =
+    object
+      [ "client-added" .= syncResponseClientAdded
+      , "client-deleted" .= syncResponseClientDeleted
+      , "server-added" .= syncResponseServerAdded
+      , "server-deleted" .= syncResponseServerDeleted
+      ]
+
+emptySyncResponse :: SyncResponse i ia
+emptySyncResponse =
+  SyncResponse
+    { 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}
+
+-- | 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.
+    }
+  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)
+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
+
+-- | A central store of items with identifiers of type @i@ and values of type @a@
+newtype ServerStore i a =
+  ServerStore
+    { serverStoreItems :: Map i a
+    }
+  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
+
+instance (NFData i, NFData a) => NFData (ServerStore i a)
+
+instance (Validity i, Validity a, Show i, Show a, Ord i, Ord a) => Validity (ServerStore i a)
+
+-- | An empty central store to start with
+emptyServerStore :: ServerStore i a
+emptyServerStore = ServerStore {serverStoreItems = M.empty}
+
+-- | Process a server-side synchronisation request using @getCurrentTime@
+--
+-- 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)
+processServerSync genUuid cs sr =
+  flip runStateT cs $
+  processServerSyncCustom
+    ServerSyncProcessor
+      { serverSyncProcessorDeleteMany = deleteMany
+      , serverSyncProcessorQueryNoLongerSynced = queryNoLongerSynced
+      , serverSyncProcessorQueryNewRemote = queryNewRemote
+      , serverSyncProcessorInsertMany = insertMany
+      }
+    sr
+  where
+    deleteMany :: Set i -> StateT (ServerStore i a) m (Set i)
+    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 =
+      traverse $ \a -> do
+        u <- lift genUuid
+        ins u a
+        pure u
+    ins :: i -> a -> StateT (ServerStore i a) m ()
+    ins i val = modC $ M.insert i val
+    modC :: (Map i a -> Map i a) -> StateT (ServerStore i a) m ()
+    modC func = modify (\(ServerStore m) -> ServerStore $ func m)
+
+diffSet :: Ord i => Map i a -> Set i -> Map i a
+diffSet m s = m `M.difference` toMap s
+
+toMap :: Set i -> Map i ()
+toMap = M.fromSet (const ())
+
+distinct :: Ord a => [a] -> Bool
+distinct ls = sort ls == S.toAscList (S.fromList ls)
diff --git a/src/Data/Mergeless/Item.hs b/src/Data/Mergeless/Item.hs
new file mode 100644
index 0000000..bda97c0
--- /dev/null
+++ b/src/Data/Mergeless/Item.hs
@@ -0,0 +1,148 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Data.Mergeless.Item where
+
+import Control.DeepSeq
+import Data.Aeson
+import Data.Validity
+import Data.Validity.Containers ()
+import GHC.Generics (Generic)
+
+{-# ANN module ("HLint: ignore Use lambda-case" :: String) #-}
+
+data ClientItem a
+  = ClientEmpty
+  | ClientAdded !a
+  | ClientSynced !a
+  | ClientDeleted
+  deriving (Show, Eq, Ord, Generic)
+
+instance Validity a => Validity (ClientItem a)
+
+instance NFData a => NFData (ClientItem a)
+
+instance FromJSON a => FromJSON (ClientItem a)
+
+instance ToJSON a => ToJSON (ClientItem a)
+
+-- | A synchronisation request for items with identifiers of type @i@ and values of type @a@
+data ItemSyncRequest a
+  = ItemSyncRequestPoll
+  | ItemSyncRequestNew a
+  | ItemSyncRequestKnown
+  | ItemSyncRequestDeleted
+  deriving (Show, Eq, Ord, Generic)
+
+instance Validity a => Validity (ItemSyncRequest a)
+
+instance NFData a => NFData (ItemSyncRequest a)
+
+instance FromJSON a => FromJSON (ItemSyncRequest a)
+
+instance ToJSON a => ToJSON (ItemSyncRequest a)
+
+makeItemSyncRequest :: ClientItem a -> ItemSyncRequest a
+makeItemSyncRequest ci =
+  case ci of
+    ClientEmpty -> ItemSyncRequestPoll
+    ClientAdded a -> ItemSyncRequestNew a
+    ClientSynced _ -> ItemSyncRequestKnown
+    ClientDeleted -> ItemSyncRequestDeleted
+
+-- | A synchronisation response for items with identifiers of type @i@ and values of type @a@
+data ItemSyncResponse a
+  = ItemSyncResponseInSyncEmpty
+  | ItemSyncResponseInSyncFull
+  | ItemSyncResponseClientAdded
+  | ItemSyncResponseClientDeleted
+  | ItemSyncResponseServerAdded !a
+  | ItemSyncResponseServerDeleted
+  deriving (Show, Eq, Ord, Generic)
+
+instance Validity a => Validity (ItemSyncResponse a)
+
+instance NFData a => NFData (ItemSyncResponse a)
+
+instance FromJSON a => FromJSON (ItemSyncResponse a)
+
+instance ToJSON a => ToJSON (ItemSyncResponse a)
+
+-- | Merge a synchronisation response back into a client-side store.
+mergeItemSyncResponse :: ClientItem a -> ItemSyncResponse a -> ClientItem a
+mergeItemSyncResponse ci sr =
+  let mismatch = ci
+   in case ci of
+        ClientEmpty ->
+          case sr of
+            ItemSyncResponseInSyncEmpty -> ClientEmpty
+            ItemSyncResponseServerAdded s -> ClientSynced s
+            _ -> mismatch
+        ClientAdded a ->
+          case sr of
+            ItemSyncResponseClientAdded -> ClientSynced a
+            ItemSyncResponseServerAdded s -> ClientSynced s
+            -- For completeness sake.
+            -- This can only happen if two clients make the item at the same time.
+            -- In practice, with named items in a collection, this will never happen.
+            _ -> mismatch
+        ClientSynced _ ->
+          case sr of
+            ItemSyncResponseInSyncFull -> ci -- No change
+            ItemSyncResponseServerDeleted -> ClientEmpty
+            _ -> mismatch
+        ClientDeleted ->
+          case sr of
+            ItemSyncResponseClientDeleted -> ClientEmpty
+            _ -> mismatch
+
+-- | An item in a central store with a value of type @a@
+data ServerItem a
+  = ServerItemEmpty
+  | ServerItemFull !a
+  deriving (Show, Eq, Ord, Generic)
+
+instance Validity a => Validity (ServerItem a)
+
+instance NFData a => NFData (ServerItem a)
+
+instance FromJSON a => FromJSON (ServerItem a)
+
+instance ToJSON a => ToJSON (ServerItem a)
+
+processServerItemSync :: ServerItem a -> ItemSyncRequest a -> (ItemSyncResponse a, ServerItem a)
+processServerItemSync si sr =
+  case si of
+    ServerItemEmpty ->
+      case sr of
+        ItemSyncRequestPoll
+          -- Both the client and the server think the item is empty, fine.
+         -> (ItemSyncResponseInSyncEmpty, si)
+        ItemSyncRequestNew a
+          -- The client has a new item and the server has space for it, add it.
+         -> (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
+          -- 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)
+    ServerItemFull s ->
+      case sr of
+        ItemSyncRequestPoll
+          -- The server has an item that the client doesn't, send it to the client.
+         -> (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)
+        ItemSyncRequestKnown -> (ItemSyncResponseInSyncFull, si)
+        ItemSyncRequestDeleted -> (ItemSyncResponseClientDeleted, ServerItemEmpty)