Really basic web server

tcp.hs

import Network (listenOn, withSocketsDo, accept, PortID(..), Socket)
import System (getArgs)
import System.IO (hSetBuffering, hGetLine, hPutStrLn, BufferMode(..), Handle, hClose)
import Control.Concurrent (forkIO)

main :: IO ()
main = withSocketsDo $ do
    args <- getArgs
    let port = fromIntegral (read $ head args :: Int)
    sock <- listenOn $ PortNumber port
    putStrLn $ "Listening on " ++ (head args)
    sockHandler sock

sockHandler :: Socket -> IO ()
sockHandler sock = do
    (handle, _, _) <- accept sock
    hSetBuffering handle NoBuffering
    forkIO $ commandProcessor handle
    sockHandler sock

commandProcessor :: Handle -> IO ()
commandProcessor handle = do
    line <- hGetLine handle
    let cmd = words line
    case (head cmd) of
        ("GET") -> echoCommand handle cmd
        ("PUT") -> echoCommand handle cmd
        ("DELETE") -> echoCommand handle cmd
        ("POST") -> echoCommand handle cmd
        _ -> do hPutStrLn handle "Unknown command"
    -- commandProcessor handle

echoCommand :: Handle -> [String] -> IO ()
echoCommand handle cmd = do
    -- hPutStrLn handle (unwords $ tail cmd)
    let headers = "HTTP/1.1 200 OK\nContent-Type: text/html; charset=UTF-8\n\n"
    let message = "Testing"
    hPutStrLn handle $ headers ++ message
    print cmd
    hClose handle