{-# LANGUAGE OverloadedStrings #-}
module Text.HTML.Form (Form(..), Input(..), parseElement, parseDocument) where

import Data.Text (Text)
import qualified Data.Text as Txt
import Text.XML.Cursor
import Text.XML (Document)

import Data.Maybe (fromMaybe)
import Network.URI (parseURIReference, URI, nullURI)
import Data.Char (isDigit)

data Form = Form {
    action :: URI,
    enctype :: Text,
    method :: Text,
    validate :: Bool,
    target :: Text,
    acceptCharset :: [Text],
    autocomplete :: Bool,
    name :: Text,
    rel :: Text,
    inputs :: [Input]
}

data Input = Input

attr :: Text -> Cursor -> Text -> Text
attr n el def | [ret] <- n `laxAttribute` el = ret
    | otherwise = def
attr' :: Text -> Cursor -> (Text -> a) -> Text -> a
attr' n el cb def = cb $ attr n el def
parseElement :: Cursor -> Maybe Form
parseElement el | _:_ <- laxElement "form" el = Just Form {
        action = attr' "action" el
            (fromMaybe nullURI . parseURIReference . Txt.unpack) ".",
        enctype = attr "enctype" el "",
        method = attr "method" el "GET",
        validate = null $ hasAttribute "novalidate" el,
        target = attr "target" el "_self",
        acceptCharset = attr' "accept-charset" el Txt.words "utf-8",
        autocomplete = not $ null $ hasAttribute "autocomplete" el,
        name = attr "name" el "",
        rel = attr "rel" el "",
        inputs = []
      }
    | otherwise = Nothing

read' :: Read a => Text -> a
read' = read . Txt.unpack
parseDocument :: Document -> Text -> Maybe Form
parseDocument doc n
    | Txt.all isDigit n = parseElement (forms doc' !! read' n)
    | el:_ <- (forms >=> attributeIs "name" n) doc' = parseElement el
    | otherwise = Nothing
  where
    forms = orSelf descendant >=> laxElement "form"
    doc' = fromDocument doc