diff options
Diffstat (limited to 'Presence/Control/Concurrent')
-rw-r--r-- | Presence/Control/Concurrent/STM/Util.hs | 21 |
1 files changed, 21 insertions, 0 deletions
diff --git a/Presence/Control/Concurrent/STM/Util.hs b/Presence/Control/Concurrent/STM/Util.hs new file mode 100644 index 00000000..4be3cff5 --- /dev/null +++ b/Presence/Control/Concurrent/STM/Util.hs | |||
@@ -0,0 +1,21 @@ | |||
1 | module Control.Concurrent.STM.Util where | ||
2 | |||
3 | import Control.Monad.IO.Class | ||
4 | import Control.Concurrent.STM | ||
5 | |||
6 | chanContents :: TChan x -> IO [x] | ||
7 | chanContents ch = do | ||
8 | x <- atomically $ do | ||
9 | bempty <- isEmptyTChan ch | ||
10 | if bempty | ||
11 | then return Nothing | ||
12 | else fmap Just $ readTChan ch | ||
13 | maybe (return []) | ||
14 | (\x -> do | ||
15 | xs <- chanContents ch | ||
16 | return (x:xs)) | ||
17 | x | ||
18 | |||
19 | ioWriteChan :: MonadIO m => TChan a -> a -> m () | ||
20 | ioWriteChan c v = liftIO . atomically $ writeTChan c v | ||
21 | |||