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

-- | A way to synchronise items without merge conflicts.
--
-- This concept has a few requirements:
--
-- * Items must be immutable.
-- * Items must allow for a centrally unique identifier monotone identifier.
-- * Items must allow for a client-side unique identifier.
-- * Identifiers for items must be generated in such a way that they are certainly unique.
--
-- Should mutation be a requirement, then there is another library: 'mergeful' for exactly this purpose.
--
--
-- There are a few obvious candidates for identifiers:
--
-- * incremental identifiers
-- * universally unique identifiers (recommended).
--
--
--
-- The typical setup is as follows:
--
-- * A central server is set up to synchronise with
-- * Each client synchronises with the central server, but never with eachother
--
--
-- A central server should operate as follows:
--
-- * The server accepts a 'SyncRequest'.
-- * The server performs operations according to the functionality of 'processServerSync'.
-- * The server respons with a 'SyncResponse'.
--
--
-- A client should operate as follows:
--
-- * The client produces a 'SyncRequest' with 'makeSyncRequest'.
-- * The client sends that request to the central server and gets a 'SyncResponse'.
-- * The client then updates its local store with 'mergeSyncResponse'.
module Data.Appendful.Collection
  ( ClientStore (..),
    SyncRequest (..),
    SyncResponse (..),

    -- * Client-side Synchronisation

    -- ** General
    ClientSyncProcessor (..),
    mergeSyncResponseCustom,

    -- ** Pure
    emptyClientStore,
    ClientId (..),
    storeSize,
    addItemToClientStore,
    emptySyncRequest,
    makeSyncRequest,
    mergeSyncResponse,
    pureClientSyncProcessor,

    -- * Server-side Synchronisation

    -- ** General synchronisation
    ServerSyncProcessor (..),
    processServerSyncCustom,

    -- ** Synchronisation with a simple central store
    ServerStore (..),
    emptyServerStore,
    emptySyncResponse,
    processServerSync,
  )
where

import Control.DeepSeq
import Control.Monad.State.Strict
import Data.Aeson
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Set (Set)
import qualified Data.Set as S
import Data.Validity
import Data.Validity.Containers ()
import Data.Word
import GHC.Generics (Generic)

{-# ANN module ("HLint: ignore Use lambda-case" :: String) #-}

-- | A Client-side identifier for items for use with pure client stores
--
-- These only need to be unique at the client.
newtype ClientId = ClientId
  { ClientId -> Word64
unClientId :: Word64
  }
  deriving (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, 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, (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, [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, 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, 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, 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)

instance Validity ClientId

instance NFData ClientId

-- | A client-side store of items with Client Id's of type @ci@, Server Id's of type @i@ and values of type @a@
data ClientStore ci si a = ClientStore
  { ClientStore ci si a -> Map ci a
clientStoreAdded :: !(Map ci a),
    ClientStore ci si a -> Map si a
clientStoreSynced :: !(Map si a)
  }
  deriving (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, Eq (ClientStore ci si a)
Eq (ClientStore ci si a)
-> (ClientStore ci si a -> ClientStore ci si a -> Ordering)
-> (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)
-> (ClientStore ci si a -> ClientStore ci si a -> Bool)
-> (ClientStore ci si a
    -> ClientStore ci si a -> ClientStore ci si a)
-> (ClientStore ci si a
    -> ClientStore ci si a -> ClientStore ci si a)
-> Ord (ClientStore ci si a)
ClientStore ci si a -> ClientStore ci si a -> Bool
ClientStore ci si a -> ClientStore ci si a -> Ordering
ClientStore ci si a -> ClientStore ci si a -> ClientStore ci si a
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 a. (Ord ci, Ord a, Ord si) => Eq (ClientStore ci si a)
forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> Bool
forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> Ordering
forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> ClientStore ci si a
min :: ClientStore ci si a -> ClientStore ci si a -> ClientStore ci si a
$cmin :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> ClientStore ci si a
max :: ClientStore ci si a -> ClientStore ci si a -> ClientStore ci si a
$cmax :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> ClientStore ci si a
>= :: ClientStore ci si a -> ClientStore ci si a -> Bool
$c>= :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> Bool
> :: ClientStore ci si a -> ClientStore ci si a -> Bool
$c> :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> Bool
<= :: ClientStore ci si a -> ClientStore ci si a -> Bool
$c<= :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> Bool
< :: ClientStore ci si a -> ClientStore ci si a -> Bool
$c< :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> Bool
compare :: ClientStore ci si a -> ClientStore ci si a -> Ordering
$ccompare :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
ClientStore ci si a -> ClientStore ci si a -> Ordering
$cp1Ord :: forall ci si a. (Ord ci, Ord a, Ord si) => Eq (ClientStore ci si a)
Ord, (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)

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

instance (Validity ci, Validity si, Validity a, Show ci, Show si, Ord ci, Ord si) => 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 a
clientStoreSynced :: Map si a
clientStoreAdded :: Map ci a
clientStoreSynced :: forall ci si a. ClientStore ci si a -> Map si a
clientStoreAdded :: 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
"the store items have distinct ids" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$
          [si] -> Bool
forall a. Ord a => [a] -> Bool
distinct ([si] -> Bool) -> [si] -> Bool
forall a b. (a -> b) -> a -> b
$
            Map si a -> [si]
forall k a. Map k a -> [k]
M.keys Map si a
clientStoreSynced
      ]

instance (Ord ci, FromJSON ci, FromJSONKey ci, Ord si, FromJSON si, FromJSONKey si, FromJSON a) => FromJSON (ClientStore ci si a) where
  parseJSON :: Value -> Parser (ClientStore ci si a)
parseJSON =
    String
-> (Object -> Parser (ClientStore ci si a))
-> Value
-> Parser (ClientStore ci si a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ClientStore" ((Object -> Parser (ClientStore ci si a))
 -> Value -> Parser (ClientStore ci si a))
-> (Object -> Parser (ClientStore ci si a))
-> Value
-> Parser (ClientStore ci si a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Map ci a -> Map si a -> ClientStore ci si a
forall ci si a. Map ci a -> Map si a -> ClientStore ci si a
ClientStore (Map ci a -> Map si a -> ClientStore ci si a)
-> Parser (Map ci a) -> Parser (Map si a -> ClientStore ci si a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (Map ci a))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"added" Parser (Maybe (Map ci a)) -> Map ci a -> Parser (Map ci a)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map ci a
forall k a. Map k a
M.empty Parser (Map si a -> ClientStore ci si a)
-> Parser (Map si a) -> Parser (ClientStore ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Map si a))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"synced" Parser (Maybe (Map si a)) -> Map si a -> Parser (Map si a)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map si a
forall k a. Map k a
M.empty

instance (Ord ci, ToJSON ci, ToJSONKey ci, Ord si, ToJSON si, ToJSONKey si, ToJSON a) => ToJSON (ClientStore ci si a) where
  toJSON :: ClientStore ci si a -> Value
toJSON ClientStore {Map ci a
Map si a
clientStoreSynced :: Map si a
clientStoreAdded :: Map ci a
clientStoreSynced :: forall ci si a. ClientStore ci si a -> Map si a
clientStoreAdded :: forall ci si a. ClientStore ci si a -> Map ci a
..} =
    [Pair] -> Value
object
      [Key
"added" Key -> Map ci a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map ci a
clientStoreAdded, Key
"synced" Key -> Map si a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map si a
clientStoreSynced]

-- | The client store with no items.
emptyClientStore :: ClientStore ci si a
emptyClientStore :: ClientStore ci si a
emptyClientStore =
  ClientStore :: forall ci si a. Map ci a -> Map si a -> ClientStore ci si a
ClientStore
    { clientStoreAdded :: Map ci a
clientStoreAdded = Map ci a
forall k a. Map k a
M.empty,
      clientStoreSynced :: Map si a
clientStoreSynced = Map si a
forall k a. Map k a
M.empty
    }

-- | The number of items in a store
--
-- This does not count the deleted items, so that those really look deleted.
storeSize :: ClientStore ci si a -> Int
storeSize :: ClientStore ci si a -> Int
storeSize ClientStore {Map ci a
Map si a
clientStoreSynced :: Map si a
clientStoreAdded :: Map ci a
clientStoreSynced :: forall ci si a. ClientStore ci si a -> Map si a
clientStoreAdded :: forall ci si a. ClientStore ci si a -> Map ci a
..} = Map ci a -> Int
forall k a. Map k a -> Int
M.size Map ci a
clientStoreAdded Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map si a -> Int
forall k a. Map k a -> Int
M.size Map si a
clientStoreSynced

clientStoreIds :: ClientStore ci si a -> Set si
clientStoreIds :: ClientStore ci si a -> Set si
clientStoreIds ClientStore {Map ci a
Map si a
clientStoreSynced :: Map si a
clientStoreAdded :: Map ci a
clientStoreSynced :: forall ci si a. ClientStore ci si a -> Map si a
clientStoreAdded :: forall ci si a. ClientStore ci si a -> Map ci a
..} = Map si a -> Set si
forall k a. Map k a -> Set k
M.keysSet Map si a
clientStoreSynced

-- | Add an item to a client store as an added item.
--
-- This will take care of the uniqueness constraint of the 'ci's in the map.
--
-- The values wrap around when reaching 'maxBound'.
addItemToClientStore :: (Enum ci, Bounded ci, Ord 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
clientStoreAdded 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 {clientStoreAdded :: Map ci a
clientStoreAdded = 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

-- | A synchronisation request for items with Client Id's of type @ci@, Server Id's of type @i@ and values of type @a@
data SyncRequest ci si a = SyncRequest
  { SyncRequest ci si a -> Map ci a
syncRequestAdded :: !(Map ci a),
    SyncRequest ci si a -> Maybe si
syncRequestMaximumSynced :: !(Maybe si)
  }
  deriving (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, Eq (SyncRequest ci si a)
Eq (SyncRequest ci si a)
-> (SyncRequest ci si a -> SyncRequest ci si a -> Ordering)
-> (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)
-> (SyncRequest ci si a -> SyncRequest ci si a -> Bool)
-> (SyncRequest ci si a
    -> SyncRequest ci si a -> SyncRequest ci si a)
-> (SyncRequest ci si a
    -> SyncRequest ci si a -> SyncRequest ci si a)
-> Ord (SyncRequest ci si a)
SyncRequest ci si a -> SyncRequest ci si a -> Bool
SyncRequest ci si a -> SyncRequest ci si a -> Ordering
SyncRequest ci si a -> SyncRequest ci si a -> SyncRequest ci si a
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 a. (Ord ci, Ord a, Ord si) => Eq (SyncRequest ci si a)
forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Bool
forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Ordering
forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> SyncRequest ci si a
min :: SyncRequest ci si a -> SyncRequest ci si a -> SyncRequest ci si a
$cmin :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> SyncRequest ci si a
max :: SyncRequest ci si a -> SyncRequest ci si a -> SyncRequest ci si a
$cmax :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> SyncRequest ci si a
>= :: SyncRequest ci si a -> SyncRequest ci si a -> Bool
$c>= :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Bool
> :: SyncRequest ci si a -> SyncRequest ci si a -> Bool
$c> :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Bool
<= :: SyncRequest ci si a -> SyncRequest ci si a -> Bool
$c<= :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Bool
< :: SyncRequest ci si a -> SyncRequest ci si a -> Bool
$c< :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Bool
compare :: SyncRequest ci si a -> SyncRequest ci si a -> Ordering
$ccompare :: forall ci si a.
(Ord ci, Ord a, Ord si) =>
SyncRequest ci si a -> SyncRequest ci si a -> Ordering
$cp1Ord :: forall ci si a. (Ord ci, Ord a, Ord si) => Eq (SyncRequest ci si a)
Ord, (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)

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

instance (Validity ci, Validity si, Validity a, Ord ci, Ord si, Show ci) => Validity (SyncRequest ci si a)

instance (FromJSON ci, FromJSON si, FromJSON a, FromJSONKey ci, Ord ci, Ord si, Ord a) => FromJSON (SyncRequest ci si a) where
  parseJSON :: Value -> Parser (SyncRequest ci si a)
parseJSON =
    String
-> (Object -> Parser (SyncRequest ci si a))
-> Value
-> Parser (SyncRequest ci si a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SyncRequest" ((Object -> Parser (SyncRequest ci si a))
 -> Value -> Parser (SyncRequest ci si a))
-> (Object -> Parser (SyncRequest ci si a))
-> Value
-> Parser (SyncRequest ci si a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Map ci a -> Maybe si -> SyncRequest ci si a
forall ci si a. Map ci a -> Maybe si -> SyncRequest ci si a
SyncRequest (Map ci a -> Maybe si -> SyncRequest ci si a)
-> Parser (Map ci a) -> Parser (Maybe si -> SyncRequest ci si a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Map ci a)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"added" Parser (Maybe si -> SyncRequest ci si a)
-> Parser (Maybe si) -> Parser (SyncRequest ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe si)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max-synced"

instance (ToJSON ci, ToJSON si, ToJSON a, ToJSONKey ci) => ToJSON (SyncRequest ci si a) where
  toJSON :: SyncRequest ci si a -> Value
toJSON SyncRequest {Maybe si
Map ci a
syncRequestMaximumSynced :: Maybe si
syncRequestAdded :: Map ci a
syncRequestMaximumSynced :: forall ci si a. SyncRequest ci si a -> Maybe si
syncRequestAdded :: forall ci si a. SyncRequest ci si a -> Map ci a
..} =
    [Pair] -> Value
object
      [ Key
"added" Key -> Map ci a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map ci a
syncRequestAdded,
        Key
"max-synced" Key -> Maybe si -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe si
syncRequestMaximumSynced
      ]

emptySyncRequest :: SyncRequest ci si a
emptySyncRequest :: SyncRequest ci si a
emptySyncRequest =
  SyncRequest :: forall ci si a. Map ci a -> Maybe si -> SyncRequest ci si a
SyncRequest
    { syncRequestAdded :: Map ci a
syncRequestAdded = Map ci a
forall k a. Map k a
M.empty,
      syncRequestMaximumSynced :: Maybe si
syncRequestMaximumSynced = Maybe si
forall a. Maybe a
Nothing
    }

-- | Produce a synchronisation request for a client-side store.
--
-- This request can then be sent to a central store 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 a
clientStoreSynced :: Map si a
clientStoreAdded :: Map ci a
clientStoreSynced :: forall ci si a. ClientStore ci si a -> Map si a
clientStoreAdded :: forall ci si a. ClientStore ci si a -> Map ci a
..} =
  SyncRequest :: forall ci si a. Map ci a -> Maybe si -> SyncRequest ci si a
SyncRequest
    { syncRequestAdded :: Map ci a
syncRequestAdded = Map ci a
clientStoreAdded,
      syncRequestMaximumSynced :: Maybe si
syncRequestMaximumSynced = (si, a) -> si
forall a b. (a, b) -> a
fst ((si, a) -> si) -> Maybe (si, a) -> Maybe si
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map si a -> Maybe (si, a)
forall k a. Map k a -> Maybe (k, a)
M.lookupMax Map si a
clientStoreSynced
    }

-- | A synchronisation response for items with identifiers of type @i@ and values of type @a@
data SyncResponse ci si a = SyncResponse
  { SyncResponse ci si a -> Map ci si
syncResponseClientAdded :: !(Map ci si),
    SyncResponse ci si a -> Map si a
syncResponseServerAdded :: !(Map si a)
  }
  deriving (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, Eq (SyncResponse ci si a)
Eq (SyncResponse ci si a)
-> (SyncResponse ci si a -> SyncResponse ci si a -> Ordering)
-> (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)
-> (SyncResponse ci si a -> SyncResponse ci si a -> Bool)
-> (SyncResponse ci si a
    -> SyncResponse ci si a -> SyncResponse ci si a)
-> (SyncResponse ci si a
    -> SyncResponse ci si a -> SyncResponse ci si a)
-> Ord (SyncResponse ci si a)
SyncResponse ci si a -> SyncResponse ci si a -> Bool
SyncResponse ci si a -> SyncResponse ci si a -> Ordering
SyncResponse ci si a
-> SyncResponse ci si a -> SyncResponse ci si a
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 a.
(Ord ci, Ord si, Ord a) =>
Eq (SyncResponse ci si a)
forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Bool
forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Ordering
forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a
-> SyncResponse ci si a -> SyncResponse ci si a
min :: SyncResponse ci si a
-> SyncResponse ci si a -> SyncResponse ci si a
$cmin :: forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a
-> SyncResponse ci si a -> SyncResponse ci si a
max :: SyncResponse ci si a
-> SyncResponse ci si a -> SyncResponse ci si a
$cmax :: forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a
-> SyncResponse ci si a -> SyncResponse ci si a
>= :: SyncResponse ci si a -> SyncResponse ci si a -> Bool
$c>= :: forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Bool
> :: SyncResponse ci si a -> SyncResponse ci si a -> Bool
$c> :: forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Bool
<= :: SyncResponse ci si a -> SyncResponse ci si a -> Bool
$c<= :: forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Bool
< :: SyncResponse ci si a -> SyncResponse ci si a -> Bool
$c< :: forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Bool
compare :: SyncResponse ci si a -> SyncResponse ci si a -> Ordering
$ccompare :: forall ci si a.
(Ord ci, Ord si, Ord a) =>
SyncResponse ci si a -> SyncResponse ci si a -> Ordering
$cp1Ord :: forall ci si a.
(Ord ci, Ord si, Ord a) =>
Eq (SyncResponse ci si a)
Ord, (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)

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

instance (Validity ci, Validity si, Validity a, Show ci, Show si, Ord ci, Ord si) => Validity (SyncResponse ci si a) where
  validate :: SyncResponse ci si a -> Validation
validate sr :: SyncResponse ci si a
sr@SyncResponse {Map ci si
Map si a
syncResponseServerAdded :: Map si a
syncResponseClientAdded :: Map ci si
syncResponseServerAdded :: forall ci si a. SyncResponse ci si a -> Map si a
syncResponseClientAdded :: forall ci si a. SyncResponse ci si a -> Map ci 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
"the sync response items have distinct uuids" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$
          [si] -> Bool
forall a. Ord 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 ci si -> [si]
forall k a. Map k a -> [a]
M.elems Map ci si
syncResponseClientAdded,
                Map si a -> [si]
forall k a. Map k a -> [k]
M.keys Map si a
syncResponseServerAdded
              ]
      ]

instance (Ord ci, Ord si, FromJSON ci, FromJSON si, FromJSONKey ci, FromJSONKey si, Ord a, FromJSON a) => FromJSON (SyncResponse ci si a) where
  parseJSON :: Value -> Parser (SyncResponse ci si a)
parseJSON =
    String
-> (Object -> Parser (SyncResponse ci si a))
-> Value
-> Parser (SyncResponse ci si a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SyncResponse" ((Object -> Parser (SyncResponse ci si a))
 -> Value -> Parser (SyncResponse ci si a))
-> (Object -> Parser (SyncResponse ci si a))
-> Value
-> Parser (SyncResponse ci si a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Map ci si -> Map si a -> SyncResponse ci si a
forall ci si a. Map ci si -> Map si a -> SyncResponse ci si a
SyncResponse (Map ci si -> Map si a -> SyncResponse ci si a)
-> Parser (Map ci si) -> Parser (Map si a -> SyncResponse ci si a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Map ci si)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"client-added" Parser (Map si a -> SyncResponse ci si a)
-> Parser (Map si a) -> Parser (SyncResponse ci si a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Map si a)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server-added"

instance (ToJSON ci, ToJSON si, ToJSONKey ci, ToJSONKey si, ToJSON a) => ToJSON (SyncResponse ci si a) where
  toJSON :: SyncResponse ci si a -> Value
toJSON SyncResponse {Map ci si
Map si a
syncResponseServerAdded :: Map si a
syncResponseClientAdded :: Map ci si
syncResponseServerAdded :: forall ci si a. SyncResponse ci si a -> Map si a
syncResponseClientAdded :: forall ci si a. SyncResponse ci si a -> Map ci si
..} =
    [Pair] -> Value
object
      [ Key
"client-added" Key -> Map ci si -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map ci si
syncResponseClientAdded,
        Key
"server-added" Key -> Map si a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map si a
syncResponseServerAdded
      ]

emptySyncResponse :: SyncResponse ci si a
emptySyncResponse :: SyncResponse ci si a
emptySyncResponse =
  SyncResponse :: forall ci si a. Map ci si -> Map si a -> SyncResponse ci si a
SyncResponse
    { syncResponseClientAdded :: Map ci si
syncResponseClientAdded = Map ci si
forall k a. Map k a
M.empty,
      syncResponseServerAdded :: Map si a
syncResponseServerAdded = Map si a
forall k a. Map k a
M.empty
    }

-- | Merge a synchronisation response back into a client-side store.
mergeSyncResponse ::
  forall ci si a.
  (Ord ci, Ord si) =>
  ClientStore ci si a ->
  SyncResponse ci si a ->
  ClientStore ci si a
mergeSyncResponse :: ClientStore ci si a -> SyncResponse ci si a -> ClientStore ci si a
mergeSyncResponse ClientStore ci si a
s 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
s (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
$
    ClientSyncProcessor ci si a (State (ClientStore ci si a))
-> SyncResponse ci si a -> State (ClientStore ci si a) ()
forall (m :: * -> *) ci si a.
Monad m =>
ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
mergeSyncResponseCustom
      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 :: * -> *).
(Map ci si -> m ())
-> (Map si a -> m ()) -> ClientSyncProcessor ci si a m
ClientSyncProcessor
    { clientSyncProcessorSyncServerAdded :: Map si a -> State (ClientStore ci si a) ()
clientSyncProcessorSyncServerAdded = \Map si 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 -> ClientStore ci si a)
 -> State (ClientStore ci si a) ())
-> (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall a b. (a -> b) -> a -> b
$ \ClientStore ci si a
cs ->
        ClientStore ci si a
cs {clientStoreSynced :: Map si a
clientStoreSynced = Map si a -> Map si a -> Map si a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (ClientStore ci si a -> Map si a
forall ci si a. ClientStore ci si a -> Map si a
clientStoreSynced ClientStore ci si a
cs) (Map si a
m Map si a -> Set si -> Map si a
forall si a. Ord si => Map si a -> Set si -> Map si a
`diffSet` ClientStore ci si a -> Set si
forall ci si a. ClientStore ci si a -> Set si
clientStoreIds ClientStore ci si a
cs)},
      clientSyncProcessorSyncClientAdded :: Map ci si -> State (ClientStore ci si a) ()
clientSyncProcessorSyncClientAdded = \Map ci si
addedItems -> (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 -> ClientStore ci si a)
 -> State (ClientStore ci si a) ())
-> (ClientStore ci si a -> ClientStore ci si a)
-> State (ClientStore ci si a) ()
forall a b. (a -> b) -> a -> b
$ \ClientStore ci si a
cs ->
        let oldAdded :: Map ci a
oldAdded = ClientStore ci si a -> Map ci a
forall ci si a. ClientStore ci si a -> Map ci a
clientStoreAdded ClientStore ci si a
cs
            oldSynced :: Map si a
oldSynced = ClientStore ci si a -> Map si a
forall ci si a. ClientStore ci si a -> Map si a
clientStoreSynced ClientStore ci si a
cs
            go :: (Map ci a, Map si a) -> ci -> si -> (Map ci a, Map si a)
            go :: (Map ci a, Map si a) -> ci -> si -> (Map ci a, Map si a)
go (Map ci a
added, Map si a
synced) ci
cid si
i =
              case ci -> Map ci a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ci
cid Map ci a
added of
                Maybe a
Nothing -> (Map ci a
added, Map si a
synced)
                Just a
a -> (ci -> Map ci a -> Map ci a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ci
cid Map ci a
added, si -> a -> Map si a -> Map si a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
i a
a Map si a
synced)
            (Map ci a
newAdded, Map si a
newSynced) = ((Map ci a, Map si a) -> ci -> si -> (Map ci a, Map si a))
-> (Map ci a, Map si a) -> Map ci si -> (Map ci a, Map si a)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (Map ci a, Map si a) -> ci -> si -> (Map ci a, Map si a)
go (Map ci a
oldAdded, Map si a
oldSynced) Map ci si
addedItems
         in ClientStore ci si a
cs {clientStoreAdded :: Map ci a
clientStoreAdded = Map ci a
newAdded, clientStoreSynced :: Map si a
clientStoreSynced = Map si a
newSynced}
    }

data ClientSyncProcessor ci si a m = ClientSyncProcessor
  { ClientSyncProcessor ci si a m -> Map ci si -> m ()
clientSyncProcessorSyncClientAdded :: Map ci si -> m (),
    ClientSyncProcessor ci si a m -> Map si a -> m ()
clientSyncProcessorSyncServerAdded :: Map si a -> 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 :: Monad m => ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
mergeSyncResponseCustom :: ClientSyncProcessor ci si a m -> SyncResponse ci si a -> m ()
mergeSyncResponseCustom ClientSyncProcessor {Map ci si -> m ()
Map si a -> m ()
clientSyncProcessorSyncServerAdded :: Map si a -> m ()
clientSyncProcessorSyncClientAdded :: Map ci si -> m ()
clientSyncProcessorSyncClientAdded :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map ci si -> m ()
clientSyncProcessorSyncServerAdded :: forall ci si a (m :: * -> *).
ClientSyncProcessor ci si a m -> Map si a -> m ()
..} SyncResponse {Map ci si
Map si a
syncResponseServerAdded :: Map si a
syncResponseClientAdded :: Map ci si
syncResponseServerAdded :: forall ci si a. SyncResponse ci si a -> Map si a
syncResponseClientAdded :: forall ci si a. SyncResponse ci si a -> Map ci si
..} = do
  -- The order here matters!
  Map si a -> m ()
clientSyncProcessorSyncServerAdded Map si a
syncResponseServerAdded
  Map ci si -> m ()
clientSyncProcessorSyncClientAdded Map ci si
syncResponseClientAdded

-- | A record of the basic operations that are necessary to build a synchronisation processor.
data ServerSyncProcessor ci si a m = ServerSyncProcessor
  { ServerSyncProcessor ci si a m -> m (Map si a)
serverSyncProcessorRead :: m (Map si a),
    ServerSyncProcessor ci si a m -> Map ci a -> m (Map ci si)
serverSyncProcessorAddItems :: Map ci a -> m (Map ci si)
  }
  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)

processServerSyncCustom ::
  forall ci si a m.
  (Ord si, Monad m) =>
  ServerSyncProcessor ci si a m ->
  SyncRequest ci si a ->
  m (SyncResponse ci si a)
processServerSyncCustom :: ServerSyncProcessor ci si a m
-> SyncRequest ci si a -> m (SyncResponse ci si a)
processServerSyncCustom ServerSyncProcessor {m (Map si a)
Map ci a -> m (Map ci si)
serverSyncProcessorAddItems :: Map ci a -> m (Map ci si)
serverSyncProcessorRead :: m (Map si a)
serverSyncProcessorAddItems :: forall ci si a (m :: * -> *).
ServerSyncProcessor ci si a m -> Map ci a -> m (Map ci si)
serverSyncProcessorRead :: forall ci si a (m :: * -> *).
ServerSyncProcessor ci si a m -> m (Map si a)
..} SyncRequest {Maybe si
Map ci a
syncRequestMaximumSynced :: Maybe si
syncRequestAdded :: Map ci a
syncRequestMaximumSynced :: forall ci si a. SyncRequest ci si a -> Maybe si
syncRequestAdded :: forall ci si a. SyncRequest ci si a -> Map ci a
..} = do
  Map si a
serverItems <- m (Map si a)
serverSyncProcessorRead
  let syncResponseServerAdded :: Map si a
syncResponseServerAdded = (Map si a -> Map si a)
-> (si -> Map si a -> Map si a) -> Maybe si -> Map si a -> Map si a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map si a -> Map si a
forall a. a -> a
id (\si
ms -> (si -> Bool) -> Map si a -> Map si a
forall k a. (k -> Bool) -> Map k a -> Map k a
M.dropWhileAntitone (si -> si -> Bool
forall a. Ord a => a -> a -> Bool
<= si
ms)) Maybe si
syncRequestMaximumSynced Map si a
serverItems
  Map ci si
syncResponseClientAdded <- Map ci a -> m (Map ci si)
serverSyncProcessorAddItems Map ci a
syncRequestAdded
  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 si -> Map si a -> SyncResponse ci si a
SyncResponse {Map ci si
Map si a
syncResponseClientAdded :: Map ci si
syncResponseServerAdded :: Map si a
syncResponseServerAdded :: Map si a
syncResponseClientAdded :: Map ci si
..}

-- | A central store of items with identifiers of type @i@ and values of type @a@
newtype ServerStore si a = ServerStore
  { ServerStore si a -> Map si a
serverStoreItems :: Map si a
  }
  deriving (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, Eq (ServerStore si a)
Eq (ServerStore si a)
-> (ServerStore si a -> ServerStore si a -> Ordering)
-> (ServerStore si a -> ServerStore si a -> Bool)
-> (ServerStore si a -> ServerStore si a -> Bool)
-> (ServerStore si a -> ServerStore si a -> Bool)
-> (ServerStore si a -> ServerStore si a -> Bool)
-> (ServerStore si a -> ServerStore si a -> ServerStore si a)
-> (ServerStore si a -> ServerStore si a -> ServerStore si a)
-> Ord (ServerStore si a)
ServerStore si a -> ServerStore si a -> Bool
ServerStore si a -> ServerStore si a -> Ordering
ServerStore si a -> ServerStore si a -> ServerStore si a
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 si a. (Ord si, Ord a) => Eq (ServerStore si a)
forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> Bool
forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> Ordering
forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> ServerStore si a
min :: ServerStore si a -> ServerStore si a -> ServerStore si a
$cmin :: forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> ServerStore si a
max :: ServerStore si a -> ServerStore si a -> ServerStore si a
$cmax :: forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> ServerStore si a
>= :: ServerStore si a -> ServerStore si a -> Bool
$c>= :: forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> Bool
> :: ServerStore si a -> ServerStore si a -> Bool
$c> :: forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> Bool
<= :: ServerStore si a -> ServerStore si a -> Bool
$c<= :: forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> Bool
< :: ServerStore si a -> ServerStore si a -> Bool
$c< :: forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> Bool
compare :: ServerStore si a -> ServerStore si a -> Ordering
$ccompare :: forall si a.
(Ord si, Ord a) =>
ServerStore si a -> ServerStore si a -> Ordering
$cp1Ord :: forall si a. (Ord si, Ord a) => Eq (ServerStore si a)
Ord, (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, 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.
(FromJSONKey si, Ord si, FromJSON a) =>
Value -> Parser [ServerStore si a]
forall si a.
(FromJSONKey si, Ord si, FromJSON a) =>
Value -> Parser (ServerStore si a)
parseJSONList :: Value -> Parser [ServerStore si a]
$cparseJSONList :: forall si a.
(FromJSONKey si, Ord si, FromJSON a) =>
Value -> Parser [ServerStore si a]
parseJSON :: Value -> Parser (ServerStore si a)
$cparseJSON :: forall si a.
(FromJSONKey si, Ord si, FromJSON 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.
(ToJSON a, ToJSONKey si) =>
[ServerStore si a] -> Encoding
forall si a.
(ToJSON a, ToJSONKey si) =>
[ServerStore si a] -> Value
forall si a.
(ToJSON a, ToJSONKey si) =>
ServerStore si a -> Encoding
forall si a. (ToJSON a, ToJSONKey si) => ServerStore si a -> Value
toEncodingList :: [ServerStore si a] -> Encoding
$ctoEncodingList :: forall si a.
(ToJSON a, ToJSONKey si) =>
[ServerStore si a] -> Encoding
toJSONList :: [ServerStore si a] -> Value
$ctoJSONList :: forall si a.
(ToJSON a, ToJSONKey si) =>
[ServerStore si a] -> Value
toEncoding :: ServerStore si a -> Encoding
$ctoEncoding :: forall si a.
(ToJSON a, ToJSONKey si) =>
ServerStore si a -> Encoding
toJSON :: ServerStore si a -> Value
$ctoJSON :: forall si a. (ToJSON a, ToJSONKey si) => ServerStore si a -> Value
ToJSON)

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

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

-- | An empty central store to start with
emptyServerStore :: ServerStore si a
emptyServerStore :: ServerStore si a
emptyServerStore = ServerStore :: forall si a. Map si a -> ServerStore si a
ServerStore {serverStoreItems :: Map si a
serverStoreItems = Map si a
forall k a. Map k a
M.empty}

-- | Process a server-side synchronisation request using a server id generator
--
-- see 'processSyncCustom'
processServerSync ::
  forall m ci si a.
  (Ord si, Monad m) =>
  m si ->
  ServerStore si a ->
  SyncRequest ci si a ->
  m (SyncResponse ci si a, ServerStore si a)
processServerSync :: m si
-> ServerStore si a
-> SyncRequest ci si a
-> m (SyncResponse ci si a, ServerStore si a)
processServerSync m si
genUuid ServerStore si a
cs 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))
-> ServerStore si a
-> StateT (ServerStore si a) m (SyncResponse ci si a)
-> m (SyncResponse ci si a, ServerStore si a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 ServerStore si a
cs (StateT (ServerStore si a) m (SyncResponse ci si a)
 -> m (SyncResponse ci si a, ServerStore si a))
-> StateT (ServerStore si a) m (SyncResponse ci si a)
-> m (SyncResponse ci si a, ServerStore si a)
forall a b. (a -> b) -> a -> b
$
    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
      ServerSyncProcessor :: forall ci si a (m :: * -> *).
m (Map si a)
-> (Map ci a -> m (Map ci si)) -> ServerSyncProcessor ci si a m
ServerSyncProcessor
        { serverSyncProcessorRead :: StateT (ServerStore si a) m (Map si a)
serverSyncProcessorRead = (ServerStore si a -> Map si a)
-> StateT (ServerStore si a) m (Map si a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ServerStore si a -> Map si a
forall si a. ServerStore si a -> Map si a
serverStoreItems,
          serverSyncProcessorAddItems :: Map ci a -> StateT (ServerStore si a) m (Map ci si)
serverSyncProcessorAddItems = Map ci a -> StateT (ServerStore si a) m (Map ci si)
insertMany
        }
      SyncRequest ci si a
sr
  where
    insertMany :: Map ci a -> StateT (ServerStore si a) m (Map ci si)
    insertMany :: Map ci a -> StateT (ServerStore si a) m (Map ci si)
insertMany =
      (a -> StateT (ServerStore si a) m si)
-> Map ci a -> StateT (ServerStore si a) m (Map ci si)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> StateT (ServerStore si a) m si)
 -> Map ci a -> StateT (ServerStore si a) m (Map ci si))
-> (a -> StateT (ServerStore si a) m si)
-> Map ci a
-> StateT (ServerStore si a) m (Map ci si)
forall a b. (a -> b) -> a -> b
$ \a
a -> do
        si
u <- m si -> StateT (ServerStore si a) m si
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m si
genUuid
        si -> a -> StateT (ServerStore si a) m ()
ins si
u a
a
        si -> StateT (ServerStore si a) m si
forall (f :: * -> *) a. Applicative f => a -> f a
pure si
u
    ins :: si -> a -> StateT (ServerStore si a) m ()
    ins :: si -> a -> StateT (ServerStore si a) m ()
ins si
i a
val = (Map si a -> Map si a) -> StateT (ServerStore si a) m ()
modC ((Map si a -> Map si a) -> StateT (ServerStore si a) m ())
-> (Map si a -> Map si a) -> StateT (ServerStore si a) m ()
forall a b. (a -> b) -> a -> b
$ si -> a -> Map si a -> Map si a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert si
i a
val
    modC :: (Map si a -> Map si a) -> StateT (ServerStore si a) m ()
    modC :: (Map si a -> Map si a) -> StateT (ServerStore si a) m ()
modC Map si a -> Map si a
func = (ServerStore si a -> ServerStore si a)
-> StateT (ServerStore si a) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(ServerStore Map si a
m) -> Map si a -> ServerStore si a
forall si a. Map si a -> ServerStore si a
ServerStore (Map si a -> ServerStore si a) -> Map si a -> ServerStore si a
forall a b. (a -> b) -> a -> b
$ Map si a -> Map si a
func Map si a
m)

diffSet :: Ord si => Map si a -> Set si -> Map si a
diffSet :: Map si a -> Set si -> Map si a
diffSet Map si a
m Set si
s = Map si a
m Map si a -> Map si () -> Map si a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Set si -> Map si ()
forall si. Set si -> Map si ()
toMap Set si
s

toMap :: Set si -> Map si ()
toMap :: Set si -> Map si ()
toMap = (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 ())

distinct :: Ord a => [a] -> Bool
distinct :: [a] -> Bool
distinct [a]
ls = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
ls [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> [a]
forall a. Set a -> [a]
S.toAscList ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
ls)