{-# LANGUAGE OverloadedStrings #-}
module Text.HTML.Form.WebApp (renderPage, Form(..)) where

import Data.ByteString as BS
import Data.Text as Txt
import Data.Text.Encoding as Txt
import Text.Read (readMaybe)
import Network.URI (unEscapeString)
import System.IO (readFile')
import System.FilePath ((</>))
import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist)

import Text.HTML.Form (Form(..), Input(..))
import Text.HTML.Form.WebApp.Ginger (template, resolveSource)
import Text.HTML.Form.Query (renderQueryString)

renderPage :: Form -> [Text] -> [(ByteString, Maybe ByteString)] -> IO (Maybe Text)
renderPage form (n:path) query
    | Just ix <- readMaybe $ Txt.unpack n, ix < Prelude.length (inputs form) =
        renderInput form ix (inputs form !! ix) path query
renderPage form [] _ = return $ Just $ Txt.concat [
    "<a href='/0/?", Txt.pack $ renderQueryString form, "'>Start!</a>"]
renderPage _ _ _ = return Nothing

renderInput :: Form -> Int -> Input -> [Text] -> [(ByteString, Maybe ByteString)] ->
    IO (Maybe Text)
renderInput form ix input [""] qs = renderInput form ix input [] qs
renderInput form ix input@Input { multiple = True } [p] qs
    | '=':v' <- Txt.unpack p,
            (utf8 $ inputName input, Just $ utf8' v') `Prelude.elem` qs =
        renderInput form ix input [] $
            unset (inputName input) (Txt.pack $ unEscapeString v') qs
    | '=':v' <- Txt.unpack p = renderInput form ix input [] $
        (utf8 $ inputName input, Just $ utf8' $ unEscapeString v'):qs
renderInput form ix input [p] qs
    | '=':v' <- Txt.unpack p = renderInput form ix input [] $
        set (inputName input) (Txt.pack $ unEscapeString v') qs
    | ':':v' <- Txt.unpack p = renderInput form ix input [] $
        set (inputName input)
            (Txt.pack (get (inputName input) qs ++ v')) qs
    | "-" <- Txt.unpack p, v'@(_:_) <- get (inputName input) qs =
        renderInput form ix input [] $ set (inputName input)
            (Txt.pack $ Prelude.init v') qs
    | "-" <- Txt.unpack p = renderInput form ix input [] qs
renderInput form ix input [x, p] qs
    | '=':v' <- Txt.unpack p = renderInput form ix input [x] $
        set (inputName input) (Txt.pack $ unEscapeString v') qs
    | ':':v' <- Txt.unpack p = renderInput form ix input [x] $
        set (inputName input)
            (Txt.pack (get (inputName input) qs ++ v')) qs
    | "-" <- Txt.unpack p, v'@(_:_) <- get (inputName input) qs =
        renderInput form ix input [x] $ set (inputName input)
            (Txt.pack $ Prelude.init v') qs
    | "-" <- Txt.unpack p = renderInput form ix input [x] qs
renderInput form ix input@Input {inputType="checkbox", inputName=k', value=v'} [] qs
    | (utf8 k', Just $ utf8 v') `Prelude.elem` qs =
        template "checkbox.html" form ix input $ unset k' v' qs
    | v' == "", (utf8 k', Nothing) `Prelude.elem` qs =
        template "checkbox.html" form ix input [
            q | q@(k, v) <- qs, not (k == utf8 k' && v == Nothing)]
    | otherwise =
        template "checkbox.html" form ix input $ (utf8 k', Just $ utf8 v'):qs
renderInput form ix input@Input {inputType="radio", inputName=k', value=v'} [] qs =
    template "checkbox.html" form ix input $ set k' v' qs
renderInput form ix input@Input { inputType="<select>" } [] qs =
    template "select.html" form ix input qs
renderInput form ix input [keyboard] qs =
    template (Txt.unpack keyboard ++ ".html") form ix input qs
renderInput form ix input [keyboard, ""] qs =
    template (Txt.unpack keyboard ++ ".html") form ix input qs
renderInput form ix input [] qs = do
    path <- getXdgDirectory XdgConfig "bureaucromancy"
    exists <- doesFileExist $ path </> "keyboard"
    keyboard <- if exists then readFile' $ path </> "keyboard"
        else return "latin1"
    let keyboard' | Just (Just _) <- resolveSource (keyboard ++ ".html") = keyboard
            | otherwise = "latin1"
    template (keyboard' ++ ".html") form ix input qs
renderInput _ _ input _ _ =
    return $ Just $ Txt.concat ["Unknown input type: ", inputType input]

utf8 :: Text -> ByteString
utf8 = Txt.encodeUtf8
utf8' :: String -> ByteString
utf8' = utf8 . Txt.pack
set :: Text -> Text -> [(ByteString, Maybe ByteString)]
    -> [(ByteString, Maybe ByteString)]
set k' v' qs = (utf8 k', Just $ utf8 v'):[q | q@(k, _) <- qs, k /= utf8 k']
unset :: Text -> Text -> [(ByteString, Maybe ByteString)]
    -> [(ByteString, Maybe ByteString)]
unset k' v' qs = [q | q@(k, v) <- qs, not (k == utf8 k' && v == Just (utf8 v'))]
get :: Text -> [(ByteString, Maybe ByteString)] -> String
get k' qs
    | Just (Just ret) <- utf8 k' `lookup` qs =
        Txt.unpack $ Txt.decodeUtf8 ret
    | otherwise = ""