Infinitely lazy server #Haskell #TCP #SpecialOlympics

import Control.Applicative
import Control.Concurrent
import Data.Attoparsec.Char8 hiding (parse, maybeResult)
import Data.Attoparsec.Lazy (skip, parse, maybeResult)
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe (fromMaybe)
import Network
import Network.Socket hiding (accept)
import System.IO

import Data.Char

chainl1 elem op = elem >>= rest where
    rest s1 = do {f <- op; s2 <- chainl1 elem op; return $ f s1 s2} <|> return s1

expr :: Parser Int
expr = chainl1 term $ (char '+' >> return (+)) <|> (char '-' >> return (-))

term = chainl1 factor $ char '*' >> return (*)

factor = (char '(' *> expr <* char ')') <|> decimal

calc str = case maybeResult $ parse (expr <* (skip isEndOfLine >> endOfInput)) str of
    Nothing -> BS.pack "error"
    Just res -> BS.pack $ show res

process handle = do
    all <- BS.hGetContents handle
    mapM_ (BS.hPutStrLn handle . calc) $ BS.split '\n' all

handler sock = do
    (handle, host, port) <- accept sock
    hSetBuffering handle LineBuffering
    forkIO $ process handle
    handler sock

main = do
    sock <- listenOn (PortNumber 65535)
    setSocketOption sock NoDelay 1
    handler sock