summaryrefslogtreecommitdiff
path: root/src/Control/Concurrent/Lifted/Instrument.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-11-18 22:43:39 -0500
committerjoe <joe@jerkface.net>2017-11-18 22:43:39 -0500
commit0f4e8b298014d9db2cb3ebdb167f3a9d9ca1a3f3 (patch)
tree47eaa1d18e2628b7e7a36f42a9e16dbdd2154d7f /src/Control/Concurrent/Lifted/Instrument.hs
parentbacefe39096c2c39afb6af7f01e729233a47522d (diff)
Removed redundant MonadIO constraint from thread instrumentation.
Diffstat (limited to 'src/Control/Concurrent/Lifted/Instrument.hs')
-rw-r--r--src/Control/Concurrent/Lifted/Instrument.hs9
1 files changed, 4 insertions, 5 deletions
diff --git a/src/Control/Concurrent/Lifted/Instrument.hs b/src/Control/Concurrent/Lifted/Instrument.hs
index 41814d98..5b3237cc 100644
--- a/src/Control/Concurrent/Lifted/Instrument.hs
+++ b/src/Control/Concurrent/Lifted/Instrument.hs
@@ -47,16 +47,15 @@ forkIO :: IO () -> IO ThreadId
47forkIO = fork 47forkIO = fork
48{-# INLINE forkIO #-} 48{-# INLINE forkIO #-}
49 49
50forkOS :: (MonadBaseControl IO m, MonadIO m) => m () -> m ThreadId 50forkOS :: MonadBaseControl IO m => m () -> m ThreadId
51forkOS = instrumented Raw.forkOS 51forkOS = instrumented Raw.forkOS
52{-# INLINE forkOS #-} 52{-# INLINE forkOS #-}
53 53
54fork :: (MonadBaseControl IO m, MonadIO m) => m () -> m ThreadId 54fork :: MonadBaseControl IO m => m () -> m ThreadId
55fork = instrumented Raw.fork 55fork = instrumented Raw.fork
56{-# INLINE fork #-} 56{-# INLINE fork #-}
57 57
58instrumented :: ( MonadBaseControl IO m 58instrumented :: MonadBaseControl IO m =>
59 , MonadIO m) =>
60 (m () -> m ThreadId) -> m () -> m ThreadId 59 (m () -> m ThreadId) -> m () -> m ThreadId
61instrumented rawFork action = do 60instrumented rawFork action = do
62 t <- rawFork $ do 61 t <- rawFork $ do
@@ -66,7 +65,7 @@ instrumented rawFork action = do
66 (return ()) 65 (return ())
67 $ do catch action $ \e -> case fromException e of 66 $ do catch action $ \e -> case fromException e of
68 Just ThreadKilled -> return () 67 Just ThreadKilled -> return ()
69 Nothing -> liftIO $ do 68 Nothing -> liftBase $ do
70 g <- takeMVar globals 69 g <- takeMVar globals
71 let l = concat [ show e 70 let l = concat [ show e
72 , " (" 71 , " ("