{-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
-- | Shuttle parsed form data to Ginger's dynamically-typed datamodel.
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, nullURI)
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)

-- | A key-value query string.
type Query = [(ByteString, Maybe ByteString)]
-- | Run the given template with the given Bureaucromancy data.
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 ()
-- | Run the given template with the given Bureaucromancy & Ginger data.
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 ()

-- | Lookup the given template from a compiled-in directory.
resolveSource :: FilePath -> Maybe (Maybe [Char])
resolveSource ('/':path) = resolveSource path
resolveSource path = Just $ fmap utf8 $
    flip lookup $(makeRelativeToProject "tpl" >>= embedRecursiveDir) $
    normalise $ '/':path

-- | Convert a query into Ginger's datamodel.
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 ()

-- | Convert a form to Ginger's datamodel.
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
  ]

-- | Convert an input to Ginger's datamodel.
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"         ~> uriToString id (fromMaybe nullURI $ imgSrc $ imageData input) "",
    "autocorrect" ~> autocorrect (textArea input),
    "cols"        ~> size input,
    "rows"        ~> rows (textArea input),
    "spellcheck"  ~> spellcheck (textArea input),
    "textwrap"    ~> textwrap (textArea input)
  ]
-- | Convert an XML node to Ginger's datamodel.
html :: Node -> Html
html node = unsafeRawHtml $ Txt.toStrict $ renderText def (
    Document (Prologue [] Nothing []) (Element "div" M.empty [node]) []
  )
-- | Convert an option group to Ginger's datamodel.
optgroup2gval :: [ByteString] -> OptionGroup -> GVal m
optgroup2gval query optgroup = orderedDict [
    "label"    ~> optsLabel optgroup,
    "disabled" ~> optsDisabled optgroup,
    ("opts", list' $ Prelude.map (opt2gval query) $ subopts optgroup)
  ]
-- | Convert an option to Ginger's datamodel.
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
  ]

-- | A ginger list which in most uses looks like its initial value.
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 }
-- | Type-constrained conversion of a list to Ginger's datamodel,
-- serves to avoid type-inference issues.
list' :: [GVal m] -> GVal m
list' = toGVal

-- | Aggregates values in a key-value list under their keys.
groupSort :: Eq k => [(k, Maybe v)] -> [(k, [v])]
groupSort q = [(k, [v | (k', Just v) <- q, k == k']) | k <- nub $ Prelude.map fst q]

-- | Convert from UTF-8 bytestring to a string.
utf8 :: ByteString -> String
utf8 = Txt.unpack . Txt.decodeUtf8