Mercurial > hg > Members > toma > bulletinboard

changeset 7:24ef053a4dc5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add function that editMessageUsingGet
author Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
date Mon, 27 Jan 2014 03:03:07 +0900
parents 0d12b5e49dfd
children 3f47943ccc5f
files RouteSetting.hs
diffstat 1 files changed, 37 insertions(+), 22 deletions(-) [+]
line wrap: on
line diff
--- a/RouteSetting.hs	Sun Jan 26 21:27:00 2014 +0900
+++ b/RouteSetting.hs	Mon Jan 27 03:03:07 2014 +0900
@@ -12,15 +12,16 @@
 import Network.HTTP.Types.URI (Query)
 import Data.Text (Text)
 import Data.Maybe (fromJust)
-import Data.ByteString.Lazy.Char8 as B (ByteString, append, pack)
-import Data.ByteString.Char8 as C (unpack)
+import Data.ByteString.Lazy.Char8 (ByteString, append, pack)
+import Data.ByteString.Char8 (unpack)
 
 routeSetting :: [([Text],(Jungle -> Query -> [Param] -> IO Response))]
 routeSetting = [([], showBoard),
                 (["createBoard"], createBoard),
                 (["showBoardMessage"], showBoardMessage),
                 (["createBoardMessage"], createBoardMessage),
-                (["editMessage"], editMessage)]
+                (["editMessage"], editMessage),
+                (["editMessageUsingGet"], editMessageUsingGet)]
 
 showBoard :: Jungle -> Query -> [Param] -> IO Response
 showBoard jungle query params = do
@@ -54,14 +55,14 @@
     createTree jungle st_bname
     updateRootNodeWith (createNewTree lb_author lb_key lb_msg) jungle st_bname
     where
-      st_bname = C.unpack $ snd bname
-      lb_author = B.pack $ unpack $ snd author -- ByteString.Lazy
-      lb_key = B.pack $ unpack $ snd key
-      lb_msg = B.pack $ unpack $ snd msg
+      st_bname = unpack $ snd bname
+      lb_author = pack $ unpack $ snd author -- ByteString.Lazy
+      lb_key = pack $ unpack $ snd key
+      lb_msg = pack $ unpack $ snd msg
       
 
 addBoardtoBoardList :: String -> Node -> Node
-addBoardtoBoardList bname node = node -: addc -: (addca "name" (B.pack bname))
+addBoardtoBoardList bname node = node -: addc -: (addca "name" (pack bname))
   where
     -- pathの最新の子にattributeを追加する
     addca key value node = putAttribute node [(numOfChild node [])] key value
@@ -78,9 +79,9 @@
 showBoardMessage :: Jungle -> Query -> [Param] -> IO Response
 showBoardMessage jungle query params = do
     node <- getRootNode jungle st_bname
-    return $ responseLBS status200 [("Content-type", "text/html")] $ showBoardMessageBy node (B.pack st_bname)
+    return $ responseLBS status200 [("Content-type", "text/html")] $ showBoardMessageBy node (pack st_bname)
     where
-      st_bname = C.unpack $ fromJust . fromJust $ lookup "bname" query
+      st_bname = unpack $ fromJust . fromJust $ lookup "bname" query
 
 showBoardMessageBy :: Node -> ByteString -> ByteString
 showBoardMessageBy node bname = "<html><body><h1>" `append` bname `append` "</h1>" `append` (createBoardMessageForm bname) `append` (getMessages node bname) `append` "</body></html>"
@@ -91,7 +92,7 @@
 getMessages :: Node -> ByteString -> ByteString
 getMessages node bname = foldr f "" (getChildrenWithKey node [])
   where
-    f (id,node) text = text `append` "<hr/><p><b>" `append` (author node) `append` "</b></p><p>" `append` (msg node) `append` "</p><small><a href='/editMessage?bname=" `append` bname `append` "&uuid=" `append` (B.pack $ show id) `append` "'>edit</a></small>"
+    f (id,node) text = text `append` "<hr/><p><b>" `append` (author node) `append` "</b></p><p>" `append` (msg node) `append` "</p><small><a href='/editMessage?bname=" `append` bname `append` "&uuid=" `append` (pack $ show id) `append` "'>edit</a></small>"
     author node = fromJust $ getAttributes node [] "author"
     msg node = fromJust $ getAttributes node [] "msg"
 
@@ -105,10 +106,10 @@
 createBoardMessageBy jungle (author:bname:key:msg:xs) = do
     updateRootNodeWith (addNewMessage lb_author lb_key lb_msg) jungle st_bname
     where
-      st_bname = C.unpack $ snd bname
-      lb_author = B.pack $ unpack $ snd author -- ByteString.Lazy
-      lb_key = B.pack $ unpack $ snd key
-      lb_msg = B.pack $ unpack $ snd msg
+      st_bname = unpack $ snd bname
+      lb_author = pack $ unpack $ snd author -- ByteString.Lazy
+      lb_key = pack $ unpack $ snd key
+      lb_msg = pack $ unpack $ snd msg
 
 addNewMessage :: ByteString -> ByteString -> ByteString -> Node -> Node
 addNewMessage author key msg node = node -: addc -: (addca "author" author) -: (addca "key" key) -: (addca "msg" msg)
@@ -122,19 +123,19 @@
     editMessageBy jungle params
     return $ responseLBS status200 [("Content-type", "text/html")] $ editMessageForm lb_bname lb_uuid
     where
-      lb_bname = B.pack $ C.unpack $ fromJust . fromJust $ lookup "bname" query
-      lb_uuid = B.pack $ C.unpack $ fromJust . fromJust $ lookup "uuid" query
+      lb_bname = pack $ unpack $ fromJust . fromJust $ lookup "bname" query
+      lb_uuid = pack $ unpack $ fromJust . fromJust $ lookup "uuid" query
 
 editMessageBy :: Jungle -> [Param] -> IO ()
 editMessageBy jungle [] = return ()
 editMessageBy jungle (author:bname:uuid:key:msg:xs) = do
     updateRootNodeWith (editMessage' id lb_author lb_key lb_msg) jungle st_bname
     where
-      st_bname = C.unpack $ snd bname
-      id = read $ C.unpack $ snd uuid
-      lb_author = B.pack $ unpack $ snd author -- ByteString.Lazy
-      lb_key = B.pack $ unpack $ snd key
-      lb_msg = B.pack $ unpack $ snd msg
+      st_bname = unpack $ snd bname
+      id = read $ unpack $ snd uuid
+      lb_author = pack $ unpack $ snd author -- ByteString.Lazy
+      lb_key = pack $ unpack $ snd key
+      lb_msg = pack $ unpack $ snd msg
 
 editMessage' :: Int -> ByteString -> ByteString -> ByteString -> Node -> Node
 editMessage' id author key msg node = node -: (addca "author" author) -: (addca "key" key) -: (addca "msg" msg)
@@ -143,3 +144,17 @@
     x -: f  = f x
 
 editMessageForm bname uuid = "<html><body><h1>edit message</h1><form method='POST'><p>Author : <input type='text' name='author'/><input type='hidden' name='bname' value='" `append` bname `append` "'/><input type='hidden' name='uuid' value='" `append` uuid `append` "'/> EditKey : <input type='text' name='key'/></p><p>Message<br/> <input type='textarea' name='msg'/> </p><p><input type='submit' value='submit'/></p></form></body></html>"
+
+editMessageUsingGet :: Jungle -> Query -> [Param] -> IO Response
+editMessageUsingGet jungle query params = do
+    editMessageUsingGetBy jungle st_bname id lb_author lb_key lb_msg
+    return $ responseLBS status200 [("Content-type", "text/html")] $ "editMessage"
+    where
+      st_bname = unpack $ fromJust . fromJust $ lookup "bname" query
+      id = read $ unpack $ fromJust . fromJust $ lookup "uuid" query
+      lb_author = pack $ unpack $ fromJust . fromJust $ lookup "author" query
+      lb_key = pack $ unpack $ fromJust . fromJust $ lookup "key" query
+      lb_msg = pack $ unpack $ fromJust . fromJust $ lookup "msg" query
+
+editMessageUsingGetBy jungle bname id author key msg = do
+    updateRootNodeWith (editMessage' id author key msg) jungle bname