Added conduit API

This commit is contained in:
Michael Snoyman 2014-03-07 07:19:24 +02:00
parent 0a2c3a1d7a
commit 15b509fcab
2 changed files with 28 additions and 2 deletions

View File

@ -1,17 +1,24 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
module Yesod.WebSockets module Yesod.WebSockets
( WebsocketsT ( -- * Core API
WebsocketsT
, webSockets , webSockets
, receiveData , receiveData
, sendTextData , sendTextData
, sendBinaryData , sendBinaryData
-- * Conduit API
, sourceWS
, sinkWSText
, sinkWSBinary
) where ) where
import Control.Monad (when) import Control.Monad (when, forever)
import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Control (control) import Control.Monad.Trans.Control (control)
import Control.Monad.Trans.Reader (ReaderT (ReaderT, runReaderT)) import Control.Monad.Trans.Reader (ReaderT (ReaderT, runReaderT))
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Network.Wai.Handler.WebSockets as WaiWS import qualified Network.Wai.Handler.WebSockets as WaiWS
import qualified Network.WebSockets as WS import qualified Network.WebSockets as WS
import qualified Yesod.Core as Y import qualified Yesod.Core as Y
@ -58,3 +65,21 @@ sendTextData x = ReaderT $ liftIO . flip WS.sendTextData x
-- Since 0.1.0 -- Since 0.1.0
sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebsocketsT m () sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebsocketsT m ()
sendBinaryData x = ReaderT $ liftIO . flip WS.sendBinaryData x sendBinaryData x = ReaderT $ liftIO . flip WS.sendBinaryData x
-- | A @Source@ of WebSockets data from the user.
--
-- Since 0.1.0
sourceWS :: (MonadIO m, WS.WebSocketsData a) => C.Producer (WebsocketsT m) a
sourceWS = forever $ Y.lift receiveData >>= C.yield
-- | A @Sink@ for sending textual data to the user.
--
-- Since 0.1.0
sinkWSText :: (MonadIO m, WS.WebSocketsData a) => C.Consumer a (WebsocketsT m) ()
sinkWSText = CL.mapM_ sendTextData
-- | A @Sink@ for sending binary data to the user.
--
-- Since 0.1.0
sinkWSBinary :: (MonadIO m, WS.WebSocketsData a) => C.Consumer a (WebsocketsT m) ()
sinkWSBinary = CL.mapM_ sendBinaryData

View File

@ -22,6 +22,7 @@ library
, transformers >= 0.2 , transformers >= 0.2
, yesod-core >= 1.2.7 , yesod-core >= 1.2.7
, monad-control >= 0.3 , monad-control >= 0.3
, conduit >= 1.0.15.1
source-repository head source-repository head
type: git type: git