example.hs

{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.HTTP.Types (status200, status404)
import Network.Wai.Handler.Warp (run)
import Control.Monad.Trans (lift)
import Data.IORef (newIORef, atomicModifyIORef)
import Data.ByteString.Lazy.UTF8 (fromString)

application counter request = function counter
  where
    function = routes $ pathInfo request

routes path = findRoute path routeSetting

findRoute path [] = notFound
findRoute path ((p,f):xs)
    | path == p = f
    | otherwise = findRoute path xs

routeSetting = [([],                 index),
                (["hello"],          hello),
                (["welcome","world"],world)]

notFound _ = return $
    responseLBS status404 [("Content-type", "text/html")] $ "404 - File Not Found"

index _ = return $
    responseLBS status200 [("Content-type", "text/html")] $ "index page"

hello _ = return $
    responseLBS status200 [("Content-type", "text/html")] $ "hello, my name is Tom"

world counter = do
    count <- lift $ incCount counter
    return $ responseLBS status200 [("Content-type", "text/html")] $
      fromString $ show count

incCount counter = atomicModifyIORef counter (\c -> (c+1, c))

main = do
  counter <- newIORef 0
  run 3000 $ application counter