module Hemokit.Conduit where
import Control.Concurrent (forkIO)
import Control.Concurrent.Chan
import Control.Monad
import Control.Monad.Trans
import Data.Aeson (ToJSON (..), encode)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Conduit
import qualified Network.Simple.TCP as TCP
import qualified Network.WebSockets as WS
import Hemokit
import Hemokit.Internal.Utils (untilNothing)
rawSource :: (MonadIO m) => EmotivDevice -> Source m EmotivRawData
rawSource dev = void $ untilNothing (liftIO (readEmotivRaw dev)) yield
parsePackets :: (MonadIO m) => EmotivDevice -> Conduit EmotivRawData m (EmotivState, EmotivPacket)
parsePackets dev = awaitForever (\raw -> liftIO (updateEmotivState dev raw) >>= yield)
emotivStates :: (MonadIO m) => EmotivDevice -> Source m EmotivState
emotivStates dev = rawSource dev $= mapOutput fst (parsePackets dev)
emotivPackets :: (MonadIO m) => EmotivDevice -> Source m EmotivPacket
emotivPackets dev = rawSource dev $= mapOutput snd (parsePackets dev)
jsonConduit :: (Monad m, ToJSON i) => Conduit i m ByteString
jsonConduit = awaitForever (yield . encode)
tcpSink :: (MonadIO m) => String -> Int -> Sink ByteString m ()
tcpSink host port = do
chan <- liftIO $ newChan
let jsonTCPServerFromChan :: (TCP.Socket, TCP.SockAddr) -> IO ()
jsonTCPServerFromChan = \(sock, _remoteAddr) -> do
void $ untilNothing (readChan chan) (TCP.send sock . BSL.toStrict)
_ <- liftIO $ forkIO $ TCP.withSocketsDo $ TCP.serve (TCP.Host host) (show port) jsonTCPServerFromChan
void $ awaitForever (liftIO . writeChan chan . Just)
liftIO $ writeChan chan Nothing
websocketSink :: (MonadIO m) => String -> Int -> Sink ByteString m ()
websocketSink host port = do
chan <- liftIO $ newChan
let jsonWSServerFromChan :: WS.PendingConnection -> IO ()
jsonWSServerFromChan = \req -> do
conn <- WS.acceptRequest req
void $ untilNothing (readChan chan) (WS.sendTextData conn)
_ <- liftIO $ forkIO $ WS.runServer host port jsonWSServerFromChan
void $ awaitForever (liftIO . writeChan chan . Just)
liftIO $ writeChan chan Nothing