Mercurial > hg > Members > toma > osc2013
changeset 6:e9af42a3707b
add prog files
author | Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Sat, 06 Jul 2013 11:07:49 +0900 |
parents | 69e052c7ef6c |
children | eea79db7cd9e |
files | prog/counter.hs prog/hello.hs prog/routes.hs |
diffstat | 3 files changed, 61 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/prog/counter.hs Sat Jul 06 11:07:49 2013 +0900 @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} +import Network.Wai +import Network.HTTP.Types (status200) +import Network.Wai.Handler.Warp (run) +import Control.Monad.Trans (liftIO, lift) +import Data.IORef (newIORef, atomicModifyIORef) +import Data.ByteString.Lazy.UTF8 (fromString) + +application counter request = 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/prog/hello.hs Sat Jul 06 11:07:49 2013 +0900 @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} +import Network.Wai +import Network.HTTP.Types (status200) +import Network.Wai.Handler.Warp (run) + +application _ = return $ + responseLBS status200 [("Content-Type", "text/plain")] "Hello World" + +main = run 3000 application +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/prog/routes.hs Sat Jul 06 11:07:49 2013 +0900 @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +import Network.Wai +import Network.HTTP.Types (status200, status404) +import Network.Wai.Handler.Warp (run) + +application request = return $ + 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 = + responseLBS status404 [("Content-type", "text/html")] $ "404 - File Not Found" + +index = + responseLBS status200 [("Content-type", "text/html")] $ "index page" + +hello = + responseLBS status200 [("Content-type", "text/html")] $ "hello, my name is Tom" + +world = + responseLBS status200 [("Content-type", "text/html")] $ "Welcome to Underground" + +main = run 3000 application +