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

import Happstack.Lite
import Happstack.Server.RqData
import Happstack.Server.Monads (askRq)
import Happstack.Server.Types (rqUri)
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 Internal.Forms as Forms
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
  putStrLn "Serving http://localhost:8000/"
  serve Nothing $ do
    req <- askRq
    liftIO $ putStrLn $ rqUri req
    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
    liftIO $ putStrLn "Creating new session!"
    (uuid, session) <- liftIO $ createSession sessions M.empty
    target <- looks "target"
    -- Not much point of a blank session, so allow loading here.
    liftIO $ putStrLn "Allocated new session!"
    case target of
        (target':_) | Just url <- Load.parseAbsoluteURI target' -> liftIO $ Load.load' session url
        _ -> return ()
    liftIO $ putStrLn "Created new session!"
    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 uuid 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,
        dir "click" $ clickElement uuid session,
        dir "type" $ typeElement uuid session
    ]

sessionHome uuid session = do
    nullDir
    method GET

    session' <- liftIO $ readMVar session
    let el = XC.fromDocument $ document session'
    related <- liftIO $ getRelatedEls session el
    Tpl.inspector ok ":root" session' $ Tpl.elPage uuid el related ""

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
    el <- looks "el"
    let (root, ancestors) = case el of {
        (el':_) | Just root <- ID.fromString el' >>= getEl session' ->
            (root, Prelude.reverse $ (XC.orSelf XC.ancestor) root);
        _ -> (XC.fromDocument $ document session', [])
    }

    results <- forM Q.engines $ \(header, engine) -> do
        results' <- liftIO $ engine q session root
        return (header, labelEmpty results')
    Tpl.inspector' q ok (Txt.pack ('🔎':q)) session' $ \langs -> H.main $ do
        H.aside $ do
            H.p $ do
                forM ancestors $ \el -> do
                    Tpl.xmlNode' $ XC.node el -- Should all be elements...
                    H.text " > "
                return ()
            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 session el',
            serveEl' uuid session session' el'
          ]
        Nothing -> Tpl.inspector notFound "404" session' $ \langs ->
            H.h1 $ l langs ElementNotFound

serveEl' uuid session session' el = do
    nullDir
    method GET
    let title = toStrict $ renderMarkup $ contents $ Tpl.xmlNode' $ XC.node el
    related <- liftIO $ getRelatedEls session el
    elValue <- liftIO $ Forms.readInput' session el
    Tpl.inspector ok title session' $ Tpl.elPage uuid el related elValue

serveElPreview uuid session el = do
    nullDir
    method GET
    let title = toStrict $ renderMarkup $ contents $ Tpl.xmlNode' $ XC.node el
    related <- liftIO $ getRelatedEls session el
    elValue <- liftIO $ Forms.readInput' session el
    Tpl.page ok [title, Txt.pack $ ID.toString uuid, "Amphiarao"] "fill" $
        Tpl.elPage uuid el related elValue

clickElement uuid session = do
    nullDir
    method POST
    elUUID <- look "el"
    session' <- liftIO $ readMVar session
    case getEl session' =<< ID.fromString elUUID of
        Just el -> do
            liftIO $ Load.clickEl session el
            seeOther ('/':ID.toString uuid) $ toResponse ()
        Nothing -> Tpl.inspector notFound "404" session' $ \langs ->
            H.h1 $ l langs ElementNotFound

typeElement uuid session = do
    nullDir
    method POST
    elUUID <- look "el"
    newValue <- lookText' "text"
    isReset <- looks "reset"
    session' <- liftIO $ readMVar session
    case getEl session' =<< ID.fromString elUUID of
        Just el | Prelude.null isReset -> do
            liftIO $ Forms.sendText (Forms.SendText newValue) el session
            seeOther ('/':ID.toString uuid) $ toResponse ()
        Just el -> do
            liftIO $ Forms.clearForm session el
            seeOther ('/':ID.toString uuid) $ toResponse ()
        Nothing -> Tpl.inspector notFound "404" session' $ \langs ->
            H.h1 $ l langs ElementNotFound