|
13
|
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
|
