git.iko.soy/streamly
on master help sign in
Make logs work with regular wait/gather APIs too
f455a06Harendra Kumar
src/Strands/Threads.hs+20−22
compare with master
unifiedsplit
@@ -559,31 +559,29 @@ wait m = waitAsync (const mzero) Nothing m
559logged :: (Loggable a, MonadIO m) => AsyncT m a -> AsyncT m a
559logged :: (Loggable a, MonadIO m) => AsyncT m a -> AsyncT m a
560logged m = AsyncT $ do
560logged m = AsyncT $ do
561 ctx <- get
561 ctx <- get
562+ case journal ctx of
563+ -- no replay
564+ CtxLog ls [] ->
562− case logsRef ctx of
565+ case logsRef ctx of
563− Nothing -> runAsyncT m
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}
564− Just _ -> runLogged ctx (runAndLogResult m)
577+ runAndLogResult m
578+ Result val -> do
579+ let x = fmap read val
580+ put $ ctx {journal = CtxLog (r : ls) rs}
581+ return x
565
582
566 where
583 where
567
584
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−
587 runAndLogResult action = runAsyncT $ do
585 runAndLogResult action = runAsyncT $ do
588 x <- action
586 x <- action
589 logResult x
587 logResult x
test/logged.hs+9−2
@@ -3,12 +3,19 @@ import Control.Monad.IO.Class (liftIO)
3
3
4main = do
4main = do
5 logs <- waitLogged comp
5 logs <- waitLogged comp
6− -- XXX even if we use wait replay should still work, though new logs will
6+
7− -- not be generated.
7+ putStrLn $ "\nResuming with logs:"
8 logs1 <- waitLogged $ eachWithLog comp logs
8 logs1 <- waitLogged $ eachWithLog comp logs
9+
10+ putStrLn $ "\nResuming with logs:"
9 logs2 <- waitLogged $ eachWithLog comp logs1
11 logs2 <- waitLogged $ eachWithLog comp logs1
12+
13+ putStrLn $ "\nLogs at the end must be empty:"
10 putStrLn $ show logs2
14 putStrLn $ show logs2
11
15
16+ putStrLn $ "\nRunning the last log again using wait:"
17+ wait $ eachWithLog comp logs1
18+
12 where
19 where
13 comp = logged $ threads 5 $ do
20 comp = logged $ threads 5 $ do
14 r <- logged $ each [1..3]
21 r <- logged $ each [1..3]