diff options
author | Joe Crayne <joe@jerkface.net> | 2018-11-04 23:32:38 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-11-05 00:02:04 -0500 |
commit | e8d00e729f1d6737180210d018f78e4b2efd8a35 (patch) | |
tree | a5b47ca8ba7f5389e696a4c9d4e48607e6803fdf /Presence/Control/Concurrent/STM | |
parent | ed3bfff125c3a81f2318ac7541123f3311e2d94e (diff) |
Factored Stanza.{Types,Parse} out of XMPPServer.
Diffstat (limited to 'Presence/Control/Concurrent/STM')
-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 | |||