git.iko.soy/streamly
on 57e6232 help sign in
streamly/src/Asyncly/Recorder.hs
73 lines 2.8 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE StandaloneDeriving #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6-- |
7-- Module : Asyncly.Recorder
8-- Copyright : (c) 2017 Harendra Kumar
9--
10-- License : MIT-style
11-- Maintainer : harendra.kumar@gmail.com
12-- Stability : experimental
13-- Portability : GHC
14--
15module Asyncly.Recorder
16 ( runAsynclyRecorded
17-- , toListRecorded
18 , playRecordings
19 )
20where
22import Control.Applicative (Alternative (..))
23import Control.Monad (liftM)
24import Control.Monad.Catch (MonadThrow)
25import Control.Monad.IO.Class (MonadIO (..))
26import Control.Monad.Trans.Class (MonadTrans (lift))
27import Control.Monad.State (StateT(..), runStateT)
28import Data.Monoid ((<>))
29import Data.IORef (IORef, newIORef, readIORef)
31import Control.Monad.Trans.Recorder (MonadRecorder(..), RecorderT,
32 Recording, blank, runRecorderT)
33import Asyncly.AsyncT
35------------------------------------------------------------------------------
36-- Running the monad with recording
37------------------------------------------------------------------------------
39-- | Compose a computation using previously captured logs
40playRecording :: (MonadAsync m, MonadRecorder m)
41 => AsyncT m a -> Recording -> AsyncT m a
42playRecording m recording = play recording >> m
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.
47playRecordings :: (MonadAsync m, MonadRecorder m)
48 => AsyncT m a -> [Recording] -> AsyncT m a
49playRecordings m logs = each logs >>= playRecording m
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.
54toListRecorded :: (MonadAsync m, MonadCatch m)
55 => AsyncT m a -> m ([a], [Recording])
56toListRecorded 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 -}
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.
68runAsynclyRecorded :: MonadAsync m => AsyncT (RecorderT m) a -> m [Recording]
69runAsynclyRecorded m = do
70 lref <- liftIO $ newIORef []
71 runRecorderT blank (runAsynclyLogged (Just lref) m)
72 logs <- liftIO $ readIORef lref
73 return logs