Ping server

gistfile1.hs

import System.Environment (getArgs, getProgName)
import Control.Concurrent (forkIO)
import Network (Socket, PortID(PortNumber), withSocketsDo, 
                listenOn, accept)
import System.IO (hPutStrLn, hGetLine, hFlush)
import Control.Monad (forever)

main = withSocketsDo $ do
  args <- getArgs
  prog <- getProgName
  case args of
    [port] -> do
      socket <- listenOn $ PortNumber (fromIntegral (read port :: Int))
      putStrLn $ "Listening for pings on " ++ port
      handleRequest socket
    _ ->
      putStrLn $ "usage: " ++ prog ++ " <port>"

handleRequest s = do
  (handle, _, _) <- accept s
  forkIO $
    forever $ do
      input <- hGetLine handle
      processPing (hPutStrLn handle) (init input)
      hFlush handle
  handleRequest s

processPing f msg = do
  case msg of
    "ping" -> f "pong!"
    _      -> f "Did you mean `ping'?"