{-# LANGUAGE OverloadedStrings #-}

module RouteSetting (routeSetting) where

import Types
import Network.Wai (Response, responseLBS)
import Network.Wai.Parse (Param)
import Network.HTTP.Types (status200)
import Network.HTTP.Types.URI (Query)
import Control.Concurrent.STM
import Data.ByteString.Lazy.Char8 as B (ByteString, append, pack)
import Data.ByteString.Lazy.UTF8 (fromString)
import Data.ByteString.Char8 (unpack)
import Data.Text (Text)
import qualified Jungle as J


routeSetting :: [([Text],(TJungle -> Query -> [Param] -> IO Response))]
routeSetting = [([], showBoard),
                (["createBoard"], createBoard),
                (["showBoardMessage"],showBoardMessage),
                (["createBoardMessage"],createBoardMessage),
                (["editMessage"],editMessage)]

showBoard jungle query params = do
    new_jungle <- modifyJungle' jungle params
    let responseText = makeResponseText new_jungle
    return $ responseLBS status200 [("Content-type", "text/html")] $ responseText

otherfunc jungle query params = do
    return $ responseLBS status200 [("Content-type", "text/html")] $ "otherfunc"

createBoard jungle query params = do
    return $ responseLBS status200 [("Content-type", "text/html")] $ "createBoard"

showBoardMessage jungle query params = do
    return $ responseLBS status200 [("Content-type", "text/html")] $ "showBoardMessage"

createBoardMessage jungle query params = do
    return $ responseLBS status200 [("Content-type", "text/html")] $ "createBoardMessage"

editMessage jungle query params = do
    return $ responseLBS status200 [("Content-type", "text/html")] $ "editMessage"

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 "boards" [] 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)