{-# 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 = [(["hello"], hello), (["hello","world"], world)] notFound _ = return $ responseLBS status404 [("Content-type", "text/html")] $ "404" hello _ = return $ responseLBS status200 [("Content-type", "text/html")] $ "hello" 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