{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module UI.Templates(page, inspector, sessionForm, xmlNode) where

import Happstack.Lite
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html
import Data.Text as Txt

import Internal
import Control.Monad.IO.Class (liftIO)
import Control.Monad (unless, when, forM)
import Control.Concurrent.MVar
import Data.UUID as ID

import Text.XML (Element(..), Node(..), Instruction(..), Name(..))
import qualified Data.Map as M

import Messages
import Happstack.Server.I18N

page :: (Response -> ServerPart Response) -> [Text] -> ([Text] -> Html) -> ServerPart Response
page return' title body' = do
    langs <- bestLanguage <$> acceptLanguage
    return' $ toResponse $ html $ do
        H.head $ do
            H.title $ text $ intercalate " — " title
        body $ body' langs

inspector :: (Response -> ServerPart Response) -> Text -> Session' -> ([Text] -> Html) -> ServerPart Response
inspector return' title session' body' = do
    let timeout = H.stringValue $ show $ pageLoad $ timeouts session'
    page return' [title, pack $ show $ currentURL $ session', "Amphiarao"] $ \langs -> do
        header $ do
            unless (Prelude.null $ backStack session') $ postButton "/nav/back" (l' langs Back') "🡸"
            unless (Prelude.null $ nextStack session') $ postButton "/nav/next" (l' langs Next') "🡺"
            postButton "/nav/reload" (l' langs Reload') "↻"
            hr
            H.form ! action' ["/", uuid', "/search"] ! alt (l' langs Search') $ do
                input ! type_ "search" ! name "q" ! placeholder (l' langs Search')
        body' langs
        footer $ do
            H.form ! action' ["/close/", uuid'] ! A.method "POST" ! alt (l' langs CloseSession') $ do
                button ! type_ "submit" $ l langs CloseSession
            hr
            H.form ! action' ["/", uuid', "/timeout"] ! A.method "POST" ! alt (l' langs LoadTimeout') $ p $ do
                H.label $ do
                    l langs LoadTimeout
                    input ! type_ "number" ! name "pageLoad" ! value timeout
                text "ms"

  where
    uuid' = ID.toString $ uuid_ session'
    action' = A.action . H.stringValue . Prelude.concat
    postButton target title' label = H.form ! action' ["/", uuid', target] ! alt title' ! A.method "POST" $ do
        button ! type_ "submit" ! A.title title' $ label

sessionForm langs = H.form ! A.method "POST" ! action "/" ! alt (l' langs CreateSession') $ do
    input ! type_ "url" ! name "target" ! placeholder "URL to debug"
    button ! type_ "submit" $ l langs CreateSession

--- XML formatting

xmlNode (NodeElement (Element name attrs childs)) = do
    symbolTok False "<"
    ident'Tok name
    forM (M.toList attrs) $ \(name, value) -> do
        text " "
        ident'Tok name
        symbolTok True "="
        stringTok $ show value -- quote it!
    when (Prelude.null childs) $ symbolTok True "/"
    symbolTok False ">"
  where
    ident'Tok (Name tag _ ns) = do
        case ns of
            Just ns' -> do
                qualifyTok ns'
                symbolTok False ":"
            Nothing -> return ()
        identTok tag
xmlNode (NodeInstruction (Instruction name value)) = do
    symbolTok False "<"
    symbolTok True "?"
    identTok name
    text " "
    stringTok $ unpack value
    symbolTok True "?"
    symbolTok False ">"

xmlNode (NodeContent text) = stringTok $ show text
xmlNode (NodeComment text) = do
    symbolTok False "<!--"
    commentTok text
    symbolTok False "-->"



symbolTok False = token "symbol silent"
symbolTok True = token "symbol"
qualifyTok = token "qualify"
identTok = token "ident"
stringTok = token "string" . pack
commentTok = token "comment"

token type_ txt = H.span ! class_ (stringValue ("tok-" ++ type_)) $ text txt