view Paper/src/warp.hs @ 3:2a4370ed68bc

add a description of the warp
author Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date Thu, 18 Jul 2013 09:07:57 +0900
parents
children
line wrap: on
line source

{-# 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