add a couple of variables to speed up UID lookups. Based on the assumption new visual gears and gears will tend to be at the end of the list. Set them on successful lookup or script gear creation, clear on delete. Oh also pick up a couple of TrevInc's translation changes
{-# LANGUAGE ScopedTypeVariables #-}
module ClientIO where
import qualified Control.Exception as Exception
import Control.Concurrent.Chan
import Control.Concurrent
import Control.Monad
import System.IO
import qualified Data.ByteString.UTF8 as BUTF8
import qualified Data.ByteString as B
----------------
import CoreTypes
listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()
listenLoop handle linesNumber buf chan clientID = do
str <- liftM BUTF8.toString $ B.hGetLine handle
if (linesNumber > 50) || (length str > 20000) then
writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
else
if str == "" then do
writeChan chan $ ClientMessage (clientID, buf)
yield
listenLoop handle 0 [] chan clientID
else
listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID
clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO ()
clientRecvLoop handle chan clientID =
listenLoop handle 0 [] chan clientID
`catch` (\e -> clientOff (show e) >> return ())
where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()
clientSendLoop handle coreChan chan clientID = do
answer <- readChan chan
doClose <- Exception.handle
(\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do
B.hPutStrLn handle $ BUTF8.fromString $ unlines answer
hFlush handle
return $ isQuit answer
if doClose then
Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle
else
clientSendLoop handle coreChan chan clientID
where
sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
isQuit ("BYE":xs) = True
isQuit _ = False