Mercurial > hg > Papers > 2014 > toma-master
diff paper/src/warp.hs @ 13:17676e245515
add warp
author | Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Thu, 30 Jan 2014 17:29:07 +0900 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/warp.hs Thu Jan 30 17:29:07 2014 +0900 @@ -0,0 +1,38 @@ +{-# 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