src/Streamly/Internal/Control/ForkLifted.hs · streamly

git.iko.soy/streamly

on 209e990 help sign in

streamly/src/Streamly/Internal/Control/ForkLifted.hs

66 lines 2.1 kB history raw

1-- |

2-- Module : Streamly.Internal.Control.ForkLifted

4-- License : BSD-3-Clause

5-- Maintainer : streamly@composewell.com

6-- Stability : experimental

7-- Portability : GHC

9module Streamly.Internal.Control.ForkLifted

10 (

11 doFork

12 , doForkWith

13 , fork

14 , forkManaged

15 )

16where

18import Control.Concurrent (ThreadId, forkIO, forkOS)

19import Control.Exception (SomeException(..), catch, mask)

20import Data.Functor (void)

21import Streamly.Internal.Control.Concurrent (MonadRunInIO, RunInIO(..), withRunInIO, withRunInIONoRestore)

22import Streamly.Internal.Control.ForkIO (rawForkIO, forkManagedWith)

24-- | Fork a thread to run the given computation, installing the provided

25-- exception handler. Lifted to any monad with 'MonadRunInIO m'

26-- capability.

27--

28-- TODO: the RunInIO argument can be removed, we can directly pass the action

29-- as "mrun action" instead.

30{-# INLINE doFork #-}

31doFork :: MonadRunInIO m

32 => m ()

33 -> RunInIO m

34 -> (SomeException -> IO ())

35 -> m ThreadId

36doFork = doForkWith False

38-- | Similar to 'doFork', but has a \"bound\" boolean parameter for specifying

39-- whether 'forkOS' should be used instead of 'rawForkIO'.

40{-# INLINE doForkWith #-}

41doForkWith :: MonadRunInIO m

42 => Bool

43 -> m ()

44 -> RunInIO m

45 -> (SomeException -> IO ())

46 -> m ThreadId

47doForkWith bound action (RunInIO mrun) exHandler =

48 withRunInIO $ \run ->

49 mask $ \restore -> do

50 tid <- (if bound then forkOS else rawForkIO) $

51 catch (restore $ void $ mrun action)

52 exHandler

53 run (return tid)

55-- | 'fork' lifted to any monad with 'MonadBaseControl IO m' capability.

56--

57{-# INLINABLE fork #-}

58fork :: MonadRunInIO m => m () -> m ThreadId

59fork m = withRunInIONoRestore $ \run -> forkIO $ void $ run m

61-- | Fork a thread that is automatically killed as soon as the reference to the

62-- returned threadId is garbage collected.

63--

64{-# INLINABLE forkManaged #-}

65forkManaged :: MonadRunInIO m => m () -> m ThreadId

66forkManaged = forkManagedWith fork