Safe Haskell | None |
---|---|
Language | Haskell2010 |
Data.Mergeful.Collection
Description
A way to synchronise a single item with safe merge conflicts.
The 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 client should operate as follows:
The client starts with an initialClientStore
.
- The client produces a
SyncRequest
withmakeSyncRequest
. - The client sends that request to the central server and gets a
SyncResponse
. - The client then updates its local store with
mergeSyncResponseIgnoreProblems
.
The central server should operate as follows:
The server starts with an initialServerStore
.
- The server accepts a
SyncRequest
. - The server performs operations according to the functionality of
processServerSync
orprocessServerSyncCustom
. - The server respons with a
SyncResponse
.
WARNING: This whole approach can break down if a server resets its server times or if a client syncs with two different servers using the same server times.
Synopsis
- data ClientStore ci si a = ClientStore {
- clientStoreAddedItems :: !(Map ci a)
- clientStoreSyncedItems :: !(Map si (Timed a))
- clientStoreSyncedButChangedItems :: !(Map si (Timed a))
- clientStoreDeletedItems :: !(Map si ServerTime)
- data Timed a = Timed {
- timedValue :: !a
- timedTime :: !ServerTime
- newtype ServerTime = ServerTime {}
- initialClientStore :: ClientStore ci si a
- clientStoreSize :: ClientStore ci si a -> Word
- clientStoreClientIdSet :: ClientStore ci si a -> Set ci
- clientStoreUndeletedSyncIdSet :: Ord si => ClientStore ci si a -> Set si
- clientStoreSyncIdSet :: Ord si => ClientStore ci si a -> Set si
- clientStoreItems :: (Ord ci, Ord si) => ClientStore ci si a -> Map (Either ci si) a
- addItemToClientStore :: (Ord ci, Enum ci, Bounded ci) => a -> ClientStore ci si a -> ClientStore ci si a
- findFreeSpot :: (Ord ci, Enum ci, Bounded ci) => Map ci a -> ci
- markItemDeletedInClientStore :: Ord si => si -> ClientStore ci si a -> ClientStore ci si a
- changeItemInClientStore :: Ord si => si -> a -> ClientStore ci si a -> ClientStore ci si a
- deleteItemFromClientStore :: Ord ci => ci -> ClientStore ci si a -> ClientStore ci si a
- data SyncRequest ci si a = SyncRequest {
- syncRequestNewItems :: !(Map ci a)
- syncRequestKnownItems :: !(Map si ServerTime)
- syncRequestKnownButChangedItems :: !(Map si (Timed a))
- syncRequestDeletedItems :: !(Map si ServerTime)
- initialSyncRequest :: SyncRequest ci si a
- makeSyncRequest :: ClientStore ci si a -> SyncRequest ci si a
- data SyncResponse ci si a = SyncResponse {
- syncResponseClientAdded :: !(Map ci (ClientAddition si))
- syncResponseClientChanged :: !(Map si ServerTime)
- syncResponseClientDeleted :: !(Set si)
- syncResponseServerAdded :: !(Map si (Timed a))
- syncResponseServerChanged :: !(Map si (Timed a))
- syncResponseServerDeleted :: !(Set si)
- syncResponseConflicts :: !(Map si (Timed a))
- syncResponseConflictsClientDeleted :: !(Map si (Timed a))
- syncResponseConflictsServerDeleted :: !(Set si)
- data ClientAddition i = ClientAddition {}
- data ItemMergeStrategy a = ItemMergeStrategy {}
- data ChangeConflictResolution a
- = KeepLocal
- | TakeRemote
- | Merged a
- data ClientDeletedConflictResolution
- data ServerDeletedConflictResolution
- mergeFromServerStrategy :: ItemMergeStrategy a
- mergeFromClientStrategy :: ItemMergeStrategy a
- mergeUsingCRDTStrategy :: (a -> a -> a) -> ItemMergeStrategy a
- mergeSyncResponseFromServer :: (Ord ci, Ord si) => ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
- mergeSyncResponseFromClient :: (Ord ci, Ord si) => ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
- mergeSyncResponseUsingCRDT :: (Ord ci, Ord si) => (a -> a -> a) -> ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
- mergeSyncResponseUsingStrategy :: (Ord ci, Ord si) => ItemMergeStrategy a -> ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
- data ClientSyncProcessor ci si a (m :: Type -> Type) = ClientSyncProcessor {
- clientSyncProcessorQuerySyncedButChangedValues :: !(Set si -> m (Map si (Timed a)))
- clientSyncProcessorSyncClientAdded :: !(Map ci (ClientAddition si) -> m ())
- clientSyncProcessorSyncClientChanged :: !(Map si ServerTime -> m ())
- clientSyncProcessorSyncClientDeleted :: !(Set si -> m ())
- clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: !(Map si (Timed a) -> m ())
- clientSyncProcessorSyncClientDeletedConflictStayDeleted :: !(Map si (Timed a) -> m ())
- clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: !(Set si -> m ())
- clientSyncProcessorSyncServerDeletedConflictDelete :: !(Set si -> m ())
- clientSyncProcessorSyncChangeConflictKeepLocal :: !(Map si (Timed a) -> m ())
- clientSyncProcessorSyncChangeConflictMerged :: !(Map si (Timed a) -> m ())
- clientSyncProcessorSyncChangeConflictTakeRemote :: !(Map si (Timed a) -> m ())
- clientSyncProcessorSyncServerAdded :: !(Map si (Timed a) -> m ())
- clientSyncProcessorSyncServerChanged :: !(Map si (Timed a) -> m ())
- clientSyncProcessorSyncServerDeleted :: !(Set si -> m ())
- mergeSyncResponseCustom :: (Ord si, Monad m) => ItemMergeStrategy a -> ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
- newtype ClientId = ClientId {
- unClientId :: Word64
- mergeAddedItems :: forall ci si a. (Ord ci, Ord si) => Map ci a -> Map ci (ClientAddition si) -> (Map ci a, Map si (Timed a))
- mergeSyncedButChangedItems :: forall i a. Ord i => Map i (Timed a) -> Map i ServerTime -> (Map i (Timed a), Map i (Timed a))
- mergeDeletedItems :: Ord i => Map i b -> Set i -> Map i b
- mergeSyncedButChangedConflicts :: forall si a. Ord si => (a -> a -> ChangeConflictResolution a) -> Map si (Timed a) -> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a), Map si (Timed a))
- mergeClientDeletedConflicts :: (a -> ClientDeletedConflictResolution) -> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a))
- mergeServerDeletedConflicts :: (a -> ServerDeletedConflictResolution) -> Map si (Timed a) -> (Set si, Set si)
- newtype ServerStore si a = ServerStore {
- serverStoreItems :: Map si (Timed a)
- initialServerStore :: ServerStore si a
- processServerSync :: forall ci si a m. (Ord si, Monad m) => m si -> ServerStore si a -> SyncRequest ci si a -> m (SyncResponse ci si a, ServerStore si a)
- data ServerSyncProcessor ci si a m = ServerSyncProcessor {
- serverSyncProcessorRead :: !(m (Map si (Timed a)))
- serverSyncProcessorAddItem :: !(ci -> a -> m (Maybe si))
- serverSyncProcessorChangeItem :: !(si -> ServerTime -> a -> m ())
- serverSyncProcessorDeleteItem :: !(si -> m ())
- processServerSyncCustom :: forall ci si a m. (Ord si, Monad m) => ServerSyncProcessor ci si a m -> SyncRequest ci si a -> m (SyncResponse ci si a)
- emptySyncResponse :: SyncResponse ci si a
- initialServerTime :: ServerTime
- incrementServerTime :: ServerTime -> ServerTime
Client side
data ClientStore ci si a Source #
Constructors
ClientStore | |
Fields
|
Instances
A value along with a server time.
Constructors
Timed | |
Fields
|
Instances
Eq a => Eq (Timed a) Source # | |
Show a => Show (Timed a) Source # | |
Generic (Timed a) Source # | |
HasCodec a => ToJSON (Timed a) Source # | |
Defined in Data.Mergeful.Timed | |
HasCodec a => FromJSON (Timed a) Source # | |
HasCodec a => HasCodec (Timed a) Source # | |
Defined in Data.Mergeful.Timed | |
NFData a => NFData (Timed a) Source # | |
Defined in Data.Mergeful.Timed | |
Validity a => Validity (Timed a) Source # | |
Defined in Data.Mergeful.Timed Methods validate :: Timed a -> Validation # | |
type Rep (Timed a) Source # | |
Defined in Data.Mergeful.Timed type Rep (Timed a) = D1 ('MetaData "Timed" "Data.Mergeful.Timed" "mergeful-0.3.0.0-IufP8wiUmUb8vtwEhWnzS0" 'False) (C1 ('MetaCons "Timed" 'PrefixI 'True) (S1 ('MetaSel ('Just "timedValue") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a) :*: S1 ('MetaSel ('Just "timedTime") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ServerTime))) |
newtype ServerTime Source #
A "time", as "measured" by the server.
This is closer to a version number than an actual timestamp, but that distinction should not matter for your usage of this library.
In any case, a client should not be changing this value.
We use a Word64
instead of a natural.
This will go wrong after 2^64 versions, but since that
will not happen in practice, we will not worry about it.
You would have to sync millions of modifications every second
until long after the sun consumes the earth for this to be a problem.
Constructors
ServerTime | |
Fields |
Instances
initialClientStore :: ClientStore ci si a Source #
A client store to start with.
This store contains no items.
Querying the client store
clientStoreSize :: ClientStore ci si a -> Word Source #
The number of items in a client store
This does not count the deleted items, so that they really look deleted..
clientStoreClientIdSet :: ClientStore ci si a -> Set ci Source #
The set of client ids.
These are only the client ids of the added items that have not been synced yet.
clientStoreUndeletedSyncIdSet :: Ord si => ClientStore ci si a -> Set si Source #
The set of server ids.
This does not include the ids of items that have been marked as deleted.
clientStoreSyncIdSet :: Ord si => ClientStore ci si a -> Set si Source #
The set of server ids.
This includes the ids of items that have been marked as deleted.
clientStoreItems :: (Ord ci, Ord si) => ClientStore ci si a -> Map (Either ci si) a Source #
The set of items in the client store
This map does not include items that have been marked as deleted.
Changing the client store
addItemToClientStore :: (Ord ci, Enum ci, Bounded ci) => a -> ClientStore ci si a -> ClientStore ci si a Source #
Add an item to a client store as an added item.
This will take care of the uniqueness constraint of the ci
s in the map.
findFreeSpot :: (Ord ci, Enum ci, Bounded ci) => Map ci a -> ci Source #
Find a free client id to use
You shouldn't need this function, addItemToClientStore
takes care of this.
The values wrap around when reaching maxBound
.
markItemDeletedInClientStore :: Ord si => si -> ClientStore ci si a -> ClientStore ci si a Source #
Mark an item deleted in a client store.
This function will not delete the item, but mark it as deleted instead.
changeItemInClientStore :: Ord si => si -> a -> ClientStore ci si a -> ClientStore ci si a Source #
Replace the given item with a new value.
This function will correctly mark the item as changed, if it exist.
It will not add an item to the store with the given id, because the server may not have been the origin of that id.
deleteItemFromClientStore :: Ord ci => ci -> ClientStore ci si a -> ClientStore ci si a Source #
Delete an unsynced item from a client store.
This function will immediately delete the item, because it has never been synced.
Making a sync request
data SyncRequest ci si a Source #
Constructors
SyncRequest | |
Fields
|
Instances
initialSyncRequest :: SyncRequest ci si a Source #
An intial SyncRequest
to start with.
It just asks the server to send over whatever it knows.
makeSyncRequest :: ClientStore ci si a -> SyncRequest ci si a Source #
Produce an SyncRequest
from a ClientStore
.
Send this to the server for synchronisation.
Merging the response
data SyncResponse ci si a Source #
Constructors
SyncResponse | |
Fields
|
Instances
data ClientAddition i Source #
Constructors
ClientAddition | |
Fields |
Instances
data ItemMergeStrategy a Source #
A strategy to merge conflicts for item synchronisation
Constructors
ItemMergeStrategy | |
Fields
|
Instances
data ChangeConflictResolution a Source #
Constructors
KeepLocal | |
TakeRemote | |
Merged a |
Instances
data ClientDeletedConflictResolution Source #
Constructors
TakeRemoteChange | |
StayDeleted |
Instances
Eq ClientDeletedConflictResolution Source # | |
Defined in Data.Mergeful.Item | |
Show ClientDeletedConflictResolution Source # | |
Defined in Data.Mergeful.Item Methods showsPrec :: Int -> ClientDeletedConflictResolution -> ShowS # | |
Generic ClientDeletedConflictResolution Source # | |
Defined in Data.Mergeful.Item Associated Types type Rep ClientDeletedConflictResolution :: Type -> Type # | |
type Rep ClientDeletedConflictResolution Source # | |
Defined in Data.Mergeful.Item type Rep ClientDeletedConflictResolution = D1 ('MetaData "ClientDeletedConflictResolution" "Data.Mergeful.Item" "mergeful-0.3.0.0-IufP8wiUmUb8vtwEhWnzS0" 'False) (C1 ('MetaCons "TakeRemoteChange" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "StayDeleted" 'PrefixI 'False) (U1 :: Type -> Type)) |
data ServerDeletedConflictResolution Source #
Constructors
KeepLocalChange | |
Delete |
Instances
Eq ServerDeletedConflictResolution Source # | |
Defined in Data.Mergeful.Item | |
Show ServerDeletedConflictResolution Source # | |
Defined in Data.Mergeful.Item Methods showsPrec :: Int -> ServerDeletedConflictResolution -> ShowS # | |
Generic ServerDeletedConflictResolution Source # | |
Defined in Data.Mergeful.Item Associated Types type Rep ServerDeletedConflictResolution :: Type -> Type # | |
type Rep ServerDeletedConflictResolution Source # | |
Defined in Data.Mergeful.Item |
mergeFromServerStrategy :: ItemMergeStrategy a Source #
A merge strategy that takes whatever the server gave the client.
Pro: Clients will converge on the same value.
Con: Conflicting updates will be lost.
mergeFromClientStrategy :: ItemMergeStrategy a Source #
A merge strategy that keeps whatever the client had.
Pro: does not lose data
Con: Clients will diverge when a conflict occurs
mergeUsingCRDTStrategy :: (a -> a -> a) -> ItemMergeStrategy a Source #
A merge strategy that uses a CRDT merging function to merge items.
In case of other-than-change conflicts, this will be the same as the mergeFromServerStrategy
strategy.
If this is not what you want, create your own ItemMergeStrategy
manually.
mergeSyncResponseFromServer :: (Ord ci, Ord si) => ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a Source #
Merge a SyncResponse
into the current ClientStore
by taking whatever the server gave the client in case of conflict.
Pro: Clients will converge on the same value.
Con: Conflicting updates will be lost.
mergeSyncResponseFromClient :: (Ord ci, Ord si) => ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a Source #
Merge a SyncResponse
into the current ClientStore
by keeping whatever the client had in case of conflict.
Pro: No data will be lost
Con: Clients will diverge when conflicts occur.
mergeSyncResponseUsingCRDT :: (Ord ci, Ord si) => (a -> a -> a) -> ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a Source #
Merge a SyncResponse
into the current ClientStore
by using the given GADT merging function in case of conflict
mergeSyncResponseUsingStrategy :: (Ord ci, Ord si) => ItemMergeStrategy a -> ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a Source #
Merge an SyncResponse
into the current ClientStore
with the given merge strategy.
In order for clients to converge on the same collection correctly, this function must be:
- Associative
- Idempotent
- The same on all clients
This function ignores mismatches.
data ClientSyncProcessor ci si a (m :: Type -> Type) Source #
A processor for dealing with SyncResponse
s on the client side.
It has to deal with each of the 13 cases:
server
- added
- changed
- deleted
client
- added
- changed
- deleted
client-deleted conflict
- take remote
- delete
server-deleted conflict
- delete
- keep local
change conflict
- take remote
- merge
- keep local
It is a lot of work to implement one of these, so make sure to have a look at the mergeful companion packages to see if maybe there is already one for your application domain.
Constructors
ClientSyncProcessor | |
Fields
|
Instances
Generic (ClientSyncProcessor ci si a m) Source # | |
Defined in Data.Mergeful.Collection Associated Types type Rep (ClientSyncProcessor ci si a m) :: Type -> Type # Methods from :: ClientSyncProcessor ci si a m -> Rep (ClientSyncProcessor ci si a m) x # to :: Rep (ClientSyncProcessor ci si a m) x -> ClientSyncProcessor ci si a m # | |
type Rep (ClientSyncProcessor ci si a m) Source # | |
Defined in Data.Mergeful.Collection type Rep (ClientSyncProcessor ci si a m) = D1 ('MetaData "ClientSyncProcessor" "Data.Mergeful.Collection" "mergeful-0.3.0.0-IufP8wiUmUb8vtwEhWnzS0" 'False) (C1 ('MetaCons "ClientSyncProcessor" 'PrefixI 'True) (((S1 ('MetaSel ('Just "clientSyncProcessorQuerySyncedButChangedValues") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set si -> m (Map si (Timed a)))) :*: (S1 ('MetaSel ('Just "clientSyncProcessorSyncClientAdded") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map ci (ClientAddition si) -> m ())) :*: S1 ('MetaSel ('Just "clientSyncProcessorSyncClientChanged") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si ServerTime -> m ())))) :*: ((S1 ('MetaSel ('Just "clientSyncProcessorSyncClientDeleted") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set si -> m ())) :*: S1 ('MetaSel ('Just "clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si (Timed a) -> m ()))) :*: (S1 ('MetaSel ('Just "clientSyncProcessorSyncClientDeletedConflictStayDeleted") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si (Timed a) -> m ())) :*: S1 ('MetaSel ('Just "clientSyncProcessorSyncServerDeletedConflictKeepLocalChange") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set si -> m ()))))) :*: ((S1 ('MetaSel ('Just "clientSyncProcessorSyncServerDeletedConflictDelete") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set si -> m ())) :*: (S1 ('MetaSel ('Just "clientSyncProcessorSyncChangeConflictKeepLocal") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si (Timed a) -> m ())) :*: S1 ('MetaSel ('Just "clientSyncProcessorSyncChangeConflictMerged") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si (Timed a) -> m ())))) :*: ((S1 ('MetaSel ('Just "clientSyncProcessorSyncChangeConflictTakeRemote") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si (Timed a) -> m ())) :*: S1 ('MetaSel ('Just "clientSyncProcessorSyncServerAdded") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si (Timed a) -> m ()))) :*: (S1 ('MetaSel ('Just "clientSyncProcessorSyncServerChanged") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si (Timed a) -> m ())) :*: S1 ('MetaSel ('Just "clientSyncProcessorSyncServerDeleted") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set si -> m ()))))))) |
mergeSyncResponseCustom :: (Ord si, Monad m) => ItemMergeStrategy a -> ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m () Source #
Utility functions for implementing pure client-side merging
A Client-side identifier for items.
These only need to be unique at the client.
Constructors
ClientId | |
Fields
|
Instances
Bounded ClientId Source # | |
Enum ClientId Source # | |
Defined in Data.Mergeful.Collection | |
Eq ClientId Source # | |
Ord ClientId Source # | |
Defined in Data.Mergeful.Collection | |
Show ClientId Source # | |
Generic ClientId Source # | |
ToJSON ClientId Source # | |
Defined in Data.Mergeful.Collection | |
ToJSONKey ClientId Source # | |
Defined in Data.Mergeful.Collection | |
FromJSON ClientId Source # | |
FromJSONKey ClientId Source # | |
Defined in Data.Mergeful.Collection Methods | |
HasCodec ClientId Source # | |
Defined in Data.Mergeful.Collection | |
NFData ClientId Source # | |
Defined in Data.Mergeful.Collection | |
Validity ClientId Source # | |
Defined in Data.Mergeful.Collection Methods validate :: ClientId -> Validation # | |
type Rep ClientId Source # | |
Defined in Data.Mergeful.Collection |
mergeAddedItems :: forall ci si a. (Ord ci, Ord si) => Map ci a -> Map ci (ClientAddition si) -> (Map ci a, Map si (Timed a)) Source #
Merge the local added items with the ones that the server has acknowledged as added.
mergeSyncedButChangedItems :: forall i a. Ord i => Map i (Timed a) -> Map i ServerTime -> (Map i (Timed a), Map i (Timed a)) Source #
Merge the local synced but changed items with the ones that the server has acknowledged as changed.
mergeDeletedItems :: Ord i => Map i b -> Set i -> Map i b Source #
Merge the local deleted items with the ones that the server has acknowledged as deleted.
Utility functions for implementing custom client-side merging
mergeSyncedButChangedConflicts Source #
Arguments
:: forall si a. Ord si | |
=> (a -> a -> ChangeConflictResolution a) | |
-> Map si (Timed a) | The conflicting items on the client side |
-> Map si (Timed a) | The conflicting items on the server side |
-> (Map si (Timed a), Map si (Timed a), Map si (Timed a)) | Unresolved conflicts on the left, merged conflicts in the middle, resolved conflicts on the right
|
Resolve change conflicts
mergeClientDeletedConflicts Source #
Arguments
:: (a -> ClientDeletedConflictResolution) | |
-> Map si (Timed a) | The conflicting items on the server side |
-> (Map si (Timed a), Map si (Timed a)) | A map of items that need to be updated on the client. |
Resolve client deleted conflicts
mergeServerDeletedConflicts Source #
Arguments
:: (a -> ServerDeletedConflictResolution) | |
-> Map si (Timed a) | The conflicting items on the client side |
-> (Set si, Set si) | The result is a map of items that need to be deleted on the client. |
Resolve server deleted conflicts
Server side
The store
newtype ServerStore si a Source #
Constructors
ServerStore | |
Fields
|
Instances
initialServerStore :: ServerStore si a Source #
A server store to start with
This store contains no items.
Processing a sync request
Arguments
:: forall ci si a m. (Ord si, Monad m) | |
=> m si | The action that is guaranteed to generate unique identifiers |
-> ServerStore si a | |
-> SyncRequest ci si a | |
-> m (SyncResponse ci si a, ServerStore si a) |
Serve an SyncRequest
using the current ServerStore
, producing an SyncResponse
and a new ServerStore
.
data ServerSyncProcessor ci si a m Source #
Constructors
ServerSyncProcessor | |
Fields
|
Instances
Generic (ServerSyncProcessor ci si a m) Source # | |
Defined in Data.Mergeful.Collection Associated Types type Rep (ServerSyncProcessor ci si a m) :: Type -> Type # Methods from :: ServerSyncProcessor ci si a m -> Rep (ServerSyncProcessor ci si a m) x # to :: Rep (ServerSyncProcessor ci si a m) x -> ServerSyncProcessor ci si a m # | |
type Rep (ServerSyncProcessor ci si a m) Source # | |
Defined in Data.Mergeful.Collection type Rep (ServerSyncProcessor ci si a m) = D1 ('MetaData "ServerSyncProcessor" "Data.Mergeful.Collection" "mergeful-0.3.0.0-IufP8wiUmUb8vtwEhWnzS0" 'False) (C1 ('MetaCons "ServerSyncProcessor" 'PrefixI 'True) ((S1 ('MetaSel ('Just "serverSyncProcessorRead") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (m (Map si (Timed a)))) :*: S1 ('MetaSel ('Just "serverSyncProcessorAddItem") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (ci -> a -> m (Maybe si)))) :*: (S1 ('MetaSel ('Just "serverSyncProcessorChangeItem") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (si -> ServerTime -> a -> m ())) :*: S1 ('MetaSel ('Just "serverSyncProcessorDeleteItem") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (si -> m ()))))) |
processServerSyncCustom Source #
Arguments
:: forall ci si a m. (Ord si, Monad m) | |
=> ServerSyncProcessor ci si a m | Your server sync processor |
-> SyncRequest ci si a | |
-> m (SyncResponse ci si a) |
Process a server sync
Implementation Details
There are four cases for the items in the sync request
- Added (A)
- Synced (S)
- Changed (C)
- Deleted (D)
Each of them present options and may require action on the sever side:
Added:
- Client Added (CA) (This is the only case where a new identifier needs to be generated.)
Synced:
- Server Changed (SC) (Nothing)
- Server Deleted (SD) (Nothing)
Changed:
- Client Changed (CC) (Update value and increment server time)
- Change Conflict (CConf) (Nothing)
- Server Deleted Conflict (SDC) (Nothing)
Deleted:
- Client Deleted (CD) (Delete the item)
- Client Deleted Conflict (CDC) (Nothing)
Extra:
- Server Added (SA) (Nothing)
For more detailed comments of the nine cases, see the source of processServerItemSync
in the Data.Mergeful.Item.
emptySyncResponse :: SyncResponse ci si a Source #
A sync response to start with.
It is entirely empty.
initialServerTime :: ServerTime Source #
A server time to start with.
incrementServerTime :: ServerTime -> ServerTime Source #
Increment a server time.