@@ -16,7 +16,8 @@ import qualified Control.Concurrent as IO
16
16
import Control.Exception (AsyncException (ThreadKilled ), Exception )
17
17
import Control.Monad.Reader (ReaderT (.. ), lift )
18
18
import Data.Kind (Type )
19
- import qualified GHC.Conc.Sync as IO (labelThread )
19
+ import GHC.Conc (ThreadStatus )
20
+ import qualified GHC.Conc.Sync as IO (labelThread , threadStatus )
20
21
21
22
22
23
class (Monad m , Eq (ThreadId m ),
@@ -27,6 +28,7 @@ class (Monad m, Eq (ThreadId m),
27
28
28
29
myThreadId :: m (ThreadId m )
29
30
labelThread :: ThreadId m -> String -> m ()
31
+ threadStatus :: ThreadId m -> m ThreadStatus
30
32
31
33
32
34
class MonadThread m => MonadFork m where
@@ -53,6 +55,7 @@ instance MonadThread IO where
53
55
type ThreadId IO = IO. ThreadId
54
56
myThreadId = IO. myThreadId
55
57
labelThread = IO. labelThread
58
+ threadStatus = IO. threadStatus
56
59
57
60
instance MonadFork IO where
58
61
forkIO = IO. forkIO
@@ -65,6 +68,7 @@ instance MonadThread m => MonadThread (ReaderT r m) where
65
68
type ThreadId (ReaderT r m ) = ThreadId m
66
69
myThreadId = lift myThreadId
67
70
labelThread t l = lift (labelThread t l)
71
+ threadStatus t = lift (threadStatus t)
68
72
69
73
instance MonadFork m => MonadFork (ReaderT e m ) where
70
74
forkIO (ReaderT f) = ReaderT $ \ e -> forkIO (f e)
0 commit comments