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

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

import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html (text, string)
import qualified Data.Text as Txt

import Webdriver
import Data.UUID as ID

import Messages
import Happstack.Server.I18N

import Internal
import Internal.Load as Load
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 "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
        ]
    ]

sessionHome session = do
    nullDir
    method GET

    session' <- liftIO $ readMVar session
    Tpl.inspector ok "UUID" session' $ \langs -> H.h1 $ string $ show $ currentURL 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
    let results = [(header, labelEmpty $ engine q session') | (header, engine) <- Q.engines]
    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.section $ do
            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 ()