{-# LANGUAGE OverloadedStrings #-}
import Network.Wai (responseLBS, Request, Response)
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