Network.hs

module Game.TcgMud.Network
    ( runServer
    ) where

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (atomically, TVar, newTVarIO, readTVar, modifyTVar')
import Control.Monad (forever)
import Network (HostName, withSocketsDo, listenOn, PortNumber, PortID(PortNumber), accept)
import System.IO (Handle, hGetLine, hPrint, hClose)
import Control.Exception (finally)

runServer :: (Show a) => PortNumber -> a -> ((HostName, PortNumber) -> a -> a) -> ((HostName, PortNumber) -> String -> a -> a) -> ((HostName, PortNumber) -> a -> a) -> IO ()
runServer port world onConnect onInput onDisconnect = do
    worldVar <- newTVarIO world
    withSocketsDo $ do
        server <- listenOn (PortNumber port)
        forever $ do
            (client, host, port) <- accept server
            forkIO handleClient where
                handleClient :: IO ()
                handleClient = (connect >> talk) `finally` disconnect

                connect = do
                    atomically $ modifyTVar' worldVar $ onConnect ident

                talk = forever $ do
                    line <- hGetLine client
                    atomically $ modifyTVar' worldVar $ onInput ident line

                disconnect = do
                    hClose client
                    atomically $ modifyTVar' worldVar $ onDisconnect ident

                ident = (host, port)