From e8d00e729f1d6737180210d018f78e4b2efd8a35 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sun, 4 Nov 2018 23:32:38 -0500 Subject: Factored Stanza.{Types,Parse} out of XMPPServer. --- Presence/Control/Concurrent/STM/Util.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 Presence/Control/Concurrent/STM/Util.hs (limited to 'Presence/Control') 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 @@ +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 + -- cgit v1.2.3