on master help sign in
Remove redundant composition primitives
eca7d81Harendra Kumar
src/Asyncly.hs+1−9
@@ -137,19 +137,11 @@ module Asyncly
137 , each
137 , each
138 --, gather
138 --, gather
139
139
140− -- * Compose
141− , before
142− , (*>>)
143− , thereafter
144− , (>>*)
145− , afterfirst
146− , (>>|)
147− -}
148−
149 -- * Record and Play
140 -- * Record and Play
150 --, waitRecord
141 --, waitRecord
151 --, waitRecord_
142 --, waitRecord_
152 --, playRecordings
143 --, playRecordings
144+-}
153 )
145 )
154where
146where
155
147
src/Asyncly/AsyncT.hs+1−54
@@ -25,22 +25,12 @@ module Asyncly.AsyncT
25-- , async
25-- , async
26-- , makeAsync
26-- , makeAsync
27
27
28−{-
29− , before
30− , (*>>)
31− , thereafter
32− , (>>*)
33− , afterfirst
34− , (>>|)
35− -}
36−
37 -- internal
28 -- internal
38 , dbg
29 , dbg
39 )
30 )
40where
31where
41
32
42import Control.Applicative (Alternative (..))
33import Control.Applicative (Alternative (..))
43−import Data.Maybe (maybe)
44import Control.Monad (ap, mzero, when)
34import Control.Monad (ap, mzero, when)
45import Control.Monad.Base (MonadBase (..), liftBaseDefault)
35import Control.Monad.Base (MonadBase (..), liftBaseDefault)
46import Control.Monad.Catch (MonadThrow, throwM)
36import Control.Monad.Catch (MonadThrow, throwM)
@@ -52,6 +42,7 @@ import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..),
52 MonadTransControl (..),
42 MonadTransControl (..),
53 defaultLiftBaseWith,
43 defaultLiftBaseWith,
54 defaultRestoreM, liftBaseWith)
44 defaultRestoreM, liftBaseWith)
45+import Data.Maybe (maybe)
55import Data.IORef (newIORef, readIORef, writeIORef)
46import Data.IORef (newIORef, readIORef, writeIORef)
56import Unsafe.Coerce (unsafeCoerce)
47import Unsafe.Coerce (unsafeCoerce)
57
48
@@ -213,50 +204,6 @@ instance (MonadAsync m, MonadRecorder m) => MonadRecorder (AsyncT m) where
213 putJournal = lift . putJournal
204 putJournal = lift . putJournal
214 play = lift . play
205 play = lift . play
215
206
216−------------------------------------------------------------------------------
217−-- Special compositions
218−------------------------------------------------------------------------------
219−
220−{-
221−-- | Run @m a@ before running @m b@. The result of @m a@ is discarded.
222−before :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m b
223−before ma mb = AsyncT $ \stp yld ->
224− (runAsyncT ma) ((runAsyncT mb) stp yld) yld
225−
226−infixr 1 *>>
227−-- | Same as 'before'.
228−(*>>) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m b
229−(*>>) = before
230−
231−-- | Run @m b@ after running @m a@. The result of @m b@ is discarded.
232−thereafter :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
233−thereafter ma mb = AsyncT $ do
234− a <- runAsyncT ma
235− _ <- runAsyncT (mb >> mzero)
236− return a
237−
238−infixr 1 >>*
239−-- | Same as 'thereafter'.
240−(>>*) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
241−(>>*) = thereafter
242−
243−-- XXX This can be moved to utility functions as it is purely app level
244−-- | Run @m b@ right after the first event in @m a@ is generated but before it
245−-- is yielded. The result of @m b@ is discarded.
246−afterfirst :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
247−afterfirst ma mb = do
248− ref <- liftIO $ newIORef False
249− x <- ma
250− done <- liftIO $ readIORef ref
251− when (not done) $ (liftIO $ writeIORef ref True) >>* mb
252− return x
253−
254−infixr 1 >>|
255−-- | Same as 'afterfirst'.
256−(>>|) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
257−(>>|) = afterfirst
258−-}
259−
260------------------------------------------------------------------------------
207------------------------------------------------------------------------------
261-- Async primitives
208-- Async primitives
262------------------------------------------------------------------------------
209------------------------------------------------------------------------------