Safe Haskell | None |
---|---|
Language | Haskell2010 |
Data.Mergeless.Collection
Description
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.
- 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 there is another library: mergeful
for exactly this purpose.
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
withmakeSyncRequest
. - The client sends that request to the central server and gets a
SyncResponse
. - The client then updates its local store with
mergeSyncResponse
.
Synopsis
- data ClientStore ci si a = ClientStore {
- clientStoreAdded :: !(Map ci a)
- clientStoreSynced :: !(Map si a)
- clientStoreDeleted :: !(Set si)
- data SyncRequest ci si a = SyncRequest {
- syncRequestAdded :: !(Map ci a)
- syncRequestSynced :: !(Set si)
- syncRequestDeleted :: !(Set si)
- data SyncResponse ci si a = SyncResponse {
- syncResponseClientAdded :: !(Map ci si)
- syncResponseClientDeleted :: !(Set si)
- syncResponseServerAdded :: !(Map si a)
- syncResponseServerDeleted :: !(Set si)
- 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 ())
- mergeSyncResponseCustom :: Monad m => ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
- emptyClientStore :: ClientStore ci si a
- newtype ClientId = ClientId {
- unClientId :: Word64
- storeSize :: ClientStore ci si a -> Int
- addItemToClientStore :: (Enum ci, Bounded ci, Ord ci) => a -> ClientStore ci si a -> ClientStore ci si a
- deleteUnsyncedFromClientStore :: Ord ci => ci -> ClientStore ci si a -> ClientStore ci si a
- deleteSyncedFromClientStore :: Ord si => si -> ClientStore ci si a -> ClientStore ci si a
- emptySyncRequest :: SyncRequest ci si a
- makeSyncRequest :: ClientStore ci si a -> SyncRequest ci si a
- mergeSyncResponse :: forall ci si a. (Ord ci, Ord si) => ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
- pureClientSyncProcessor :: forall ci si a. (Ord ci, Ord si) => ClientSyncProcessor ci si a (State (ClientStore ci si a))
- 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))
- processServerSyncCustom :: forall ci si a m. (Ord si, Monad m) => ServerSyncProcessor ci si a m -> SyncRequest ci si a -> m (SyncResponse ci si a)
- newtype ServerStore si a = ServerStore {
- serverStoreItems :: Map si a
- emptyServerStore :: ServerStore si a
- emptySyncResponse :: SyncResponse ci si a
- processServerSync :: 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)
Documentation
data ClientStore ci si a Source #
A client-side store of items with Client Id's of type ci
, Server Id's of type i
and values of type a
Constructors
ClientStore | |
Fields
|
Instances
data SyncRequest ci si a Source #
A synchronisation request for items with Client Id's of type ci
, Server Id's of type i
and values of type a
Constructors
SyncRequest | |
Fields
|
Instances
data SyncResponse ci si a Source #
A synchronisation response for items with identifiers of type i
and values of type a
Constructors
SyncResponse | |
Fields
|
Instances
Client-side Synchronisation
General
data ClientSyncProcessor ci si a m Source #
Constructors
ClientSyncProcessor | |
Fields
|
Instances
Generic (ClientSyncProcessor ci si a m) Source # | |
Defined in Data.Mergeless.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.Mergeless.Collection type Rep (ClientSyncProcessor ci si a m) = D1 ('MetaData "ClientSyncProcessor" "Data.Mergeless.Collection" "mergeless-0.4.0.0-9fBBdk4jjdm1sIN7SjvtgQ" 'False) (C1 ('MetaCons "ClientSyncProcessor" 'PrefixI 'True) ((S1 ('MetaSel ('Just "clientSyncProcessorSyncServerAdded") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map si a -> m ())) :*: S1 ('MetaSel ('Just "clientSyncProcessorSyncClientAdded") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map ci si -> m ()))) :*: (S1 ('MetaSel ('Just "clientSyncProcessorSyncServerDeleted") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set si -> m ())) :*: S1 ('MetaSel ('Just "clientSyncProcessorSyncClientDeleted") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set si -> m ()))))) |
mergeSyncResponseCustom :: Monad m => ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m () Source #
Pure
emptyClientStore :: ClientStore ci si a Source #
The client store with no items.
A Client-side identifier for items for use with pure client stores
These only need to be unique at the client.
Constructors
ClientId | |
Fields
|
Instances
Bounded ClientId Source # | |
Enum ClientId Source # | |
Defined in Data.Mergeless.Collection | |
Eq ClientId Source # | |
Ord ClientId Source # | |
Defined in Data.Mergeless.Collection | |
Show ClientId Source # | |
Generic ClientId Source # | |
ToJSON ClientId Source # | |
Defined in Data.Mergeless.Collection | |
ToJSONKey ClientId Source # | |
Defined in Data.Mergeless.Collection | |
FromJSON ClientId Source # | |
FromJSONKey ClientId Source # | |
Defined in Data.Mergeless.Collection Methods | |
HasCodec ClientId Source # | |
Defined in Data.Mergeless.Collection | |
NFData ClientId Source # | |
Defined in Data.Mergeless.Collection | |
Validity ClientId Source # | |
Defined in Data.Mergeless.Collection Methods validate :: ClientId -> Validation # | |
type Rep ClientId Source # | |
Defined in Data.Mergeless.Collection |
storeSize :: ClientStore ci si a -> Int Source #
The number of items in a store
This does not count the deleted items, so that those really look deleted.
addItemToClientStore :: (Enum ci, Bounded ci, Ord 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.
The values wrap around when reaching maxBound
.
deleteUnsyncedFromClientStore :: Ord ci => ci -> ClientStore ci si a -> ClientStore ci si a Source #
deleteSyncedFromClientStore :: Ord si => si -> ClientStore ci si a -> ClientStore ci si a Source #
emptySyncRequest :: SyncRequest ci si a Source #
makeSyncRequest :: ClientStore ci si a -> SyncRequest ci si a Source #
Produce a synchronisation request for a client-side store.
This request can then be sent to a central store for synchronisation.
mergeSyncResponse :: forall ci si a. (Ord ci, Ord si) => ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a Source #
Merge a synchronisation response back into a client-side store.
pureClientSyncProcessor :: forall ci si a. (Ord ci, Ord si) => ClientSyncProcessor ci si a (State (ClientStore ci si a)) Source #
Server-side Synchronisation
General synchronisation
data ServerSyncProcessor ci si a m Source #
A record of the basic operations that are necessary to build a synchronisation processor.
Constructors
ServerSyncProcessor | |
Fields
|
Instances
Generic (ServerSyncProcessor ci si a m) Source # | |
Defined in Data.Mergeless.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.Mergeless.Collection type Rep (ServerSyncProcessor ci si a m) = D1 ('MetaData "ServerSyncProcessor" "Data.Mergeless.Collection" "mergeless-0.4.0.0-9fBBdk4jjdm1sIN7SjvtgQ" 'False) (C1 ('MetaCons "ServerSyncProcessor" 'PrefixI 'True) (S1 ('MetaSel ('Just "serverSyncProcessorRead") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (m (Map si a))) :*: (S1 ('MetaSel ('Just "serverSyncProcessorAddItems") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map ci a -> m (Map ci si))) :*: S1 ('MetaSel ('Just "serverSyncProcessorDeleteItems") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set si -> m (Set si)))))) |
processServerSyncCustom :: forall ci si a m. (Ord si, Monad m) => ServerSyncProcessor ci si a m -> SyncRequest ci si a -> m (SyncResponse ci si a) Source #
Synchronisation with a simple central store
newtype ServerStore si a Source #
A central store of items with identifiers of type i
and values of type a
Constructors
ServerStore | |
Fields
|
Instances
emptyServerStore :: ServerStore si a Source #
An empty central store to start with
emptySyncResponse :: SyncResponse ci si a Source #
processServerSync :: 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) Source #
Process a server-side synchronisation request using a server id generator
see processSyncCustom