@@ -559,31 +559,29 @@ wait m = waitAsync (const mzero) Nothing m
559559logged :: (Loggable a, MonadIO m) => AsyncT m a -> AsyncT m a
560560logged m = AsyncT $ do
561561 ctx <- get
562− case logsRef ctx of
563− Nothing -> runAsyncT m
564− Just _ -> runLogged ctx (runAndLogResult m)
562+ case journal ctx of
563+ -- no replay
564+ CtxLog ls [] ->
565+ case logsRef ctx of
566+ Nothing -> runAsyncT m
567+ Just _ -> do
568+ put $ ctx {journal = CtxLog (Executing : ls) []}
569+ runAndLogResult m
570+
571+ -- replaying the log
572+ CtxLog ls (r:rs) -> do
573+ -- dbg $ "Replay: j: " ++ show j
574+ case r of
575+ Executing -> do
576+ put $ ctx {journal = CtxLog (r : ls) rs}
577+ runAndLogResult m
578+ Result val -> do
579+ let x = fmap read val
580+ put $ ctx {journal = CtxLog (r : ls) rs}
581+ return x
565582
566583 where
567584
568− runLogged ctx action =
569− case journal ctx of
570− -- no replay
571− CtxLog ls [] -> do
572− put $ ctx {journal = CtxLog (Executing : ls) []}
573− action
574−
575− -- replaying the log
576− CtxLog ls (r:rs) -> do
577− -- dbg $ "Replay: j: " ++ show j
578− case r of
579− Executing -> do
580− put $ ctx {journal = CtxLog (r : ls) rs}
581− action
582− Result val -> do
583− let x = fmap read val
584− put $ ctx {journal = CtxLog (r : ls) rs}
585− return x
586−
587585 runAndLogResult action = runAsyncT $ do
588586 x <- action
589587 logResult x