@@ -18,11 +18,8 @@ module Asyncly.RunAsync
1818 , toList
1919 , each
2020 , threads
21−
22− {-
23− , runAsyclyRecorded
24− , waitRecord
25− -}
21+ , runAsynclyRecorded
22+-- , toListRecorded
2623 , playRecordings
2724 )
2825where
@@ -30,19 +27,14 @@ where
3027import Control.Applicative (Alternative (..))
3128import Control.Concurrent.STM (atomically, newTChan)
3229import Control.Monad (liftM)
33−import Control.Monad.Catch (MonadCatch, MonadThrow, throwM, try)
30+import Control.Monad.Catch (MonadThrow)
3431import Control.Monad.IO.Class (MonadIO (..))
3532import Control.Monad.Trans.Class (MonadTrans (lift))
36−import Control.Monad.Trans.Control (MonadBaseControl)
3733import Control.Monad.State (StateT(..), runStateT)
38−import Control.Monad.Trans.Class (MonadTrans (lift))
39−import Data.Atomics (atomicModifyIORefCAS)
4034import Data.IORef (IORef, newIORef, readIORef)
4135
4236import Control.Monad.Trans.Recorder (MonadRecorder(..), RecorderT,
4337 Recording, blank, runRecorderT)
44−import GHC.Prim (Any)
45−
4638import Asyncly.Threads
4739import Asyncly.AsyncT
4840
@@ -58,9 +50,11 @@ deriving instance Monad m => Applicative (AsynclyT m)
5850deriving instance Monad m => Alternative (AsynclyT m)
5951deriving instance Monad m => Monad (AsynclyT m)
6052deriving instance MonadIO m => MonadIO (AsynclyT m)
53+deriving instance MonadThrow m => MonadThrow (AsynclyT m)
6154instance MonadTrans (AsynclyT) where
62− lift mx = AsynclyT $ AsyncT $ \s k -> lift mx >>= (\a -> (k a Nothing))
55+ lift mx = AsynclyT $ AsyncT $ \_ k -> lift mx >>= (\a -> (k a Nothing))
6356
57+-- XXX orphan instance, use a newtype instead?
6458instance (Monad m, MonadRecorder m)
6559 => MonadRecorder (StateT Context m) where
6660 getJournal = lift getJournal
@@ -83,24 +77,28 @@ getContext lref = do
8377
8478-- | Run an 'AsynclyT m' computation, wait for it to finish and discard the
8579-- results.
86−{-# INLINABLE runAsyncly #-}
87−runAsyncly :: (MonadAsync m, MonadCatch m) => AsynclyT m a -> m ()
88−runAsyncly (AsynclyT m) = do
89− ctx <- liftIO $ getContext Nothing
80+{-# INLINABLE runAsynclyLogged #-}
81+runAsynclyLogged :: MonadAsync m
82+ => Maybe (IORef [Recording]) -> AsynclyT m a -> m ()
83+runAsynclyLogged lref (AsynclyT m) = do
84+ ctx <- liftIO $ getContext lref
9085 _ <- runStateT (run m) ctx
9186 return ()
9287
9388 where
9489
9590 stop = return ()
96− run m = (runAsyncT m) stop (\_ r -> maybe stop run r)
91+ run mx = (runAsyncT mx) stop (\_ r -> maybe stop run r)
92+
93+runAsyncly :: MonadAsync m => AsynclyT m a -> m ()
94+runAsyncly m = runAsynclyLogged Nothing m
9795
9896data Step a r = Stop | Done a | Yield a r
9997
10098-- | Run an 'AsynclyT m' computation and collect the results generated by each
10199-- thread of the computation in a list.
102100{-# INLINABLE toList #-}
103−toList :: (MonadAsync m, MonadCatch m) => AsynclyT m a -> m [a]
101+toList :: MonadAsync m => AsynclyT m a -> m [a]
104102toList (AsynclyT m) = liftIO (getContext Nothing) >>= run m
105103
106104 where
@@ -152,24 +150,23 @@ playRecordings m logs = each logs >>= playRecording m
152150{-
153151-- | Run an 'AsyncT' computation with recording enabled, wait for it to finish
154152-- returning results for completed threads and recordings for paused threads.
155−waitRecord :: (MonadAsync m, MonadCatch m)
156− => AsyncT m a -> m ([a], [Recording])
157−waitRecord m = do
153+toListRecorded :: (MonadAsync m, MonadCatch m)
154+ => AsynclyT m a -> m ([a], [Recording])
155+toListRecorded m = do
158156 resultsRef <- liftIO $ newIORef []
159157 lref <- liftIO $ newIORef []
160158 waitAsync (gatherResult resultsRef) (Just lref) m
161159 res <- liftIO $ readIORef resultsRef
162160 logs <- liftIO $ readIORef lref
163161 return (res, logs)
162+ -}
164163
165164-- | Run an 'AsyncT' computation with recording enabled, wait for it to finish
166165-- and discard the results and return the recordings for paused threads, if
167166-- any.
168−runAsynclyRecorded :: (MonadAsync m, MonadCatch m)
169− => AsynclyT (RecorderT m) a -> m [Recording]
167+runAsynclyRecorded :: MonadAsync m => AsynclyT (RecorderT m) a -> m [Recording]
170168runAsynclyRecorded m = do
171169 lref <- liftIO $ newIORef []
172− runRecorderT blank (waitAsync (const (return Nothing)) (Just lref) m)
170+ runRecorderT blank (runAsynclyLogged (Just lref) m)
173171 logs <- liftIO $ readIORef lref
174172 return logs
175−-}