module Erebos.Sync (
    SyncService(..),
) where

import Control.Monad
import Control.Monad.Reader

import Data.List

import Erebos.Identity
import Erebos.Service
import Erebos.State
import Erebos.Storage
import Erebos.Storage.Merge

data SyncService = SyncPacket (Stored SharedState)

instance Service SyncService where
    serviceID :: forall (proxy :: * -> *). proxy SyncService -> ServiceID
serviceID proxy SyncService
_ = String -> ServiceID
mkServiceID String
"a4f538d0-4e50-4082-8e10-7e3ec2af175d"

    serviceHandler :: Stored SyncService -> ServiceHandler SyncService ()
serviceHandler Stored SyncService
packet = do
        let SyncPacket Stored SharedState
added = Stored SyncService -> SyncService
forall a. Stored a -> a
fromStored Stored SyncService
packet
        UnifiedIdentity
pid <- (ServiceInput SyncService -> UnifiedIdentity)
-> ServiceHandler SyncService UnifiedIdentity
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput SyncService -> UnifiedIdentity
forall s. ServiceInput s -> UnifiedIdentity
svcPeerIdentity
        UnifiedIdentity
self <- ServiceHandler SyncService UnifiedIdentity
forall s. ServiceHandler s UnifiedIdentity
svcSelf
        Bool
-> ServiceHandler SyncService () -> ServiceHandler SyncService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UnifiedIdentity -> ComposedIdentity
forall (m :: * -> *).
(Foldable m, Applicative m) =>
Identity m -> ComposedIdentity
finalOwner UnifiedIdentity
pid ComposedIdentity -> ComposedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
`sameIdentity` UnifiedIdentity -> ComposedIdentity
forall (m :: * -> *).
(Foldable m, Applicative m) =>
Identity m -> ComposedIdentity
finalOwner UnifiedIdentity
self) (ServiceHandler SyncService () -> ServiceHandler SyncService ())
-> ServiceHandler SyncService () -> ServiceHandler SyncService ()
forall a b. (a -> b) -> a -> b
$ do
            (Stored LocalState
 -> ServiceHandler SyncService (Stored LocalState))
-> ServiceHandler SyncService ()
forall a (m :: * -> *).
MonadHead a m =>
(Stored a -> m (Stored a)) -> m ()
updateLocalHead_ ((Stored LocalState
  -> ServiceHandler SyncService (Stored LocalState))
 -> ServiceHandler SyncService ())
-> (Stored LocalState
    -> ServiceHandler SyncService (Stored LocalState))
-> ServiceHandler SyncService ()
forall a b. (a -> b) -> a -> b
$ \Stored LocalState
ls -> do
                let current :: [Stored SharedState]
current = [Stored SharedState] -> [Stored SharedState]
forall a. Ord a => [a] -> [a]
sort ([Stored SharedState] -> [Stored SharedState])
-> [Stored SharedState] -> [Stored SharedState]
forall a b. (a -> b) -> a -> b
$ LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> LocalState -> [Stored SharedState]
forall a b. (a -> b) -> a -> b
$ Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored Stored LocalState
ls
                    updated :: [Stored SharedState]
updated = [Stored SharedState] -> [Stored SharedState]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors (Stored SharedState
added Stored SharedState -> [Stored SharedState] -> [Stored SharedState]
forall a. a -> [a] -> [a]
: [Stored SharedState]
current)
                if [Stored SharedState]
current [Stored SharedState] -> [Stored SharedState] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Stored SharedState]
updated
                   then LocalState -> ServiceHandler SyncService (Stored LocalState)
forall a. Storable a => a -> ServiceHandler SyncService (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore (Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored Stored LocalState
ls) { lsShared = updated }
                   else Stored LocalState -> ServiceHandler SyncService (Stored LocalState)
forall a. a -> ServiceHandler SyncService a
forall (m :: * -> *) a. Monad m => a -> m a
return Stored LocalState
ls

    serviceNewPeer :: ServiceHandler SyncService ()
serviceNewPeer = [Stored SharedState] -> ServiceHandler SyncService ()
notifyPeer ([Stored SharedState] -> ServiceHandler SyncService ())
-> (Stored LocalState -> [Stored SharedState])
-> Stored LocalState
-> ServiceHandler SyncService ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> [Stored SharedState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored (Stored LocalState -> ServiceHandler SyncService ())
-> ServiceHandler SyncService (Stored LocalState)
-> ServiceHandler SyncService ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ServiceHandler SyncService (Stored LocalState)
forall s. ServiceHandler s (Stored LocalState)
svcGetLocal
    serviceStorageWatchers :: forall (proxy :: * -> *).
proxy SyncService -> [SomeStorageWatcher SyncService]
serviceStorageWatchers proxy SyncService
_ = (SomeStorageWatcher SyncService
-> [SomeStorageWatcher SyncService]
-> [SomeStorageWatcher SyncService]
forall a. a -> [a] -> [a]
:[]) (SomeStorageWatcher SyncService
 -> [SomeStorageWatcher SyncService])
-> SomeStorageWatcher SyncService
-> [SomeStorageWatcher SyncService]
forall a b. (a -> b) -> a -> b
$ (Stored LocalState -> [Stored SharedState])
-> ([Stored SharedState] -> ServiceHandler SyncService ())
-> SomeStorageWatcher SyncService
forall s a.
Eq a =>
(Stored LocalState -> a)
-> (a -> ServiceHandler s ()) -> SomeStorageWatcher s
SomeStorageWatcher (LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> [Stored SharedState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored) [Stored SharedState] -> ServiceHandler SyncService ()
notifyPeer

instance Storable SyncService where
    store' :: SyncService -> Store
store' (SyncPacket Stored SharedState
smsg) = Stored SharedState -> Store
forall a. Storable a => a -> Store
store' Stored SharedState
smsg
    load' :: Load SyncService
load' = Stored SharedState -> SyncService
SyncPacket (Stored SharedState -> SyncService)
-> Load (Stored SharedState) -> Load SyncService
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Load (Stored SharedState)
forall a. Storable a => Load a
load'

notifyPeer :: [Stored SharedState] -> ServiceHandler SyncService ()
notifyPeer :: [Stored SharedState] -> ServiceHandler SyncService ()
notifyPeer [Stored SharedState]
shared = do
    UnifiedIdentity
pid <- (ServiceInput SyncService -> UnifiedIdentity)
-> ServiceHandler SyncService UnifiedIdentity
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ServiceInput SyncService -> UnifiedIdentity
forall s. ServiceInput s -> UnifiedIdentity
svcPeerIdentity
    UnifiedIdentity
self <- ServiceHandler SyncService UnifiedIdentity
forall s. ServiceHandler s UnifiedIdentity
svcSelf
    Bool
-> ServiceHandler SyncService () -> ServiceHandler SyncService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UnifiedIdentity -> ComposedIdentity
forall (m :: * -> *).
(Foldable m, Applicative m) =>
Identity m -> ComposedIdentity
finalOwner UnifiedIdentity
pid ComposedIdentity -> ComposedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
`sameIdentity` UnifiedIdentity -> ComposedIdentity
forall (m :: * -> *).
(Foldable m, Applicative m) =>
Identity m -> ComposedIdentity
finalOwner UnifiedIdentity
self) (ServiceHandler SyncService () -> ServiceHandler SyncService ())
-> ServiceHandler SyncService () -> ServiceHandler SyncService ()
forall a b. (a -> b) -> a -> b
$ do
        [Stored SharedState]
-> (Stored SharedState -> ServiceHandler SyncService ())
-> ServiceHandler SyncService ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stored SharedState]
shared ((Stored SharedState -> ServiceHandler SyncService ())
 -> ServiceHandler SyncService ())
-> (Stored SharedState -> ServiceHandler SyncService ())
-> ServiceHandler SyncService ()
forall a b. (a -> b) -> a -> b
$ \Stored SharedState
sh ->
            Stored SyncService -> ServiceHandler SyncService ()
forall s. Service s => Stored s -> ServiceHandler s ()
replyStoredRef (Stored SyncService -> ServiceHandler SyncService ())
-> ServiceHandler SyncService (Stored SyncService)
-> ServiceHandler SyncService ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SyncService -> ServiceHandler SyncService (Stored SyncService)
forall a. Storable a => a -> ServiceHandler SyncService (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore (SyncService -> ServiceHandler SyncService (Stored SyncService))
-> (Stored SharedState -> SyncService)
-> Stored SharedState
-> ServiceHandler SyncService (Stored SyncService)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored SharedState -> SyncService
SyncPacket) Stored SharedState
sh