{-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
module Text.HTML.Form.WebApp.Ginger(template) 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, (~>))
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)
import Text.XML (Document(..), Element(..), Prologue(..), Node, def, renderText)

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

type Query = [(ByteString, Maybe ByteString)]
template :: Monad m => String -> Form -> Int -> Input -> Query -> m (Maybe Text)
template name form ix input query
    | Just (Right tpl) <- parseGingerFile resolveSource name =
        return $ Just $ htmlSource $ flip runGinger tpl $ makeContextHtml ctxt
    | Just (Left err) <- parseGingerFile resolveSource name =
        return $ Just $ Txt.pack $ show err
    | otherwise = return $ Just "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 _ = toGVal ()

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

query2gval :: Query -> GVal m
query2gval qs =
    (orderedDict [(Txt.decodeUtf8 k, list1 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]
    utf8 = Txt.unpack . Txt.decodeUtf8

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,
    "description" ~> html (description input),
    "inputType"   ~> inputType input,
    "dirName"     ~> dirname input,
    "name"        ~> inputName input,
    "value"       ~> value input,
    "autocomplete"~> inputAutocomplete input,
    "autofocus"   ~> autofocus input,
    "checked"     ~> 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 $ 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 :: OptionGroup -> GVal m
optgroup2gval optgroup = orderedDict [
    "label"    ~> optsLabel optgroup,
    "disabled" ~> optsDisabled optgroup,
    ("opts", list' $ Prelude.map opt2gval $ subopts optgroup)
  ]
opt2gval :: Option -> GVal m
opt2gval opt = orderedDict [
    "label"    ~> optLabel opt,
    "value"    ~> optValue opt,
    "selected" ~> optSelected opt,
    "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]