git.iko.soy/streamly
on 63407dc help sign in
streamly/src/Streamly/Internal/Control/Concurrent.hs
77 lines 2.5 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)
26import Streamly.Internal.Data.SVar.Type (RunInIO(..))
28#ifdef USE_UNLIFTIO
29import Control.Monad.IO.Unlift (MonadUnliftIO(..), UnliftIO(..), askUnliftIO)
30#else
31import Control.Monad.IO.Class (MonadIO)
32import Control.Monad.Trans.Control (MonadBaseControl(..), control)
33#endif
35#ifdef USE_UNLIFTIO
36type MonadRunInIO m = MonadUnliftIO m
37#else
38type MonadRunInIO m = (MonadIO m, MonadBaseControl IO m)
39#endif
41-- | A monad that can perform concurrent or parallel IO operations. Streams
42-- that can be composed concurrently require the underlying monad to be
43-- 'MonadAsync'.
44--
45#ifdef USE_UNLIFTIO
46type MonadAsync m = (MonadUnliftIO m, MonadThrow m)
47#else
48type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)
49#endif
51-- | When we run computations concurrently, we completely isolate the state of
52-- the concurrent computations from the parent computation. The invariant is
53-- that we should never be running two concurrent computations in the same
54-- thread without using the runInIO function. Also, we should never be running
55-- a concurrent computation in the parent thread, otherwise it may affect the
56-- state of the parent which is against the defined semantics of concurrent
57-- execution.
58askRunInIO :: MonadRunInIO m => m (RunInIO m)
59#ifdef USE_UNLIFTIO
60askRunInIO = fmap (\(UnliftIO run) -> RunInIO run) askUnliftIO
61#else
62askRunInIO = control $ \run -> run (return $ RunInIO run)
63#endif
65#ifdef USE_UNLIFTIO
66withRunInIONoRestore :: MonadRunInIO m => ((forall a. m a -> IO a) -> IO b) -> m b
67withRunInIONoRestore = withRunInIO
69restoreM :: MonadRunInIO m => a -> m a
70restoreM = return
71#else
72withRunInIO :: MonadRunInIO m => ((forall a. m a -> IO (StM m a)) -> IO (StM m b)) -> m b
73withRunInIO = control
75withRunInIONoRestore :: MonadRunInIO m => ((forall a. m a -> IO (StM m a)) -> IO b) -> m b
76withRunInIONoRestore = liftBaseWith
77#endif