Simple server #Haskell #SpecialOlympics

import Control.Applicative
import Control.Concurrent
import Data.Attoparsec.Char8
import qualified Data.ByteString.Char8 as BS
import Network
import System.IO

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

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

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

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

calc str = case parseOnly (expr <* endOfInput) str of
    Right res -> BS.pack $ show res
    Left err -> BS.pack "error"

process handle = do
    str <- BS.hGetLine handle
    BS.hPutStrLn handle $ calc str
    process handle

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

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