# HG changeset patch # User Daichi TOMA # Date 1390759387 -32400 # Node ID 24ef053a4dc549c7b382c48181749bfa8fa7a3f4 # Parent 0d12b5e49dfd4ff57ca9e8087b577a82066afd5b add function that editMessageUsingGet diff -r 0d12b5e49dfd -r 24ef053a4dc5 RouteSetting.hs --- 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 = "

" `append` bname `append` "

" `append` (createBoardMessageForm bname) `append` (getMessages node bname) `append` "" @@ -91,7 +92,7 @@ getMessages :: Node -> ByteString -> ByteString getMessages node bname = foldr f "" (getChildrenWithKey node []) where - f (id,node) text = text `append` "

" `append` (author node) `append` "

" `append` (msg node) `append` "

edit" + f (id,node) text = text `append` "

" `append` (author node) `append` "

" `append` (msg node) `append` "

edit" 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 = "

edit message

" + +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