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 Data.Conduit
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)
websocketSink :: (MonadIO m, ToJSON a) => String -> Int -> Sink a 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 . encode)
_ <- liftIO $ forkIO $ WS.runServer host port jsonWSServerFromChan
void $ awaitForever (liftIO . writeChan chan . Just)
liftIO $ writeChan chan Nothing