{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.HList.TypeEqGeneric1()
import Data.HList.TypeCastGeneric1()
import ByteStringOperators

import Data.ByteString.Lazy.Char8 as L 
    ( ByteString
    , hPutStrLn
    , init )
import System.IO 
    ( Handle
    )
import Control.Concurrent (forkIO)
import Control.Concurrent.Chan
import Data.HList

import Connection.Tcp


startCon socket st  = do
    let chan = hOccursFst st
        nr = hOccursFst st :: ConnId
        hdl = hOccursFst st :: Handle
        quit = writeChan chan (nr,Nothing)
        broadcast msg = writeChan chan (nr,Just msg)
    chan' <- dupChan chan
    reader <- forkIO $ fix $ \loop -> do
        (nr', line) <- readChan chan'
        case ( line, nr==nr') of
          ( Nothing   , True  ) -> Prelude.putStrLn "quit-client."
          ( Just msg  , False ) -> hPutStrLn hdl msg >> loop
          _                     -> loop

    hPutStrLn hdl "Hi, what's your name?"
    line <- getPacket hdl
    let name = L.init line
    Prelude.putStrLn $ "readFst: " ++ show line
    hPutStrLn hdl ("Welcome, " <++> name <++> "!")
    broadcast ("--> " <++> name <++> " entered.")

    return (name .*. ConnectionFinalizer quit .*. st)

doCon st bs cont = do
    let hdl = hOccursFst st :: Handle 
        nr = hOccursFst st :: ConnId
        chan = hOccursFst st
        broadcast msg = writeChan chan (nr,Just msg)
        name = hHead st
    Prelude.putStrLn $ "read: " ++ show bs
    case bs of
     "quit\n" -> hPutStrLn hdl "Bye!"
     _      -> do
        broadcast (name <++> ": " <++> L.init bs)
        cont ()


main = do
    (chan :: Chan (ConnId, Maybe ByteString)) <- newChan
    doServer (5222 .*. chan .*. HNil)
             doCon
             startCon
    getLine