@@ -1,8 +1,7 @@
11{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
2+{-# LANGUAGE FlexibleInstances #-}
33{-# LANGUAGE StandaloneDeriving #-}
44{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE UndecidableInstances #-}
65
76-- |
87-- Module : Asyncly.Threads
@@ -19,11 +18,12 @@ module Asyncly.RunAsync
1918 , toList
2019 , each
2120 , threads
21+
2222 {-
23− , waitRecord_
23+ , runAsyclyRecorded
2424 , waitRecord
25− , playRecordings
2625 -}
26+ , playRecordings
2727 )
2828where
2929
@@ -34,7 +34,7 @@ import Control.Monad.Catch (MonadCatch, MonadThrow, throwM, tr
3434import Control.Monad.IO.Class (MonadIO (..))
3535import Control.Monad.Trans.Class (MonadTrans (lift))
3636import Control.Monad.Trans.Control (MonadBaseControl)
37−import Control.Monad.State (StateT, runStateT)
37+import Control.Monad.State (StateT(..), runStateT)
3838import Control.Monad.Trans.Class (MonadTrans (lift))
3939import Data.Atomics (atomicModifyIORefCAS)
4040import Data.IORef (IORef, newIORef, readIORef)
@@ -53,14 +53,23 @@ import Asyncly.AsyncT
5353
5454newtype AsynclyT m a = AsynclyT { runAsynclyT :: AsyncT (StateT Context m) a }
5555
56−deriving instance MonadAsync m => Functor (AsynclyT m)
57−deriving instance MonadAsync m => Applicative (AsynclyT m)
58−deriving instance MonadAsync m => Alternative (AsynclyT m)
59−deriving instance MonadAsync m => Monad (AsynclyT m)
60−deriving instance MonadAsync m => MonadIO (AsynclyT m)
56+deriving instance Monad m => Functor (AsynclyT m)
57+deriving instance Monad m => Applicative (AsynclyT m)
58+deriving instance Monad m => Alternative (AsynclyT m)
59+deriving instance Monad m => Monad (AsynclyT m)
60+deriving instance MonadIO m => MonadIO (AsynclyT m)
6161instance MonadTrans (AsynclyT) where
6262 lift mx = AsynclyT $ AsyncT $ \s k -> lift mx >>= (\a -> (k a Nothing))
6363
64+instance (Monad m, MonadRecorder m)
65+ => MonadRecorder (StateT Context m) where
66+ getJournal = lift getJournal
67+ putJournal = lift . putJournal
68+ play = lift . play
69+
70+deriving instance (Monad m, MonadRecorder m)
71+ => MonadRecorder (AsynclyT m)
72+
6473------------------------------------------------------------------------------
6574-- Running the monad
6675------------------------------------------------------------------------------
@@ -124,23 +133,23 @@ threads :: MonadAsync m => Int -> AsynclyT m a -> AsynclyT m a
124133threads n action = AsynclyT $ AsyncT $ \stp yld ->
125134 threadCtl n ((runAsyncT $ runAsynclyT action) stp yld)
126135
127−{-
128136------------------------------------------------------------------------------
129137-- Logging
130138------------------------------------------------------------------------------
131139
132140-- | Compose a computation using previously captured logs
133141playRecording :: (MonadAsync m, MonadRecorder m)
134− => AsyncT m a -> Recording -> AsyncT m a
142+ => AsynclyT m a -> Recording -> AsynclyT m a
135143playRecording m recording = play recording >> m
136144
137145-- | Resume an 'AsyncT' computation using previously recorded logs. The
138146-- recording consists of a list of journals one for each thread in the
139147-- computation.
140148playRecordings :: (MonadAsync m, MonadRecorder m)
141− => AsyncT m a -> [Recording] -> AsyncT m a
149+ => AsynclyT m a -> [Recording] -> AsynclyT m a
142150playRecordings m logs = each logs >>= playRecording m
143151
152+{-
144153-- | Run an 'AsyncT' computation with recording enabled, wait for it to finish
145154-- returning results for completed threads and recordings for paused threads.
146155waitRecord :: (MonadAsync m, MonadCatch m)
@@ -156,12 +165,11 @@ waitRecord m = do
156165-- | Run an 'AsyncT' computation with recording enabled, wait for it to finish
157166-- and discard the results and return the recordings for paused threads, if
158167-- any.
159−waitRecord_ :: (MonadAsync m, MonadCatch m)
160− => AsyncT (RecorderT m) a -> m [Recording]
161−waitRecord_ m = do
168+runAsynclyRecorded :: (MonadAsync m, MonadCatch m)
169+ => AsynclyT (RecorderT m) a -> m [Recording]
170+runAsynclyRecorded m = do
162171 lref <- liftIO $ newIORef []
163172 runRecorderT blank (waitAsync (const (return Nothing)) (Just lref) m)
164173 logs <- liftIO $ readIORef lref
165174 return logs
166−
167175-}