{-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
module Text.HTML.Form.WebApp.Ginger(template, template', resolveSource, list') where

import Text.HTML.Form
import Text.HTML.Form.Query (renderQueryString')

import FileEmbedLzma
import Data.FileEmbed
import System.FilePath

import Text.Ginger.Parse (parseGingerFile, SourcePos)
import Text.Ginger.Run (runGinger, makeContextHtml, Run)
import Text.Ginger.GVal as V (GVal(..), toGVal, ToGVal, orderedDict, (~>),
        fromFunction, Function)
import Text.Ginger.Html (Html, htmlSource, unsafeRawHtml)
import Control.Monad.Writer.Lazy (Writer)

import Data.Text as Txt
import Data.Text.Encoding as Txt
import Data.Text.Lazy as Txt (toStrict)
import Data.ByteString.Char8 as B8
import Network.URI (uriToString, escapeURIString, isUnescapedInURIComponent)
import Text.XML (Document(..), Element(..), Prologue(..), Node, def, renderText)

import Data.List (nub)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Map as M

import Text.HTML.Form.Validate (inputErrorMessage')
import Text.HTML.Form.Query (applyQuery)

type Query = [(ByteString, Maybe ByteString)]
template :: Monad m => String -> Form -> Int -> Input -> Query ->
        m (Maybe (Either Query Text))
template name form ix input query =
    template' name form ix input query $ const $ toGVal ()
template' :: Monad m => String -> Form -> Int -> Input -> Query ->
        (Text -> GVal (Run SourcePos (Writer Html) Html)) ->
        m (Maybe (Either Query Text))
template' name form ix input query ctxt'
    | Just (Right tpl) <- parseGingerFile resolveSource name =
        return $ Just $ Right $ htmlSource $
            flip runGinger tpl $ makeContextHtml ctxt
    | Just (Left err) <- parseGingerFile resolveSource name =
        return $ Just $ Right $ Txt.pack $ show err
    | otherwise = return $ Just $ Right "Unexpected error!"
  where
    ctxt :: Text -> GVal (Run SourcePos (Writer Html) Html)
    ctxt "Q" = query2gval query
    ctxt "form" = form2gval form
    ctxt "inputs" = list' $ Prelude.map (flip input2gval query) $
        Prelude.zip [0..] $ inputs form
    ctxt "input" = input2gval (ix, input) query
    ctxt "xURI" = fromFunction xURI
    ctxt x = ctxt' x
    xURI [(_, uri)] = let uri' = Txt.unpack $ asText uri in
        return$toGVal$Txt.pack $ escapeURIString isUnescapedInURIComponent uri'
    xURI _ = return $ toGVal ()

resolveSource :: FilePath -> Maybe (Maybe [Char])
resolveSource ('/':path) = resolveSource path
resolveSource path = Just $ fmap utf8 $
    flip lookup $(makeRelativeToProject "tpl" >>= embedRecursiveDir) $
    normalise $ '/':path

query2gval :: Monad m => Query -> GVal m
query2gval qs =
    (orderedDict [(Txt.decodeUtf8 k, (list1 vs){ asFunction = Just $ gElem vs })
            | (k, vs) <- groupSort qs]) {
        asText = Txt.pack q,
        asHtml = unsafeRawHtml $ Txt.pack q
    }
  where
    q = '?':renderQueryString' [(utf8 k, utf8 $ fromMaybe "" v) | (k, v) <- qs]
    gElem :: Monad m => [ByteString] -> Function m
    gElem xs [(_, x)] | Just x' <- asBytes x = return$toGVal$Prelude.elem x' xs
    gElem _ _ = return $ toGVal ()

form2gval :: Form -> GVal m
form2gval form = orderedDict [
    "action"   ~> uriToString id (action form) "",
    "enctype"  ~> enctype form,
    "method"   ~> method form,
    "validate" ~> validate form,
    "target"   ~> target form,
    "charset"  ~> acceptCharset form,
    "autocomplete"~>autocomplete form,
    "name"     ~> formName form,
    "rel"      ~> rel form
  ]

input2gval :: (Int, Input) -> Query -> GVal m
input2gval (ix, input) query = orderedDict [
    "index"       ~> ix,
    "label"       ~> label input,
    "error"       ~> inputErrorMessage' (applyQuery input
            [(B8.unpack k, B8.unpack $ fromMaybe "" v) | (k, v) <- query]),
    "description" ~> html (description input),
    "inputType"   ~> inputType input,
    "dirName"     ~> dirname input,
    "name"        ~> inputName input,
    "value"       ~> if inputType input `Prelude.elem` ["radio", "checkbox"]
        then value input
        else Txt.intercalate ", " [Txt.decodeUtf8 v | (k, Just v) <- query,
            Txt.encodeUtf8 (inputName input) == k],
    "autocomplete"~> inputAutocomplete input,
    "autofocus"   ~> autofocus input,
    "checked"     ~> (inputType input `Prelude.elem` ["radio", "checkbox"] &&
        if value input== ""
        then isJust $ Prelude.lookup (Txt.encodeUtf8 $ inputName input) query
        else (Txt.encodeUtf8 $ inputName input,
            Just $ Txt.encodeUtf8 $ value input) `Prelude.elem` query),
    "disabled"    ~> disabled input,
    "readonly"    ~> readonly input,
    "multiple"    ~> multiple input,
    ("form", orderedDict [
        "action"  ~> (flip (uriToString id) "" <$> formAction input),
        "enctype" ~> formEnctype input,
        "method"  ~> formMethod input,
        "validate"~> formValidate input,
        "target"  ~> formTarget input
    ]),
    "inputmode"   ~> inputMode input,
    ("list", list' $ Prelude.map (optgroup2gval [v |
            (k, Just v) <- query, Txt.decodeUtf8 k == inputName input])
        $ list input),
    "min"         ~> fst (range input),
    "max"         ~> snd (range input),
    "step"        ~> step input,
    "minlength"   ~> fst (lengthRange input),
    "maxLength"   ~> snd (lengthRange input),
    "required"    ~> required input,
    "placeholder" ~> placeholder input,
    "title"       ~> title input,
    "size"        ~> size input,
    "accept"      ~> fileAccept (fileData input),
    "capture"     ~> fileCapture (fileData input),
    "alt"         ~> imgAlt (imageData input),
    "width"       ~> fst (imgSize $ imageData input),
    "height"      ~> snd (imgSize $ imageData input),
    "src"         ~> imgSrc (imageData input),
    "autocorrect" ~> autocorrect (textArea input),
    "cols"        ~> size input,
    "rows"        ~> rows (textArea input),
    "spellcheck"  ~> spellcheck (textArea input),
    "textwrap"    ~> textwrap (textArea input)
  ]
html :: Node -> Html
html node = unsafeRawHtml $ Txt.toStrict $ renderText def (
    Document (Prologue [] Nothing []) (Element "div" M.empty [node]) []
  )
optgroup2gval :: [ByteString] -> OptionGroup -> GVal m
optgroup2gval query optgroup = orderedDict [
    "label"    ~> optsLabel optgroup,
    "disabled" ~> optsDisabled optgroup,
    ("opts", list' $ Prelude.map (opt2gval query) $ subopts optgroup)
  ]
opt2gval :: [ByteString] -> Option -> GVal m
opt2gval query opt = orderedDict [
    "label"    ~> optLabel opt,
    "value"    ~> optValue opt,
    "selected" ~> (optValue opt `Prelude.elem` Prelude.map Txt.decodeUtf8 query),
    "disabled" ~> optDisabled opt
  ]

list1 :: ToGVal m a => [a] -> GVal m
list1 vs@(v:_) = (toGVal v) {
    asList = Just $ Prelude.map toGVal vs,
    V.length = Just $ Prelude.length vs
  }
list1 [] = (toGVal True) { asList = Just [], V.length = Just 0 }
list' :: [GVal m] -> GVal m
list' = toGVal

groupSort :: Eq k => [(k, Maybe v)] -> [(k, [v])]
groupSort q = [(k, [v | (k', Just v) <- q, k == k']) | k <- nub $ Prelude.map fst q]

utf8 :: ByteString -> String
utf8 = Txt.unpack . Txt.decodeUtf8