{-# LANGUAGE OverloadedStrings #-}
module Internal.Forms(findForm, prefillForm) where

import Text.XML
import Text.XML.Cursor
import qualified Data.Map as M
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as Txt

import Data.Maybe

findForm cursor id2els
    | Just (NodeElement el@(Element (Name "form" _ _) _ _)) <- node cursor = el
    | Just (NodeElement el) <- node cursor, Just el' <- findForm' el id2els = el'
    | (form:_) <- parent cursor = findForm form id2els -- Propagate id2els for the sake of event dispatch.
    | otherwise = Element "fail" M.empty [] -- Tombstone value

findForm' (Element (Name name _ _) attrs _) id2els
    | name == "label", Just for <- "for" `M.lookup` attrs',
            Just input <- for `M.lookup` id2els = Just $ findForm input id2els
    | Just form <- "form" `M.lookup` attrs', Just cursor <- form `M.lookup` id2els,
        Just (NodeElement ret) <- node cursor = Just ret
    | otherwise = Nothing
  where attrs' = M.mapKeys nameLocalName attrs

prefillForm (Element (Name "form" _ _) attrs children) root = HM.fromListWith (++) (
    (prefillForm' $ map node $ (descendant >=> checkElement isForForm) root) ++
    prefillForm' children)
  where
    isForForm (Element _ attrs' _) | Just id <- "id" `M.lookup` M.mapKeys nameLocalName attrs,
        Just form <- "form" `M.lookup` M.mapKeys nameLocalName attrs' = id == form
    isForForm _ = False

prefillForm' (NodeElement (Element (Name "input" _ _) attrs _):nodes)
    | Just type_ <- "type" `M.lookup` attrs', Just name <- "name" `M.lookup` attrs', Just value <- "value" `M.lookup` attrs',
            type_ `notElem` ["radio", "checkbox", "reset", "submit", "button"] || "checked" `M.member` attrs' =
        (name, [value]):prefillForm' nodes
    | otherwise = prefillForm' nodes
  where attrs' = M.mapKeys nameLocalName attrs
prefillForm' (NodeElement (Element (Name "select" _ _) attrs childs):nodes)
    | Just name <- "name" `M.lookup` attrs' =
        case [value | NodeElement (Element _ attrs2 _) <- childs,
                value <- maybeToList $ M.lookup "value" $ M.mapKeys nameLocalName attrs2] of
            [] -> prefillForm' nodes
            values | "multiple" `M.member` attrs' -> (name, values):prefillForm' nodes
            (value:_) -> (name, [value]):prefillForm' nodes
    | otherwise = prefillForm' nodes
  where attrs' = M.mapKeys nameLocalName attrs
prefillForm' (NodeElement (Element (Name "textarea" _ _) attrs childs):nodes)
    | Just name <- "name" `M.lookup` attrs =
        (name, [Txt.concat [value | NodeContent value <- childs]]):prefillForm' nodes
    | otherwise = prefillForm' nodes