Mercurial > hg > Papers > 2013 > toma-jssst
comparison 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 |
comparison
equal
deleted
inserted
replaced
| 2:92fbcd85d3b9 | 3:2a4370ed68bc |
|---|---|
| 1 {-# LANGUAGE OverloadedStrings #-} | |
| 2 import Network.Wai | |
| 3 import Network.HTTP.Types (status200, status404) | |
| 4 import Network.Wai.Handler.Warp (run) | |
| 5 import Control.Monad.Trans (lift) | |
| 6 import Data.IORef (newIORef, atomicModifyIORef) | |
| 7 import Data.ByteString.Lazy.UTF8 (fromString) | |
| 8 | |
| 9 application counter request = function counter | |
| 10 where | |
| 11 function = routes $ pathInfo request | |
| 12 | |
| 13 routes path = findRoute path routeSetting | |
| 14 | |
| 15 findRoute path [] = notFound | |
| 16 findRoute path ((p,f):xs) | |
| 17 | path == p = f | |
| 18 | otherwise = findRoute path xs | |
| 19 | |
| 20 routeSetting = [(["hello"], hello), | |
| 21 (["hello","world"], world)] | |
| 22 | |
| 23 notFound _ = return $ | |
| 24 responseLBS status404 [("Content-type", "text/html")] $ "404" | |
| 25 | |
| 26 hello _ = return $ | |
| 27 responseLBS status200 [("Content-type", "text/html")] $ "hello" | |
| 28 | |
| 29 world counter = do | |
| 30 count <- lift $ incCount counter | |
| 31 return $ responseLBS status200 [("Content-type", "text/html")] $ | |
| 32 fromString $ show count | |
| 33 | |
| 34 incCount counter = atomicModifyIORef counter (\c -> (c+1, c)) | |
| 35 | |
| 36 main = do | |
| 37 counter <- newIORef 0 | |
| 38 run 3000 $ application counter |