--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Web.hs	Tue Jun 11 17:25:05 2013 +0900
@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai (responseLBS, Request, Response, rawQueryString)
+import Network.Wai.Parse (parseRequestBody, lbsBackEnd, Param)
+import Network.Wai.Handler.Warp (run)
+import Network.HTTP.Types (status200)
+import Control.Monad.Trans (liftIO, lift)
+import Data.Conduit (ResourceT)
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad
+import Data.ByteString.Lazy.Char8 as B (concat, ByteString, append, pack)
+import Data.ByteString.Lazy.UTF8 (fromString)
+import Data.ByteString.Char8 (unpack)
+import qualified Jungle as J
+
+type TJungle = TVar J.Jungle
+
+newJungle :: IO TJungle
+newJungle = do
+    let
+      jungle = J.createTree J.createJungle "new_tree"
+    tv <- newTVarIO jungle
+    return tv
+
+application :: TJungle -> Request -> ResourceT IO Response
+application jungle request = do
+    (params, _) <- parseRequestBody lbsBackEnd request
+    liftIO $ putStrLn.show $ params
+    new_jungle <- lift $ modifyJungle jungle params
+    let responseText = makeResponseText new_jungle
+    return $ responseLBS status200 [("Content-type", "text/html")] $ responseText
+
+makeResponseText :: (Show a) => a -> B.ByteString
+makeResponseText s = form `append` "<h1>Hello " `append` (toByteString s) `append` "</h1>\n"
+    where 
+      form = "<form method=\"POST\" action=\"#\"><input name=\"key\" type=\"text\"><input name=\"value\" type=\"text\"><input type=\"submit\"></form>"
+
+toByteString :: (Show a) => a -> B.ByteString
+toByteString s = fromString $ show s
+
+modifyJungle :: TJungle -> [Param] -> IO J.Jungle
+modifyJungle jungle [] = atomically $ readTVar jungle
+modifyJungle jungle (key:value:xs) = atomically $ test jungle (unpack $ snd key) (unpack $ snd value)
+
+add :: TJungle -> String -> String -> STM ()
+add tv key value = do
+    jungle <- readTVar tv
+    let
+      new_jungle = putAttribute jungle "new_tree" [] key (B.pack value)
+    writeTVar tv new_jungle
+
+test jungle key value = do
+    add jungle key value
+    readTVar jungle
+
+putAttribute :: J.Jungle -> String -> J.Path -> String -> B.ByteString -> J.Jungle
+putAttribute jungle tree_name path key value = new_jungle jungle
+  where
+    new_tree jungle = J.putAttribute (J.getTreeByName jungle tree_name) path key value
+    new_jungle jungle = J.updateTree jungle (new_tree jungle)
+
+main = do
+    putStrLn $ "Listening on port " ++ show 3000
+    jungle <- newJungle
+    run 3000 $ application jungle