@@ -1,73 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE StandaloneDeriving #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−
6−-- |
7−-- Module : Asyncly.Recorder
8−-- Copyright : (c) 2017 Harendra Kumar
9−--
10−-- License : BSD3
11−-- Maintainer : harendra.kumar@gmail.com
12−-- Stability : experimental
13−-- Portability : GHC
14−--
15−module Asyncly.Recorder
16− ( runAsynclyRecorded
17−-- , toListRecorded
18− , playRecordings
19− )
20−where
21−
22−import Control.Applicative (Alternative (..))
23−import Control.Monad (liftM)
24−import Control.Monad.Catch (MonadThrow)
25−import Control.Monad.IO.Class (MonadIO (..))
26−import Control.Monad.Trans.Class (MonadTrans (lift))
27−import Control.Monad.State (StateT(..), runStateT)
28−import Data.Monoid ((<>))
29−import Data.IORef (IORef, newIORef, readIORef)
30−
31−import Control.Monad.Trans.Recorder (MonadRecorder(..), RecorderT,
32− Recording, blank, runRecorderT)
33−import Asyncly.AsyncT
34−
35−------------------------------------------------------------------------------
36−-- Running the monad with recording
37−------------------------------------------------------------------------------
38−
39−-- | Compose a computation using previously captured logs
40−playRecording :: (MonadAsync m, MonadRecorder m)
41− => AsyncT m a -> Recording -> AsyncT m a
42−playRecording m recording = play recording >> m
43−
44−-- | Resume an 'AsyncT' computation using previously recorded logs. The
45−-- recording consists of a list of journals one for each thread in the
46−-- computation.
47−playRecordings :: (MonadAsync m, MonadRecorder m)
48− => AsyncT m a -> [Recording] -> AsyncT m a
49−playRecordings m logs = each logs >>= playRecording m
50−
51−{-
52−-- | Run an 'AsyncT' computation with recording enabled, wait for it to finish
53−-- returning results for completed threads and recordings for paused threads.
54−toListRecorded :: (MonadAsync m, MonadCatch m)
55− => AsyncT m a -> m ([a], [Recording])
56−toListRecorded m = do
57− resultsRef <- liftIO $ newIORef []
58− lref <- liftIO $ newIORef []
59− waitAsync (gatherResult resultsRef) (Just lref) m
60− res <- liftIO $ readIORef resultsRef
61− logs <- liftIO $ readIORef lref
62− return (res, logs)
63− -}
64−
65−-- | Run an 'AsyncT' computation with recording enabled, wait for it to finish
66−-- and discard the results and return the recordings for paused threads, if
67−-- any.
68−runAsynclyRecorded :: MonadAsync m => AsyncT (RecorderT m) a -> m [Recording]
69−runAsynclyRecorded m = do
70− lref <- liftIO $ newIORef []
71− runRecorderT blank (runAsynclyLogged (Just lref) m)
72− logs <- liftIO $ readIORef lref
73− return logs