module PlayTak (
module PlayTak.Commands,
module PlayTak.Parser,
module PlayTak.Types,
playTakClient
) where
import Control.Concurrent
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Network.Socket hiding (recv, send)
import Network.Socket.ByteString
import PlayTak.Commands
import PlayTak.Parser
import PlayTak.Types
type PlayTakHandler a = PlayTakClient -> PlayTakMsg -> a -> IO a
playTakClient :: PlayTakHandler a -> a -> IO ()
playTakClient handler state = do
sock <- socket AF_INET Stream defaultProtocol
addrs <- getAddrInfo Nothing (Just "playtak.com") (Just "10000")
connect sock $ addrAddress $ head addrs
chanMsg <- newChan
chanCmd <- newChan
_ <- forkOS $ handleMessages chanMsg chanCmd handler state
_ <- forkOS $ pinger chanCmd
_ <- forkOS $ writer sock chanCmd
reader sock chanMsg
handleMessages :: Chan PlayTakMsg -> Chan String -> PlayTakHandler a -> a -> IO ()
handleMessages chanMsg chanCmd handler state = loop state where
loop currState = do
msg <- readChan chanMsg
currState' <- handler ptc msg currState
loop currState'
ptc = PlayTakClient chanCmd
pinger :: Chan String -> IO ()
pinger chanCmd = forever $ do
writeChan chanCmd "PING"
threadDelay $ 15 * 1000000
writer :: Socket -> Chan String -> IO ()
writer sock chanCmd = forever $ do
cmd <- readChan chanCmd
send' $ cmd ++ "\n"
where
send' str = do
sent <- send sock $ BS.pack str
if sent < length str then error "Not all data sent" else return ()
reader :: Socket -> Chan PlayTakMsg -> IO ()
reader sock chanMsg = loop BS.empty where
loop leftover = do
str <- if BS.elem '\n' leftover
then return leftover
else do
received <- recv sock 4096
return $ BS.append leftover received
let (line, rest) = BS.breakSubstring (BS.pack "\n") str
rest' = if BS.length rest == 0 then rest else BS.tail rest
case parsePlayTak line of
Left err -> writeChan chanMsg $ ParseFailed (BS.unpack line) err
Right msg -> writeChan chanMsg msg
loop rest'