{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Mergeless.Persistent
(
clientMakeSyncRequestQuery,
clientMergeSyncResponseQuery,
clientSyncProcessor,
serverProcessSyncQuery,
serverProcessSyncWithCustomIdQuery,
serverSyncProcessor,
serverSyncProcessorWithCustomId,
setupUnsyncedClientQuery,
setupClientQuery,
clientGetStoreQuery,
serverGetStoreQuery,
setupServerQuery,
)
where
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Map as M
import Data.Maybe
import Data.Mergeless
import qualified Data.Set as S
import Database.Persist
import Database.Persist.Sql
import Lens.Micro
clientMakeSyncRequestQuery ::
( Ord sid,
PersistEntity clientRecord,
PersistField sid,
PersistEntityBackend clientRecord ~ SqlBackend,
MonadIO m
) =>
(clientRecord -> a) ->
EntityField clientRecord (Maybe sid) ->
EntityField clientRecord Bool ->
SqlPersistT m (SyncRequest (Key clientRecord) sid a)
clientMakeSyncRequestQuery func serverIdField deletedField = do
syncRequestAdded <-
M.fromList . map (\(Entity cid ct) -> (cid, func ct))
<$> selectList
[ serverIdField ==. Nothing,
deletedField ==. False
]
[]
syncRequestSynced <-
S.fromList . mapMaybe (\e -> e ^. fieldLens serverIdField)
<$> selectList
[ serverIdField !=. Nothing,
deletedField ==. False
]
[]
syncRequestDeleted <-
S.fromList . mapMaybe (\e -> e ^. fieldLens serverIdField)
<$> selectList
[ serverIdField !=. Nothing,
deletedField ==. True
]
[]
pure SyncRequest {..}
clientMergeSyncResponseQuery ::
( PersistEntity clientRecord,
PersistField sid,
PersistEntityBackend clientRecord ~ SqlBackend,
MonadIO m
) =>
(sid -> a -> clientRecord) ->
EntityField clientRecord (Maybe sid) ->
EntityField clientRecord Bool ->
SyncResponse (Key clientRecord) sid a ->
SqlPersistT m ()
clientMergeSyncResponseQuery func serverIdField deletedField = mergeSyncResponseCustom $ clientSyncProcessor func serverIdField deletedField
clientSyncProcessor ::
( PersistEntity clientRecord,
PersistField sid,
PersistEntityBackend clientRecord ~ SqlBackend,
MonadIO m
) =>
(sid -> a -> clientRecord) ->
EntityField clientRecord (Maybe sid) ->
EntityField clientRecord Bool ->
ClientSyncProcessor (Key clientRecord) sid a (SqlPersistT m)
clientSyncProcessor func serverIdField deletedField = ClientSyncProcessor {..}
where
clientSyncProcessorSyncServerAdded m = forM_ (M.toList m) $ \(si, st) ->
insert_ $ func si st
clientSyncProcessorSyncClientAdded m = forM_ (M.toList m) $ \(cid, sid) ->
update cid [serverIdField =. Just sid]
clientSyncProcessorSyncServerDeleted s = forM_ (S.toList s) $ \sid ->
deleteWhere [serverIdField ==. Just sid]
clientSyncProcessorSyncClientDeleted s = forM_ (S.toList s) $ \sid ->
deleteWhere [serverIdField ==. Just sid, deletedField ==. True]
serverProcessSyncQuery ::
( PersistEntity record,
PersistEntityBackend record ~ SqlBackend,
MonadIO m
) =>
[Filter record] ->
(record -> a) ->
(a -> record) ->
SyncRequest ci (Key record) a ->
SqlPersistT m (SyncResponse ci (Key record) a)
serverProcessSyncQuery filters funcTo funcFrom = processServerSyncCustom $ serverSyncProcessor filters funcTo funcFrom
serverSyncProcessor ::
( PersistEntity record,
PersistEntityBackend record ~ SqlBackend,
MonadIO m
) =>
[Filter record] ->
(record -> a) ->
(a -> record) ->
ServerSyncProcessor ci (Key record) a (SqlPersistT m)
serverSyncProcessor filters funcTo funcFrom =
ServerSyncProcessor {..}
where
serverSyncProcessorRead = M.fromList . map (\(Entity i record) -> (i, funcTo record)) <$> selectList filters []
serverSyncProcessorAddItems = mapM $ insert . funcFrom
serverSyncProcessorDeleteItems s = do
mapM_ delete s
pure s
serverProcessSyncWithCustomIdQuery ::
( Ord sid,
PersistEntity record,
PersistField sid,
PersistEntityBackend record ~ SqlBackend,
MonadIO m
) =>
SqlPersistT m sid ->
EntityField record sid ->
[Filter record] ->
(record -> (sid, a)) ->
(sid -> a -> record) ->
SyncRequest ci sid a ->
SqlPersistT m (SyncResponse ci sid a)
serverProcessSyncWithCustomIdQuery genId idField filters funcTo funcFrom = processServerSyncCustom $ serverSyncProcessorWithCustomId genId idField filters funcTo funcFrom
serverSyncProcessorWithCustomId ::
( Ord sid,
PersistEntity record,
PersistField sid,
PersistEntityBackend record ~ SqlBackend,
MonadIO m
) =>
SqlPersistT m sid ->
EntityField record sid ->
[Filter record] ->
(record -> (sid, a)) ->
(sid -> a -> record) ->
ServerSyncProcessor ci sid a (SqlPersistT m)
serverSyncProcessorWithCustomId genId idField filters funcTo funcFrom =
ServerSyncProcessor {..}
where
serverSyncProcessorRead = M.fromList . map (funcTo . entityVal) <$> selectList filters []
serverSyncProcessorAddItems = mapM $ \a -> do
sid <- genId
let record = funcFrom sid a
insert_ record
pure sid
serverSyncProcessorDeleteItems s = do
forM_ s $ \sid -> deleteWhere [idField ==. sid]
pure s
setupUnsyncedClientQuery ::
( PersistEntity clientRecord,
PersistEntityBackend clientRecord ~ SqlBackend,
MonadIO m
) =>
(a -> clientRecord) ->
[a] ->
SqlPersistT m ()
setupUnsyncedClientQuery func = mapM_ (insert . func)
setupClientQuery ::
( PersistEntity clientRecord,
PersistEntityBackend clientRecord ~ SqlBackend,
MonadIO m
) =>
(a -> clientRecord) ->
(sid -> a -> clientRecord) ->
(sid -> clientRecord) ->
ClientStore (Key clientRecord) sid a ->
SqlPersistT m ()
setupClientQuery funcU funcS funcD ClientStore {..} = do
forM_ (M.toList clientStoreAdded) $ \(cid, st) ->
insertKey
cid
(funcU st)
forM_ (M.toList clientStoreSynced) $ \(sid, st) ->
insert_ (funcS sid st)
forM_ (S.toList clientStoreDeleted) $ \sid ->
insert_ (funcD sid)
clientGetStoreQuery ::
( Ord sid,
PersistEntity clientRecord,
PersistField sid,
PersistEntityBackend clientRecord ~ SqlBackend,
MonadIO m
) =>
(clientRecord -> a) ->
EntityField clientRecord (Maybe sid) ->
EntityField clientRecord Bool ->
SqlPersistT m (ClientStore (Key clientRecord) sid a)
clientGetStoreQuery func serverIdField deletedField = do
clientStoreAdded <-
M.fromList . map (\(Entity cid ct) -> (cid, func ct))
<$> selectList
[ serverIdField ==. Nothing,
deletedField ==. False
]
[]
clientStoreSynced <-
M.fromList . mapMaybe (\e@(Entity _ ct) -> (,) <$> (e ^. fieldLens serverIdField) <*> pure (func ct))
<$> selectList
[ serverIdField !=. Nothing,
deletedField ==. False
]
[]
clientStoreDeleted <-
S.fromList . mapMaybe (\e -> e ^. fieldLens serverIdField)
<$> selectList
[ serverIdField !=. Nothing,
deletedField ==. True
]
[]
pure ClientStore {..}
serverGetStoreQuery ::
( PersistEntity record,
PersistEntityBackend record ~ SqlBackend,
MonadIO m
) =>
(record -> a) ->
SqlPersistT m (ServerStore (Key record) a)
serverGetStoreQuery func = ServerStore . M.fromList . map (\(Entity stid st) -> (stid, func st)) <$> selectList [] []
setupServerQuery ::
( PersistEntity record,
PersistEntityBackend record ~ SqlBackend,
MonadIO m
) =>
(a -> record) ->
ServerStore (Key record) a ->
SqlPersistT m ()
setupServerQuery func ServerStore {..} = forM_ (M.toList serverStoreItems) $ \(i, e) -> void $ insertKey i $ func e