{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | 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' with 'makeSyncRequest'.
-- * 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' or 'processServerSyncCustom'.
-- * 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.
module Data.Mergeful.Collection
  ( -- * Client side
    ClientStore (..),
    Timed (..),
    ServerTime (..),
    initialClientStore,

    -- ** Querying the client store
    clientStoreSize,
    clientStoreClientIdSet,
    clientStoreUndeletedSyncIdSet,
    clientStoreSyncIdSet,
    clientStoreItems,

    -- ** Changing the client store
    addItemToClientStore,
    findFreeSpot,
    markItemDeletedInClientStore,
    changeItemInClientStore,
    deleteItemFromClientStore,

    -- ** Making a sync request
    SyncRequest (..),
    initialSyncRequest,
    makeSyncRequest,

    -- ** Merging the response
    SyncResponse (..),
    ClientAddition (..),
    ItemMergeStrategy (..),
    ChangeConflictResolution (..),
    ClientDeletedConflictResolution (..),
    ServerDeletedConflictResolution (..),
    mergeFromServerStrategy,
    mergeFromClientStrategy,
    mergeUsingCRDTStrategy,
    mergeSyncResponseFromServer,
    mergeSyncResponseFromClient,
    mergeSyncResponseUsingCRDT,
    mergeSyncResponseUsingStrategy,
    ClientSyncProcessor (..),
    mergeSyncResponseCustom,

    -- *** Utility functions for implementing pure client-side merging
    ClientId (..),
    mergeAddedItems,
    mergeSyncedButChangedItems,
    mergeDeletedItems,

    -- *** Utility functions for implementing custom client-side merging
    mergeSyncedButChangedConflicts,
    mergeClientDeletedConflicts,
    mergeServerDeletedConflicts,

    -- * Server side

    -- ** The store
    ServerStore (..),
    initialServerStore,

    -- ** Processing a sync request
    processServerSync,
    ServerSyncProcessor (..),
    processServerSyncCustom,
    emptySyncResponse,
    initialServerTime,
    incrementServerTime,
  )
where

import Autodocodec
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Control.Monad.State
import Data.Aeson (FromJSON, FromJSONKey (..), ToJSON, ToJSONKey (..))
import Data.Kind
import Data.List
import Data.Map (Map)
import qualified Data.Map as M
import Data.Mergeful.Item
import Data.Mergeful.Timed
import Data.Set (Set)
import qualified Data.Set as S
import Data.Validity
import Data.Validity.Containers ()
import Data.Word
import GHC.Generics (Generic)

-- | A Client-side identifier for items.
--
-- These only need to be unique at the client.
newtype ClientId = ClientId
  { ClientId -> Word64
unClientId :: Word64
  }
  deriving stock (Int -> ClientId -> ShowS
[ClientId] -> ShowS
ClientId -> String
(Int -> ClientId -> ShowS)
-> (ClientId -> String) -> ([ClientId] -> ShowS) -> Show ClientId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientId] -> ShowS
$cshowList :: [ClientId] -> ShowS
show :: ClientId -> String
$cshow :: ClientId -> String
showsPrec :: Int -> ClientId -> ShowS
$cshowsPrec :: Int -> ClientId -> ShowS
Show, ClientId -> ClientId -> Bool
(ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool) -> Eq ClientId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientId -> ClientId -> Bool
$c/= :: ClientId -> ClientId -> Bool
== :: ClientId -> ClientId -> Bool
$c== :: ClientId -> ClientId -> Bool
Eq, Eq ClientId
Eq ClientId
-> (ClientId -> ClientId -> Ordering)
-> (ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> ClientId)
-> (ClientId -> ClientId -> ClientId)
-> Ord ClientId
ClientId -> ClientId -> Bool
ClientId -> ClientId -> Ordering
ClientId -> ClientId -> ClientId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClientId -> ClientId -> ClientId
$cmin :: ClientId -> ClientId -> ClientId
max :: ClientId -> ClientId -> ClientId
$cmax :: ClientId -> ClientId -> ClientId
>= :: ClientId -> ClientId -> Bool
$c>= :: ClientId -> ClientId -> Bool
> :: ClientId -> ClientId -> Bool
$c> :: ClientId -> ClientId -> Bool
<= :: ClientId -> ClientId -> Bool
$c<= :: ClientId -> ClientId -> Bool
< :: ClientId -> ClientId -> Bool
$c< :: ClientId -> ClientId -> Bool
compare :: ClientId -> ClientId -> Ordering
$ccompare :: ClientId -> ClientId -> Ordering
$cp1Ord :: Eq ClientId
Ord, (forall x. ClientId -> Rep ClientId x)
-> (forall x. Rep ClientId x -> ClientId) -> Generic ClientId
forall x. Rep ClientId x -> ClientId
forall x. ClientId -> Rep ClientId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientId x -> ClientId
$cfrom :: forall x. ClientId -> Rep ClientId x
Generic)
  deriving newtype (Int -> ClientId
ClientId -> Int
ClientId -> [ClientId]
ClientId -> ClientId
ClientId -> ClientId -> [ClientId]
ClientId -> ClientId -> ClientId -> [ClientId]
(ClientId -> ClientId)
-> (ClientId -> ClientId)
-> (Int -> ClientId)
-> (ClientId -> Int)
-> (ClientId -> [ClientId])
-> (ClientId -> ClientId -> [ClientId])
-> (ClientId -> ClientId -> [ClientId])
-> (ClientId -> ClientId -> ClientId -> [ClientId])
-> Enum ClientId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ClientId -> ClientId -> ClientId -> [ClientId]
$cenumFromThenTo :: ClientId -> ClientId -> ClientId -> [ClientId]
enumFromTo :: ClientId -> ClientId -> [ClientId]
$cenumFromTo :: ClientId -> ClientId -> [ClientId]
enumFromThen :: ClientId -> ClientId -> [ClientId]
$cenumFromThen :: ClientId -> ClientId -> [ClientId]
enumFrom :: ClientId -> [ClientId]
$cenumFrom :: ClientId -> [ClientId]
fromEnum :: ClientId -> Int
$cfromEnum :: ClientId -> Int
toEnum :: Int -> ClientId
$ctoEnum :: Int -> ClientId
pred :: ClientId -> ClientId
$cpred :: ClientId -> ClientId
succ :: ClientId -> ClientId
$csucc :: ClientId -> ClientId
Enum, ClientId
ClientId -> ClientId -> Bounded ClientId
forall a. a -> a -> Bounded a
maxBound :: ClientId
$cmaxBound :: ClientId
minBound :: ClientId
$cminBound :: ClientId
Bounded, ToJSONKeyFunction [ClientId]
ToJSONKeyFunction ClientId
ToJSONKeyFunction ClientId
-> ToJSONKeyFunction [ClientId] -> ToJSONKey ClientId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [ClientId]
$ctoJSONKeyList :: ToJSONKeyFunction [ClientId]
toJSONKey :: ToJSONKeyFunction ClientId
$ctoJSONKey :: ToJSONKeyFunction ClientId
ToJSONKey, FromJSONKeyFunction [ClientId]
FromJSONKeyFunction ClientId
FromJSONKeyFunction ClientId
-> FromJSONKeyFunction [ClientId] -> FromJSONKey ClientId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ClientId]
$cfromJSONKeyList :: FromJSONKeyFunction [ClientId]
fromJSONKey :: FromJSONKeyFunction ClientId
$cfromJSONKey :: FromJSONKeyFunction ClientId
FromJSONKey)
  deriving (Value -> Parser [ClientId]
Value -> Parser ClientId
(Value -> Parser ClientId)
-> (Value -> Parser [ClientId]) -> FromJSON ClientId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ClientId]
$cparseJSONList :: Value -> Parser [ClientId]
parseJSON :: Value -> Parser ClientId
$cparseJSON :: Value -> Parser ClientId
FromJSON, [ClientId] -> Encoding
[ClientId] -> Value
ClientId -> Encoding
ClientId -> Value
(ClientId -> Value)
-> (ClientId -> Encoding)
-> ([ClientId] -> Value)
-> ([ClientId] -> Encoding)
-> ToJSON ClientId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ClientId] -> Encoding
$ctoEncodingList :: [ClientId] -> Encoding
toJSONList :: [ClientId] -> Value
$ctoJSONList :: [ClientId] -> Value
toEncoding :: ClientId -> Encoding
$ctoEncoding :: ClientId -> Encoding
toJSON :: ClientId -> Value
$ctoJSON :: ClientId -> Value
ToJSON) via (Autodocodec ClientId)

instance Validity ClientId

instance NFData ClientId

instance HasCodec ClientId where
  codec :: JSONCodec ClientId
codec = (Word64 -> ClientId)
-> (ClientId -> Word64)
-> Codec Value Word64 Word64
-> JSONCodec ClientId
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Word64 -> ClientId
ClientId ClientId -> Word64
unClientId Codec Value Word64 Word64
forall value. HasCodec value => JSONCodec value
codec JSONCodec ClientId -> Text -> JSONCodec ClientId
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"ClientId"

data ClientStore ci si a = ClientStore
  { -- | These items are new locally but have not been synced to the server yet.
    ClientStore ci si a -> Map ci a
clientStoreAddedItems :: !(Map ci a),
    -- | These items have been synced at their respective 'ServerTime's.
    ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems :: !(Map si (Timed a)),
    -- | These items have been synced at their respective 'ServerTime's
    -- but modified locally since then.
    ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems :: !(Map si (Timed a)),
    -- | These items have been deleted locally after they were synced
    -- but the server has not been notified of that yet.
    ClientStore ci si a -> Map si ServerTime
clientStoreDeletedItems :: !(Map si ServerTime)
  }
  deriving stock (Int -> ClientStore ci si a -> ShowS
[ClientStore ci si a] -> ShowS
ClientStore ci si a -> String
(Int -> ClientStore ci si a -> ShowS)
-> (ClientStore ci si a -> String)
-> ([ClientStore ci si a] -> ShowS)
-> Show (ClientStore ci si a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ci si a.
(Show ci, Show a, Show si) =>
Int -> ClientStore ci si a -> ShowS
forall ci si a.
(Show ci, Show a, Show si) =>
[ClientStore ci si a] -> ShowS
forall ci si a.
(Show ci, Show a, Show si) =>
ClientStore ci si a -> String
showList :: [ClientStore ci si a] -> ShowS
$cshowList :: forall ci si a.
(Show ci, Show a, Show si) =>
[ClientStore ci si a] -> ShowS
show :: ClientStore ci si a -> String
$cshow :: forall ci si a.
(Show ci, Show a, Show si) =>
ClientStore ci si a -> String
showsPrec :: Int -> ClientStore ci si a -> ShowS
$cshowsPrec :: forall ci si a.
(Show ci, Show a, Show si) =>
Int -> ClientStore ci si a -> ShowS
Show, ClientStore ci si a -> ClientStore ci si a -> Bool
(ClientStore ci si a -> ClientStore ci si a -> Bool)
-> (ClientStore ci si a -> ClientStore ci si a -> Bool)
-> Eq (ClientStore ci si a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ci si a.
(Eq ci, Eq a, Eq si) =>
ClientStore ci si a -> ClientStore ci si a -> Bool
/= :: ClientStore ci si a -> ClientStore ci si a -> Bool
$c/= :: forall ci si a.
(Eq ci, Eq a, Eq si) =>
ClientStore ci si a -> ClientStore ci si a -> Bool
== :: ClientStore ci si a -> ClientStore ci si a -> Bool
$c== :: forall ci si a.
(Eq ci, Eq a, Eq si) =>
ClientStore ci si a -> ClientStore ci si a -> Bool
Eq, (forall x. ClientStore ci si a -> Rep (ClientStore ci si a) x)
-> (forall x. Rep (ClientStore ci si a) x -> ClientStore ci si a)
-> Generic (ClientStore ci si a)
forall x. Rep (ClientStore ci si a) x -> ClientStore ci si a
forall x. ClientStore ci si a -> Rep (ClientStore ci si a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ci si a x.
Rep (ClientStore ci si a) x -> ClientStore ci si a
forall ci si a x.
ClientStore ci si a -> Rep (ClientStore ci si a) x
$cto :: forall ci si a x.
Rep (ClientStore ci si a) x -> ClientStore ci si a
$cfrom :: forall ci si a x.
ClientStore ci si a -> Rep (ClientStore ci si a) x
Generic)
  deriving (Value -> Parser [ClientStore ci si a]
Value -> Parser (ClientStore ci si a)
(Value -> Parser (ClientStore ci si a))
-> (Value -> Parser [ClientStore ci si a])
-> FromJSON (ClientStore ci si a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
Value -> Parser [ClientStore ci si a]
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
Value -> Parser (ClientStore ci si a)
parseJSONList :: Value -> Parser [ClientStore ci si a]
$cparseJSONList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
Value -> Parser [ClientStore ci si a]
parseJSON :: Value -> Parser (ClientStore ci si a)
$cparseJSON :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
Value -> Parser (ClientStore ci si a)
FromJSON, [ClientStore ci si a] -> Encoding
[ClientStore ci si a] -> Value
ClientStore ci si a -> Encoding
ClientStore ci si a -> Value
(ClientStore ci si a -> Value)
-> (ClientStore ci si a -> Encoding)
-> ([ClientStore ci si a] -> Value)
-> ([ClientStore ci si a] -> Encoding)
-> ToJSON (ClientStore ci si a)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
[ClientStore ci si a] -> Encoding
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
[ClientStore ci si a] -> Value
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
ClientStore ci si a -> Encoding
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
ClientStore ci si a -> Value
toEncodingList :: [ClientStore ci si a] -> Encoding
$ctoEncodingList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
[ClientStore ci si a] -> Encoding
toJSONList :: [ClientStore ci si a] -> Value
$ctoJSONList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
[ClientStore ci si a] -> Value
toEncoding :: ClientStore ci si a -> Encoding
$ctoEncoding :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
ClientStore ci si a -> Encoding
toJSON :: ClientStore ci si a -> Value
$ctoJSON :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
ClientStore ci si a -> Value
ToJSON) via (Autodocodec (ClientStore ci si a))

instance
  (Validity ci, Validity si, Show ci, Show si, Ord ci, Ord si, Validity a) =>
  Validity (ClientStore ci si a)
  where
  validate :: ClientStore ci si a -> Validation
validate cs :: ClientStore ci si a
cs@ClientStore {Map ci a
Map si (Timed a)
Map si ServerTime
clientStoreDeletedItems :: Map si ServerTime
clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedItems :: Map si (Timed a)
clientStoreAddedItems :: Map ci a
clientStoreDeletedItems :: forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreSyncedButChangedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreAddedItems :: forall ci si a. ClientStore ci si a -> Map ci a
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ ClientStore ci si a -> Validation
forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate ClientStore ci si a
cs,
        String -> Bool -> Validation
declare String
"There are no duplicate IDs" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$
          [si] -> Bool
forall a. Eq a => [a] -> Bool
distinct ([si] -> Bool) -> [si] -> Bool
forall a b. (a -> b) -> a -> b
$
            [[si]] -> [si]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ Map si (Timed a) -> [si]
forall k a. Map k a -> [k]
M.keys Map si (Timed a)
clientStoreSyncedItems,
                Map si (Timed a) -> [si]
forall k a. Map k a -> [k]
M.keys Map si (Timed a)
clientStoreSyncedButChangedItems,
                Map si ServerTime -> [si]
forall k a. Map k a -> [k]
M.keys Map si ServerTime
clientStoreDeletedItems
              ]
      ]

instance (NFData ci, NFData si, NFData a) => NFData (ClientStore ci si a)

instance
  ( Ord ci,
    FromJSONKey ci,
    ToJSONKey ci,
    Ord si,
    FromJSONKey si,
    ToJSONKey si,
    Eq a,
    HasCodec a
  ) =>
  HasCodec (ClientStore ci si a)
  where
  codec :: JSONCodec (ClientStore ci si a)
codec =
    Text
-> ObjectCodec (ClientStore ci si a) (ClientStore ci si a)
-> JSONCodec (ClientStore ci si a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ClientStore" (ObjectCodec (ClientStore ci si a) (ClientStore ci si a)
 -> JSONCodec (ClientStore ci si a))
-> ObjectCodec (ClientStore ci si a) (ClientStore ci si a)
-> JSONCodec (ClientStore ci si a)
forall a b. (a -> b) -> a -> b
$
      Map ci a
-> Map si (Timed a)
-> Map si (Timed a)
-> Map si ServerTime
-> ClientStore ci si a
forall ci si a.
Map ci a
-> Map si (Timed a)
-> Map si (Timed a)
-> Map si ServerTime
-> ClientStore ci si a
ClientStore
        (Map ci a
 -> Map si (Timed a)
 -> Map si (Timed a)
 -> Map si ServerTime
 -> ClientStore ci si a)
-> Codec Object (ClientStore ci si a) (Map ci a)
-> Codec
     Object
     (ClientStore ci si a)
     (Map si (Timed a)
      -> Map si (Timed a) -> Map si ServerTime -> ClientStore ci si a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map ci a -> Text -> ObjectCodec (Map ci a) (Map ci a)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"added" Map ci a
forall k a. Map k a
M.empty Text
"added items" ObjectCodec (Map ci a) (Map ci a)
-> (ClientStore ci si a -> Map ci a)
-> Codec Object (ClientStore ci si a) (Map ci a)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ClientStore ci si a -> Map ci a
forall ci si a. ClientStore ci si a -> Map ci a
clientStoreAddedItems
        Codec
  Object
  (ClientStore ci si a)
  (Map si (Timed a)
   -> Map si (Timed a) -> Map si ServerTime -> ClientStore ci si a)
-> Codec Object (ClientStore ci si a) (Map si (Timed a))
-> Codec
     Object
     (ClientStore ci si a)
     (Map si (Timed a) -> Map si ServerTime -> ClientStore ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si (Timed a)
-> Text
-> ObjectCodec (Map si (Timed a)) (Map si (Timed a))
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"synced" Map si (Timed a)
forall k a. Map k a
M.empty Text
"synced items" ObjectCodec (Map si (Timed a)) (Map si (Timed a))
-> (ClientStore ci si a -> Map si (Timed a))
-> Codec Object (ClientStore ci si a) (Map si (Timed a))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems
        Codec
  Object
  (ClientStore ci si a)
  (Map si (Timed a) -> Map si ServerTime -> ClientStore ci si a)
-> Codec Object (ClientStore ci si a) (Map si (Timed a))
-> Codec
     Object
     (ClientStore ci si a)
     (Map si ServerTime -> ClientStore ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si (Timed a)
-> Text
-> ObjectCodec (Map si (Timed a)) (Map si (Timed a))
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"changed" Map si (Timed a)
forall k a. Map k a
M.empty Text
"changed items" ObjectCodec (Map si (Timed a)) (Map si (Timed a))
-> (ClientStore ci si a -> Map si (Timed a))
-> Codec Object (ClientStore ci si a) (Map si (Timed a))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems
        Codec
  Object
  (ClientStore ci si a)
  (Map si ServerTime -> ClientStore ci si a)
-> Codec Object (ClientStore ci si a) (Map si ServerTime)
-> ObjectCodec (ClientStore ci si a) (ClientStore ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si ServerTime
-> Text
-> ObjectCodec (Map si ServerTime) (Map si ServerTime)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"deleted" Map si ServerTime
forall k a. Map k a
M.empty Text
"deleted items" ObjectCodec (Map si ServerTime) (Map si ServerTime)
-> (ClientStore ci si a -> Map si ServerTime)
-> Codec Object (ClientStore ci si a) (Map si ServerTime)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ClientStore ci si a -> Map si ServerTime
forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreDeletedItems

-- | A client store to start with.
--
-- This store contains no items.
initialClientStore :: ClientStore ci si a
initialClientStore :: ClientStore ci si a
initialClientStore =
  ClientStore :: forall ci si a.
Map ci a
-> Map si (Timed a)
-> Map si (Timed a)
-> Map si ServerTime
-> ClientStore ci si a
ClientStore
    { clientStoreAddedItems :: Map ci a
clientStoreAddedItems = Map ci a
forall k a. Map k a
M.empty,
      clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = Map si (Timed a)
forall k a. Map k a
M.empty,
      clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems = Map si (Timed a)
forall k a. Map k a
M.empty,
      clientStoreDeletedItems :: Map si ServerTime
clientStoreDeletedItems = Map si ServerTime
forall k a. Map k a
M.empty
    }

-- | The number of items in a client store
--
-- This does not count the deleted items, so that they really look deleted..
clientStoreSize :: ClientStore ci si a -> Word
clientStoreSize :: ClientStore ci si a -> Word
clientStoreSize ClientStore {Map ci a
Map si (Timed a)
Map si ServerTime
clientStoreDeletedItems :: Map si ServerTime
clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedItems :: Map si (Timed a)
clientStoreAddedItems :: Map ci a
clientStoreDeletedItems :: forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreSyncedButChangedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreAddedItems :: forall ci si a. ClientStore ci si a -> Map ci a
..} =
  Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$
    [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
      [ Map ci a -> Int
forall k a. Map k a -> Int
M.size Map ci a
clientStoreAddedItems,
        Map si (Timed a) -> Int
forall k a. Map k a -> Int
M.size Map si (Timed a)
clientStoreSyncedItems,
        Map si (Timed a) -> Int
forall k a. Map k a -> Int
M.size Map si (Timed a)
clientStoreSyncedButChangedItems
      ]

-- | The set of client ids.
--
-- These are only the client ids of the added items that have not been synced yet.
clientStoreClientIdSet :: ClientStore ci si a -> Set ci
clientStoreClientIdSet :: ClientStore ci si a -> Set ci
clientStoreClientIdSet ClientStore {Map ci a
Map si (Timed a)
Map si ServerTime
clientStoreDeletedItems :: Map si ServerTime
clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedItems :: Map si (Timed a)
clientStoreAddedItems :: Map ci a
clientStoreDeletedItems :: forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreSyncedButChangedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreAddedItems :: forall ci si a. ClientStore ci si a -> Map ci a
..} = Map ci a -> Set ci
forall k a. Map k a -> Set k
M.keysSet Map ci a
clientStoreAddedItems

-- | The set of server ids.
--
-- This does not include the ids of items that have been marked as deleted.
clientStoreUndeletedSyncIdSet :: Ord si => ClientStore ci si a -> Set si
clientStoreUndeletedSyncIdSet :: ClientStore ci si a -> Set si
clientStoreUndeletedSyncIdSet ClientStore {Map si (Timed a)
Map si ServerTime
Map ci a
clientStoreDeletedItems :: Map si ServerTime
clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedItems :: Map si (Timed a)
clientStoreAddedItems :: Map ci a
clientStoreDeletedItems :: forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreSyncedButChangedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreAddedItems :: forall ci si a. ClientStore ci si a -> Map ci a
..} =
  [Set si] -> Set si
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions [Map si (Timed a) -> Set si
forall k a. Map k a -> Set k
M.keysSet Map si (Timed a)
clientStoreSyncedItems, Map si (Timed a) -> Set si
forall k a. Map k a -> Set k
M.keysSet Map si (Timed a)
clientStoreSyncedButChangedItems]

-- | The set of server ids.
--
-- This includes the ids of items that have been marked as deleted.
clientStoreSyncIdSet :: Ord si => ClientStore ci si a -> Set si
clientStoreSyncIdSet :: ClientStore ci si a -> Set si
clientStoreSyncIdSet ClientStore {Map si (Timed a)
Map si ServerTime
Map ci a
clientStoreDeletedItems :: Map si ServerTime
clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedItems :: Map si (Timed a)
clientStoreAddedItems :: Map ci a
clientStoreDeletedItems :: forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreSyncedButChangedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreAddedItems :: forall ci si a. ClientStore ci si a -> Map ci a
..} =
  [Set si] -> Set si
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions
    [ Map si (Timed a) -> Set si
forall k a. Map k a -> Set k
M.keysSet Map si (Timed a)
clientStoreSyncedItems,
      Map si (Timed a) -> Set si
forall k a. Map k a -> Set k
M.keysSet Map si (Timed a)
clientStoreSyncedButChangedItems,
      Map si ServerTime -> Set si
forall k a. Map k a -> Set k
M.keysSet Map si ServerTime
clientStoreDeletedItems
    ]

-- | The set of items in the client store
--
-- This map does not include items that have been marked as deleted.
clientStoreItems :: (Ord ci, Ord si) => ClientStore ci si a -> Map (Either ci si) a
clientStoreItems :: ClientStore ci si a -> Map (Either ci si) a
clientStoreItems ClientStore {Map ci a
Map si (Timed a)
Map si ServerTime
clientStoreDeletedItems :: Map si ServerTime
clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedItems :: Map si (Timed a)
clientStoreAddedItems :: Map ci a
clientStoreDeletedItems :: forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreSyncedButChangedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreAddedItems :: forall ci si a. ClientStore ci si a -> Map ci a
..} =
  [Map (Either ci si) a] -> Map (Either ci si) a
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
    [ (ci -> Either ci si) -> Map ci a -> Map (Either ci si) a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys ci -> Either ci si
forall a b. a -> Either a b
Left Map ci a
clientStoreAddedItems,
      (si -> Either ci si) -> Map si a -> Map (Either ci si) a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys si -> Either ci si
forall a b. b -> Either a b
Right (Map si a -> Map (Either ci si) a)
-> Map si a -> Map (Either ci si) a
forall a b. (a -> b) -> a -> b
$ (Timed a -> a) -> Map si (Timed a) -> Map si a
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Timed a -> a
forall a. Timed a -> a
timedValue Map si (Timed a)
clientStoreSyncedItems,
      (si -> Either ci si) -> Map si a -> Map (Either ci si) a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys si -> Either ci si
forall a b. b -> Either a b
Right (Map si a -> Map (Either ci si) a)
-> Map si a -> Map (Either ci si) a
forall a b. (a -> b) -> a -> b
$ (Timed a -> a) -> Map si (Timed a) -> Map si a
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Timed a -> a
forall a. Timed a -> a
timedValue Map si (Timed a)
clientStoreSyncedButChangedItems
    ]

-- | 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.
addItemToClientStore ::
  (Ord ci, Enum ci, Bounded ci) => a -> ClientStore ci si a -> ClientStore ci si a
addItemToClientStore :: a -> ClientStore ci si a -> ClientStore ci si a
addItemToClientStore a
a ClientStore ci si a
cs =
  let oldAddedItems :: Map ci a
oldAddedItems = ClientStore ci si a -> Map ci a
forall ci si a. ClientStore ci si a -> Map ci a
clientStoreAddedItems ClientStore ci si a
cs
      newAddedItems :: Map ci a
newAddedItems =
        let newKey :: ci
newKey = Map ci a -> ci
forall ci a. (Ord ci, Enum ci, Bounded ci) => Map ci a -> ci
findFreeSpot Map ci a
oldAddedItems
         in ci -> a -> Map ci a -> Map ci a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ci
newKey a
a Map ci a
oldAddedItems
   in ClientStore ci si a
cs {clientStoreAddedItems :: Map ci a
clientStoreAddedItems = Map ci a
newAddedItems}

-- | 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'.
findFreeSpot :: (Ord ci, Enum ci, Bounded ci) => Map ci a -> ci
findFreeSpot :: Map ci a -> ci
findFreeSpot Map ci a
m =
  if Map ci a -> Bool
forall k a. Map k a -> Bool
M.null Map ci a
m
    then ci
forall a. Bounded a => a
minBound
    else
      let (ci
i, a
_) = Map ci a -> (ci, a)
forall k a. Map k a -> (k, a)
M.findMax Map ci a
m
       in ci -> ci
go (ci -> ci
forall p. (Eq p, Bounded p, Enum p) => p -> p
next ci
i)
  where
    go :: ci -> ci
go ci
i =
      if ci -> Map ci a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member ci
i Map ci a
m
        then ci -> ci
go (ci -> ci
forall p. (Eq p, Bounded p, Enum p) => p -> p
next ci
i)
        else ci
i
    next :: p -> p
next p
ci
      | p
ci p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
forall a. Bounded a => a
maxBound = p
forall a. Bounded a => a
minBound
      | Bool
otherwise = p -> p
forall a. Enum a => a -> a
succ p
ci

-- | Mark an item deleted in a client store.
--
-- This function will not delete the item, but mark it as deleted instead.
markItemDeletedInClientStore :: Ord si => si -> ClientStore ci si a -> ClientStore ci si a
markItemDeletedInClientStore :: si -> ClientStore ci si a -> ClientStore ci si a
markItemDeletedInClientStore si
u ClientStore ci si a
cs =
  let oldSyncedItems :: Map si (Timed a)
oldSyncedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs
      oldChangedItems :: Map si (Timed a)
oldChangedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs
      oldDeletedItems :: Map si ServerTime
oldDeletedItems = ClientStore ci si a -> Map si ServerTime
forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreDeletedItems ClientStore ci si a
cs
      mItem :: Maybe (Timed a)
mItem = si -> Map si (Timed a) -> Maybe (Timed a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup si
u Map si (Timed a)
oldSyncedItems Maybe (Timed a) -> Maybe (Timed a) -> Maybe (Timed a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> si -> Map si (Timed a) -> Maybe (Timed a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup si
u Map si (Timed a)
oldChangedItems
   in case Maybe (Timed a)
mItem of
        Maybe (Timed a)
Nothing -> ClientStore ci si a
cs
        Just Timed a
t ->
          let newSyncedItems :: Map si (Timed a)
newSyncedItems = si -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete si
u Map si (Timed a)
oldSyncedItems
              newChangedItems :: Map si (Timed a)
newChangedItems = si -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete si
u Map si (Timed a)
oldChangedItems
              newDeletedItems :: Map si ServerTime
newDeletedItems = si -> ServerTime -> Map si ServerTime -> Map si ServerTime
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
u (Timed a -> ServerTime
forall a. Timed a -> ServerTime
timedTime Timed a
t) Map si ServerTime
oldDeletedItems
           in ClientStore ci si a
cs
                { clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = Map si (Timed a)
newSyncedItems,
                  clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems = Map si (Timed a)
newChangedItems,
                  clientStoreDeletedItems :: Map si ServerTime
clientStoreDeletedItems = Map si ServerTime
newDeletedItems
                }

-- | 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.
changeItemInClientStore :: Ord si => si -> a -> ClientStore ci si a -> ClientStore ci si a
changeItemInClientStore :: si -> a -> ClientStore ci si a -> ClientStore ci si a
changeItemInClientStore si
i a
a ClientStore ci si a
cs =
  case si -> Map si (Timed a) -> Maybe (Timed a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup si
i (ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs) of
    Just Timed a
t ->
      ClientStore ci si a
cs
        { clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = si -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete si
i (ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs),
          clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems =
            si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
i (Timed a
t {timedValue :: a
timedValue = a
a}) (ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs)
        }
    Maybe (Timed a)
Nothing ->
      case si -> Map si (Timed a) -> Maybe (Timed a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup si
i (ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs) of
        Maybe (Timed a)
Nothing -> ClientStore ci si a
cs
        Just Timed a
_ ->
          ClientStore ci si a
cs
            { clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems =
                (Timed a -> Timed a) -> si -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\Timed a
t -> Timed a
t {timedValue :: a
timedValue = a
a}) si
i (ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs)
            }

-- | Delete an unsynced item from a client store.
--
-- This function will immediately delete the item, because it has never been synced.
deleteItemFromClientStore :: Ord ci => ci -> ClientStore ci si a -> ClientStore ci si a
deleteItemFromClientStore :: ci -> ClientStore ci si a -> ClientStore ci si a
deleteItemFromClientStore ci
i ClientStore ci si a
cs = ClientStore ci si a
cs {clientStoreAddedItems :: Map ci a
clientStoreAddedItems = ci -> Map ci a -> Map ci a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ci
i (ClientStore ci si a -> Map ci a
forall ci si a. ClientStore ci si a -> Map ci a
clientStoreAddedItems ClientStore ci si a
cs)}

newtype ServerStore si a = ServerStore
  { -- | A map of items, named using an 'si', together with the 'ServerTime' at which
    -- they were last synced.
    ServerStore si a -> Map si (Timed a)
serverStoreItems :: Map si (Timed a)
  }
  deriving stock (Int -> ServerStore si a -> ShowS
[ServerStore si a] -> ShowS
ServerStore si a -> String
(Int -> ServerStore si a -> ShowS)
-> (ServerStore si a -> String)
-> ([ServerStore si a] -> ShowS)
-> Show (ServerStore si a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall si a. (Show si, Show a) => Int -> ServerStore si a -> ShowS
forall si a. (Show si, Show a) => [ServerStore si a] -> ShowS
forall si a. (Show si, Show a) => ServerStore si a -> String
showList :: [ServerStore si a] -> ShowS
$cshowList :: forall si a. (Show si, Show a) => [ServerStore si a] -> ShowS
show :: ServerStore si a -> String
$cshow :: forall si a. (Show si, Show a) => ServerStore si a -> String
showsPrec :: Int -> ServerStore si a -> ShowS
$cshowsPrec :: forall si a. (Show si, Show a) => Int -> ServerStore si a -> ShowS
Show, ServerStore si a -> ServerStore si a -> Bool
(ServerStore si a -> ServerStore si a -> Bool)
-> (ServerStore si a -> ServerStore si a -> Bool)
-> Eq (ServerStore si a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall si a.
(Eq si, Eq a) =>
ServerStore si a -> ServerStore si a -> Bool
/= :: ServerStore si a -> ServerStore si a -> Bool
$c/= :: forall si a.
(Eq si, Eq a) =>
ServerStore si a -> ServerStore si a -> Bool
== :: ServerStore si a -> ServerStore si a -> Bool
$c== :: forall si a.
(Eq si, Eq a) =>
ServerStore si a -> ServerStore si a -> Bool
Eq, (forall x. ServerStore si a -> Rep (ServerStore si a) x)
-> (forall x. Rep (ServerStore si a) x -> ServerStore si a)
-> Generic (ServerStore si a)
forall x. Rep (ServerStore si a) x -> ServerStore si a
forall x. ServerStore si a -> Rep (ServerStore si a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall si a x. Rep (ServerStore si a) x -> ServerStore si a
forall si a x. ServerStore si a -> Rep (ServerStore si a) x
$cto :: forall si a x. Rep (ServerStore si a) x -> ServerStore si a
$cfrom :: forall si a x. ServerStore si a -> Rep (ServerStore si a) x
Generic)
  deriving (Value -> Parser [ServerStore si a]
Value -> Parser (ServerStore si a)
(Value -> Parser (ServerStore si a))
-> (Value -> Parser [ServerStore si a])
-> FromJSON (ServerStore si a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
Value -> Parser [ServerStore si a]
forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
Value -> Parser (ServerStore si a)
parseJSONList :: Value -> Parser [ServerStore si a]
$cparseJSONList :: forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
Value -> Parser [ServerStore si a]
parseJSON :: Value -> Parser (ServerStore si a)
$cparseJSON :: forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
Value -> Parser (ServerStore si a)
FromJSON, [ServerStore si a] -> Encoding
[ServerStore si a] -> Value
ServerStore si a -> Encoding
ServerStore si a -> Value
(ServerStore si a -> Value)
-> (ServerStore si a -> Encoding)
-> ([ServerStore si a] -> Value)
-> ([ServerStore si a] -> Encoding)
-> ToJSON (ServerStore si a)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
[ServerStore si a] -> Encoding
forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
[ServerStore si a] -> Value
forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
ServerStore si a -> Encoding
forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
ServerStore si a -> Value
toEncodingList :: [ServerStore si a] -> Encoding
$ctoEncodingList :: forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
[ServerStore si a] -> Encoding
toJSONList :: [ServerStore si a] -> Value
$ctoJSONList :: forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
[ServerStore si a] -> Value
toEncoding :: ServerStore si a -> Encoding
$ctoEncoding :: forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
ServerStore si a -> Encoding
toJSON :: ServerStore si a -> Value
$ctoJSON :: forall si a.
(Ord si, FromJSONKey si, ToJSONKey si, HasCodec a) =>
ServerStore si a -> Value
ToJSON) via (Autodocodec (ServerStore si a))

instance (Validity si, Show si, Ord si, Validity a) => Validity (ServerStore si a)

instance (NFData si, NFData a) => NFData (ServerStore si a)

instance
  ( Ord si,
    FromJSONKey si,
    ToJSONKey si,
    HasCodec a
  ) =>
  HasCodec (ServerStore si a)
  where
  codec :: JSONCodec (ServerStore si a)
codec = (Map si (Timed a) -> ServerStore si a)
-> (ServerStore si a -> Map si (Timed a))
-> Codec Value (Map si (Timed a)) (Map si (Timed a))
-> JSONCodec (ServerStore si a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Map si (Timed a) -> ServerStore si a
forall si a. Map si (Timed a) -> ServerStore si a
ServerStore ServerStore si a -> Map si (Timed a)
forall si a. ServerStore si a -> Map si (Timed a)
serverStoreItems Codec Value (Map si (Timed a)) (Map si (Timed a))
forall value. HasCodec value => JSONCodec value
codec

-- | A server store to start with
--
-- This store contains no items.
initialServerStore :: ServerStore si a
initialServerStore :: ServerStore si a
initialServerStore = ServerStore :: forall si a. Map si (Timed a) -> ServerStore si a
ServerStore {serverStoreItems :: Map si (Timed a)
serverStoreItems = Map si (Timed a)
forall k a. Map k a
M.empty}

data SyncRequest ci si a = SyncRequest
  { -- | These items are new locally but have not been synced to the server yet.
    SyncRequest ci si a -> Map ci a
syncRequestNewItems :: !(Map ci a),
    -- | These items have been synced at their respective 'ServerTime's.
    SyncRequest ci si a -> Map si ServerTime
syncRequestKnownItems :: !(Map si ServerTime),
    -- | These items have been synced at their respective 'ServerTime's
    -- but modified locally since then.
    SyncRequest ci si a -> Map si (Timed a)
syncRequestKnownButChangedItems :: !(Map si (Timed a)),
    -- | These items have been deleted locally after they were synced
    -- but the server has not been notified of that yet.
    SyncRequest ci si a -> Map si ServerTime
syncRequestDeletedItems :: !(Map si ServerTime)
  }
  deriving stock (Int -> SyncRequest ci si a -> ShowS
[SyncRequest ci si a] -> ShowS
SyncRequest ci si a -> String
(Int -> SyncRequest ci si a -> ShowS)
-> (SyncRequest ci si a -> String)
-> ([SyncRequest ci si a] -> ShowS)
-> Show (SyncRequest ci si a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ci si a.
(Show ci, Show a, Show si) =>
Int -> SyncRequest ci si a -> ShowS
forall ci si a.
(Show ci, Show a, Show si) =>
[SyncRequest ci si a] -> ShowS
forall ci si a.
(Show ci, Show a, Show si) =>
SyncRequest ci si a -> String
showList :: [SyncRequest ci si a] -> ShowS
$cshowList :: forall ci si a.
(Show ci, Show a, Show si) =>
[SyncRequest ci si a] -> ShowS
show :: SyncRequest ci si a -> String
$cshow :: forall ci si a.
(Show ci, Show a, Show si) =>
SyncRequest ci si a -> String
showsPrec :: Int -> SyncRequest ci si a -> ShowS
$cshowsPrec :: forall ci si a.
(Show ci, Show a, Show si) =>
Int -> SyncRequest ci si a -> ShowS
Show, SyncRequest ci si a -> SyncRequest ci si a -> Bool
(SyncRequest ci si a -> SyncRequest ci si a -> Bool)
-> (SyncRequest ci si a -> SyncRequest ci si a -> Bool)
-> Eq (SyncRequest ci si a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ci si a.
(Eq ci, Eq a, Eq si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Bool
/= :: SyncRequest ci si a -> SyncRequest ci si a -> Bool
$c/= :: forall ci si a.
(Eq ci, Eq a, Eq si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Bool
== :: SyncRequest ci si a -> SyncRequest ci si a -> Bool
$c== :: forall ci si a.
(Eq ci, Eq a, Eq si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Bool
Eq, (forall x. SyncRequest ci si a -> Rep (SyncRequest ci si a) x)
-> (forall x. Rep (SyncRequest ci si a) x -> SyncRequest ci si a)
-> Generic (SyncRequest ci si a)
forall x. Rep (SyncRequest ci si a) x -> SyncRequest ci si a
forall x. SyncRequest ci si a -> Rep (SyncRequest ci si a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ci si a x.
Rep (SyncRequest ci si a) x -> SyncRequest ci si a
forall ci si a x.
SyncRequest ci si a -> Rep (SyncRequest ci si a) x
$cto :: forall ci si a x.
Rep (SyncRequest ci si a) x -> SyncRequest ci si a
$cfrom :: forall ci si a x.
SyncRequest ci si a -> Rep (SyncRequest ci si a) x
Generic)
  deriving (Value -> Parser [SyncRequest ci si a]
Value -> Parser (SyncRequest ci si a)
(Value -> Parser (SyncRequest ci si a))
-> (Value -> Parser [SyncRequest ci si a])
-> FromJSON (SyncRequest ci si a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
Value -> Parser [SyncRequest ci si a]
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
Value -> Parser (SyncRequest ci si a)
parseJSONList :: Value -> Parser [SyncRequest ci si a]
$cparseJSONList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
Value -> Parser [SyncRequest ci si a]
parseJSON :: Value -> Parser (SyncRequest ci si a)
$cparseJSON :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
Value -> Parser (SyncRequest ci si a)
FromJSON, [SyncRequest ci si a] -> Encoding
[SyncRequest ci si a] -> Value
SyncRequest ci si a -> Encoding
SyncRequest ci si a -> Value
(SyncRequest ci si a -> Value)
-> (SyncRequest ci si a -> Encoding)
-> ([SyncRequest ci si a] -> Value)
-> ([SyncRequest ci si a] -> Encoding)
-> ToJSON (SyncRequest ci si a)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
[SyncRequest ci si a] -> Encoding
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
[SyncRequest ci si a] -> Value
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
SyncRequest ci si a -> Encoding
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
SyncRequest ci si a -> Value
toEncodingList :: [SyncRequest ci si a] -> Encoding
$ctoEncodingList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
[SyncRequest ci si a] -> Encoding
toJSONList :: [SyncRequest ci si a] -> Value
$ctoJSONList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
[SyncRequest ci si a] -> Value
toEncoding :: SyncRequest ci si a -> Encoding
$ctoEncoding :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
SyncRequest ci si a -> Encoding
toJSON :: SyncRequest ci si a -> Value
$ctoJSON :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec a, Eq a) =>
SyncRequest ci si a -> Value
ToJSON) via (Autodocodec (SyncRequest ci si a))

instance
  (Validity ci, Validity si, Show ci, Show si, Ord ci, Ord si, Validity a) =>
  Validity (SyncRequest ci si a)
  where
  validate :: SyncRequest ci si a -> Validation
validate sr :: SyncRequest ci si a
sr@SyncRequest {Map ci a
Map si (Timed a)
Map si ServerTime
syncRequestDeletedItems :: Map si ServerTime
syncRequestKnownButChangedItems :: Map si (Timed a)
syncRequestKnownItems :: Map si ServerTime
syncRequestNewItems :: Map ci a
syncRequestDeletedItems :: forall ci si a. SyncRequest ci si a -> Map si ServerTime
syncRequestKnownButChangedItems :: forall ci si a. SyncRequest ci si a -> Map si (Timed a)
syncRequestKnownItems :: forall ci si a. SyncRequest ci si a -> Map si ServerTime
syncRequestNewItems :: forall ci si a. SyncRequest ci si a -> Map ci a
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ SyncRequest ci si a -> Validation
forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate SyncRequest ci si a
sr,
        String -> Bool -> Validation
declare String
"There are no duplicate IDs" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$
          [si] -> Bool
forall a. Eq a => [a] -> Bool
distinct ([si] -> Bool) -> [si] -> Bool
forall a b. (a -> b) -> a -> b
$
            [[si]] -> [si]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ Map si ServerTime -> [si]
forall k a. Map k a -> [k]
M.keys Map si ServerTime
syncRequestKnownItems,
                Map si (Timed a) -> [si]
forall k a. Map k a -> [k]
M.keys Map si (Timed a)
syncRequestKnownButChangedItems,
                Map si ServerTime -> [si]
forall k a. Map k a -> [k]
M.keys Map si ServerTime
syncRequestDeletedItems
              ]
      ]

instance (NFData ci, NFData si, NFData a) => NFData (SyncRequest ci si a)

instance
  ( Ord ci,
    FromJSONKey ci,
    ToJSONKey ci,
    Ord si,
    FromJSONKey si,
    ToJSONKey si,
    Eq a,
    HasCodec a
  ) =>
  HasCodec (SyncRequest ci si a)
  where
  codec :: JSONCodec (SyncRequest ci si a)
codec =
    Text
-> ObjectCodec (SyncRequest ci si a) (SyncRequest ci si a)
-> JSONCodec (SyncRequest ci si a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"SyncRequest" (ObjectCodec (SyncRequest ci si a) (SyncRequest ci si a)
 -> JSONCodec (SyncRequest ci si a))
-> ObjectCodec (SyncRequest ci si a) (SyncRequest ci si a)
-> JSONCodec (SyncRequest ci si a)
forall a b. (a -> b) -> a -> b
$
      Map ci a
-> Map si ServerTime
-> Map si (Timed a)
-> Map si ServerTime
-> SyncRequest ci si a
forall ci si a.
Map ci a
-> Map si ServerTime
-> Map si (Timed a)
-> Map si ServerTime
-> SyncRequest ci si a
SyncRequest
        (Map ci a
 -> Map si ServerTime
 -> Map si (Timed a)
 -> Map si ServerTime
 -> SyncRequest ci si a)
-> Codec Object (SyncRequest ci si a) (Map ci a)
-> Codec
     Object
     (SyncRequest ci si a)
     (Map si ServerTime
      -> Map si (Timed a) -> Map si ServerTime -> SyncRequest ci si a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map ci a -> Text -> ObjectCodec (Map ci a) (Map ci a)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"added" Map ci a
forall k a. Map k a
M.empty Text
"new items" ObjectCodec (Map ci a) (Map ci a)
-> (SyncRequest ci si a -> Map ci a)
-> Codec Object (SyncRequest ci si a) (Map ci a)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncRequest ci si a -> Map ci a
forall ci si a. SyncRequest ci si a -> Map ci a
syncRequestNewItems
        Codec
  Object
  (SyncRequest ci si a)
  (Map si ServerTime
   -> Map si (Timed a) -> Map si ServerTime -> SyncRequest ci si a)
-> Codec Object (SyncRequest ci si a) (Map si ServerTime)
-> Codec
     Object
     (SyncRequest ci si a)
     (Map si (Timed a) -> Map si ServerTime -> SyncRequest ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si ServerTime
-> Text
-> ObjectCodec (Map si ServerTime) (Map si ServerTime)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"synced" Map si ServerTime
forall k a. Map k a
M.empty Text
"known items" ObjectCodec (Map si ServerTime) (Map si ServerTime)
-> (SyncRequest ci si a -> Map si ServerTime)
-> Codec Object (SyncRequest ci si a) (Map si ServerTime)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncRequest ci si a -> Map si ServerTime
forall ci si a. SyncRequest ci si a -> Map si ServerTime
syncRequestKnownItems
        Codec
  Object
  (SyncRequest ci si a)
  (Map si (Timed a) -> Map si ServerTime -> SyncRequest ci si a)
-> Codec Object (SyncRequest ci si a) (Map si (Timed a))
-> Codec
     Object
     (SyncRequest ci si a)
     (Map si ServerTime -> SyncRequest ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si (Timed a)
-> Text
-> ObjectCodec (Map si (Timed a)) (Map si (Timed a))
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"changed" Map si (Timed a)
forall k a. Map k a
M.empty Text
"known but changed items" ObjectCodec (Map si (Timed a)) (Map si (Timed a))
-> (SyncRequest ci si a -> Map si (Timed a))
-> Codec Object (SyncRequest ci si a) (Map si (Timed a))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncRequest ci si a -> Map si (Timed a)
forall ci si a. SyncRequest ci si a -> Map si (Timed a)
syncRequestKnownButChangedItems
        Codec
  Object
  (SyncRequest ci si a)
  (Map si ServerTime -> SyncRequest ci si a)
-> Codec Object (SyncRequest ci si a) (Map si ServerTime)
-> ObjectCodec (SyncRequest ci si a) (SyncRequest ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si ServerTime
-> Text
-> ObjectCodec (Map si ServerTime) (Map si ServerTime)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"deleted" Map si ServerTime
forall k a. Map k a
M.empty Text
"deleted items" ObjectCodec (Map si ServerTime) (Map si ServerTime)
-> (SyncRequest ci si a -> Map si ServerTime)
-> Codec Object (SyncRequest ci si a) (Map si ServerTime)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncRequest ci si a -> Map si ServerTime
forall ci si a. SyncRequest ci si a -> Map si ServerTime
syncRequestDeletedItems

-- | An intial 'SyncRequest' to start with.
--
-- It just asks the server to send over whatever it knows.
initialSyncRequest :: SyncRequest ci si a
initialSyncRequest :: SyncRequest ci si a
initialSyncRequest =
  SyncRequest :: forall ci si a.
Map ci a
-> Map si ServerTime
-> Map si (Timed a)
-> Map si ServerTime
-> SyncRequest ci si a
SyncRequest
    { syncRequestNewItems :: Map ci a
syncRequestNewItems = Map ci a
forall k a. Map k a
M.empty,
      syncRequestKnownItems :: Map si ServerTime
syncRequestKnownItems = Map si ServerTime
forall k a. Map k a
M.empty,
      syncRequestKnownButChangedItems :: Map si (Timed a)
syncRequestKnownButChangedItems = Map si (Timed a)
forall k a. Map k a
M.empty,
      syncRequestDeletedItems :: Map si ServerTime
syncRequestDeletedItems = Map si ServerTime
forall k a. Map k a
M.empty
    }

data ClientAddition i = ClientAddition
  { ClientAddition i -> i
clientAdditionId :: !i,
    ClientAddition i -> ServerTime
clientAdditionServerTime :: !ServerTime
  }
  deriving stock (Int -> ClientAddition i -> ShowS
[ClientAddition i] -> ShowS
ClientAddition i -> String
(Int -> ClientAddition i -> ShowS)
-> (ClientAddition i -> String)
-> ([ClientAddition i] -> ShowS)
-> Show (ClientAddition i)
forall i. Show i => Int -> ClientAddition i -> ShowS
forall i. Show i => [ClientAddition i] -> ShowS
forall i. Show i => ClientAddition i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientAddition i] -> ShowS
$cshowList :: forall i. Show i => [ClientAddition i] -> ShowS
show :: ClientAddition i -> String
$cshow :: forall i. Show i => ClientAddition i -> String
showsPrec :: Int -> ClientAddition i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> ClientAddition i -> ShowS
Show, ClientAddition i -> ClientAddition i -> Bool
(ClientAddition i -> ClientAddition i -> Bool)
-> (ClientAddition i -> ClientAddition i -> Bool)
-> Eq (ClientAddition i)
forall i. Eq i => ClientAddition i -> ClientAddition i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientAddition i -> ClientAddition i -> Bool
$c/= :: forall i. Eq i => ClientAddition i -> ClientAddition i -> Bool
== :: ClientAddition i -> ClientAddition i -> Bool
$c== :: forall i. Eq i => ClientAddition i -> ClientAddition i -> Bool
Eq, (forall x. ClientAddition i -> Rep (ClientAddition i) x)
-> (forall x. Rep (ClientAddition i) x -> ClientAddition i)
-> Generic (ClientAddition i)
forall x. Rep (ClientAddition i) x -> ClientAddition i
forall x. ClientAddition i -> Rep (ClientAddition i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (ClientAddition i) x -> ClientAddition i
forall i x. ClientAddition i -> Rep (ClientAddition i) x
$cto :: forall i x. Rep (ClientAddition i) x -> ClientAddition i
$cfrom :: forall i x. ClientAddition i -> Rep (ClientAddition i) x
Generic)
  deriving (Value -> Parser [ClientAddition i]
Value -> Parser (ClientAddition i)
(Value -> Parser (ClientAddition i))
-> (Value -> Parser [ClientAddition i])
-> FromJSON (ClientAddition i)
forall i. HasCodec i => Value -> Parser [ClientAddition i]
forall i. HasCodec i => Value -> Parser (ClientAddition i)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ClientAddition i]
$cparseJSONList :: forall i. HasCodec i => Value -> Parser [ClientAddition i]
parseJSON :: Value -> Parser (ClientAddition i)
$cparseJSON :: forall i. HasCodec i => Value -> Parser (ClientAddition i)
FromJSON, [ClientAddition i] -> Encoding
[ClientAddition i] -> Value
ClientAddition i -> Encoding
ClientAddition i -> Value
(ClientAddition i -> Value)
-> (ClientAddition i -> Encoding)
-> ([ClientAddition i] -> Value)
-> ([ClientAddition i] -> Encoding)
-> ToJSON (ClientAddition i)
forall i. HasCodec i => [ClientAddition i] -> Encoding
forall i. HasCodec i => [ClientAddition i] -> Value
forall i. HasCodec i => ClientAddition i -> Encoding
forall i. HasCodec i => ClientAddition i -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ClientAddition i] -> Encoding
$ctoEncodingList :: forall i. HasCodec i => [ClientAddition i] -> Encoding
toJSONList :: [ClientAddition i] -> Value
$ctoJSONList :: forall i. HasCodec i => [ClientAddition i] -> Value
toEncoding :: ClientAddition i -> Encoding
$ctoEncoding :: forall i. HasCodec i => ClientAddition i -> Encoding
toJSON :: ClientAddition i -> Value
$ctoJSON :: forall i. HasCodec i => ClientAddition i -> Value
ToJSON) via (Autodocodec (ClientAddition i))

instance Validity i => Validity (ClientAddition i)

instance NFData i => NFData (ClientAddition i)

instance HasCodec i => HasCodec (ClientAddition i) where
  codec :: JSONCodec (ClientAddition i)
codec =
    Text
-> ObjectCodec (ClientAddition i) (ClientAddition i)
-> JSONCodec (ClientAddition i)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ClientAddition" (ObjectCodec (ClientAddition i) (ClientAddition i)
 -> JSONCodec (ClientAddition i))
-> ObjectCodec (ClientAddition i) (ClientAddition i)
-> JSONCodec (ClientAddition i)
forall a b. (a -> b) -> a -> b
$
      i -> ServerTime -> ClientAddition i
forall i. i -> ServerTime -> ClientAddition i
ClientAddition
        (i -> ServerTime -> ClientAddition i)
-> Codec Object (ClientAddition i) i
-> Codec Object (ClientAddition i) (ServerTime -> ClientAddition i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec i i
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"id" Text
"client-side identifier" ObjectCodec i i
-> (ClientAddition i -> i) -> Codec Object (ClientAddition i) i
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ClientAddition i -> i
forall i. ClientAddition i -> i
clientAdditionId
        Codec Object (ClientAddition i) (ServerTime -> ClientAddition i)
-> Codec Object (ClientAddition i) ServerTime
-> ObjectCodec (ClientAddition i) (ClientAddition i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec ServerTime ServerTime
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"time" Text
"server-side time" ObjectCodec ServerTime ServerTime
-> (ClientAddition i -> ServerTime)
-> Codec Object (ClientAddition i) ServerTime
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ClientAddition i -> ServerTime
forall i. ClientAddition i -> ServerTime
clientAdditionServerTime

data SyncResponse ci si a = SyncResponse
  { -- | The client added these items and server has succesfully been made aware of that.
    --
    -- The client needs to update their server times
    SyncResponse ci si a -> Map ci (ClientAddition si)
syncResponseClientAdded :: !(Map ci (ClientAddition si)),
    -- | The client changed these items and server has succesfully been made aware of that.
    --
    -- The client needs to update their server times
    SyncResponse ci si a -> Map si ServerTime
syncResponseClientChanged :: !(Map si ServerTime),
    -- | The client deleted these items and server has succesfully been made aware of that.
    --
    -- The client can delete them from its deleted items
    SyncResponse ci si a -> Set si
syncResponseClientDeleted :: !(Set si),
    -- | These items have been added on the server side
    --
    -- The client should add them too.
    SyncResponse ci si a -> Map si (Timed a)
syncResponseServerAdded :: !(Map si (Timed a)),
    -- | These items have been modified on the server side.
    --
    -- The client should modify them too.
    SyncResponse ci si a -> Map si (Timed a)
syncResponseServerChanged :: !(Map si (Timed a)),
    -- | These items were deleted on the server side
    --
    -- The client should delete them too
    SyncResponse ci si a -> Set si
syncResponseServerDeleted :: !(Set si),
    -- | These are conflicts where the server and the client both have an item, but it is different.
    --
    -- The server kept its part of each, the client can either take whatever the server gave them
    -- or deal with the conflicts somehow, and then try to re-sync.
    SyncResponse ci si a -> Map si (Timed a)
syncResponseConflicts :: !(Map si (Timed a)),
    -- | These are conflicts where the server has an item but the client does not.
    --
    -- The server kept its item, the client can either take whatever the server gave them
    -- or deal with the conflicts somehow, and then try to re-sync.
    SyncResponse ci si a -> Map si (Timed a)
syncResponseConflictsClientDeleted :: !(Map si (Timed a)),
    -- | These are conflicts where the server has no item but the client has a modified item.
    --
    -- The server left its item deleted, the client can either delete its items too
    -- or deal with the conflicts somehow, and then try to re-sync.
    SyncResponse ci si a -> Set si
syncResponseConflictsServerDeleted :: !(Set si)
  }
  deriving stock (Int -> SyncResponse ci si a -> ShowS
[SyncResponse ci si a] -> ShowS
SyncResponse ci si a -> String
(Int -> SyncResponse ci si a -> ShowS)
-> (SyncResponse ci si a -> String)
-> ([SyncResponse ci si a] -> ShowS)
-> Show (SyncResponse ci si a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ci si a.
(Show ci, Show si, Show a) =>
Int -> SyncResponse ci si a -> ShowS
forall ci si a.
(Show ci, Show si, Show a) =>
[SyncResponse ci si a] -> ShowS
forall ci si a.
(Show ci, Show si, Show a) =>
SyncResponse ci si a -> String
showList :: [SyncResponse ci si a] -> ShowS
$cshowList :: forall ci si a.
(Show ci, Show si, Show a) =>
[SyncResponse ci si a] -> ShowS
show :: SyncResponse ci si a -> String
$cshow :: forall ci si a.
(Show ci, Show si, Show a) =>
SyncResponse ci si a -> String
showsPrec :: Int -> SyncResponse ci si a -> ShowS
$cshowsPrec :: forall ci si a.
(Show ci, Show si, Show a) =>
Int -> SyncResponse ci si a -> ShowS
Show, SyncResponse ci si a -> SyncResponse ci si a -> Bool
(SyncResponse ci si a -> SyncResponse ci si a -> Bool)
-> (SyncResponse ci si a -> SyncResponse ci si a -> Bool)
-> Eq (SyncResponse ci si a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ci si a.
(Eq ci, Eq si, Eq a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Bool
/= :: SyncResponse ci si a -> SyncResponse ci si a -> Bool
$c/= :: forall ci si a.
(Eq ci, Eq si, Eq a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Bool
== :: SyncResponse ci si a -> SyncResponse ci si a -> Bool
$c== :: forall ci si a.
(Eq ci, Eq si, Eq a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Bool
Eq, (forall x. SyncResponse ci si a -> Rep (SyncResponse ci si a) x)
-> (forall x. Rep (SyncResponse ci si a) x -> SyncResponse ci si a)
-> Generic (SyncResponse ci si a)
forall x. Rep (SyncResponse ci si a) x -> SyncResponse ci si a
forall x. SyncResponse ci si a -> Rep (SyncResponse ci si a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ci si a x.
Rep (SyncResponse ci si a) x -> SyncResponse ci si a
forall ci si a x.
SyncResponse ci si a -> Rep (SyncResponse ci si a) x
$cto :: forall ci si a x.
Rep (SyncResponse ci si a) x -> SyncResponse ci si a
$cfrom :: forall ci si a x.
SyncResponse ci si a -> Rep (SyncResponse ci si a) x
Generic)
  deriving (Value -> Parser [SyncResponse ci si a]
Value -> Parser (SyncResponse ci si a)
(Value -> Parser (SyncResponse ci si a))
-> (Value -> Parser [SyncResponse ci si a])
-> FromJSON (SyncResponse ci si a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
Value -> Parser [SyncResponse ci si a]
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
Value -> Parser (SyncResponse ci si a)
parseJSONList :: Value -> Parser [SyncResponse ci si a]
$cparseJSONList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
Value -> Parser [SyncResponse ci si a]
parseJSON :: Value -> Parser (SyncResponse ci si a)
$cparseJSON :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
Value -> Parser (SyncResponse ci si a)
FromJSON, [SyncResponse ci si a] -> Encoding
[SyncResponse ci si a] -> Value
SyncResponse ci si a -> Encoding
SyncResponse ci si a -> Value
(SyncResponse ci si a -> Value)
-> (SyncResponse ci si a -> Encoding)
-> ([SyncResponse ci si a] -> Value)
-> ([SyncResponse ci si a] -> Encoding)
-> ToJSON (SyncResponse ci si a)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
[SyncResponse ci si a] -> Encoding
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
[SyncResponse ci si a] -> Value
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
SyncResponse ci si a -> Encoding
forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
SyncResponse ci si a -> Value
toEncodingList :: [SyncResponse ci si a] -> Encoding
$ctoEncodingList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
[SyncResponse ci si a] -> Encoding
toJSONList :: [SyncResponse ci si a] -> Value
$ctoJSONList :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
[SyncResponse ci si a] -> Value
toEncoding :: SyncResponse ci si a -> Encoding
$ctoEncoding :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
SyncResponse ci si a -> Encoding
toJSON :: SyncResponse ci si a -> Value
$ctoJSON :: forall ci si a.
(Ord ci, Ord si, FromJSONKey ci, FromJSONKey si, ToJSONKey ci,
 ToJSONKey si, HasCodec ci, HasCodec si, HasCodec a, Eq a) =>
SyncResponse ci si a -> Value
ToJSON) via (Autodocodec (SyncResponse ci si a))

instance
  (Validity ci, Validity si, Show ci, Show si, Ord ci, Ord si, Validity a) =>
  Validity (SyncResponse ci si a)
  where
  validate :: SyncResponse ci si a -> Validation
validate sr :: SyncResponse ci si a
sr@SyncResponse {Map ci (ClientAddition si)
Map si (Timed a)
Map si ServerTime
Set si
syncResponseConflictsServerDeleted :: Set si
syncResponseConflictsClientDeleted :: Map si (Timed a)
syncResponseConflicts :: Map si (Timed a)
syncResponseServerDeleted :: Set si
syncResponseServerChanged :: Map si (Timed a)
syncResponseServerAdded :: Map si (Timed a)
syncResponseClientDeleted :: Set si
syncResponseClientChanged :: Map si ServerTime
syncResponseClientAdded :: Map ci (ClientAddition si)
syncResponseConflictsServerDeleted :: forall ci si a. SyncResponse ci si a -> Set si
syncResponseConflictsClientDeleted :: forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseConflicts :: forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseServerDeleted :: forall ci si a. SyncResponse ci si a -> Set si
syncResponseServerChanged :: forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseServerAdded :: forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseClientDeleted :: forall ci si a. SyncResponse ci si a -> Set si
syncResponseClientChanged :: forall ci si a. SyncResponse ci si a -> Map si ServerTime
syncResponseClientAdded :: forall ci si a. SyncResponse ci si a -> Map ci (ClientAddition si)
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ SyncResponse ci si a -> Validation
forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate SyncResponse ci si a
sr,
        String -> Bool -> Validation
declare String
"There are no duplicate IDs" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$
          [si] -> Bool
forall a. Eq a => [a] -> Bool
distinct ([si] -> Bool) -> [si] -> Bool
forall a b. (a -> b) -> a -> b
$
            [[si]] -> [si]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ ((ci, ClientAddition si) -> si)
-> [(ci, ClientAddition si)] -> [si]
forall a b. (a -> b) -> [a] -> [b]
map (\(ci
_, ClientAddition {si
ServerTime
clientAdditionServerTime :: ServerTime
clientAdditionId :: si
clientAdditionServerTime :: forall i. ClientAddition i -> ServerTime
clientAdditionId :: forall i. ClientAddition i -> i
..}) -> si
clientAdditionId) ([(ci, ClientAddition si)] -> [si])
-> [(ci, ClientAddition si)] -> [si]
forall a b. (a -> b) -> a -> b
$ Map ci (ClientAddition si) -> [(ci, ClientAddition si)]
forall k a. Map k a -> [(k, a)]
M.toList Map ci (ClientAddition si)
syncResponseClientAdded,
                Map si ServerTime -> [si]
forall k a. Map k a -> [k]
M.keys Map si ServerTime
syncResponseClientChanged,
                Set si -> [si]
forall a. Set a -> [a]
S.toList Set si
syncResponseClientDeleted,
                Map si (Timed a) -> [si]
forall k a. Map k a -> [k]
M.keys Map si (Timed a)
syncResponseServerAdded,
                Map si (Timed a) -> [si]
forall k a. Map k a -> [k]
M.keys Map si (Timed a)
syncResponseServerChanged,
                Set si -> [si]
forall a. Set a -> [a]
S.toList Set si
syncResponseServerDeleted,
                Map si (Timed a) -> [si]
forall k a. Map k a -> [k]
M.keys Map si (Timed a)
syncResponseConflicts,
                Map si (Timed a) -> [si]
forall k a. Map k a -> [k]
M.keys Map si (Timed a)
syncResponseConflictsClientDeleted,
                Set si -> [si]
forall a. Set a -> [a]
S.toList Set si
syncResponseConflictsServerDeleted
              ]
      ]

instance (NFData ci, NFData si, NFData a) => NFData (SyncResponse ci si a)

instance
  ( Ord ci,
    FromJSONKey ci,
    ToJSONKey ci,
    HasCodec ci,
    Ord si,
    FromJSONKey si,
    ToJSONKey si,
    HasCodec si,
    Eq a,
    HasCodec a
  ) =>
  HasCodec (SyncResponse ci si a)
  where
  codec :: JSONCodec (SyncResponse ci si a)
codec =
    Text
-> ObjectCodec (SyncResponse ci si a) (SyncResponse ci si a)
-> JSONCodec (SyncResponse ci si a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"SyncResponse" (ObjectCodec (SyncResponse ci si a) (SyncResponse ci si a)
 -> JSONCodec (SyncResponse ci si a))
-> ObjectCodec (SyncResponse ci si a) (SyncResponse ci si a)
-> JSONCodec (SyncResponse ci si a)
forall a b. (a -> b) -> a -> b
$
      Map ci (ClientAddition si)
-> Map si ServerTime
-> Set si
-> Map si (Timed a)
-> Map si (Timed a)
-> Set si
-> Map si (Timed a)
-> Map si (Timed a)
-> Set si
-> SyncResponse ci si a
forall ci si a.
Map ci (ClientAddition si)
-> Map si ServerTime
-> Set si
-> Map si (Timed a)
-> Map si (Timed a)
-> Set si
-> Map si (Timed a)
-> Map si (Timed a)
-> Set si
-> SyncResponse ci si a
SyncResponse
        (Map ci (ClientAddition si)
 -> Map si ServerTime
 -> Set si
 -> Map si (Timed a)
 -> Map si (Timed a)
 -> Set si
 -> Map si (Timed a)
 -> Map si (Timed a)
 -> Set si
 -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Map ci (ClientAddition si))
-> Codec
     Object
     (SyncResponse ci si a)
     (Map si ServerTime
      -> Set si
      -> Map si (Timed a)
      -> Map si (Timed a)
      -> Set si
      -> Map si (Timed a)
      -> Map si (Timed a)
      -> Set si
      -> SyncResponse ci si a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map ci (ClientAddition si)
-> Text
-> ObjectCodec
     (Map ci (ClientAddition si)) (Map ci (ClientAddition si))
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"client-added" Map ci (ClientAddition si)
forall k a. Map k a
M.empty Text
"items added by the client" ObjectCodec
  (Map ci (ClientAddition si)) (Map ci (ClientAddition si))
-> (SyncResponse ci si a -> Map ci (ClientAddition si))
-> Codec Object (SyncResponse ci si a) (Map ci (ClientAddition si))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Map ci (ClientAddition si)
forall ci si a. SyncResponse ci si a -> Map ci (ClientAddition si)
syncResponseClientAdded
        Codec
  Object
  (SyncResponse ci si a)
  (Map si ServerTime
   -> Set si
   -> Map si (Timed a)
   -> Map si (Timed a)
   -> Set si
   -> Map si (Timed a)
   -> Map si (Timed a)
   -> Set si
   -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Map si ServerTime)
-> Codec
     Object
     (SyncResponse ci si a)
     (Set si
      -> Map si (Timed a)
      -> Map si (Timed a)
      -> Set si
      -> Map si (Timed a)
      -> Map si (Timed a)
      -> Set si
      -> SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si ServerTime
-> Text
-> ObjectCodec (Map si ServerTime) (Map si ServerTime)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"client-changed" Map si ServerTime
forall k a. Map k a
M.empty Text
"items changed by the client" ObjectCodec (Map si ServerTime) (Map si ServerTime)
-> (SyncResponse ci si a -> Map si ServerTime)
-> Codec Object (SyncResponse ci si a) (Map si ServerTime)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Map si ServerTime
forall ci si a. SyncResponse ci si a -> Map si ServerTime
syncResponseClientChanged
        Codec
  Object
  (SyncResponse ci si a)
  (Set si
   -> Map si (Timed a)
   -> Map si (Timed a)
   -> Set si
   -> Map si (Timed a)
   -> Map si (Timed a)
   -> Set si
   -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Set si)
-> Codec
     Object
     (SyncResponse ci si a)
     (Map si (Timed a)
      -> Map si (Timed a)
      -> Set si
      -> Map si (Timed a)
      -> Map si (Timed a)
      -> Set si
      -> SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Set si -> Text -> ObjectCodec (Set si) (Set si)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"client-deleted" Set si
forall a. Set a
S.empty Text
"items deleted by the client" ObjectCodec (Set si) (Set si)
-> (SyncResponse ci si a -> Set si)
-> Codec Object (SyncResponse ci si a) (Set si)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Set si
forall ci si a. SyncResponse ci si a -> Set si
syncResponseClientDeleted
        Codec
  Object
  (SyncResponse ci si a)
  (Map si (Timed a)
   -> Map si (Timed a)
   -> Set si
   -> Map si (Timed a)
   -> Map si (Timed a)
   -> Set si
   -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Map si (Timed a))
-> Codec
     Object
     (SyncResponse ci si a)
     (Map si (Timed a)
      -> Set si
      -> Map si (Timed a)
      -> Map si (Timed a)
      -> Set si
      -> SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si (Timed a)
-> Text
-> ObjectCodec (Map si (Timed a)) (Map si (Timed a))
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"server-added" Map si (Timed a)
forall k a. Map k a
M.empty Text
"items added by the server" ObjectCodec (Map si (Timed a)) (Map si (Timed a))
-> (SyncResponse ci si a -> Map si (Timed a))
-> Codec Object (SyncResponse ci si a) (Map si (Timed a))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Map si (Timed a)
forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseServerAdded
        Codec
  Object
  (SyncResponse ci si a)
  (Map si (Timed a)
   -> Set si
   -> Map si (Timed a)
   -> Map si (Timed a)
   -> Set si
   -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Map si (Timed a))
-> Codec
     Object
     (SyncResponse ci si a)
     (Set si
      -> Map si (Timed a)
      -> Map si (Timed a)
      -> Set si
      -> SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si (Timed a)
-> Text
-> ObjectCodec (Map si (Timed a)) (Map si (Timed a))
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"server-changed" Map si (Timed a)
forall k a. Map k a
M.empty Text
"items changed by the server" ObjectCodec (Map si (Timed a)) (Map si (Timed a))
-> (SyncResponse ci si a -> Map si (Timed a))
-> Codec Object (SyncResponse ci si a) (Map si (Timed a))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Map si (Timed a)
forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseServerChanged
        Codec
  Object
  (SyncResponse ci si a)
  (Set si
   -> Map si (Timed a)
   -> Map si (Timed a)
   -> Set si
   -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Set si)
-> Codec
     Object
     (SyncResponse ci si a)
     (Map si (Timed a)
      -> Map si (Timed a) -> Set si -> SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Set si -> Text -> ObjectCodec (Set si) (Set si)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"server-deleted" Set si
forall a. Set a
S.empty Text
"items deleted by the server" ObjectCodec (Set si) (Set si)
-> (SyncResponse ci si a -> Set si)
-> Codec Object (SyncResponse ci si a) (Set si)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Set si
forall ci si a. SyncResponse ci si a -> Set si
syncResponseServerDeleted
        Codec
  Object
  (SyncResponse ci si a)
  (Map si (Timed a)
   -> Map si (Timed a) -> Set si -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Map si (Timed a))
-> Codec
     Object
     (SyncResponse ci si a)
     (Map si (Timed a) -> Set si -> SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si (Timed a)
-> Text
-> ObjectCodec (Map si (Timed a)) (Map si (Timed a))
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"conflict" Map si (Timed a)
forall k a. Map k a
M.empty Text
"items that were changed simultaneously" ObjectCodec (Map si (Timed a)) (Map si (Timed a))
-> (SyncResponse ci si a -> Map si (Timed a))
-> Codec Object (SyncResponse ci si a) (Map si (Timed a))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Map si (Timed a)
forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseConflicts
        Codec
  Object
  (SyncResponse ci si a)
  (Map si (Timed a) -> Set si -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Map si (Timed a))
-> Codec
     Object (SyncResponse ci si a) (Set si -> SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map si (Timed a)
-> Text
-> ObjectCodec (Map si (Timed a)) (Map si (Timed a))
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"conflict-client-deleted" Map si (Timed a)
forall k a. Map k a
M.empty Text
"items that the server changed while the client deleted it" ObjectCodec (Map si (Timed a)) (Map si (Timed a))
-> (SyncResponse ci si a -> Map si (Timed a))
-> Codec Object (SyncResponse ci si a) (Map si (Timed a))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Map si (Timed a)
forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseConflictsClientDeleted
        Codec
  Object (SyncResponse ci si a) (Set si -> SyncResponse ci si a)
-> Codec Object (SyncResponse ci si a) (Set si)
-> ObjectCodec (SyncResponse ci si a) (SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Set si -> Text -> ObjectCodec (Set si) (Set si)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"conflict-server-deleted" Set si
forall a. Set a
S.empty Text
"items that the client changed while the server deleted it" ObjectCodec (Set si) (Set si)
-> (SyncResponse ci si a -> Set si)
-> Codec Object (SyncResponse ci si a) (Set si)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SyncResponse ci si a -> Set si
forall ci si a. SyncResponse ci si a -> Set si
syncResponseConflictsServerDeleted

-- | A sync response to start with.
--
-- It is entirely empty.
emptySyncResponse :: SyncResponse ci si a
emptySyncResponse :: SyncResponse ci si a
emptySyncResponse =
  SyncResponse :: forall ci si a.
Map ci (ClientAddition si)
-> Map si ServerTime
-> Set si
-> Map si (Timed a)
-> Map si (Timed a)
-> Set si
-> Map si (Timed a)
-> Map si (Timed a)
-> Set si
-> SyncResponse ci si a
SyncResponse
    { syncResponseClientAdded :: Map ci (ClientAddition si)
syncResponseClientAdded = Map ci (ClientAddition si)
forall k a. Map k a
M.empty,
      syncResponseClientChanged :: Map si ServerTime
syncResponseClientChanged = Map si ServerTime
forall k a. Map k a
M.empty,
      syncResponseClientDeleted :: Set si
syncResponseClientDeleted = Set si
forall a. Set a
S.empty,
      syncResponseServerAdded :: Map si (Timed a)
syncResponseServerAdded = Map si (Timed a)
forall k a. Map k a
M.empty,
      syncResponseServerChanged :: Map si (Timed a)
syncResponseServerChanged = Map si (Timed a)
forall k a. Map k a
M.empty,
      syncResponseServerDeleted :: Set si
syncResponseServerDeleted = Set si
forall a. Set a
S.empty,
      syncResponseConflicts :: Map si (Timed a)
syncResponseConflicts = Map si (Timed a)
forall k a. Map k a
M.empty,
      syncResponseConflictsClientDeleted :: Map si (Timed a)
syncResponseConflictsClientDeleted = Map si (Timed a)
forall k a. Map k a
M.empty,
      syncResponseConflictsServerDeleted :: Set si
syncResponseConflictsServerDeleted = Set si
forall a. Set a
S.empty
    }

-- | Produce an 'SyncRequest' from a 'ClientStore'.
--
-- Send this to the server for synchronisation.
makeSyncRequest :: ClientStore ci si a -> SyncRequest ci si a
makeSyncRequest :: ClientStore ci si a -> SyncRequest ci si a
makeSyncRequest ClientStore {Map ci a
Map si (Timed a)
Map si ServerTime
clientStoreDeletedItems :: Map si ServerTime
clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedItems :: Map si (Timed a)
clientStoreAddedItems :: Map ci a
clientStoreDeletedItems :: forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreSyncedButChangedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreAddedItems :: forall ci si a. ClientStore ci si a -> Map ci a
..} =
  SyncRequest :: forall ci si a.
Map ci a
-> Map si ServerTime
-> Map si (Timed a)
-> Map si ServerTime
-> SyncRequest ci si a
SyncRequest
    { syncRequestNewItems :: Map ci a
syncRequestNewItems = Map ci a
clientStoreAddedItems,
      syncRequestKnownItems :: Map si ServerTime
syncRequestKnownItems = (Timed a -> ServerTime) -> Map si (Timed a) -> Map si ServerTime
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Timed a -> ServerTime
forall a. Timed a -> ServerTime
timedTime Map si (Timed a)
clientStoreSyncedItems,
      syncRequestKnownButChangedItems :: Map si (Timed a)
syncRequestKnownButChangedItems = Map si (Timed a)
clientStoreSyncedButChangedItems,
      syncRequestDeletedItems :: Map si ServerTime
syncRequestDeletedItems = Map si ServerTime
clientStoreDeletedItems
    }

-- | 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.__
mergeSyncResponseFromServer ::
  (Ord ci, Ord si) => ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
mergeSyncResponseFromServer :: ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
mergeSyncResponseFromServer =
  ItemMergeStrategy a
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
forall ci si a.
(Ord ci, Ord si) =>
ItemMergeStrategy a
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
mergeSyncResponseUsingStrategy ItemMergeStrategy a
forall a. ItemMergeStrategy a
mergeFromServerStrategy

-- | 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.__
mergeSyncResponseFromClient ::
  (Ord ci, Ord si) => ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
mergeSyncResponseFromClient :: ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
mergeSyncResponseFromClient = ItemMergeStrategy a
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
forall ci si a.
(Ord ci, Ord si) =>
ItemMergeStrategy a
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
mergeSyncResponseUsingStrategy ItemMergeStrategy a
forall a. ItemMergeStrategy a
mergeFromClientStrategy

-- | Merge a 'SyncResponse' into the current 'ClientStore' by using the given GADT merging function in case of conflict
mergeSyncResponseUsingCRDT :: (Ord ci, Ord si) => (a -> a -> a) -> ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
mergeSyncResponseUsingCRDT :: (a -> a -> a)
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
mergeSyncResponseUsingCRDT = ItemMergeStrategy a
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
forall ci si a.
(Ord ci, Ord si) =>
ItemMergeStrategy a
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
mergeSyncResponseUsingStrategy (ItemMergeStrategy a
 -> ClientStore ci si a
 -> SyncResponse ci si a
 -> ClientStore ci si a)
-> ((a -> a -> a) -> ItemMergeStrategy a)
-> (a -> a -> a)
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> ItemMergeStrategy a
forall a. (a -> a -> a) -> ItemMergeStrategy a
mergeUsingCRDTStrategy

-- | 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.
mergeSyncResponseUsingStrategy ::
  (Ord ci, Ord si) =>
  ItemMergeStrategy a ->
  ClientStore ci si a ->
  SyncResponse ci si a ->
  ClientStore ci si a
mergeSyncResponseUsingStrategy :: ItemMergeStrategy a
-> ClientStore ci si a
-> SyncResponse ci si a
-> ClientStore ci si a
mergeSyncResponseUsingStrategy ItemMergeStrategy a
strat ClientStore ci si a
cs SyncResponse ci si a
sr =
  (State (ClientStore ci si a) ()
 -> ClientStore ci si a -> ClientStore ci si a)
-> ClientStore ci si a
-> State (ClientStore ci si a) ()
-> ClientStore ci si a
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (ClientStore ci si a) ()
-> ClientStore ci si a -> ClientStore ci si a
forall s a. State s a -> s -> s
execState ClientStore ci si a
cs (State (ClientStore ci si a) () -> ClientStore ci si a)
-> State (ClientStore ci si a) () -> ClientStore ci si a
forall a b. (a -> b) -> a -> b
$ ItemMergeStrategy a
-> ClientSyncProcessor ci si a (State (ClientStore ci si a))
-> SyncResponse ci si a
-> State (ClientStore ci si a) ()
forall si (m :: * -> *) a ci.
(Ord si, Monad m) =>
ItemMergeStrategy a
-> ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
mergeSyncResponseCustom ItemMergeStrategy a
strat ClientSyncProcessor ci si a (State (ClientStore ci si a))
forall ci si a.
(Ord ci, Ord si) =>
ClientSyncProcessor ci si a (State (ClientStore ci si a))
pureClientSyncProcessor SyncResponse ci si a
sr

pureClientSyncProcessor :: forall ci si a. (Ord ci, Ord si) => ClientSyncProcessor ci si a (State (ClientStore ci si a))
pureClientSyncProcessor :: ClientSyncProcessor ci si a (State (ClientStore ci si a))
pureClientSyncProcessor =
  ClientSyncProcessor :: forall ci si a (m :: * -> *).
(Set si -> m (Map si (Timed a)))
-> (Map ci (ClientAddition si) -> m ())
-> (Map si ServerTime -> m ())
-> (Set si -> m ())
-> (Map si (Timed a) -> m ())
-> (Map si (Timed a) -> m ())
-> (Set si -> m ())
-> (Set si -> m ())
-> (Map si (Timed a) -> m ())
-> (Map si (Timed a) -> m ())
-> (Map si (Timed a) -> m ())
-> (Map si (Timed a) -> m ())
-> (Map si (Timed a) -> m ())
-> (Set si -> m ())
-> ClientSyncProcessor ci si a m
ClientSyncProcessor
    { clientSyncProcessorQuerySyncedButChangedValues :: Set si -> State (ClientStore ci si a) (Map si (Timed a))
clientSyncProcessorQuerySyncedButChangedValues = \Set si
s ->
        (ClientStore ci si a -> Map si (Timed a))
-> State (ClientStore ci si a) (Map si (Timed a))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets
          ( \ClientStore ci si a
cs -> Map si (Timed a) -> Map si () -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection (ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs) ((si -> ()) -> Set si -> Map si ()
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet (() -> si -> ()
forall a b. a -> b -> a
const ()) Set si
s)
          ),
      clientSyncProcessorSyncClientAdded :: Map ci (ClientAddition si) -> State (ClientStore ci si a) ()
clientSyncProcessorSyncClientAdded = \Map ci (ClientAddition si)
m ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
          ( \ClientStore ci si a
cs ->
              let (Map ci a
leftovers, Map si (Timed a)
added) = Map ci a
-> Map ci (ClientAddition si) -> (Map ci a, Map si (Timed a))
forall ci si a.
(Ord ci, Ord si) =>
Map ci a
-> Map ci (ClientAddition si) -> (Map ci a, Map si (Timed a))
mergeAddedItems (ClientStore ci si a -> Map ci a
forall ci si a. ClientStore ci si a -> Map ci a
clientStoreAddedItems ClientStore ci si a
cs) Map ci (ClientAddition si)
m
               in ClientStore ci si a
cs {clientStoreAddedItems :: Map ci a
clientStoreAddedItems = Map ci a
leftovers, clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = Map si (Timed a)
added Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs}
          ),
      clientSyncProcessorSyncClientChanged :: Map si ServerTime -> State (ClientStore ci si a) ()
clientSyncProcessorSyncClientChanged = \Map si ServerTime
m ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
          ( \ClientStore ci si a
cs ->
              let (Map si (Timed a)
leftovers, Map si (Timed a)
changed) = Map si (Timed a)
-> Map si ServerTime -> (Map si (Timed a), Map si (Timed a))
forall i a.
Ord i =>
Map i (Timed a)
-> Map i ServerTime -> (Map i (Timed a), Map i (Timed a))
mergeSyncedButChangedItems (ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs) Map si ServerTime
m
               in ClientStore ci si a
cs {clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems = Map si (Timed a)
leftovers, clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = Map si (Timed a)
changed Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs}
          ),
      clientSyncProcessorSyncClientDeleted :: Set si -> State (ClientStore ci si a) ()
clientSyncProcessorSyncClientDeleted = \Set si
s ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
          ( \ClientStore ci si a
cs ->
              let leftovers :: Map si ServerTime
leftovers = Map si ServerTime -> Set si -> Map si ServerTime
forall i b. Ord i => Map i b -> Set i -> Map i b
mergeDeletedItems (ClientStore ci si a -> Map si ServerTime
forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreDeletedItems ClientStore ci si a
cs) Set si
s
               in ClientStore ci si a
cs {clientStoreDeletedItems :: Map si ServerTime
clientStoreDeletedItems = Map si ServerTime
leftovers}
          ),
      clientSyncProcessorSyncChangeConflictKeepLocal :: Map si (Timed a) -> State (ClientStore ci si a) ()
clientSyncProcessorSyncChangeConflictKeepLocal = \Map si (Timed a)
_ -> () -> State (ClientStore ci si a) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      clientSyncProcessorSyncChangeConflictMerged :: Map si (Timed a) -> State (ClientStore ci si a) ()
clientSyncProcessorSyncChangeConflictMerged = \Map si (Timed a)
resolved ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
          ( \ClientStore ci si a
cs ->
              let newSyncedButChanged :: Map si (Timed a)
newSyncedButChanged = Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map si (Timed a)
resolved (ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs)
               in ClientStore ci si a
cs {clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems = Map si (Timed a)
newSyncedButChanged, clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map si (Timed a)
newSyncedButChanged}
          ),
      clientSyncProcessorSyncChangeConflictTakeRemote :: Map si (Timed a) -> State (ClientStore ci si a) ()
clientSyncProcessorSyncChangeConflictTakeRemote = \Map si (Timed a)
m ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
          ( \ClientStore ci si a
cs ->
              let newSynced :: Map si (Timed a)
newSynced = Map si (Timed a)
m Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs
               in ClientStore ci si a
cs {clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = Map si (Timed a)
newSynced, clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map si (Timed a)
newSynced}
          ),
      clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: Map si (Timed a) -> State (ClientStore ci si a) ()
clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged = \Map si (Timed a)
m ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ClientStore ci si a
cs -> ClientStore ci si a
cs {clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = Map si (Timed a)
m Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs}),
      clientSyncProcessorSyncClientDeletedConflictStayDeleted :: Map si (Timed a) -> State (ClientStore ci si a) ()
clientSyncProcessorSyncClientDeletedConflictStayDeleted = \Map si (Timed a)
_ -> () -> State (ClientStore ci si a) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: Set si -> State (ClientStore ci si a) ()
clientSyncProcessorSyncServerDeletedConflictKeepLocalChange = \Set si
_ -> () -> State (ClientStore ci si a) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      clientSyncProcessorSyncServerDeletedConflictDelete :: Set si -> State (ClientStore ci si a) ()
clientSyncProcessorSyncServerDeletedConflictDelete = \Set si
s ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
          ( \ClientStore ci si a
cs ->
              let m :: Map si ()
m = (si -> ()) -> Set si -> Map si ()
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet (() -> si -> ()
forall a b. a -> b -> a
const ()) Set si
s
               in ClientStore ci si a
cs
                    { clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs Map si (Timed a) -> Map si () -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map si ()
m,
                      clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs Map si (Timed a) -> Map si () -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map si ()
m
                    }
          ),
      clientSyncProcessorSyncServerAdded :: Map si (Timed a) -> State (ClientStore ci si a) ()
clientSyncProcessorSyncServerAdded = \Map si (Timed a)
m ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ClientStore ci si a
cs -> ClientStore ci si a
cs {clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = Map si (Timed a)
m Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs}),
      clientSyncProcessorSyncServerChanged :: Map si (Timed a) -> State (ClientStore ci si a) ()
clientSyncProcessorSyncServerChanged = \Map si (Timed a)
m ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
          ( \ClientStore ci si a
cs ->
              let newSynced :: Map si (Timed a)
newSynced = Map si (Timed a)
m Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs
               in ClientStore ci si a
cs {clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = Map si (Timed a)
newSynced, clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs Map si (Timed a) -> Map si (Timed a) -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map si (Timed a)
newSynced}
          ),
      clientSyncProcessorSyncServerDeleted :: Set si -> State (ClientStore ci si a) ()
clientSyncProcessorSyncServerDeleted = \Set si
s ->
        (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
          ( \ClientStore ci si a
cs ->
              let m :: Map si ()
m = (si -> ()) -> Set si -> Map si ()
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet (() -> si -> ()
forall a b. a -> b -> a
const ()) Set si
s
               in ClientStore ci si a
cs
                    { clientStoreSyncedItems :: Map si (Timed a)
clientStoreSyncedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedItems ClientStore ci si a
cs Map si (Timed a) -> Map si () -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map si ()
m,
                      clientStoreSyncedButChangedItems :: Map si (Timed a)
clientStoreSyncedButChangedItems = ClientStore ci si a -> Map si (Timed a)
forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems ClientStore ci si a
cs Map si (Timed a) -> Map si () -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map si ()
m
                    }
          )
    }

-- | Merge the local added items with the ones that the server has acknowledged as added.
mergeAddedItems ::
  forall ci si a.
  (Ord ci, Ord si) =>
  Map ci a ->
  Map ci (ClientAddition si) ->
  (Map ci a, Map si (Timed a))
mergeAddedItems :: Map ci a
-> Map ci (ClientAddition si) -> (Map ci a, Map si (Timed a))
mergeAddedItems Map ci a
local Map ci (ClientAddition si)
added = ((Map ci a, Map si (Timed a))
 -> ci -> a -> (Map ci a, Map si (Timed a)))
-> (Map ci a, Map si (Timed a))
-> Map ci a
-> (Map ci a, Map si (Timed a))
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (Map ci a, Map si (Timed a))
-> ci -> a -> (Map ci a, Map si (Timed a))
go (Map ci a
forall k a. Map k a
M.empty, Map si (Timed a)
forall k a. Map k a
M.empty) Map ci a
local
  where
    go :: (Map ci a, Map si (Timed a)) -> ci -> a -> (Map ci a, Map si (Timed a))
    go :: (Map ci a, Map si (Timed a))
-> ci -> a -> (Map ci a, Map si (Timed a))
go (Map ci a
as, Map si (Timed a)
m) ci
ci a
a =
      case ci -> Map ci (ClientAddition si) -> Maybe (ClientAddition si)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ci
ci Map ci (ClientAddition si)
added of
        Maybe (ClientAddition si)
Nothing -> (ci -> a -> Map ci a -> Map ci a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ci
ci a
a Map ci a
as, Map si (Timed a)
m)
        Just ClientAddition {si
ServerTime
clientAdditionServerTime :: ServerTime
clientAdditionId :: si
clientAdditionServerTime :: forall i. ClientAddition i -> ServerTime
clientAdditionId :: forall i. ClientAddition i -> i
..} ->
          ( Map ci a
as,
            si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
              si
clientAdditionId
              (Timed :: forall a. a -> ServerTime -> Timed a
Timed {timedValue :: a
timedValue = a
a, timedTime :: ServerTime
timedTime = ServerTime
clientAdditionServerTime})
              Map si (Timed a)
m
          )

-- | Merge the local synced but changed items with the ones that the server has acknowledged as changed.
mergeSyncedButChangedItems ::
  forall i a.
  Ord i =>
  Map i (Timed a) ->
  Map i ServerTime ->
  (Map i (Timed a), Map i (Timed a))
mergeSyncedButChangedItems :: Map i (Timed a)
-> Map i ServerTime -> (Map i (Timed a), Map i (Timed a))
mergeSyncedButChangedItems Map i (Timed a)
local Map i ServerTime
changed = ((Map i (Timed a), Map i (Timed a))
 -> i -> Timed a -> (Map i (Timed a), Map i (Timed a)))
-> (Map i (Timed a), Map i (Timed a))
-> Map i (Timed a)
-> (Map i (Timed a), Map i (Timed a))
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (Map i (Timed a), Map i (Timed a))
-> i -> Timed a -> (Map i (Timed a), Map i (Timed a))
go (Map i (Timed a)
forall k a. Map k a
M.empty, Map i (Timed a)
forall k a. Map k a
M.empty) Map i (Timed a)
local
  where
    go :: (Map i (Timed a), Map i (Timed a)) -> i -> Timed a -> (Map i (Timed a), Map i (Timed a))
    go :: (Map i (Timed a), Map i (Timed a))
-> i -> Timed a -> (Map i (Timed a), Map i (Timed a))
go (Map i (Timed a)
m1, Map i (Timed a)
m2) i
k Timed a
t =
      case i -> Map i ServerTime -> Maybe ServerTime
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup i
k Map i ServerTime
changed of
        Maybe ServerTime
Nothing -> (i -> Timed a -> Map i (Timed a) -> Map i (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert i
k Timed a
t Map i (Timed a)
m1, Map i (Timed a)
m2)
        Just ServerTime
st' -> (Map i (Timed a)
m1, i -> Timed a -> Map i (Timed a) -> Map i (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert i
k (Timed a
t {timedTime :: ServerTime
timedTime = ServerTime
st'}) Map i (Timed a)
m2)

-- | Merge the local deleted items with the ones that the server has acknowledged as deleted.
mergeDeletedItems :: Ord i => Map i b -> Set i -> Map i b
mergeDeletedItems :: Map i b -> Set i -> Map i b
mergeDeletedItems Map i b
m Set i
s = Map i b
m Map i b -> Map i () -> Map i b
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` (i -> ()) -> Set i -> Map i ()
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet (() -> i -> ()
forall a b. a -> b -> a
const ()) Set i
s

-- | 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.
data ClientSyncProcessor ci si a (m :: Type -> Type) = ClientSyncProcessor
  { -- | Get the synced values with keys in the given set
    ClientSyncProcessor ci si a m -> Set si -> m (Map si (Timed a))
clientSyncProcessorQuerySyncedButChangedValues :: !(Set si -> m (Map si (Timed a))),
    -- | Complete additions that were acknowledged by the server.
    --
    -- This involves saving the server id and the server time
    ClientSyncProcessor ci si a m -> Map ci (ClientAddition si) -> m ()
clientSyncProcessorSyncClientAdded :: !(Map ci (ClientAddition si) -> m ()),
    -- | Complete changes that were acknowledged by the server
    --
    -- This involves updating the server time
    ClientSyncProcessor ci si a m -> Map si ServerTime -> m ()
clientSyncProcessorSyncClientChanged :: !(Map si ServerTime -> m ()),
    -- | Complete deletions that were acknowledged by the server
    --
    -- This means deleting these tombstoned items entirely
    ClientSyncProcessor ci si a m -> Set si -> m ()
clientSyncProcessorSyncClientDeleted :: !(Set si -> m ()),
    -- | Re-create the items that need to be created locally as a result of a 'client deleted' conflict that has been merged by taking the remote value.
    --
    -- You can likely implement this in the same way as @clientSyncProcessorSyncServerAdded@.
    ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: !(Map si (Timed a) -> m ()),
    -- | Leave the items deleted that need to be left deleted as a result of a 'client deleted' conflict that has been merged by leaving it deleted.
    --
    -- You likely don't have to do anything with these, as they are the way that has been decided they should be, but you may want to log them or so.
    ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncClientDeletedConflictStayDeleted :: !(Map si (Timed a) -> m ()),
    -- | Leave the items undeleted that need to be left deleted as a result of a 'server deleted' conflict that has been merged by leaving it undeleted.
    --
    -- You likely don't have to do anything with these, as they are the way that has been decided they should be, but you may want to log them or so.
    ClientSyncProcessor ci si a m -> Set si -> m ()
clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: !(Set si -> m ()),
    -- | Delete the items that need to be deleted locally as a result of a 'server deleted' conflict that has been merged by deleting the local value.
    --
    -- You can likely implement this in the same way as @clientSyncProcessorSyncServerDeleted@.
    ClientSyncProcessor ci si a m -> Set si -> m ()
clientSyncProcessorSyncServerDeletedConflictDelete :: !(Set si -> m ()),
    -- | Deal with the items for which no conflict was resolved.
    --
    -- You likely don't have to do anything with these, as they are the way that has been decided they should be, but you may want to log them or so.
    ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictKeepLocal :: !(Map si (Timed a) -> m ()),
    -- | Store the items that were in a conflict but the conflict was resolved correctly.
    -- These items should be marked as changed.
    ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictMerged :: !(Map si (Timed a) -> m ()),
    -- | Store the items that were in a conflict but the client will take the remote values
    -- These items should be marked as unchanged.
    --
    -- You can likely implement this in the same way as @clientSyncProcessorSyncServerChanged@.
    ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictTakeRemote :: !(Map si (Timed a) -> m ()),
    -- | Store the items that the server added
    ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncServerAdded :: !(Map si (Timed a) -> m ()),
    -- | Store the items that the server changed
    ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncServerChanged :: !(Map si (Timed a) -> m ()),
    -- | Store the items that the server deleted
    ClientSyncProcessor ci si a m -> Set si -> m ()
clientSyncProcessorSyncServerDeleted :: !(Set si -> m ())
  }
  deriving ((forall x.
 ClientSyncProcessor ci si a m
 -> Rep (ClientSyncProcessor ci si a m) x)
-> (forall x.
    Rep (ClientSyncProcessor ci si a m) x
    -> ClientSyncProcessor ci si a m)
-> Generic (ClientSyncProcessor ci si a m)
forall x.
Rep (ClientSyncProcessor ci si a m) x
-> ClientSyncProcessor ci si a m
forall x.
ClientSyncProcessor ci si a m
-> Rep (ClientSyncProcessor ci si a m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ci si a (m :: * -> *) x.
Rep (ClientSyncProcessor ci si a m) x
-> ClientSyncProcessor ci si a m
forall ci si a (m :: * -> *) x.
ClientSyncProcessor ci si a m
-> Rep (ClientSyncProcessor ci si a m) x
$cto :: forall ci si a (m :: * -> *) x.
Rep (ClientSyncProcessor ci si a m) x
-> ClientSyncProcessor ci si a m
$cfrom :: forall ci si a (m :: * -> *) x.
ClientSyncProcessor ci si a m
-> Rep (ClientSyncProcessor ci si a m) x
Generic)

mergeSyncResponseCustom :: (Ord si, Monad m) => ItemMergeStrategy a -> ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
mergeSyncResponseCustom :: ItemMergeStrategy a
-> ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
mergeSyncResponseCustom ItemMergeStrategy {a -> ServerDeletedConflictResolution
a -> ClientDeletedConflictResolution
a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeServerDeletedConflict :: forall a.
ItemMergeStrategy a -> a -> ServerDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict :: forall a.
ItemMergeStrategy a -> a -> ClientDeletedConflictResolution
itemMergeStrategyMergeChangeConflict :: forall a.
ItemMergeStrategy a -> a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeServerDeletedConflict :: a -> ServerDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict :: a -> ClientDeletedConflictResolution
itemMergeStrategyMergeChangeConflict :: a -> a -> ChangeConflictResolution a
..} ClientSyncProcessor {Map si (Timed a) -> m ()
Map si ServerTime -> m ()
Map ci (ClientAddition si) -> m ()
Set si -> m ()
Set si -> m (Map si (Timed a))
clientSyncProcessorSyncServerDeleted :: Set si -> m ()
clientSyncProcessorSyncServerChanged :: Map si (Timed a) -> m ()
clientSyncProcessorSyncServerAdded :: Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictTakeRemote :: Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictMerged :: Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictKeepLocal :: Map si (Timed a) -> m ()
clientSyncProcessorSyncServerDeletedConflictDelete :: Set si -> m ()
clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: Set si -> m ()
clientSyncProcessorSyncClientDeletedConflictStayDeleted :: Map si (Timed a) -> m ()
clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: Map si (Timed a) -> m ()
clientSyncProcessorSyncClientDeleted :: Set si -> m ()
clientSyncProcessorSyncClientChanged :: Map si ServerTime -> m ()
clientSyncProcessorSyncClientAdded :: Map ci (ClientAddition si) -> m ()
clientSyncProcessorQuerySyncedButChangedValues :: Set si -> m (Map si (Timed a))
clientSyncProcessorSyncServerDeleted :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Set si -> m ()
clientSyncProcessorSyncServerChanged :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncServerAdded :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncServerDeletedConflictDelete :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Set si -> m ()
clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Set si -> m ()
clientSyncProcessorSyncClientDeletedConflictStayDeleted :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictTakeRemote :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictMerged :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictKeepLocal :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si (Timed a) -> m ()
clientSyncProcessorSyncClientDeleted :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Set si -> m ()
clientSyncProcessorSyncClientChanged :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si ServerTime -> m ()
clientSyncProcessorSyncClientAdded :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map ci (ClientAddition si) -> m ()
clientSyncProcessorQuerySyncedButChangedValues :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Set si -> m (Map si (Timed a))
..} SyncResponse {Map si (Timed a)
Map si ServerTime
Map ci (ClientAddition si)
Set si
syncResponseConflictsServerDeleted :: Set si
syncResponseConflictsClientDeleted :: Map si (Timed a)
syncResponseConflicts :: Map si (Timed a)
syncResponseServerDeleted :: Set si
syncResponseServerChanged :: Map si (Timed a)
syncResponseServerAdded :: Map si (Timed a)
syncResponseClientDeleted :: Set si
syncResponseClientChanged :: Map si ServerTime
syncResponseClientAdded :: Map ci (ClientAddition si)
syncResponseConflictsServerDeleted :: forall ci si a. SyncResponse ci si a -> Set si
syncResponseConflictsClientDeleted :: forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseConflicts :: forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseServerDeleted :: forall ci si a. SyncResponse ci si a -> Set si
syncResponseServerChanged :: forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseServerAdded :: forall ci si a. SyncResponse ci si a -> Map si (Timed a)
syncResponseClientDeleted :: forall ci si a. SyncResponse ci si a -> Set si
syncResponseClientChanged :: forall ci si a. SyncResponse ci si a -> Map si ServerTime
syncResponseClientAdded :: forall ci si a. SyncResponse ci si a -> Map ci (ClientAddition si)
..} = do
  -- Every client deleted conflict needs to be added, if the sync processor says so
  let (Map si (Timed a)
remoteChangeToTake, Map si (Timed a)
remoteChangesToIgnore) = (a -> ClientDeletedConflictResolution)
-> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a))
forall a si.
(a -> ClientDeletedConflictResolution)
-> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a))
mergeClientDeletedConflicts a -> ClientDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict Map si (Timed a)
syncResponseConflictsClientDeleted
  -- Every change conflict, unless the client item is kept, needs to be updated
  -- The unresolved conflicts don't need to be updated.
  Map si (Timed a)
clientChangeConflicts <- Set si -> m (Map si (Timed a))
clientSyncProcessorQuerySyncedButChangedValues (Set si -> m (Map si (Timed a))) -> Set si -> m (Map si (Timed a))
forall a b. (a -> b) -> a -> b
$ Map si (Timed a) -> Set si
forall k a. Map k a -> Set k
M.keysSet Map si (Timed a)
syncResponseConflicts
  let (Map si (Timed a)
unresolvedChangeConflicts, Map si (Timed a)
mergedChangeConflicts, Map si (Timed a)
resolvedChangeConflicts) = (a -> a -> ChangeConflictResolution a)
-> Map si (Timed a)
-> Map si (Timed a)
-> (Map si (Timed a), Map si (Timed a), Map si (Timed a))
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))
mergeSyncedButChangedConflicts a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeChangeConflict Map si (Timed a)
clientChangeConflicts Map si (Timed a)
syncResponseConflicts
  -- Every served deleted conflict needs to be deleted, if the sync processor says so
  Map si (Timed a)
clientServerDeletedConflicts <- Set si -> m (Map si (Timed a))
clientSyncProcessorQuerySyncedButChangedValues Set si
syncResponseConflictsServerDeleted
  let (Set si
localChangesToDelete, Set si
localChangesToBeKept) = (a -> ServerDeletedConflictResolution)
-> Map si (Timed a) -> (Set si, Set si)
forall a si.
(a -> ServerDeletedConflictResolution)
-> Map si (Timed a) -> (Set si, Set si)
mergeServerDeletedConflicts a -> ServerDeletedConflictResolution
itemMergeStrategyMergeServerDeletedConflict Map si (Timed a)
clientServerDeletedConflicts
  -- The order here matters.
  Map si (Timed a) -> m ()
clientSyncProcessorSyncServerAdded Map si (Timed a)
syncResponseServerAdded
  Map si (Timed a) -> m ()
clientSyncProcessorSyncServerChanged Map si (Timed a)
syncResponseServerChanged
  Set si -> m ()
clientSyncProcessorSyncServerDeleted Set si
syncResponseServerDeleted
  Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictTakeRemote Map si (Timed a)
resolvedChangeConflicts
  Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictMerged Map si (Timed a)
mergedChangeConflicts
  Map si (Timed a) -> m ()
clientSyncProcessorSyncChangeConflictKeepLocal Map si (Timed a)
unresolvedChangeConflicts
  Map si (Timed a) -> m ()
clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged Map si (Timed a)
remoteChangeToTake
  Map si (Timed a) -> m ()
clientSyncProcessorSyncClientDeletedConflictStayDeleted Map si (Timed a)
remoteChangesToIgnore
  Set si -> m ()
clientSyncProcessorSyncServerDeletedConflictDelete Set si
localChangesToDelete
  Set si -> m ()
clientSyncProcessorSyncServerDeletedConflictKeepLocalChange Set si
localChangesToBeKept
  Set si -> m ()
clientSyncProcessorSyncClientDeleted Set si
syncResponseClientDeleted
  Map si ServerTime -> m ()
clientSyncProcessorSyncClientChanged Map si ServerTime
syncResponseClientChanged
  Map ci (ClientAddition si) -> m ()
clientSyncProcessorSyncClientAdded Map ci (ClientAddition si)
syncResponseClientAdded

-- | Resolve change conflicts
mergeSyncedButChangedConflicts ::
  forall si a.
  Ord si =>
  (a -> a -> ChangeConflictResolution a) ->
  -- | The conflicting items on the client side
  Map si (Timed a) ->
  -- | The conflicting items on the server side
  Map si (Timed a) ->
  -- | Unresolved conflicts on the left, merged conflicts in the middle, resolved conflicts on the right
  --
  -- * The unresolved conflicts should remain as-is
  -- * The merged conflicts should be updated and marked as changed
  -- * The resolved conflicts should be updated and marked as unchanged
  (Map si (Timed a), Map si (Timed a), Map si (Timed a))
mergeSyncedButChangedConflicts :: (a -> a -> ChangeConflictResolution a)
-> Map si (Timed a)
-> Map si (Timed a)
-> (Map si (Timed a), Map si (Timed a), Map si (Timed a))
mergeSyncedButChangedConflicts a -> a -> ChangeConflictResolution a
func Map si (Timed a)
clientItems =
  ((Map si (Timed a), Map si (Timed a), Map si (Timed a))
 -> si
 -> Timed a
 -> (Map si (Timed a), Map si (Timed a), Map si (Timed a)))
-> (Map si (Timed a), Map si (Timed a), Map si (Timed a))
-> Map si (Timed a)
-> (Map si (Timed a), Map si (Timed a), Map si (Timed a))
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (Map si (Timed a), Map si (Timed a), Map si (Timed a))
-> si
-> Timed a
-> (Map si (Timed a), Map si (Timed a), Map si (Timed a))
go (Map si (Timed a)
forall k a. Map k a
M.empty, Map si (Timed a)
forall k a. Map k a
M.empty, Map si (Timed a)
forall k a. Map k a
M.empty)
  where
    go ::
      (Map si (Timed a), Map si (Timed a), Map si (Timed a)) ->
      si ->
      Timed a ->
      (Map si (Timed a), Map si (Timed a), Map si (Timed a))
    go :: (Map si (Timed a), Map si (Timed a), Map si (Timed a))
-> si
-> Timed a
-> (Map si (Timed a), Map si (Timed a), Map si (Timed a))
go tup :: (Map si (Timed a), Map si (Timed a), Map si (Timed a))
tup@(Map si (Timed a)
unresolved, Map si (Timed a)
merged, Map si (Timed a)
resolved) si
key s :: Timed a
s@(Timed a
si ServerTime
st) = case si -> Map si (Timed a) -> Maybe (Timed a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup si
key Map si (Timed a)
clientItems of
      Maybe (Timed a)
Nothing -> (Map si (Timed a), Map si (Timed a), Map si (Timed a))
tup -- TODO not even sure what this would mean. Should not happen I guess. Just throw it away
      Just c :: Timed a
c@(Timed a
ci ServerTime
_) -> case a -> a -> ChangeConflictResolution a
func a
ci a
si of
        ChangeConflictResolution a
KeepLocal ->
          (si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
key Timed a
c Map si (Timed a)
unresolved, Map si (Timed a)
merged, Map si (Timed a)
resolved)
        Merged a
mi ->
          (Map si (Timed a)
unresolved, si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
key (a -> ServerTime -> Timed a
forall a. a -> ServerTime -> Timed a
Timed a
mi ServerTime
st) Map si (Timed a)
merged, si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
key Timed a
s Map si (Timed a)
resolved)
        ChangeConflictResolution a
TakeRemote ->
          (Map si (Timed a)
unresolved, Map si (Timed a)
merged, si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
key Timed a
s Map si (Timed a)
resolved)

-- | Resolve client deleted conflicts
mergeClientDeletedConflicts ::
  (a -> ClientDeletedConflictResolution) ->
  -- | The conflicting items on the server side
  Map si (Timed a) ->
  -- | A map of items that need to be updated on the client.
  (Map si (Timed a), Map si (Timed a))
mergeClientDeletedConflicts :: (a -> ClientDeletedConflictResolution)
-> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a))
mergeClientDeletedConflicts a -> ClientDeletedConflictResolution
func = (Timed a -> Bool)
-> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a))
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition ((Timed a -> Bool)
 -> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a)))
-> (Timed a -> Bool)
-> Map si (Timed a)
-> (Map si (Timed a), Map si (Timed a))
forall a b. (a -> b) -> a -> b
$ \(Timed a
si ServerTime
_) ->
  case a -> ClientDeletedConflictResolution
func a
si of
    ClientDeletedConflictResolution
TakeRemoteChange -> Bool
True
    ClientDeletedConflictResolution
StayDeleted -> Bool
False

-- | Resolve server deleted conflicts
mergeServerDeletedConflicts ::
  (a -> ServerDeletedConflictResolution) ->
  -- | The conflicting items on the client side
  Map si (Timed a) ->
  -- | The result is a map of items that need to be deleted on the client.
  (Set si, Set si)
mergeServerDeletedConflicts :: (a -> ServerDeletedConflictResolution)
-> Map si (Timed a) -> (Set si, Set si)
mergeServerDeletedConflicts a -> ServerDeletedConflictResolution
func Map si (Timed a)
m = (Map si (Timed a) -> Set si)
-> (Map si (Timed a), Map si (Timed a)) -> (Set si, Set si)
forall a b. (a -> b) -> (a, a) -> (b, b)
both Map si (Timed a) -> Set si
forall k a. Map k a -> Set k
M.keysSet ((Map si (Timed a), Map si (Timed a)) -> (Set si, Set si))
-> (Map si (Timed a), Map si (Timed a)) -> (Set si, Set si)
forall a b. (a -> b) -> a -> b
$
  ((Timed a -> Bool)
 -> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a)))
-> Map si (Timed a)
-> (Timed a -> Bool)
-> (Map si (Timed a), Map si (Timed a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Timed a -> Bool)
-> Map si (Timed a) -> (Map si (Timed a), Map si (Timed a))
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition Map si (Timed a)
m ((Timed a -> Bool) -> (Map si (Timed a), Map si (Timed a)))
-> (Timed a -> Bool) -> (Map si (Timed a), Map si (Timed a))
forall a b. (a -> b) -> a -> b
$ \(Timed a
si ServerTime
_) -> case a -> ServerDeletedConflictResolution
func a
si of
    ServerDeletedConflictResolution
KeepLocalChange -> Bool
False
    ServerDeletedConflictResolution
Delete -> Bool
True
  where
    both :: (a -> b) -> (a, a) -> (b, b)
    both :: (a -> b) -> (a, a) -> (b, b)
both a -> b
f (a
a1, a
a2) = (a -> b
f a
a1, a -> b
f a
a2)

data Identifier ci si
  = OnlyServer !si
  | BothServerAndClient !si !ci
  deriving (Int -> Identifier ci si -> ShowS
[Identifier ci si] -> ShowS
Identifier ci si -> String
(Int -> Identifier ci si -> ShowS)
-> (Identifier ci si -> String)
-> ([Identifier ci si] -> ShowS)
-> Show (Identifier ci si)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ci si.
(Show si, Show ci) =>
Int -> Identifier ci si -> ShowS
forall ci si. (Show si, Show ci) => [Identifier ci si] -> ShowS
forall ci si. (Show si, Show ci) => Identifier ci si -> String
showList :: [Identifier ci si] -> ShowS
$cshowList :: forall ci si. (Show si, Show ci) => [Identifier ci si] -> ShowS
show :: Identifier ci si -> String
$cshow :: forall ci si. (Show si, Show ci) => Identifier ci si -> String
showsPrec :: Int -> Identifier ci si -> ShowS
$cshowsPrec :: forall ci si.
(Show si, Show ci) =>
Int -> Identifier ci si -> ShowS
Show, Identifier ci si -> Identifier ci si -> Bool
(Identifier ci si -> Identifier ci si -> Bool)
-> (Identifier ci si -> Identifier ci si -> Bool)
-> Eq (Identifier ci si)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ci si.
(Eq si, Eq ci) =>
Identifier ci si -> Identifier ci si -> Bool
/= :: Identifier ci si -> Identifier ci si -> Bool
$c/= :: forall ci si.
(Eq si, Eq ci) =>
Identifier ci si -> Identifier ci si -> Bool
== :: Identifier ci si -> Identifier ci si -> Bool
$c== :: forall ci si.
(Eq si, Eq ci) =>
Identifier ci si -> Identifier ci si -> Bool
Eq, Eq (Identifier ci si)
Eq (Identifier ci si)
-> (Identifier ci si -> Identifier ci si -> Ordering)
-> (Identifier ci si -> Identifier ci si -> Bool)
-> (Identifier ci si -> Identifier ci si -> Bool)
-> (Identifier ci si -> Identifier ci si -> Bool)
-> (Identifier ci si -> Identifier ci si -> Bool)
-> (Identifier ci si -> Identifier ci si -> Identifier ci si)
-> (Identifier ci si -> Identifier ci si -> Identifier ci si)
-> Ord (Identifier ci si)
Identifier ci si -> Identifier ci si -> Bool
Identifier ci si -> Identifier ci si -> Ordering
Identifier ci si -> Identifier ci si -> Identifier ci si
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall ci si. (Ord si, Ord ci) => Eq (Identifier ci si)
forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Bool
forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Ordering
forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Identifier ci si
min :: Identifier ci si -> Identifier ci si -> Identifier ci si
$cmin :: forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Identifier ci si
max :: Identifier ci si -> Identifier ci si -> Identifier ci si
$cmax :: forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Identifier ci si
>= :: Identifier ci si -> Identifier ci si -> Bool
$c>= :: forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Bool
> :: Identifier ci si -> Identifier ci si -> Bool
$c> :: forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Bool
<= :: Identifier ci si -> Identifier ci si -> Bool
$c<= :: forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Bool
< :: Identifier ci si -> Identifier ci si -> Bool
$c< :: forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Bool
compare :: Identifier ci si -> Identifier ci si -> Ordering
$ccompare :: forall ci si.
(Ord si, Ord ci) =>
Identifier ci si -> Identifier ci si -> Ordering
$cp1Ord :: forall ci si. (Ord si, Ord ci) => Eq (Identifier ci si)
Ord, (forall x. Identifier ci si -> Rep (Identifier ci si) x)
-> (forall x. Rep (Identifier ci si) x -> Identifier ci si)
-> Generic (Identifier ci si)
forall x. Rep (Identifier ci si) x -> Identifier ci si
forall x. Identifier ci si -> Rep (Identifier ci si) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ci si x. Rep (Identifier ci si) x -> Identifier ci si
forall ci si x. Identifier ci si -> Rep (Identifier ci si) x
$cto :: forall ci si x. Rep (Identifier ci si) x -> Identifier ci si
$cfrom :: forall ci si x. Identifier ci si -> Rep (Identifier ci si) x
Generic)

instance (Validity ci, Validity si) => Validity (Identifier ci si)

instance (NFData ci, NFData si) => NFData (Identifier ci si)

data ServerSyncProcessor ci si a m = ServerSyncProcessor
  { -- | Read all items
    ServerSyncProcessor ci si a m -> m (Map si (Timed a))
serverSyncProcessorRead :: !(m (Map si (Timed a))),
    -- | Add an item with 'initialServerTime', can fail.
    ServerSyncProcessor ci si a m -> ci -> a -> m (Maybe si)
serverSyncProcessorAddItem :: !(ci -> a -> m (Maybe si)),
    -- | Update an item
    ServerSyncProcessor ci si a m -> si -> ServerTime -> a -> m ()
serverSyncProcessorChangeItem :: !(si -> ServerTime -> a -> m ()),
    -- | Delete an item
    ServerSyncProcessor ci si a m -> si -> m ()
serverSyncProcessorDeleteItem :: !(si -> m ())
  }
  deriving ((forall x.
 ServerSyncProcessor ci si a m
 -> Rep (ServerSyncProcessor ci si a m) x)
-> (forall x.
    Rep (ServerSyncProcessor ci si a m) x
    -> ServerSyncProcessor ci si a m)
-> Generic (ServerSyncProcessor ci si a m)
forall x.
Rep (ServerSyncProcessor ci si a m) x
-> ServerSyncProcessor ci si a m
forall x.
ServerSyncProcessor ci si a m
-> Rep (ServerSyncProcessor ci si a m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ci si a (m :: * -> *) x.
Rep (ServerSyncProcessor ci si a m) x
-> ServerSyncProcessor ci si a m
forall ci si a (m :: * -> *) x.
ServerSyncProcessor ci si a m
-> Rep (ServerSyncProcessor ci si a m) x
$cto :: forall ci si a (m :: * -> *) x.
Rep (ServerSyncProcessor ci si a m) x
-> ServerSyncProcessor ci si a m
$cfrom :: forall ci si a (m :: * -> *) x.
ServerSyncProcessor ci si a m
-> Rep (ServerSyncProcessor ci si a m) x
Generic)

-- | 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".
processServerSyncCustom ::
  forall ci si a m.
  ( Ord si,
    Monad m
  ) =>
  -- | Your server sync processor
  ServerSyncProcessor ci si a m ->
  SyncRequest ci si a ->
  m (SyncResponse ci si a)
processServerSyncCustom :: ServerSyncProcessor ci si a m
-> SyncRequest ci si a -> m (SyncResponse ci si a)
processServerSyncCustom ServerSyncProcessor {m (Map si (Timed a))
ci -> a -> m (Maybe si)
si -> m ()
si -> ServerTime -> a -> m ()
serverSyncProcessorDeleteItem :: si -> m ()
serverSyncProcessorChangeItem :: si -> ServerTime -> a -> m ()
serverSyncProcessorAddItem :: ci -> a -> m (Maybe si)
serverSyncProcessorRead :: m (Map si (Timed a))
serverSyncProcessorDeleteItem :: forall ci si a (m :: * -> *).
ServerSyncProcessor ci si a m -> si -> m ()
serverSyncProcessorChangeItem :: forall ci si a (m :: * -> *).
ServerSyncProcessor ci si a m -> si -> ServerTime -> a -> m ()
serverSyncProcessorAddItem :: forall ci si a (m :: * -> *).
ServerSyncProcessor ci si a m -> ci -> a -> m (Maybe si)
serverSyncProcessorRead :: forall ci si a (m :: * -> *).
ServerSyncProcessor ci si a m -> m (Map si (Timed a))
..} SyncRequest {Map ci a
Map si (Timed a)
Map si ServerTime
syncRequestDeletedItems :: Map si ServerTime
syncRequestKnownButChangedItems :: Map si (Timed a)
syncRequestKnownItems :: Map si ServerTime
syncRequestNewItems :: Map ci a
syncRequestDeletedItems :: forall ci si a. SyncRequest ci si a -> Map si ServerTime
syncRequestKnownButChangedItems :: forall ci si a. SyncRequest ci si a -> Map si (Timed a)
syncRequestKnownItems :: forall ci si a. SyncRequest ci si a -> Map si ServerTime
syncRequestNewItems :: forall ci si a. SyncRequest ci si a -> Map ci a
..} = do
  Map si (Timed a)
serverItems <- m (Map si (Timed a))
serverSyncProcessorRead
  -- A: CA (generate a new identifier)
  Map ci (ClientAddition si)
syncResponseClientAdded <- (Map ci (Maybe (ClientAddition si)) -> Map ci (ClientAddition si))
-> m (Map ci (Maybe (ClientAddition si)))
-> m (Map ci (ClientAddition si))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (ClientAddition si) -> Maybe (ClientAddition si))
-> Map ci (Maybe (ClientAddition si)) -> Map ci (ClientAddition si)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Maybe (ClientAddition si) -> Maybe (ClientAddition si)
forall a. a -> a
id) (m (Map ci (Maybe (ClientAddition si)))
 -> m (Map ci (ClientAddition si)))
-> m (Map ci (Maybe (ClientAddition si)))
-> m (Map ci (ClientAddition si))
forall a b. (a -> b) -> a -> b
$
    ((ci -> a -> m (Maybe (ClientAddition si)))
 -> Map ci a -> m (Map ci (Maybe (ClientAddition si))))
-> Map ci a
-> (ci -> a -> m (Maybe (ClientAddition si)))
-> m (Map ci (Maybe (ClientAddition si)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ci -> a -> m (Maybe (ClientAddition si)))
-> Map ci a -> m (Map ci (Maybe (ClientAddition si)))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey Map ci a
syncRequestNewItems ((ci -> a -> m (Maybe (ClientAddition si)))
 -> m (Map ci (Maybe (ClientAddition si))))
-> (ci -> a -> m (Maybe (ClientAddition si)))
-> m (Map ci (Maybe (ClientAddition si)))
forall a b. (a -> b) -> a -> b
$ \ci
cid a
a -> do
      Maybe si
msi <- ci -> a -> m (Maybe si)
serverSyncProcessorAddItem ci
cid a
a
      Maybe (ClientAddition si) -> m (Maybe (ClientAddition si))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ClientAddition si) -> m (Maybe (ClientAddition si)))
-> Maybe (ClientAddition si) -> m (Maybe (ClientAddition si))
forall a b. (a -> b) -> a -> b
$ (\si
si -> ClientAddition :: forall i. i -> ServerTime -> ClientAddition i
ClientAddition {clientAdditionId :: si
clientAdditionId = si
si, clientAdditionServerTime :: ServerTime
clientAdditionServerTime = ServerTime
initialServerTime}) (si -> ClientAddition si) -> Maybe si -> Maybe (ClientAddition si)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe si
msi :: Maybe si)
  -- C:
  let decideOnSynced :: (Map si (Timed a), Set si)
-> (si, ServerTime) -> (Map si (Timed a), Set si)
decideOnSynced tup :: (Map si (Timed a), Set si)
tup@(Map si (Timed a)
sc, Set si
sd) (si
si, ServerTime
ct) =
        case si -> Map si (Timed a) -> Maybe (Timed a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup si
si Map si (Timed a)
serverItems of
          -- SD: The server must have deleted it.
          Maybe (Timed a)
Nothing -> (Map si (Timed a)
sc, si -> Set si -> Set si
forall a. Ord a => a -> Set a -> Set a
S.insert si
si Set si
sd)
          Just t :: Timed a
t@(Timed a
_ ServerTime
st) ->
            if ServerTime
ct ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
>= ServerTime
st
              then (Map si (Timed a), Set si)
tup -- In sync
              else (si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
si Timed a
t Map si (Timed a)
sc, Set si
sd) -- SC: The server has changed it because its server time is newer
  let (Map si (Timed a)
syncResponseServerChanged, Set si
syncResponseServerDeleted) = ((Map si (Timed a), Set si)
 -> (si, ServerTime) -> (Map si (Timed a), Set si))
-> (Map si (Timed a), Set si)
-> [(si, ServerTime)]
-> (Map si (Timed a), Set si)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Map si (Timed a), Set si)
-> (si, ServerTime) -> (Map si (Timed a), Set si)
decideOnSynced (Map si (Timed a)
forall k a. Map k a
M.empty, Set si
forall a. Set a
S.empty) (Map si ServerTime -> [(si, ServerTime)]
forall k a. Map k a -> [(k, a)]
M.toList Map si ServerTime
syncRequestKnownItems)
  -- S:
  let decideOnChanged :: (Map si ServerTime, Map si (Timed a), Set si)
-> (si, Timed a) -> m (Map si ServerTime, Map si (Timed a), Set si)
decideOnChanged (Map si ServerTime
cc, Map si (Timed a)
cConf, Set si
sdc) (si
si, Timed a
clientItem ServerTime
ct) = do
        case si -> Map si (Timed a) -> Maybe (Timed a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup si
si Map si (Timed a)
serverItems of
          -- SDC
          Maybe (Timed a)
Nothing -> (Map si ServerTime, Map si (Timed a), Set si)
-> m (Map si ServerTime, Map si (Timed a), Set si)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map si ServerTime
cc, Map si (Timed a)
cConf, si -> Set si -> Set si
forall a. Ord a => a -> Set a -> Set a
S.insert si
si Set si
sdc)
          Just serverTimed :: Timed a
serverTimed@(Timed a
_ ServerTime
st) ->
            if ServerTime
ct ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
>= ServerTime
st
              then do
                -- CC
                let st' :: ServerTime
st' = ServerTime -> ServerTime
incrementServerTime ServerTime
st
                -- Update the server item
                si -> ServerTime -> a -> m ()
serverSyncProcessorChangeItem si
si ServerTime
st' a
clientItem
                (Map si ServerTime, Map si (Timed a), Set si)
-> m (Map si ServerTime, Map si (Timed a), Set si)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (si -> ServerTime -> Map si ServerTime -> Map si ServerTime
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
si ServerTime
st' Map si ServerTime
cc, Map si (Timed a)
cConf, Set si
sdc)
              else do
                -- CConf
                (Map si ServerTime, Map si (Timed a), Set si)
-> m (Map si ServerTime, Map si (Timed a), Set si)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map si ServerTime
cc, si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
si Timed a
serverTimed Map si (Timed a)
cConf, Set si
sdc)
  (Map si ServerTime
syncResponseClientChanged, Map si (Timed a)
syncResponseConflicts, Set si
syncResponseConflictsServerDeleted) <- ((Map si ServerTime, Map si (Timed a), Set si)
 -> (si, Timed a)
 -> m (Map si ServerTime, Map si (Timed a), Set si))
-> (Map si ServerTime, Map si (Timed a), Set si)
-> [(si, Timed a)]
-> m (Map si ServerTime, Map si (Timed a), Set si)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Map si ServerTime, Map si (Timed a), Set si)
-> (si, Timed a) -> m (Map si ServerTime, Map si (Timed a), Set si)
decideOnChanged (Map si ServerTime
forall k a. Map k a
M.empty, Map si (Timed a)
forall k a. Map k a
M.empty, Set si
forall a. Set a
S.empty) (Map si (Timed a) -> [(si, Timed a)]
forall k a. Map k a -> [(k, a)]
M.toList Map si (Timed a)
syncRequestKnownButChangedItems)
  --- D:
  let decideOnDeleted :: (Set si, Map si (Timed a))
-> (si, ServerTime) -> m (Set si, Map si (Timed a))
decideOnDeleted (Set si
cd, Map si (Timed a)
cdc) (si
si, ServerTime
ct) = do
        case si -> Map si (Timed a) -> Maybe (Timed a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup si
si Map si (Timed a)
serverItems of
          Maybe (Timed a)
Nothing -> do
            -- CD: It was already deleted on the server side, Just pretend that the client made that happen.
            (Set si, Map si (Timed a)) -> m (Set si, Map si (Timed a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (si -> Set si -> Set si
forall a. Ord a => a -> Set a -> Set a
S.insert si
si Set si
cd, Map si (Timed a)
cdc)
          Just serverTimed :: Timed a
serverTimed@(Timed a
_ ServerTime
st) ->
            if ServerTime
ct ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
>= ServerTime
st
              then do
                -- CD
                -- Delete the item
                si -> m ()
serverSyncProcessorDeleteItem si
si
                (Set si, Map si (Timed a)) -> m (Set si, Map si (Timed a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (si -> Set si -> Set si
forall a. Ord a => a -> Set a -> Set a
S.insert si
si Set si
cd, Map si (Timed a)
cdc)
              else do
                -- CDC
                (Set si, Map si (Timed a)) -> m (Set si, Map si (Timed a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set si
cd, si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
si Timed a
serverTimed Map si (Timed a)
cdc)
  (Set si
syncResponseClientDeleted, Map si (Timed a)
syncResponseConflictsClientDeleted) <- ((Set si, Map si (Timed a))
 -> (si, ServerTime) -> m (Set si, Map si (Timed a)))
-> (Set si, Map si (Timed a))
-> [(si, ServerTime)]
-> m (Set si, Map si (Timed a))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Set si, Map si (Timed a))
-> (si, ServerTime) -> m (Set si, Map si (Timed a))
decideOnDeleted (Set si
forall a. Set a
S.empty, Map si (Timed a)
forall k a. Map k a
M.empty) (Map si ServerTime -> [(si, ServerTime)]
forall k a. Map k a -> [(k, a)]
M.toList Map si ServerTime
syncRequestDeletedItems)
  -- Extra: for all items that are in the server but not in the sync request, we need to say they are server added.
  let syncResponseServerAdded :: Map si (Timed a)
syncResponseServerAdded = Map si (Timed a)
serverItems Map si (Timed a) -> Map si () -> Map si (Timed a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` [Map si ()] -> Map si ()
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions [() () -> Map si ServerTime -> Map si ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map si ServerTime
syncRequestKnownItems, () () -> Map si (Timed a) -> Map si ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map si (Timed a)
syncRequestKnownButChangedItems, () () -> Map si ServerTime -> Map si ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map si ServerTime
syncRequestDeletedItems]
  SyncResponse ci si a -> m (SyncResponse ci si a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SyncResponse :: forall ci si a.
Map ci (ClientAddition si)
-> Map si ServerTime
-> Set si
-> Map si (Timed a)
-> Map si (Timed a)
-> Set si
-> Map si (Timed a)
-> Map si (Timed a)
-> Set si
-> SyncResponse ci si a
SyncResponse {Map ci (ClientAddition si)
Map si (Timed a)
Map si ServerTime
Set si
syncResponseServerAdded :: Map si (Timed a)
syncResponseConflictsClientDeleted :: Map si (Timed a)
syncResponseClientDeleted :: Set si
syncResponseConflictsServerDeleted :: Set si
syncResponseConflicts :: Map si (Timed a)
syncResponseClientChanged :: Map si ServerTime
syncResponseServerDeleted :: Set si
syncResponseServerChanged :: Map si (Timed a)
syncResponseClientAdded :: Map ci (ClientAddition si)
syncResponseConflictsServerDeleted :: Set si
syncResponseConflictsClientDeleted :: Map si (Timed a)
syncResponseConflicts :: Map si (Timed a)
syncResponseServerDeleted :: Set si
syncResponseServerChanged :: Map si (Timed a)
syncResponseServerAdded :: Map si (Timed a)
syncResponseClientDeleted :: Set si
syncResponseClientChanged :: Map si ServerTime
syncResponseClientAdded :: Map ci (ClientAddition si)
..}

-- | Serve an 'SyncRequest' using the current 'ServerStore', producing an 'SyncResponse' and a new 'ServerStore'.
processServerSync ::
  forall ci si a m.
  ( Ord si,
    Monad m
  ) =>
  -- | The action that is guaranteed to generate unique identifiers
  m si ->
  ServerStore si a ->
  SyncRequest ci si a ->
  m (SyncResponse ci si a, ServerStore si a)
processServerSync :: m si
-> ServerStore si a
-> SyncRequest ci si a
-> m (SyncResponse ci si a, ServerStore si a)
processServerSync m si
genId ServerStore si a
ss SyncRequest ci si a
sr = StateT (ServerStore si a) m (SyncResponse ci si a)
-> ServerStore si a -> m (SyncResponse ci si a, ServerStore si a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ServerSyncProcessor ci si a (StateT (ServerStore si a) m)
-> SyncRequest ci si a
-> StateT (ServerStore si a) m (SyncResponse ci si 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 (m si -> ServerSyncProcessor ci si a (StateT (ServerStore si a) m)
forall si (m :: * -> *) ci a.
(Ord si, Monad m) =>
m si -> ServerSyncProcessor ci si a (StateT (ServerStore si a) m)
pureServerSyncProcessor m si
genId) SyncRequest ci si a
sr) ServerStore si a
ss

-- | A potentially pure sync processor
pureServerSyncProcessor ::
  (Ord si, Monad m) =>
  -- | The action that is guaranteed to generate unique identifiers
  m si ->
  ServerSyncProcessor ci si a (StateT (ServerStore si a) m)
pureServerSyncProcessor :: m si -> ServerSyncProcessor ci si a (StateT (ServerStore si a) m)
pureServerSyncProcessor m si
genId = ServerSyncProcessor :: forall ci si a (m :: * -> *).
m (Map si (Timed a))
-> (ci -> a -> m (Maybe si))
-> (si -> ServerTime -> a -> m ())
-> (si -> m ())
-> ServerSyncProcessor ci si a m
ServerSyncProcessor {StateT (ServerStore si a) m (Map si (Timed a))
si -> StateT (ServerStore si a) m ()
si -> ServerTime -> a -> StateT (ServerStore si a) m ()
ci -> a -> StateT (ServerStore si a) m (Maybe si)
forall si a (m :: * -> *).
(MonadState (ServerStore si a) m, Ord si) =>
si -> m ()
forall si a (m :: * -> *).
(MonadState (ServerStore si a) m, Ord si) =>
si -> ServerTime -> a -> m ()
forall (t :: (* -> *) -> * -> *) a p.
(MonadTrans t, MonadState (ServerStore si a) (t m)) =>
p -> a -> t m (Maybe si)
serverSyncProcessorDeleteItem :: forall si a (m :: * -> *).
(MonadState (ServerStore si a) m, Ord si) =>
si -> m ()
serverSyncProcessorChangeItem :: forall si a (m :: * -> *).
(MonadState (ServerStore si a) m, Ord si) =>
si -> ServerTime -> a -> m ()
serverSyncProcessorAddItem :: forall (t :: (* -> *) -> * -> *) a p.
(MonadTrans t, MonadState (ServerStore si a) (t m)) =>
p -> a -> t m (Maybe si)
serverSyncProcessorRead :: StateT (ServerStore si a) m (Map si (Timed a))
serverSyncProcessorDeleteItem :: si -> StateT (ServerStore si a) m ()
serverSyncProcessorChangeItem :: si -> ServerTime -> a -> StateT (ServerStore si a) m ()
serverSyncProcessorAddItem :: ci -> a -> StateT (ServerStore si a) m (Maybe si)
serverSyncProcessorRead :: StateT (ServerStore si a) m (Map si (Timed a))
..}
  where
    serverSyncProcessorRead :: StateT (ServerStore si a) m (Map si (Timed a))
serverSyncProcessorRead = (ServerStore si a -> Map si (Timed a))
-> StateT (ServerStore si a) m (Map si (Timed a))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ServerStore si a -> Map si (Timed a)
forall si a. ServerStore si a -> Map si (Timed a)
serverStoreItems
    serverSyncProcessorAddItem :: p -> a -> t m (Maybe si)
serverSyncProcessorAddItem p
_ a
a = do
      si
i <- m si -> t m si
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m si
genId
      (ServerStore si a -> ServerStore si a) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(ServerStore Map si (Timed a)
m) -> Map si (Timed a) -> ServerStore si a
forall si a. Map si (Timed a) -> ServerStore si a
ServerStore (si -> Timed a -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
i (a -> ServerTime -> Timed a
forall a. a -> ServerTime -> Timed a
Timed a
a ServerTime
initialServerTime) Map si (Timed a)
m))
      Maybe si -> t m (Maybe si)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (si -> Maybe si
forall a. a -> Maybe a
Just si
i) -- Always succeed
    serverSyncProcessorChangeItem :: si -> ServerTime -> a -> m ()
serverSyncProcessorChangeItem si
si ServerTime
st a
a =
      (ServerStore si a -> ServerStore si a) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
        ( \(ServerStore Map si (Timed a)
m) ->
            let m' :: Map si (Timed a)
m' = (Timed a -> Timed a) -> si -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Timed a -> Timed a -> Timed a
forall a b. a -> b -> a
const (a -> ServerTime -> Timed a
forall a. a -> ServerTime -> Timed a
Timed a
a ServerTime
st)) si
si Map si (Timed a)
m
             in Map si (Timed a) -> ServerStore si a
forall si a. Map si (Timed a) -> ServerStore si a
ServerStore Map si (Timed a)
m'
        )
    serverSyncProcessorDeleteItem :: si -> m ()
serverSyncProcessorDeleteItem si
si =
      (ServerStore si a -> ServerStore si a) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
        ( \(ServerStore Map si (Timed a)
m) ->
            let m' :: Map si (Timed a)
m' = si -> Map si (Timed a) -> Map si (Timed a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete si
si Map si (Timed a)
m
             in Map si (Timed a) -> ServerStore si a
forall si a. Map si (Timed a) -> ServerStore si a
ServerStore Map si (Timed a)
m'
        )

distinct :: Eq a => [a] -> Bool
distinct :: [a] -> Bool
distinct [a]
ls = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
ls [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
ls