Mercurial > hg > Members > toma > bulletinboard
changeset 7:24ef053a4dc5
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