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
        -- print line
        case parsePlayTak line of
            Left err -> writeChan chanMsg $ ParseFailed (BS.unpack line) err
            Right msg -> writeChan chanMsg msg
        loop rest'