view prog/example.hs @ 10:bf2da4395b5f default tip

add example
author Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date Sat, 06 Jul 2013 15:04: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 = [([],                 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