{-# LANGUAGE TemplateHaskell #-}

module Tcp
( runServer
) where

import           Control.Concurrent
import           Control.Lens
import           Control.Monad.State
import           Data.Maybe          (isJust)
import           Network
import           System.IO

import           EventLog

data ClientSessionData = ClientSessionData { _handle     :: Handle
                                           , _subscriber :: Maybe Subscriber
                                           }

makeLenses ''ClientSessionData

type ClientSession = StateT ClientSessionData IO

pongCommand :: ClientSession ()
pongCommand = do
  session <- get
  liftIO $ hPutStrLn (_handle session) "pong"

unknownCommand :: ClientSession ()
unknownCommand = do
  session <- get
  liftIO $ hPutStrLn (_handle session) "Unknown command"

notifyCommand :: EventLog -> [String] -> ClientSession ()
notifyCommand eventLog args = do
  session <- get
  let eventId = unwords args
  liftIO $ notify eventLog eventId

registerCommand :: EventLog -> ClientSession ()
registerCommand eventLog = do
  session <- get
  if isJust (_subscriber session) then
    liftIO $ hPutStrLn (_handle session) "already registered"
  else do
    newSub <- liftIO $ newSubscriber $ hPutStrLn $ _handle session
    liftIO $ register eventLog newSub
    modify' $ set' subscriber $ Just newSub

unregisterCommand :: EventLog -> ClientSession ()
unregisterCommand eventLog = get >>= \session ->
    mapM_ (liftIO . unregister eventLog) (_subscriber session)

portNumber = PortNumber 32044

runServer :: EventLog -> IO ()
runServer eventLog = withSocketsDo $ do

  sock <- listenOn portNumber
  putStrLn $ "listening on " ++ show portNumber

  forever $ do
    (handle, _, _) <- accept sock
    let session = ClientSessionData handle Nothing
    forkIO $ do
      execStateT (handleClientInput eventLog) session
      return ()

handleClientInput :: EventLog -> ClientSession ()
handleClientInput eventLog = do
  session <- get
  let handle = _handle session
  line <- liftIO $ hGetLine handle
  let cmd = words line
  if head cmd `elem` ["exit", "quit"] then do
    liftIO $ hPutStrLn handle "Good Bye."
    liftIO $ hClose handle
  else do
    case head cmd of
      ("ping") -> pongCommand
      ("notify") -> notifyCommand eventLog (tail cmd)
      ("register") -> registerCommand eventLog
      ("unregister") -> unregisterCommand eventLog
      _ -> unknownCommand
    handleClientInput eventLog
