debug, fix callbacks

diff --git a/src/Data/Acid/Centered/Master.hs b/src/Data/Acid/Centered/Master.hs
index 6431ff1..e39f2b5 100644 (file)
--- a/src/Data/Acid/Centered/Master.hs
+++ b/src/Data/Acid/Centered/Master.hs
@@ -230,7 +230,9 @@ scheduleMasterUpdate :: UpdateEvent event => MasterState (EventState event) -> e
 scheduleMasterUpdate masterState@MasterState{..} event = do
         debug "Update by Master."
         result <- newEmptyMVar 
-        let callback = void $ forkIO (putMVar result =<< takeMVar =<< scheduleUpdate localState event)
+        let callback = do
+                hd <- scheduleUpdate localState event
+                void $ forkIO (putMVar result =<< takeMVar hd)
         let encoded = runPutLazy (safePut event) 
         queueUpdate masterState ((methodTag event, encoded), Left callback)
         return result

diff --git a/src/Data/Acid/Centered/Slave.hs b/src/Data/Acid/Centered/Slave.hs
index 9770c51..fa57b29 100644 (file)
--- a/src/Data/Acid/Centered/Slave.hs
+++ b/src/Data/Acid/Centered/Slave.hs
@@ -185,8 +185,8 @@ replicateSyncUpdate slaveState rev event = replicateUpdate slaveState (rev, Noth
 replicateUpdate :: SlaveState st -> SlaveRepItem -> Bool -> IO ()
 replicateUpdate SlaveState{..} (rev, reqId, event) syncing = do
         debug $ "Got an Update to replicate " ++ show rev
-        modifyMVar_ slaveRevision $ \nr -> case rev - 1 of
-            nr -> do
+        modifyMVar_ slaveRevision $ \nr -> if rev - 1 == nr 
+            then do
                 -- commit / run it locally 
                 case reqId of
                     Nothing -> 
@@ -203,7 +203,7 @@ replicateUpdate SlaveState{..} (rev, reqId, event) syncing = do
                 -- send reply: we're done
                 unless syncing $ sendToMaster slaveZmqSocket $ RepDone rev
                 return rev
-            _  -> do 
+            else do 
                 sendToMaster slaveZmqSocket RepError
                 error $ "Replication failed at revision " ++ show rev ++ " -> " ++ show nr
                 return nr
@@ -225,7 +225,9 @@ scheduleSlaveUpdate slaveState@SlaveState{..} event = do
             let encoded = runPutLazy (safePut event)
             sendToMaster slaveZmqSocket $ ReqUpdate reqId (methodTag event, encoded)
             debug "after send"
-            let callback = void $ forkIO $ putMVar result =<< takeMVar =<< scheduleUpdate slaveLocalState event 
+            let callback = do
+                    hd <- scheduleUpdate slaveLocalState event 
+                    void $ forkIO $ putMVar result =<< takeMVar hd
             return $ M.insert reqId callback srs
         return result