{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- Because newer versions of persistent do not required a
-- ToBackendKey SlBackend constraint in some places.
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Data.Mergeful.Persistent
  ( -- * Client side
    clientMakeSyncRequestQuery,
    clientMergeSyncResponseQuery,

    -- ** Raw processors
    clientSyncProcessor,

    -- ** Merging
    ItemMergeStrategy (..),
    mergeFromServerStrategy,
    mergeFromClientStrategy,
    mergeUsingCRDTStrategy,

    -- * Server side
    serverProcessSyncQuery,
    serverProcessSyncWithCustomIdQuery,

    -- ** Raw processors
    serverSyncProcessor,
    serverSyncWithCustomIdProcessor,

    -- * Utils

    -- ** Client side
    setupClientQuery,
    clientGetStoreQuery,

    -- ** Server side
    setupServerQuery,
    serverGetStoreQuery,
  )
where

import Control.Monad
import Control.Monad.IO.Class
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Mergeful
import Data.Set (Set)
import qualified Data.Set as S
import Database.Persist
import Database.Persist.Sql

deriving instance PersistField ServerTime

deriving instance PersistFieldSql ServerTime

-- | Make a sync request
clientMakeSyncRequestQuery ::
  forall record sid a m.
  ( Ord sid,
    PersistEntity record,
    PersistField sid,
    PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    MonadIO m
  ) =>
  -- | The server id field
  EntityField record (Maybe sid) ->
  -- | The server time field
  EntityField record (Maybe ServerTime) ->
  -- | The changed flag
  EntityField record Bool ->
  -- | The deleted flag
  EntityField record Bool ->
  -- | How to read an unsynced client item
  (record -> a) ->
  -- | How to read a synced client item that's been changed
  (record -> (sid, Timed a)) ->
  -- | How to read a synced or deleted client item
  (record -> (sid, ServerTime)) ->
  SqlPersistT m (SyncRequest (Key record) sid a)
clientMakeSyncRequestQuery :: forall record sid a (m :: * -> *).
(Ord sid, PersistEntity record, PersistField sid,
 PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, MonadIO m) =>
EntityField record (Maybe sid)
-> EntityField record (Maybe ServerTime)
-> EntityField record Bool
-> EntityField record Bool
-> (record -> a)
-> (record -> (sid, Timed a))
-> (record -> (sid, ServerTime))
-> SqlPersistT m (SyncRequest (Key record) sid a)
clientMakeSyncRequestQuery
  EntityField record (Maybe sid)
serverIdField
  EntityField record (Maybe ServerTime)
serverTimeField
  EntityField record Bool
changedField
  EntityField record Bool
deletedField
  record -> a
unmakeUnsyncedClientThing
  record -> (sid, Timed a)
unmakeSyncedClientThing
  record -> (sid, ServerTime)
unmakeDeletedClientThing = do
    Map (Key record) a
syncRequestNewItems <-
      forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Entity Key record
cid record
r) -> (Key record
cid, record -> a
unmakeUnsyncedClientThing record
r))
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
          [ EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. Maybe a
Nothing,
            EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. Maybe a
Nothing
          ]
          []
    Map sid ServerTime
syncRequestKnownItems <-
      forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (record -> (sid, ServerTime)
unmakeDeletedClientThing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
          [ EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
            EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
            EntityField record Bool
changedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
False,
            EntityField record Bool
deletedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
False
          ]
          []
    Map sid (Timed a)
syncRequestKnownButChangedItems <-
      forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (record -> (sid, Timed a)
unmakeSyncedClientThing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
          [ EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
            EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
            EntityField record Bool
changedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
True,
            EntityField record Bool
deletedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
False
          ]
          []
    Map sid ServerTime
syncRequestDeletedItems <-
      forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (record -> (sid, ServerTime)
unmakeDeletedClientThing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
          [ EntityField record Bool
deletedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
True
          ]
          []
    forall (f :: * -> *) a. Applicative f => a -> f a
pure SyncRequest {Map sid ServerTime
Map sid (Timed a)
Map (Key record) a
syncRequestNewItems :: Map (Key record) a
syncRequestKnownItems :: Map sid ServerTime
syncRequestKnownButChangedItems :: Map sid (Timed a)
syncRequestDeletedItems :: Map sid ServerTime
syncRequestDeletedItems :: Map sid ServerTime
syncRequestKnownButChangedItems :: Map sid (Timed a)
syncRequestKnownItems :: Map sid ServerTime
syncRequestNewItems :: Map (Key record) a
..}

-- Merge a sync response
clientMergeSyncResponseQuery ::
  forall record sid a m.
  ( Ord sid,
    PersistField sid,
    PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    SafeToInsert record,
    MonadIO m
  ) =>
  -- | The server id field
  EntityField record (Maybe sid) ->
  -- | The server time field
  EntityField record (Maybe ServerTime) ->
  -- | The changed flag
  EntityField record Bool ->
  -- | The deleted flag
  EntityField record Bool ->
  -- | How to build a synced record from a server id and a timed item
  (sid -> Timed a -> record) ->
  -- | How to read a synced record back into a server id and a timed item
  (record -> (sid, Timed a)) ->
  -- | How to update a row with new data
  --
  -- You only need to perform the updates that have anything to do with the data to sync.
  -- The housekeeping updates are already taken care of.
  (a -> [Update record]) ->
  -- | The merge strategy.
  ItemMergeStrategy a ->
  -- | The sync response to merge
  SyncResponse (Key record) sid a ->
  SqlPersistT m ()
clientMergeSyncResponseQuery :: forall record sid a (m :: * -> *).
(Ord sid, PersistField sid,
 PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record (Maybe sid)
-> EntityField record (Maybe ServerTime)
-> EntityField record Bool
-> EntityField record Bool
-> (sid -> Timed a -> record)
-> (record -> (sid, Timed a))
-> (a -> [Update record])
-> ItemMergeStrategy a
-> SyncResponse (Key record) sid a
-> SqlPersistT m ()
clientMergeSyncResponseQuery
  EntityField record (Maybe sid)
serverIdField
  EntityField record (Maybe ServerTime)
serverTimeField
  EntityField record Bool
changedField
  EntityField record Bool
deletedField
  sid -> Timed a -> record
makeSyncedClientThing
  record -> (sid, Timed a)
unmakeSyncedClientThing
  a -> [Update record]
recordUpdates
  ItemMergeStrategy a
strat =
    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 forall a b. (a -> b) -> a -> b
$
      forall record sid a (m :: * -> *).
(Ord sid, PersistField sid,
 PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record (Maybe sid)
-> EntityField record (Maybe ServerTime)
-> EntityField record Bool
-> EntityField record Bool
-> (sid -> Timed a -> record)
-> (record -> (sid, Timed a))
-> (a -> [Update record])
-> ClientSyncProcessor (Key record) sid a (SqlPersistT m)
clientSyncProcessor
        EntityField record (Maybe sid)
serverIdField
        EntityField record (Maybe ServerTime)
serverTimeField
        EntityField record Bool
changedField
        EntityField record Bool
deletedField
        sid -> Timed a -> record
makeSyncedClientThing
        record -> (sid, Timed a)
unmakeSyncedClientThing
        a -> [Update record]
recordUpdates

clientSyncProcessor ::
  forall record sid a m.
  ( Ord sid,
    PersistField sid,
    PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    SafeToInsert record,
    MonadIO m
  ) =>
  -- | The server id field
  EntityField record (Maybe sid) ->
  -- | The server time field
  EntityField record (Maybe ServerTime) ->
  -- | The changed flag
  EntityField record Bool ->
  -- | The deleted flag
  EntityField record Bool ->
  -- | How to build a synced record from a server id and a timed item
  (sid -> Timed a -> record) ->
  -- | How to read a synced record back into a server id and a timed item
  (record -> (sid, Timed a)) ->
  -- | How to update a row with new data
  --
  -- You only need to perform the updates that have anything to do with the data to sync.
  -- The housekeeping updates are already taken care of.
  (a -> [Update record]) ->
  ClientSyncProcessor (Key record) sid a (SqlPersistT m)
clientSyncProcessor :: forall record sid a (m :: * -> *).
(Ord sid, PersistField sid,
 PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record (Maybe sid)
-> EntityField record (Maybe ServerTime)
-> EntityField record Bool
-> EntityField record Bool
-> (sid -> Timed a -> record)
-> (record -> (sid, Timed a))
-> (a -> [Update record])
-> ClientSyncProcessor (Key record) sid a (SqlPersistT m)
clientSyncProcessor
  EntityField record (Maybe sid)
serverIdField
  EntityField record (Maybe ServerTime)
serverTimeField
  EntityField record Bool
changedField
  EntityField record Bool
deletedField
  sid -> Timed a -> record
makeSyncedClientThing
  record -> (sid, Timed a)
unmakeSyncedClientThing
  a -> [Update record]
recordUpdates = ClientSyncProcessor {Map sid ServerTime -> SqlPersistT m ()
Map sid (Timed a) -> SqlPersistT m ()
Map (Key record) (ClientAddition sid) -> SqlPersistT m ()
Set sid -> SqlPersistT m ()
Set sid -> SqlPersistT m (Map sid (Timed a))
forall si. Set si -> SqlPersistT m ()
clientSyncProcessorQuerySyncedButChangedValues :: Set sid -> SqlPersistT m (Map sid (Timed a))
clientSyncProcessorSyncClientAdded :: Map (Key record) (ClientAddition sid) -> SqlPersistT m ()
clientSyncProcessorSyncClientChanged :: Map sid ServerTime -> SqlPersistT m ()
clientSyncProcessorSyncClientDeleted :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncClientDeletedConflictStayDeleted :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncServerDeletedConflictDelete :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictKeepLocal :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictMerged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictTakeRemote :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerAdded :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerChanged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerDeleted :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncServerDeleted :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncServerChanged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerAdded :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerDeletedConflictDelete :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: forall si. Set si -> SqlPersistT m ()
clientSyncProcessorSyncClientDeletedConflictStayDeleted :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictTakeRemote :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictMerged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictKeepLocal :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncClientDeleted :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncClientChanged :: Map sid ServerTime -> SqlPersistT m ()
clientSyncProcessorSyncClientAdded :: Map (Key record) (ClientAddition sid) -> SqlPersistT m ()
clientSyncProcessorQuerySyncedButChangedValues :: Set sid -> SqlPersistT m (Map sid (Timed a))
..}
    where
      clientSyncProcessorQuerySyncedButChangedValues :: Set sid -> SqlPersistT m (Map sid (Timed a))
      clientSyncProcessorQuerySyncedButChangedValues :: Set sid -> SqlPersistT m (Map sid (Timed a))
clientSyncProcessorQuerySyncedButChangedValues Set sid
si = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Entity Key record
_ record
r) -> record -> (sid, Timed a)
unmakeSyncedClientThing record
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes) forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Set a -> [a]
S.toList Set sid
si) forall a b. (a -> b) -> a -> b
$ \sid
sid ->
          forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst
            [ EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. a -> Maybe a
Just sid
sid,
              EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
              EntityField record Bool
changedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
True,
              EntityField record Bool
deletedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
False
            ]
            []
      clientSyncProcessorSyncClientAdded :: Map (Key record) (ClientAddition sid) -> SqlPersistT m ()
      clientSyncProcessorSyncClientAdded :: Map (Key record) (ClientAddition sid) -> SqlPersistT m ()
clientSyncProcessorSyncClientAdded Map (Key record) (ClientAddition sid)
m = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map (Key record) (ClientAddition sid)
m) forall a b. (a -> b) -> a -> b
$ \(Key record
cid, ClientAddition {sid
ServerTime
clientAdditionId :: forall i. ClientAddition i -> i
clientAdditionServerTime :: forall i. ClientAddition i -> ServerTime
clientAdditionServerTime :: ServerTime
clientAdditionId :: sid
..}) ->
        forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update
          Key record
cid
          [ EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. forall a. a -> Maybe a
Just sid
clientAdditionId,
            EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. forall a. a -> Maybe a
Just ServerTime
clientAdditionServerTime
          ]
      clientSyncProcessorSyncClientChanged :: Map sid ServerTime -> SqlPersistT m ()
      clientSyncProcessorSyncClientChanged :: Map sid ServerTime -> SqlPersistT m ()
clientSyncProcessorSyncClientChanged Map sid ServerTime
m = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map sid ServerTime
m) forall a b. (a -> b) -> a -> b
$ \(sid
sid, ServerTime
st) ->
        forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere
          [EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. a -> Maybe a
Just sid
sid]
          [ EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. forall a. a -> Maybe a
Just ServerTime
st,
            EntityField record Bool
changedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Bool
False
          ]
      clientSyncProcessorSyncClientDeleted :: Set sid -> SqlPersistT m ()
      clientSyncProcessorSyncClientDeleted :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncClientDeleted Set sid
s = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Set a -> [a]
S.toList Set sid
s) forall a b. (a -> b) -> a -> b
$ \sid
sid ->
        forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. a -> Maybe a
Just sid
sid]
      clientSyncProcessorSyncChangeConflictKeepLocal :: Map sid (Timed a) -> SqlPersistT m ()
      clientSyncProcessorSyncChangeConflictKeepLocal :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictKeepLocal Map sid (Timed a)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      clientSyncProcessorSyncChangeConflictMerged :: Map sid (Timed a) -> SqlPersistT m ()
      clientSyncProcessorSyncChangeConflictMerged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictMerged Map sid (Timed a)
m = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map sid (Timed a)
m) forall a b. (a -> b) -> a -> b
$ \(sid
sid, Timed a
a ServerTime
st) ->
        forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere
          [EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. a -> Maybe a
Just sid
sid]
          forall a b. (a -> b) -> a -> b
$ [ EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. forall a. a -> Maybe a
Just ServerTime
st,
              EntityField record Bool
changedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Bool
True
            ]
            forall a. [a] -> [a] -> [a]
++ a -> [Update record]
recordUpdates a
a
      clientSyncProcessorSyncChangeConflictTakeRemote :: Map sid (Timed a) -> SqlPersistT m ()
      clientSyncProcessorSyncChangeConflictTakeRemote :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncChangeConflictTakeRemote = Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerChanged
      clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: Map sid (Timed a) -> SqlPersistT m ()
      clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncClientDeletedConflictTakeRemoteChanged = Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerAdded
      clientSyncProcessorSyncClientDeletedConflictStayDeleted :: Map sid (Timed a) -> SqlPersistT m ()
      clientSyncProcessorSyncClientDeletedConflictStayDeleted :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncClientDeletedConflictStayDeleted Map sid (Timed a)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: Set si -> SqlPersistT m ()
      clientSyncProcessorSyncServerDeletedConflictKeepLocalChange :: forall si. Set si -> SqlPersistT m ()
clientSyncProcessorSyncServerDeletedConflictKeepLocalChange Set si
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      clientSyncProcessorSyncServerDeletedConflictDelete :: Set sid -> SqlPersistT m ()
      clientSyncProcessorSyncServerDeletedConflictDelete :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncServerDeletedConflictDelete = Set sid -> SqlPersistT m ()
clientSyncProcessorSyncServerDeleted
      clientSyncProcessorSyncServerAdded :: Map sid (Timed a) -> SqlPersistT m ()
      clientSyncProcessorSyncServerAdded :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerAdded Map sid (Timed a)
m =
        forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
[record] -> ReaderT backend m ()
insertMany_ forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry sid -> Timed a -> record
makeSyncedClientThing) (forall k a. Map k a -> [(k, a)]
M.toList Map sid (Timed a)
m)
      clientSyncProcessorSyncServerChanged :: Map sid (Timed a) -> SqlPersistT m ()
      clientSyncProcessorSyncServerChanged :: Map sid (Timed a) -> SqlPersistT m ()
clientSyncProcessorSyncServerChanged Map sid (Timed a)
m = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map sid (Timed a)
m) forall a b. (a -> b) -> a -> b
$ \(sid
sid, Timed a
a ServerTime
st) -> do
        forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere
          [EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. a -> Maybe a
Just sid
sid]
          forall a b. (a -> b) -> a -> b
$ [ EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. forall a. a -> Maybe a
Just ServerTime
st,
              EntityField record Bool
changedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Bool
False
            ]
            forall a. [a] -> [a] -> [a]
++ a -> [Update record]
recordUpdates a
a
      clientSyncProcessorSyncServerDeleted :: Set sid -> SqlPersistT m ()
      clientSyncProcessorSyncServerDeleted :: Set sid -> SqlPersistT m ()
clientSyncProcessorSyncServerDeleted Set sid
s = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Set a -> [a]
S.toList Set sid
s) forall a b. (a -> b) -> a -> b
$ \sid
sid ->
        forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. a -> Maybe a
Just sid
sid]

-- | Set up a client store.
--
-- You shouldn't need this.
setupClientQuery ::
  forall record sid a m.
  ( PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    SafeToInsert record,
    MonadIO m
  ) =>
  (a -> record) ->
  (sid -> Timed a -> record) ->
  (sid -> Timed a -> record) ->
  (sid -> ServerTime -> record) ->
  ClientStore (Key record) sid a ->
  SqlPersistT m ()
setupClientQuery :: forall record sid a (m :: * -> *).
(PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
(a -> record)
-> (sid -> Timed a -> record)
-> (sid -> Timed a -> record)
-> (sid -> ServerTime -> record)
-> ClientStore (Key record) sid a
-> SqlPersistT m ()
setupClientQuery a -> record
makeUnsyncedClientThing sid -> Timed a -> record
makeSyncedClientThing sid -> Timed a -> record
makeSyncedButChangedClientThing sid -> ServerTime -> record
makeDeletedClientThing ClientStore {Map sid ServerTime
Map sid (Timed a)
Map (Key record) a
clientStoreAddedItems :: forall ci si a. ClientStore ci si a -> Map ci a
clientStoreSyncedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreSyncedButChangedItems :: forall ci si a. ClientStore ci si a -> Map si (Timed a)
clientStoreDeletedItems :: forall ci si a. ClientStore ci si a -> Map si ServerTime
clientStoreDeletedItems :: Map sid ServerTime
clientStoreSyncedButChangedItems :: Map sid (Timed a)
clientStoreSyncedItems :: Map sid (Timed a)
clientStoreAddedItems :: Map (Key record) a
..} = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map (Key record) a
clientStoreAddedItems) forall a b. (a -> b) -> a -> b
$ \(Key record
cid, a
t) ->
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key record
cid forall a b. (a -> b) -> a -> b
$ a -> record
makeUnsyncedClientThing a
t
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map sid (Timed a)
clientStoreSyncedItems) forall a b. (a -> b) -> a -> b
$ \(sid
sid, Timed a
tt) ->
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ forall a b. (a -> b) -> a -> b
$ sid -> Timed a -> record
makeSyncedClientThing sid
sid Timed a
tt
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map sid (Timed a)
clientStoreSyncedButChangedItems) forall a b. (a -> b) -> a -> b
$ \(sid
sid, Timed a
tt) ->
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ forall a b. (a -> b) -> a -> b
$ sid -> Timed a -> record
makeSyncedButChangedClientThing sid
sid Timed a
tt
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map sid ServerTime
clientStoreDeletedItems) forall a b. (a -> b) -> a -> b
$ \(sid
sid, ServerTime
st) -> forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ forall a b. (a -> b) -> a -> b
$ sid -> ServerTime -> record
makeDeletedClientThing sid
sid ServerTime
st

-- | Get the client store.
--
-- You shouldn't need this.
clientGetStoreQuery ::
  forall record sid a m.
  ( Ord sid,
    PersistEntity record,
    PersistField sid,
    PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    MonadIO m
  ) =>
  EntityField record (Maybe sid) ->
  EntityField record (Maybe ServerTime) ->
  EntityField record Bool ->
  EntityField record Bool ->
  (record -> a) ->
  (record -> (sid, Timed a)) ->
  (record -> (sid, ServerTime)) ->
  SqlPersistT m (ClientStore (Key record) sid a)
clientGetStoreQuery :: forall record sid a (m :: * -> *).
(Ord sid, PersistEntity record, PersistField sid,
 PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, MonadIO m) =>
EntityField record (Maybe sid)
-> EntityField record (Maybe ServerTime)
-> EntityField record Bool
-> EntityField record Bool
-> (record -> a)
-> (record -> (sid, Timed a))
-> (record -> (sid, ServerTime))
-> SqlPersistT m (ClientStore (Key record) sid a)
clientGetStoreQuery
  EntityField record (Maybe sid)
serverIdField
  EntityField record (Maybe ServerTime)
serverTimeField
  EntityField record Bool
changedField
  EntityField record Bool
deletedField
  record -> a
unmakeUnsyncedClientThing
  record -> (sid, Timed a)
unmakeSyncedClientThing
  record -> (sid, ServerTime)
unmakeDeletedClientThing = do
    Map (Key record) a
clientStoreAddedItems <-
      forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Entity Key record
cid record
cr) -> (Key record
cid, record -> a
unmakeUnsyncedClientThing record
cr))
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
          [ EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. Maybe a
Nothing,
            EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall a. Maybe a
Nothing
          ]
          []
    Map sid (Timed a)
clientStoreSyncedItems <-
      forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (record -> (sid, Timed a)
unmakeSyncedClientThing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
          [ EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
            EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
            EntityField record Bool
changedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
False,
            EntityField record Bool
deletedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
False
          ]
          []
    Map sid (Timed a)
clientStoreSyncedButChangedItems <-
      forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (record -> (sid, Timed a)
unmakeSyncedClientThing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
          [ EntityField record (Maybe sid)
serverIdField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
            EntityField record (Maybe ServerTime)
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. forall a. Maybe a
Nothing,
            EntityField record Bool
changedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
True,
            EntityField record Bool
deletedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
False
          ]
          []
    Map sid ServerTime
clientStoreDeletedItems <-
      forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (record -> (sid, ServerTime)
unmakeDeletedClientThing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
          [ EntityField record Bool
deletedField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Bool
True
          ]
          []
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStore {Map sid ServerTime
Map sid (Timed a)
Map (Key record) a
clientStoreDeletedItems :: Map sid ServerTime
clientStoreSyncedButChangedItems :: Map sid (Timed a)
clientStoreSyncedItems :: Map sid (Timed a)
clientStoreAddedItems :: Map (Key record) a
clientStoreAddedItems :: Map (Key record) a
clientStoreSyncedItems :: Map sid (Timed a)
clientStoreSyncedButChangedItems :: Map sid (Timed a)
clientStoreDeletedItems :: Map sid ServerTime
..}

-- | Process a sync request on the server side
serverProcessSyncQuery ::
  forall cid record a m.
  ( PersistEntity record,
    PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    SafeToInsert record,
    MonadIO m
  ) =>
  -- | The server time field
  EntityField record ServerTime ->
  -- | The filters to select the relevant records
  --
  -- Use this if you want per-user syncing
  [Filter record] ->
  -- | How to load an item from the database
  (record -> Timed a) ->
  -- | How to add an item in the database with initial server time
  (cid -> a -> record) ->
  -- | How to update a record given new data
  (a -> [Update record]) ->
  -- | A sync request
  SyncRequest cid (Key record) a ->
  SqlPersistT m (SyncResponse cid (Key record) a)
serverProcessSyncQuery :: forall cid record a (m :: * -> *).
(PersistEntity record, PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record ServerTime
-> [Filter record]
-> (record -> Timed a)
-> (cid -> a -> record)
-> (a -> [Update record])
-> SyncRequest cid (Key record) a
-> SqlPersistT m (SyncResponse cid (Key record) a)
serverProcessSyncQuery
  EntityField record ServerTime
serverTimeField
  [Filter record]
filters
  record -> Timed a
unmakeFunc
  cid -> a -> record
makeFunc
  a -> [Update record]
recordUpdates =
    forall ci si a (m :: * -> *).
(Ord si, Monad m) =>
ServerSyncProcessor ci si a m
-> SyncRequest ci si a -> m (SyncResponse ci si a)
processServerSyncCustom forall a b. (a -> b) -> a -> b
$
      forall cid record a (m :: * -> *).
(PersistEntity record, PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record ServerTime
-> [Filter record]
-> (record -> Timed a)
-> (cid -> a -> record)
-> (a -> [Update record])
-> ServerSyncProcessor cid (Key record) a (SqlPersistT m)
serverSyncProcessor
        EntityField record ServerTime
serverTimeField
        [Filter record]
filters
        record -> Timed a
unmakeFunc
        cid -> a -> record
makeFunc
        a -> [Update record]
recordUpdates

serverSyncProcessor ::
  forall cid record a m.
  ( PersistEntity record,
    PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    SafeToInsert record,
    MonadIO m
  ) =>
  -- | The server time field
  EntityField record ServerTime ->
  -- | The filters to select the relevant records
  --
  -- Use this if you want per-user syncing
  [Filter record] ->
  -- | How to load an item from the database
  (record -> Timed a) ->
  -- | How to add an item in the database with initial server time
  (cid -> a -> record) ->
  -- | How to update a record given new data
  (a -> [Update record]) ->
  ServerSyncProcessor cid (Key record) a (SqlPersistT m)
serverSyncProcessor :: forall cid record a (m :: * -> *).
(PersistEntity record, PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record ServerTime
-> [Filter record]
-> (record -> Timed a)
-> (cid -> a -> record)
-> (a -> [Update record])
-> ServerSyncProcessor cid (Key record) a (SqlPersistT m)
serverSyncProcessor
  EntityField record ServerTime
serverTimeField
  [Filter record]
filters
  record -> Timed a
unmakeFunc
  cid -> a -> record
makeFunc
  a -> [Update record]
recordUpdates =
    ServerSyncProcessor {ReaderT SqlBackend m (Map (Key record) (Timed a))
cid -> a -> ReaderT SqlBackend m (Maybe (Key record))
Key record -> ReaderT SqlBackend m ()
Key record -> ServerTime -> a -> ReaderT SqlBackend m ()
serverSyncProcessorRead :: ReaderT SqlBackend m (Map (Key record) (Timed a))
serverSyncProcessorAddItem :: cid -> a -> ReaderT SqlBackend m (Maybe (Key record))
serverSyncProcessorChangeItem :: Key record -> ServerTime -> a -> ReaderT SqlBackend m ()
serverSyncProcessorDeleteItem :: Key record -> ReaderT SqlBackend m ()
serverSyncProcessorDeleteItem :: Key record -> ReaderT SqlBackend m ()
serverSyncProcessorChangeItem :: Key record -> ServerTime -> a -> ReaderT SqlBackend m ()
serverSyncProcessorAddItem :: cid -> a -> ReaderT SqlBackend m (Maybe (Key record))
serverSyncProcessorRead :: ReaderT SqlBackend m (Map (Key record) (Timed a))
..} :: ServerSyncProcessor cid (Key record) a (SqlPersistT m)
    where
      serverSyncProcessorRead :: ReaderT SqlBackend m (Map (Key record) (Timed a))
serverSyncProcessorRead = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Entity Key record
i record
r) -> (Key record
i, record -> Timed a
unmakeFunc record
r)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [Filter record]
filters []
      serverSyncProcessorAddItem :: cid -> a -> ReaderT SqlBackend m (Maybe (Key record))
serverSyncProcessorAddItem cid
cid a
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ cid -> a -> record
makeFunc cid
cid a
a
      serverSyncProcessorChangeItem :: Key record -> ServerTime -> a -> ReaderT SqlBackend m ()
serverSyncProcessorChangeItem Key record
si ServerTime
st a
a = forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key record
si forall a b. (a -> b) -> a -> b
$ (EntityField record ServerTime
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ServerTime
st) forall a. a -> [a] -> [a]
: a -> [Update record]
recordUpdates a
a
      serverSyncProcessorDeleteItem :: Key record -> ReaderT SqlBackend m ()
serverSyncProcessorDeleteItem = forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete

-- | Process a sync request on the server side with a custom id field
--
-- You can use this function if you want to use a UUID as your id instead of the sqlkey of the item.
serverProcessSyncWithCustomIdQuery ::
  forall cid sid record a m.
  ( Ord sid,
    PersistField sid,
    PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    SafeToInsert record,
    MonadIO m
  ) =>
  -- | The custom id field
  EntityField record sid ->
  -- | The generator to generate the custom id field
  SqlPersistT m sid ->
  -- | The server time field
  EntityField record ServerTime ->
  -- | The filters to select the relevant records
  --
  -- Use this if you want per-user syncing
  [Filter record] ->
  -- | How to load an item from the database
  (record -> (sid, Timed a)) ->
  -- | How to add an item in the database with initial server time
  (cid -> sid -> a -> record) ->
  -- | How to update a record given new data
  (a -> [Update record]) ->
  -- | A sync request
  SyncRequest cid sid a ->
  SqlPersistT m (SyncResponse cid sid a)
serverProcessSyncWithCustomIdQuery :: forall cid sid record a (m :: * -> *).
(Ord sid, PersistField sid,
 PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record sid
-> SqlPersistT m sid
-> EntityField record ServerTime
-> [Filter record]
-> (record -> (sid, Timed a))
-> (cid -> sid -> a -> record)
-> (a -> [Update record])
-> SyncRequest cid sid a
-> SqlPersistT m (SyncResponse cid sid a)
serverProcessSyncWithCustomIdQuery
  EntityField record sid
idField
  SqlPersistT m sid
uuidGen
  EntityField record ServerTime
serverTimeField
  [Filter record]
filters
  record -> (sid, Timed a)
unmakeFunc
  cid -> sid -> a -> record
makeFunc
  a -> [Update record]
recordUpdates =
    forall ci si a (m :: * -> *).
(Ord si, Monad m) =>
ServerSyncProcessor ci si a m
-> SyncRequest ci si a -> m (SyncResponse ci si a)
processServerSyncCustom forall a b. (a -> b) -> a -> b
$
      forall cid sid record a (m :: * -> *).
(Ord sid, PersistField sid,
 PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record sid
-> SqlPersistT m sid
-> EntityField record ServerTime
-> [Filter record]
-> (record -> (sid, Timed a))
-> (cid -> sid -> a -> record)
-> (a -> [Update record])
-> ServerSyncProcessor cid sid a (SqlPersistT m)
serverSyncWithCustomIdProcessor
        EntityField record sid
idField
        SqlPersistT m sid
uuidGen
        EntityField record ServerTime
serverTimeField
        [Filter record]
filters
        record -> (sid, Timed a)
unmakeFunc
        cid -> sid -> a -> record
makeFunc
        a -> [Update record]
recordUpdates

serverSyncWithCustomIdProcessor ::
  forall cid sid record a m.
  ( Ord sid,
    PersistField sid,
    PersistEntityBackend record ~ SqlBackend,
    ToBackendKey SqlBackend record,
    SafeToInsert record,
    MonadIO m
  ) =>
  -- | The custom id field
  EntityField record sid ->
  -- | The generator to generate the custom id field
  SqlPersistT m sid ->
  -- | The server time field
  EntityField record ServerTime ->
  -- | The filters to select the relevant records
  --
  -- Use this if you want per-user syncing
  [Filter record] ->
  -- | How to load an item from the database
  (record -> (sid, Timed a)) ->
  -- | How to add an item in the database with 'initialServerTime'
  (cid -> sid -> a -> record) ->
  -- | How to update a record given new data
  (a -> [Update record]) ->
  ServerSyncProcessor cid sid a (SqlPersistT m)
serverSyncWithCustomIdProcessor :: forall cid sid record a (m :: * -> *).
(Ord sid, PersistField sid,
 PersistEntityBackend record ~ SqlBackend,
 ToBackendKey SqlBackend record, SafeToInsert record, MonadIO m) =>
EntityField record sid
-> SqlPersistT m sid
-> EntityField record ServerTime
-> [Filter record]
-> (record -> (sid, Timed a))
-> (cid -> sid -> a -> record)
-> (a -> [Update record])
-> ServerSyncProcessor cid sid a (SqlPersistT m)
serverSyncWithCustomIdProcessor
  EntityField record sid
idField
  SqlPersistT m sid
uuidGen
  EntityField record ServerTime
serverTimeField
  [Filter record]
filters
  record -> (sid, Timed a)
unmakeFunc
  cid -> sid -> a -> record
makeFunc
  a -> [Update record]
recordUpdates = ServerSyncProcessor {ReaderT SqlBackend m (Map sid (Timed a))
cid -> a -> ReaderT SqlBackend m (Maybe sid)
sid -> ReaderT SqlBackend m ()
sid -> ServerTime -> a -> ReaderT SqlBackend m ()
serverSyncProcessorDeleteItem :: sid -> ReaderT SqlBackend m ()
serverSyncProcessorChangeItem :: sid -> ServerTime -> a -> ReaderT SqlBackend m ()
serverSyncProcessorAddItem :: cid -> a -> ReaderT SqlBackend m (Maybe sid)
serverSyncProcessorRead :: ReaderT SqlBackend m (Map sid (Timed a))
serverSyncProcessorRead :: ReaderT SqlBackend m (Map sid (Timed a))
serverSyncProcessorAddItem :: cid -> a -> ReaderT SqlBackend m (Maybe sid)
serverSyncProcessorChangeItem :: sid -> ServerTime -> a -> ReaderT SqlBackend m ()
serverSyncProcessorDeleteItem :: sid -> ReaderT SqlBackend m ()
..} :: ServerSyncProcessor cid sid a (SqlPersistT m)
    where
      serverSyncProcessorRead :: ReaderT SqlBackend m (Map sid (Timed a))
serverSyncProcessorRead = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Entity Key record
_ record
record) -> record -> (sid, Timed a)
unmakeFunc record
record) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [Filter record]
filters []
      serverSyncProcessorAddItem :: cid -> a -> ReaderT SqlBackend m (Maybe sid)
serverSyncProcessorAddItem cid
cid a
a = do
        sid
uuid <- SqlPersistT m sid
uuidGen
        forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ forall a b. (a -> b) -> a -> b
$ cid -> sid -> a -> record
makeFunc cid
cid sid
uuid a
a
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just sid
uuid)
      serverSyncProcessorChangeItem :: sid -> ServerTime -> a -> ReaderT SqlBackend m ()
serverSyncProcessorChangeItem sid
si ServerTime
st a
a = forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere [EntityField record sid
idField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. sid
si] forall a b. (a -> b) -> a -> b
$ (EntityField record ServerTime
serverTimeField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ServerTime
st) forall a. a -> [a] -> [a]
: a -> [Update record]
recordUpdates a
a
      serverSyncProcessorDeleteItem :: sid -> ReaderT SqlBackend m ()
serverSyncProcessorDeleteItem sid
si = forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField record sid
idField forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. sid
si]

-- | Set up the server store
--
-- You shouldn't need this.
setupServerQuery ::
  forall sid record a.
  ( PersistEntity record,
    PersistEntityBackend record ~ SqlBackend
  ) =>
  (sid -> Timed a -> Entity record) ->
  ServerStore sid a ->
  SqlPersistT IO ()
setupServerQuery :: forall sid record a.
(PersistEntity record, PersistEntityBackend record ~ SqlBackend) =>
(sid -> Timed a -> Entity record)
-> ServerStore sid a -> SqlPersistT IO ()
setupServerQuery sid -> Timed a -> Entity record
func ServerStore {Map sid (Timed a)
serverStoreItems :: forall si a. ServerStore si a -> Map si (Timed a)
serverStoreItems :: Map sid (Timed a)
..} =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map sid (Timed a)
serverStoreItems) forall a b. (a -> b) -> a -> b
$ \(sid
sid, Timed a
tt) ->
    let (Entity Key record
k record
r) = sid -> Timed a -> Entity record
func sid
sid Timed a
tt
     in forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key record
k record
r

-- | Get the server store
--
-- You shouldn't need this.
serverGetStoreQuery ::
  ( Ord sid,
    PersistEntity record,
    PersistEntityBackend record ~ SqlBackend
  ) =>
  (Entity record -> (sid, Timed a)) ->
  SqlPersistT IO (ServerStore sid a)
serverGetStoreQuery :: forall sid record a.
(Ord sid, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
(Entity record -> (sid, Timed a))
-> SqlPersistT IO (ServerStore sid a)
serverGetStoreQuery Entity record -> (sid, Timed a)
func = forall si a. Map si (Timed a) -> ServerStore si a
ServerStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Entity record -> (sid, Timed a)
func forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []

#if !MIN_VERSION_persistent(2,14,0)
type SafeToInsert a = a ~ a
#endif