git.iko.soy/streamly
on ba01fcd help sign in
streamly/core/src/Streamly/Internal/Control/Concurrent.hs
88 lines 2.7 kB history raw
1-- |
2-- Module : Streamly.Internal.Control.Concurrent
3-- Copyright : (c) 2017 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
8--
9-- Note: This module is primarily for abstractions related to MonadBaseControl.
10-- Please do not add any general routines in this. It should be renamed
11-- appropriately.
13module Streamly.Internal.Control.Concurrent
14 (
15 MonadAsync
16 , MonadRunInIO
17 , RunInIO(..)
18 , askRunInIO
19 , withRunInIO
20 , withRunInIONoRestore
21 , restoreM
22 )
23where
25import Control.Monad.Catch (MonadThrow)
27#ifdef USE_UNLIFTIO
28import Control.Monad.IO.Unlift (MonadUnliftIO(..), UnliftIO(..), askUnliftIO)
29#else
30import Control.Monad.IO.Class (MonadIO)
31import Control.Monad.Trans.Control (MonadBaseControl(..), control)
32#endif
34#ifdef USE_UNLIFTIO
35type MonadRunInIO m = MonadUnliftIO m
36#else
37type MonadRunInIO m = (MonadIO m, MonadBaseControl IO m)
38#endif
40-- /Since: 0.8.0 ("Streamly.Prelude")/
41--
42-- | A monad that can perform concurrent or parallel IO operations. Streams
43-- that can be composed concurrently require the underlying monad to be
44-- 'MonadAsync'.
45--
46-- /Since: 0.1.0 ("Streamly")/
47--
48-- @since 0.8.0
49#ifdef USE_UNLIFTIO
50type MonadAsync m = (MonadUnliftIO m, MonadThrow m)
51#else
52type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)
53#endif
56#ifdef USE_UNLIFTIO
57newtype RunInIO m = RunInIO { runInIO :: forall b. m b -> IO b }
58#else
59newtype RunInIO m = RunInIO { runInIO :: forall b. m b -> IO (StM m b) }
60#endif
62-- | When we run computations concurrently, we completely isolate the state of
63-- the concurrent computations from the parent computation. The invariant is
64-- that we should never be running two concurrent computations in the same
65-- thread without using the runInIO function. Also, we should never be running
66-- a concurrent computation in the parent thread, otherwise it may affect the
67-- state of the parent which is against the defined semantics of concurrent
68-- execution.
69askRunInIO :: MonadRunInIO m => m (RunInIO m)
70#ifdef USE_UNLIFTIO
71askRunInIO = fmap (\(UnliftIO run) -> RunInIO run) askUnliftIO
72#else
73askRunInIO = control $ \run -> run (return $ RunInIO run)
74#endif
76#ifdef USE_UNLIFTIO
77withRunInIONoRestore :: MonadRunInIO m => ((forall a. m a -> IO a) -> IO b) -> m b
78withRunInIONoRestore = withRunInIO
80restoreM :: MonadRunInIO m => a -> m a
81restoreM = return
82#else
83withRunInIO :: MonadRunInIO m => ((forall a. m a -> IO (StM m a)) -> IO (StM m b)) -> m b
84withRunInIO = control
86withRunInIONoRestore :: MonadRunInIO m => ((forall a. m a -> IO (StM m a)) -> IO b) -> m b
87withRunInIONoRestore = liftBaseWith
88#endif