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
+