summaryrefslogtreecommitdiff
path: root/dht/Presence/Control/Concurrent/STM/Util.hs
blob: 4be3cff50946c0755a1584710c5e310e9462e4f3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
module Control.Concurrent.STM.Util where

import Control.Monad.IO.Class
import Control.Concurrent.STM

chanContents :: TChan x -> IO [x]
chanContents ch = do
        x  <- atomically $ do
            bempty <- isEmptyTChan ch
            if bempty
                then return Nothing
                else fmap Just $ readTChan ch
        maybe (return [])
              (\x -> do
                xs <- chanContents ch
                return (x:xs))
              x

ioWriteChan :: MonadIO m => TChan a -> a -> m ()
ioWriteChan c v = liftIO . atomically $ writeTChan c v