From a0c6c341ba1629a1c1070edf69855c745c6bd7eb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 19 Jan 2020 21:36:40 +0100
Subject: Synchronization service

---
 src/Sync.hs | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)
 create mode 100644 src/Sync.hs

(limited to 'src/Sync.hs')

diff --git a/src/Sync.hs b/src/Sync.hs
new file mode 100644
index 0000000..e8edf33
--- /dev/null
+++ b/src/Sync.hs
@@ -0,0 +1,37 @@
+module Sync (
+    SyncService,
+    ServicePacket(..),
+) where
+
+import Control.Monad
+
+import Data.List
+
+import Service
+import State
+import Storage
+import Storage.Merge
+
+data SyncService
+
+instance Service SyncService where
+    serviceID _ = mkServiceID "a4f538d0-4e50-4082-8e10-7e3ec2af175d"
+
+    data ServiceState SyncService = SyncService
+    emptyServiceState = SyncService
+
+    newtype ServicePacket SyncService = SyncPacket (Stored SharedState)
+
+    serviceHandler packet = do
+        let SyncPacket added = fromStored packet
+        ls <- svcGetLocal
+        let st = storedStorage ls
+            current = sort $ lsShared $ fromStored ls
+            updated = filterAncestors (added : current)
+        when (current /= updated) $ do
+            svcSetLocal =<< wrappedStore st (fromStored ls) { lsShared = updated }
+        return Nothing
+
+instance Storable (ServicePacket SyncService) where
+    store' (SyncPacket smsg) = store' smsg
+    load' = SyncPacket <$> load'
-- 
cgit v1.2.3