Added conduit API
This commit is contained in:
parent
0a2c3a1d7a
commit
15b509fcab
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user