summaryrefslogtreecommitdiff
path: root/src/Sync.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2020-01-19 21:36:40 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2020-01-19 21:36:40 +0100
commita0c6c341ba1629a1c1070edf69855c745c6bd7eb (patch)
treeba5000382f7f7a905c4011d991fb286ef7abfda5 /src/Sync.hs
parent25324026a1033c43652a058f966dfb3d255102ae (diff)
Synchronization service
Diffstat (limited to 'src/Sync.hs')
-rw-r--r--src/Sync.hs37
1 files changed, 37 insertions, 0 deletions
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'