{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
module Main where

import Happstack.Lite
import Happstack.Server.RqData
import Control.Concurrent.MVar
import Data.HashMap.Strict as M
import Data.FileEmbed

import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html (text, string, contents)
import Text.Blaze.Renderer.Text (renderMarkup)
import qualified Data.Text as Txt
import Data.Text.Lazy (toStrict)

import Webdriver
import Data.UUID as ID

import qualified Text.XML.Cursor as XC
import Data.Maybe

import Messages
import Happstack.Server.I18N

import Internal
import Internal.Load as Load
import Internal.Elements as El
import Control.Monad.IO.Class (liftIO)
import Control.Monad (forM)

import qualified UI.Templates as Tpl
import qualified UI.Search as Q

main :: IO ()
main = do
  sessions <- initSessions
  serve Nothing $ msum [
      dir "assets" $ path $ ok . toResponse . fromMaybe "Not Found" . flip Prelude.lookup $(embedDir "assets"),
      dir "webdriver" $ dir "v1" $ serveWebdriver sessions,
      postHome sessions,
      serveHome,
      dir "preview-prompt" servePreviewPrompt,
      dir "close" $ path $ deleteSession sessions,
      path $ serveSession sessions
    ]

serveHome :: ServerPart Response
serveHome = do
    nullDir
    method GET
    Tpl.page ok ["Amphiarao"] "" $ \langs -> do
        l langs AmphiaraoIntro
        Tpl.sessionForm langs

postHome sessions = do
    nullDir
    method POST
    (uuid, session) <- liftIO $ createSession sessions M.empty
    target <- looks "target"
    -- Not much point of a blank session, so allow loading here.
    case target of
        (target':_) | Just url <- Load.parseAbsoluteURI target' -> liftIO $ Load.load' session url
        _ -> return ()
    seeOther ('/' : ID.toString uuid) $ toResponse ()

deleteSession sessions uuid = do
    nullDir
    method POST
    case ID.fromString uuid of
        Just id -> liftIO $ delSession id sessions
        Nothing -> return ()
    seeOther ['/'] $ toResponse ()

servePreviewPrompt = do
    nullDir
    method GET
    Tpl.page ok ["?", "Amphiarao"] "" $ \langs -> H.p $ l langs PromptPreview

---

serveSession :: Sessions -> String -> ServerPart Response
serveSession = withSession session404 $ \uuid session -> msum [
        sessionHome session,
        dir "timeout" $ setTimeout uuid session,
        dir "search" $ searchSession session,
        dir "nav" $ msum [
            dir "load" $ loadPage uuid session,
            dir "reload" $ reloadPage uuid session,
            dir "back" $ sessionAction' uuid session Load.back,
            dir "next" $ sessionAction' uuid session Load.next
        ],
        dir "el" $ path $ serveEl uuid session
    ]

sessionHome session = do
    nullDir
    method GET

    session' <- liftIO $ readMVar session
    Tpl.inspector ok ":root" session' $ \langs ->
        Tpl.elPage $ XC.fromDocument $ document session'

session404 uuid = do
    Tpl.page notFound ["404", "Amphiarao"] "" $ \langs -> do
        H.h1 $ l langs SessionNotFound
        Tpl.sessionForm langs

setTimeout uuid session = do
    nullDir
    method POST
    timeout <- lookRead "pageLoad"
    let inner s = return $ s {timeouts = (timeouts s) {pageLoad = Just timeout}}
    liftIO $ modifyMVar_ session inner
    seeOther ('/':ID.toString uuid) $ toResponse ()

searchSession session = do
    nullDir
    method GET
    q <- look "q"
    session' <- liftIO $ readMVar session
    results <- forM Q.engines $ \(header, engine) -> do
        results' <- liftIO $ engine q session session'
        return (header, labelEmpty results')
    Tpl.inspector ok (Txt.pack ('🔎':q)) session' $ \langs -> H.main $ do
        H.aside $ do
            H.form $ do
                H.input H.! A.type_ "search" H.! A.name "q" H.! A.value (H.stringValue q)
            H.dl $ do
                forM results $ \(header, results') -> do
                    H.dt $ header langs
                    forM results' $ \result -> H.dd $ result langs
                    return ()
                return ()
        H.iframe H.! A.src "/preview-prompt" H.! A.name "preview" $ ""
  where
    labelEmpty [] = [\langs -> l langs NoResults]
    labelEmpty x = x

loadPage uuid session = do
    nullDir
    method POST
    target <- look "url"
    case Load.parseAbsoluteURI target of
        Just url -> do
            liftIO $ Load.load session url
            seeOther ('/':ID.toString uuid) $ toResponse ()
        Nothing -> do
            session' <- liftIO $ readMVar session
            Tpl.inspector ok "400" session' $ \langs -> l langs ErrURL

reloadPage uuid session = do
    nullDir
    method POST
    session' <- liftIO $ readMVar session
    liftIO $ Load.load' session $ currentURL session'
    seeOther ('/':ID.toString uuid) $ toResponse ()

sessionAction' uuid session cb = do
    nullDir
    method POST
    liftIO $ cb session
    seeOther ('/':ID.toString uuid) $ toResponse ()

---

serveEl :: UUID -> Session -> String -> ServerPart Response
serveEl uuid session el = do
    session' <- liftIO $ readMVar session
    case getEl session' =<< ID.fromString el of
        Just el' -> msum [
            dir "preview" $ serveElPreview uuid el',
            serveEl' uuid session' el'
          ]
        Nothing -> Tpl.inspector notFound "404" session' $ \langs ->
            H.h1 $ l langs ElementNotFound

serveEl' uuid session' el = do
    nullDir
    method GET
    let title = toStrict $ renderMarkup $ contents $ Tpl.xmlNode' $ XC.node el
    Tpl.inspector ok title session' $ \langs -> Tpl.elPage el

serveElPreview uuid el = do
    nullDir
    method GET
    let title = toStrict $ renderMarkup $ contents $ Tpl.xmlNode' $ XC.node el
    Tpl.page ok [title, Txt.pack $ ID.toString uuid, "Amphiarao"] "fill" $ \langs -> Tpl.elPage el