{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
-- | Parse webforms out of webpages
module Text.HTML.Form (Form(..), Input(..), OptionGroup(..), Option(..),
    FileSelector(..), defaultFileData, ImageData(..), defaultImageData,
    TextArea(..), defaultTextArea, parseElement, parseElement',
    parseDocument, parseDocument', ensureButtons) where

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

import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Data.List (singleton)
import Text.Read (readMaybe)
import Data.Function (on)

import Network.URI (parseURIReference, URI, nullURI)
import Text.Regex.TDFA (Regex, defaultCompOpt, defaultExecOpt)
import Text.Regex.TDFA.Text (compile)

-- | A collection of controls intended to be handle by a particular URL endpoint.
data Form = Form {
    -- | The URL which should receive valid input from this form.
    Form -> URI
action :: URI,
    -- | How to encode the data to be received by the URL.
    Form -> Text
enctype :: Text,
    -- | Which HTTP method to use.
    Form -> Text
method :: Text,
    -- | Whether to validate the form data before submitting it to the endpoint.
    Form -> Bool
validate :: Bool,
    -- | Where to display the response.
    Form -> Text
target :: Text,
    -- | Which character sets to encode the data in.
    Form -> [Text]
acceptCharset :: [Text],
    -- | Whether to offer autocompletions for all controls.
    Form -> Bool
autocomplete :: Bool,
    -- | The name of this form.
    Form -> Text
formName :: Text,
    -- | The purpose of this form, typically using an external vocabulary.
    Form -> Text
rel :: Text,
    -- | What data should be sent to the endpoint.
    Form -> [Input]
inputs :: [Input],
    -- | Which human language the form is written? To which additional messages should be localized?
    Form -> String
lang :: String
}

-- | Individual piece of data to send to a webservice.
data Input = Input {
    -- Core attributes
    -- | Human-legible yet brief description of this input.
    Input -> Text
label :: Text,
    -- | Human-legible longer-form description of this input.
    Input -> Node
description :: Node,
    -- | How this control should be presented to the user, supporting all the HTML5 input types.
    -- Support for more types may be added in the future, with any unsupported types
    -- fallingback to text entry.
    Input -> Text
inputType :: Text,
    -- | In which query parameter should we store the text direction?
    Input -> Text
dirname :: Text,
    -- | In which query parameter should we store this value?
    Input -> Text
inputName :: Text,
    -- State
    -- | The user-provided value or caller-provided default to upload to the server.
    Input -> Text
value :: Text,
    -- | Whether to autocomplete this input, if its enabled on the form.
    Input -> Text
inputAutocomplete :: Text,
    -- | Whether this input has initial focus.
    Input -> Bool
autofocus :: Bool,
    -- | Whether (for certain types) to upload the data for this input.
    Input -> Bool
checked :: Bool,
    -- | Whether to temporarily-disallow users from editting this value.
    Input -> Bool
disabled :: Bool,
    -- | Whether to permanantly-disallow users from editting this value.
    Input -> Bool
readonly :: Bool,
    -- Input behaviour
    -- | Whether to allow entering multiple values.
    Input -> Bool
multiple :: Bool,
    -- | If this control is used to submit the form, where to upload it.
    Input -> Maybe URI
formAction :: Maybe URI,
    -- | If this control is used to submit the form, which text encoding to use in the upload.
    Input -> Maybe Text
formEnctype :: Maybe Text,
    -- | If this control is used to submit the form, which HTTP method to use.
    Input -> Maybe Text
formMethod :: Maybe Text,
    -- | If this control is used to submit the form, whether to enforce validation.
    Input -> Bool
formValidate :: Bool,
    -- | If this control is used to submit the form, where to render the response.
    Input -> Maybe Text
formTarget :: Maybe Text,
    -- | Suggests which keyboard to use for the input.
    Input -> Text
inputMode :: Text,
    -- | Autocompletion values provided by caller.
    Input -> [OptionGroup]
list :: [OptionGroup],
    -- Validation
    -- | The minimum & maximum values for the value of this input.
    Input -> (Maybe Text, Maybe Text)
range :: (Maybe Text, Maybe Text),
    -- | In which period from start do valid values occur?
    Input -> Maybe Text
step :: Maybe Text,
    -- | The minimum & maximum lengths for the value of this input.
    Input -> (Maybe Int, Maybe Int)
lengthRange :: (Maybe Int, Maybe Int),
    -- | Optional regex to enforce on the value of this input.
    Input -> Maybe Regex
pattern :: Maybe Regex,
    -- | Whether this control must have a value for it to be considered valid.
    Input -> Bool
required :: Bool,
    -- Presentation
    -- | Sample value, often visual clarity of its role incurs inaccessibility.
    -- Make sure to communicate what's implied here elsewhere.
    Input -> Text
placeholder :: Text,
    -- sort by tabindex?
    -- | Longform clarifications.
    Input -> Text
title :: Text,
    -- | How wide the control should be.
    Input -> Maybe Int
size :: Maybe Int,
    -- | Additional data for inputs of type "file".
    Input -> FileSelector
fileData :: FileSelector,
    -- | Additional data for inputs of type "image".
    Input -> ImageData
imageData :: ImageData,
    -- | Additional data for inputs of type "textarea".
    Input -> TextArea
textArea :: TextArea
}
-- | A labelled-group of options, that can be collectively disabled.
data OptionGroup = OptGroup {
    -- | A brief human-legible description of the options on this group.
    OptionGroup -> Text
optsLabel :: Text,
    -- | Whether these options can be selected.
    OptionGroup -> Bool
optsDisabled :: Bool,
    -- | The options in this group.
    OptionGroup -> [Option]
subopts :: [Option]
}
-- | A possible value for an input.
data Option = Option {
    -- | Human-legible text identifying this option.
    Option -> Text
optLabel :: Text,
    -- | Machine-legible text identifying this option.
    Option -> Text
optValue :: Text,
    -- | Whether the option is selected.
    Option -> Bool
optSelected :: Bool,
    -- | Whether the option can be selected.
    Option -> Bool
optDisabled :: Bool
}
-- | Data specific to "file" inputs.
data FileSelector = FileSelector {
    -- | The MIMEtypes of the files which can be validly entered into this control.
    FileSelector -> [Text]
fileAccept :: [Text],
    -- | Whether options for capturing from a camera should be offered.
    FileSelector -> Text
fileCapture :: Text
}
-- | Empty values for file data.
defaultFileData :: FileSelector
defaultFileData :: FileSelector
defaultFileData = [Text] -> Text -> FileSelector
FileSelector [] Text
""
-- | Data specific to "image" inputs.
data ImageData = ImageData {
    -- | Text describing the image, in case the reader can't view it.
    ImageData -> Maybe Text
imgAlt :: Maybe Text,
    -- | How much screenspace the image takes up.
    ImageData -> (Maybe Int, Maybe Int)
imgSize :: (Maybe Int, Maybe Int),
    -- | The link to the image.
    ImageData -> Maybe URI
imgSrc :: Maybe URI
}
-- | Empty values for image data.
defaultImageData :: ImageData
defaultImageData :: ImageData
defaultImageData = Maybe Text -> (Maybe Int, Maybe Int) -> Maybe URI -> ImageData
ImageData Maybe Text
forall a. Maybe a
Nothing (Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing) Maybe URI
forall a. Maybe a
Nothing
-- | Data specific to textarea inputs.
data TextArea = TextArea {
    -- | Whether to enable autocorrect.
    TextArea -> Bool
autocorrect :: Bool,
    -- | Number of rows to display.
    TextArea -> Maybe Int
rows :: Maybe Int,
    -- | Whether to enable spellcheck.
    TextArea -> Maybe Bool
spellcheck :: Maybe Bool,
    -- | Whether to enable text-wrap.
    TextArea -> Maybe Bool
textwrap :: Maybe Bool
}
-- | Empty values for textarea data.
defaultTextArea :: TextArea
defaultTextArea :: TextArea
defaultTextArea = Bool -> Maybe Int -> Maybe Bool -> Maybe Bool -> TextArea
TextArea Bool
True Maybe Int
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

-- | Helper for looking up attributes on a selected element, with fallback.
attr :: Text -> Cursor -> Text -> Text
attr :: Text -> Cursor -> Text -> Text
attr Text
n Cursor
el Text
def | [Text
ret] <- Text
n Text -> Cursor -> [Text]
`laxAttribute` Cursor
el = Text
ret
    | Bool
otherwise = Text
def
-- | Helper for looking up attributes on a selected element, with fallback & callback.
attr' :: Text -> Cursor -> (Text -> a) -> Text -> a
attr' :: forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
n Cursor
el Text -> a
cb Text
def = Text -> a
cb (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text -> Text
attr Text
n Cursor
el Text
def
-- | Variant of `attr'` which passes which unpacks the callback's argument to a string.
attr'' :: Text -> Cursor -> (String -> a) -> Text -> a
attr'' :: forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
n Cursor
el String -> a
cb Text
def = Text -> Cursor -> (Text -> a) -> Text -> a
forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
n Cursor
el (String -> a
cb (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Txt.unpack) Text
def
-- | Helper for checking whether an attribute is present.
hasAttr :: Name -> Cursor -> Bool
hasAttr :: Name -> Cursor -> Bool
hasAttr Name
n = Bool -> Bool
not (Bool -> Bool) -> (Cursor -> Bool) -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cursor] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cursor] -> Bool) -> (Cursor -> [Cursor]) -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Cursor -> [Cursor]
hasAttribute Name
n
-- | Helper for looking up an attribute on a selected element if present.
mAttr :: Text -> Cursor -> Maybe Text
mAttr :: Text -> Cursor -> Maybe Text
mAttr Text
n = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text)
-> (Cursor -> [Text]) -> Cursor -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Cursor -> [Text]
laxAttribute Text
n
-- | Parse a form from the selected HTML element.
parseElement :: Cursor -> Maybe Form
parseElement :: Cursor -> Maybe Form
parseElement = Text -> Cursor -> Maybe Form
parseElement' Text
"en"
parseElement' :: Text -> Cursor -> Maybe Form
parseElement' :: Text -> Cursor -> Maybe Form
parseElement' Text
language Cursor
el | Cursor
_:[Cursor]
_ <- Text -> Cursor -> [Cursor]
laxElement Text
"form" Cursor
el = Form -> Maybe Form
forall a. a -> Maybe a
Just Form {
        action :: URI
action = Text -> Cursor -> (String -> URI) -> Text -> URI
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"action" Cursor
el (URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe URI
nullURI (Maybe URI -> URI) -> (String -> Maybe URI) -> String -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
parseURIReference) Text
".",
        enctype :: Text
enctype = Text -> Cursor -> Text -> Text
attr Text
"enctype" Cursor
el Text
"",
        method :: Text
method = Text -> Cursor -> Text -> Text
attr Text
"method" Cursor
el Text
"GET",
        validate :: Bool
validate = [Cursor] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cursor] -> Bool) -> [Cursor] -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Cursor]
hasAttribute Name
"novalidate" Cursor
el,
        target :: Text
target = Text -> Cursor -> Text -> Text
attr Text
"target" Cursor
el Text
"_self",
        acceptCharset :: [Text]
acceptCharset = Text -> Cursor -> (Text -> [Text]) -> Text -> [Text]
forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
"accept-charset" Cursor
el Text -> [Text]
Txt.words Text
"utf-8",
        autocomplete :: Bool
autocomplete = Name -> Cursor -> Bool
hasAttr Name
"autocomplete" Cursor
el,
        formName :: Text
formName = Text -> Cursor -> Text -> Text
attr Text
"name" Cursor
el Text
"",
        rel :: Text
rel = Text -> Cursor -> Text -> Text
attr Text
"rel" Cursor
el Text
"",
        inputs :: [Input]
inputs = (Cursor -> Maybe Input) -> [Cursor] -> [Input]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Cursor -> Maybe Input
parseInput ([Cursor] -> [Input]) -> [Cursor] -> [Input]
forall a b. (a -> b) -> a -> b
$ Cursor -> [Cursor]
queryInputs Cursor
el,
        lang :: String
lang = Text -> String
Txt.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
language (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$
                (Cursor -> Maybe Text) -> [Cursor] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Cursor -> Maybe Text
mAttr Text
"lang") ([Cursor] -> [Text]) -> [Cursor] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node. Axis node -> Axis node
orSelf Cursor -> [Cursor]
forall node. Axis node
ancestor Cursor
el
      }
    | Bool
otherwise = Maybe Form
forall a. Maybe a
Nothing

-- | Helper to retrieve the root node of a document.
root :: Axis
root :: Cursor -> [Cursor]
root = Cursor -> [Cursor]
forall a. a -> [a]
singleton (Cursor -> [Cursor]) -> (Cursor -> Cursor) -> Cursor -> [Cursor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cursor] -> Cursor
forall a. HasCallStack => [a] -> a
last ([Cursor] -> Cursor) -> (Cursor -> [Cursor]) -> Cursor -> Cursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node. Axis node -> Axis node
orSelf Cursor -> [Cursor]
forall node. Axis node
ancestor
-- | Case-insensitive element selection.
laxElements :: [Text] -> Axis
laxElements :: [Text] -> Cursor -> [Cursor]
laxElements [Text]
ns = (Name -> Bool) -> Cursor -> [Cursor]
forall b. Boolean b => (Name -> b) -> Cursor -> [Cursor]
checkName (\Name
x -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
    (Text -> Text -> Bool) -> (Text -> Text) -> Text -> Text -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text -> Text
Txt.toCaseFold Text
n (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> Text
nameLocalName Name
x | Text
n <- [Text]
ns])
-- | Retrieve all the inputs associated with a form element.
queryInputs :: Cursor -> [Cursor]
queryInputs :: Cursor -> [Cursor]
queryInputs Cursor
form = (Cursor -> [Cursor]
allInputs (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Cursor]
inForm) Cursor
form
  where
    allInputs :: Cursor -> [Cursor]
allInputs = Cursor -> [Cursor]
root (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Cursor]
forall node. Axis node
descendant (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Text] -> Cursor -> [Cursor]
laxElements [
        Text
"input", Text
"textarea", Text
"button", Text
"select"]
    inForm :: Cursor -> [Cursor]
inForm = (Cursor -> Bool) -> Cursor -> [Cursor]
forall b. Boolean b => (Cursor -> b) -> Cursor -> [Cursor]
check (\Cursor
x ->
        Text -> Cursor -> [Text]
laxAttribute Text
"form" Cursor
x [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Cursor -> [Text]
laxAttribute Text
"id" Cursor
form Bool -> Bool -> Bool
||
        Cursor -> Bool
nestedInForm Cursor
x)
    nestedInForm :: Cursor -> Bool
nestedInForm Cursor
x = [Cursor] -> Maybe Cursor
forall a. [a] -> Maybe a
listToMaybe ((Cursor -> [Cursor]
forall node. Axis node
ancestor (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Cursor -> [Cursor]
laxElement Text
"form") Cursor
x) Maybe Cursor -> Maybe Cursor -> Bool
forall a. Eq a => a -> a -> Bool
== Cursor -> Maybe Cursor
forall a. a -> Maybe a
Just Cursor
form
-- | Parse an input from the selected element.
parseInput :: Cursor -> Maybe Input
parseInput :: Cursor -> Maybe Input
parseInput Cursor
el | Cursor
_:[Cursor]
_ <- Text -> Cursor -> [Cursor]
laxElement Text
"input" Cursor
el = Input -> Maybe Input
forall a. a -> Maybe a
Just Input {
        label :: Text
label = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe
                -- Additional fallbacks are primarily for buttons
                (Text -> Cursor -> Text -> Text
attr Text
"name" Cursor
el (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text -> Text
attr Text
"value" Cursor
el (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text -> Text
attr Text
"alt" Cursor
el (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                Text -> Cursor -> Text -> Text
attr Text
"type" Cursor
el Text
"text") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Cursor -> Text) -> Maybe Cursor -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> Text
text Maybe Cursor
label',
        description :: Node
description = Node -> Maybe Node -> Node
forall a. a -> Maybe a -> a
fromMaybe (Text -> Node
mkEl (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text -> Text
attr Text
"title" Cursor
el Text
"") (Maybe Node -> Node) -> Maybe Node -> Node
forall a b. (a -> b) -> a -> b
$ (Cursor -> Node) -> Maybe Cursor -> Maybe Node
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> Node
forall node. Cursor node -> node
node (Maybe Cursor -> Maybe Node) -> Maybe Cursor -> Maybe Node
forall a b. (a -> b) -> a -> b
$
            Text -> Maybe Cursor
elByID (Text -> Cursor -> Text -> Text
attr Text
"aria-describedby" Cursor
el Text
"") Maybe Cursor -> Maybe Cursor -> Maybe Cursor
forall a. Maybe a -> Maybe a -> Maybe a
`orElse` Maybe Cursor
label',
        inputType :: Text
inputType = Text -> Cursor -> Text -> Text
attr Text
"type" Cursor
el Text
"text",
        value :: Text
value = Text -> Cursor -> Text -> Text
attr Text
"value" Cursor
el Text
"",
        inputAutocomplete :: Text
inputAutocomplete = Text -> Cursor -> Text -> Text
attr Text
"autocomplete" Cursor
el Text
"on",
        autofocus :: Bool
autofocus = Name -> Cursor -> Bool
hasAttr Name
"autofocus" Cursor
el,
        checked :: Bool
checked = Name -> Cursor -> Bool
hasAttr Name
"checked" Cursor
el,
        -- NOTE: No remaining harm in displaying hidden inputs,
        -- might be informative...
        disabled :: Bool
disabled = Name -> Cursor -> Bool
hasAttr Name
"disabled" Cursor
el Bool -> Bool -> Bool
|| Text -> Cursor -> Text -> Text
attr Text
"type" Cursor
el Text
"" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"hidden",
        readonly :: Bool
readonly = Name -> Cursor -> Bool
hasAttr Name
"readonly" Cursor
el Bool -> Bool -> Bool
|| Text -> Cursor -> Text -> Text
attr Text
"type" Cursor
el Text
"" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"hidden",
        multiple :: Bool
multiple = Name -> Cursor -> Bool
hasAttr Name
"multiple" Cursor
el,
        dirname :: Text
dirname = Text -> Cursor -> Text -> Text
attr Text
"dirname" Cursor
el Text
"",
        inputName :: Text
inputName = Text -> Cursor -> Text -> Text
attr Text
"name" Cursor
el Text
"",
        formAction :: Maybe URI
formAction = if Name -> Cursor -> Bool
hasAttr Name
"formaction" Cursor
el
            then Text -> Cursor -> (Text -> Maybe URI) -> Text -> Maybe URI
forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
"formaction" Cursor
el (String -> Maybe URI
parseURIReference (String -> Maybe URI) -> (Text -> String) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Txt.unpack) Text
""
            else Maybe URI
forall a. Maybe a
Nothing,
        formEnctype :: Maybe Text
formEnctype = Text -> Cursor -> Maybe Text
mAttr Text
"formenctype" Cursor
el,
        formMethod :: Maybe Text
formMethod = Text -> Cursor -> Maybe Text
mAttr Text
"formmethod" Cursor
el,
        formValidate :: Bool
formValidate = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> Bool
hasAttr Name
"formnovalidate" Cursor
el,
        formTarget :: Maybe Text
formTarget = Text -> Cursor -> Maybe Text
mAttr Text
"formtarget" Cursor
el,
        inputMode :: Text
inputMode = Text -> Cursor -> Text -> Text
attr Text
"inputmode" Cursor
el Text
"text",
        list :: [OptionGroup]
list = [OptionGroup] -> Maybe [OptionGroup] -> [OptionGroup]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [OptionGroup] -> [OptionGroup])
-> Maybe [OptionGroup] -> [OptionGroup]
forall a b. (a -> b) -> a -> b
$ (Cursor -> [OptionGroup]) -> Maybe Cursor -> Maybe [OptionGroup]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> [OptionGroup]
parseOptions (Text -> Maybe Cursor
elByID (Text -> Maybe Cursor) -> Maybe Text -> Maybe Cursor
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Cursor -> Maybe Text
mAttr Text
"list" Cursor
el),
        range :: (Maybe Text, Maybe Text)
range = (Text -> Cursor -> Maybe Text
mAttr Text
"min" Cursor
el, Text -> Cursor -> Maybe Text
mAttr Text
"max" Cursor
el),
        step :: Maybe Text
step = Text -> Cursor -> Maybe Text
mAttr Text
"step" Cursor
el,
        lengthRange :: (Maybe Int, Maybe Int)
lengthRange = (Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"minlength" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
"",
            Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"maxLength" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
""),
        pattern :: Maybe Regex
pattern = Text -> Cursor -> (Text -> Maybe Regex) -> Text -> Maybe Regex
forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
"pattern" Cursor
el
            (Either String Regex -> Maybe Regex
forall a b. Either a b -> Maybe b
rightToMaybe (Either String Regex -> Maybe Regex)
-> (Text -> Either String Regex) -> Text -> Maybe Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompOption -> ExecOption -> Text -> Either String Regex
compile CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt) Text
".*",
        required :: Bool
required = Name -> Cursor -> Bool
hasAttr Name
"required" Cursor
el,
        placeholder :: Text
placeholder = Text -> Cursor -> Text -> Text
attr Text
"placeholder" Cursor
el Text
"",
        title :: Text
title = Text -> Cursor -> Text -> Text
attr Text
"title" Cursor
el Text
"",
        size :: Maybe Int
size = Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"size" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
"",
        fileData :: FileSelector
fileData = FileSelector {
            fileAccept :: [Text]
fileAccept = Text -> Cursor -> (Text -> [Text]) -> Text -> [Text]
forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
"accept" Cursor
el Text -> [Text]
Txt.words Text
"*",
            fileCapture :: Text
fileCapture = Text -> Cursor -> Text -> Text
attr Text
"capture" Cursor
el Text
""
        },
        imageData :: ImageData
imageData = ImageData {
            imgAlt :: Maybe Text
imgAlt = Text -> Cursor -> Maybe Text
mAttr Text
"alt" Cursor
el,
            imgSize :: (Maybe Int, Maybe Int)
imgSize = (Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"width" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
"",
                Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"height" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
""),
            imgSrc :: Maybe URI
imgSrc = Text -> Cursor -> (String -> Maybe URI) -> Text -> Maybe URI
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"src" Cursor
el (String -> Maybe URI
parseURIReference) Text
""
        },
        textArea :: TextArea
textArea = TextArea
defaultTextArea
      }
    | Cursor
_:[Cursor]
_ <- Text -> Cursor -> [Cursor]
laxElement Text
"textarea" Cursor
el = Input -> Maybe Input
forall a. a -> Maybe a
Just Input {
        inputType :: Text
inputType = Text
"<textarea>",
        label :: Text
label = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Cursor -> Text -> Text
attr Text
"name" Cursor
el Text
"") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Cursor -> Text) -> Maybe Cursor -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> Text
text Maybe Cursor
label',
        description :: Node
description = Node -> Maybe Node -> Node
forall a. a -> Maybe a -> a
fromMaybe (Text -> Node
mkEl (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text -> Text
attr Text
"title" Cursor
el Text
"") (Maybe Node -> Node) -> Maybe Node -> Node
forall a b. (a -> b) -> a -> b
$ (Cursor -> Node) -> Maybe Cursor -> Maybe Node
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> Node
forall node. Cursor node -> node
node (Maybe Cursor -> Maybe Node) -> Maybe Cursor -> Maybe Node
forall a b. (a -> b) -> a -> b
$
            Text -> Maybe Cursor
elByID (Text -> Cursor -> Text -> Text
attr Text
"aria-describedby" Cursor
el Text
"") Maybe Cursor -> Maybe Cursor -> Maybe Cursor
forall a. Maybe a -> Maybe a -> Maybe a
`orElse` Maybe Cursor
label',
        value :: Text
value = Cursor -> Text
text Cursor
el,

        inputAutocomplete :: Text
inputAutocomplete = Text -> Cursor -> Text -> Text
attr Text
"autocomplete" Cursor
el Text
"on",
        autofocus :: Bool
autofocus = Name -> Cursor -> Bool
hasAttr Name
"autofocus" Cursor
el,
        size :: Maybe Int
size = Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"cols" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
"",
        dirname :: Text
dirname = Text -> Cursor -> Text -> Text
attr Text
"dirname" Cursor
el Text
"",
        disabled :: Bool
disabled = Name -> Cursor -> Bool
hasAttr Name
"disabled" Cursor
el,
        lengthRange :: (Maybe Int, Maybe Int)
lengthRange = (Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"minLength" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
"",
            Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"maxLength" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
""),
        inputName :: Text
inputName = Text -> Cursor -> Text -> Text
attr Text
"name" Cursor
el Text
"",
        placeholder :: Text
placeholder = Text -> Cursor -> Text -> Text
attr Text
"placeholder" Cursor
el Text
"",
        readonly :: Bool
readonly = Name -> Cursor -> Bool
hasAttr Name
"readonly" Cursor
el,
        required :: Bool
required = Name -> Cursor -> Bool
hasAttr Name
"required" Cursor
el,
        title :: Text
title = Text -> Cursor -> Text -> Text
attr Text
"title" Cursor
el Text
"",
        inputMode :: Text
inputMode = Text -> Cursor -> Text -> Text
attr Text
"inputMode" Cursor
el Text
"text",
        textArea :: TextArea
textArea = TextArea {
            autocorrect :: Bool
autocorrect = Text -> Cursor -> Text -> Text
attr Text
"autocorrect" Cursor
el Text
"on" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"off",
            rows :: Maybe Int
rows = Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"rows" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
"",
            spellcheck :: Maybe Bool
spellcheck = Text -> Cursor -> (Text -> Maybe Bool) -> Text -> Maybe Bool
forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
"spellcheck" Cursor
el (\Text
x -> case Text
x of
                Text
"true" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                Text
"false" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                Text
"default" -> Maybe Bool
forall a. Maybe a
Nothing
                Text
_ -> Maybe Bool
forall a. Maybe a
Nothing) Text
"default",
            textwrap :: Maybe Bool
textwrap = Text -> Cursor -> (Text -> Maybe Bool) -> Text -> Maybe Bool
forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
"wrap" Cursor
el (\Text
x -> case Text
x of
                Text
"hard" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                Text
"soft" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                Text
"off" -> Maybe Bool
forall a. Maybe a
Nothing
                Text
_ -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) Text
"soft"
        },

        checked :: Bool
checked = Bool
False,
        multiple :: Bool
multiple = Bool
True,
        formAction :: Maybe URI
formAction = Maybe URI
forall a. Maybe a
Nothing,
        formEnctype :: Maybe Text
formEnctype = Maybe Text
forall a. Maybe a
Nothing,
        formMethod :: Maybe Text
formMethod = Maybe Text
forall a. Maybe a
Nothing,
        formValidate :: Bool
formValidate = Bool
False,
        formTarget :: Maybe Text
formTarget = Maybe Text
forall a. Maybe a
Nothing,
        list :: [OptionGroup]
list = [],
        range :: (Maybe Text, Maybe Text)
range = (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing),
        step :: Maybe Text
step = Maybe Text
forall a. Maybe a
Nothing,
        pattern :: Maybe Regex
pattern = Maybe Regex
forall a. Maybe a
Nothing,
        fileData :: FileSelector
fileData = FileSelector
defaultFileData,
        imageData :: ImageData
imageData = ImageData
defaultImageData
    }
    | Cursor
_:[Cursor]
_ <- Text -> Cursor -> [Cursor]
laxElement Text
"button" Cursor
el = Input -> Maybe Input
forall a. a -> Maybe a
Just Input {
        -- Fallingback to the input itself as its label allow for
        -- the full richness of its children to be rendered!
        label :: Text
label = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Cursor -> Text
text Cursor
el) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Cursor -> Text) -> Maybe Cursor -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> Text
text Maybe Cursor
label',
        description :: Node
description = Node -> Maybe Node -> Node
forall a. a -> Maybe a -> a
fromMaybe (Cursor -> Node
forall node. Cursor node -> node
node Cursor
el) (Maybe Node -> Node) -> Maybe Node -> Node
forall a b. (a -> b) -> a -> b
$ (Cursor -> Node) -> Maybe Cursor -> Maybe Node
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> Node
forall node. Cursor node -> node
node (Maybe Cursor -> Maybe Node) -> Maybe Cursor -> Maybe Node
forall a b. (a -> b) -> a -> b
$
            Text -> Maybe Cursor
elByID (Text -> Maybe Cursor) -> Text -> Maybe Cursor
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text -> Text
attr Text
"aria-describedby" Cursor
el Text
"",

        autofocus :: Bool
autofocus = Name -> Cursor -> Bool
hasAttr Name
"autofocus" Cursor
el,
        disabled :: Bool
disabled = Name -> Cursor -> Bool
hasAttr Name
"disabled" Cursor
el,
        formAction :: Maybe URI
formAction = if Name -> Cursor -> Bool
hasAttr Name
"formaction" Cursor
el
            then Text -> Cursor -> (Text -> Maybe URI) -> Text -> Maybe URI
forall a. Text -> Cursor -> (Text -> a) -> Text -> a
attr' Text
"formaction" Cursor
el (String -> Maybe URI
parseURIReference (String -> Maybe URI) -> (Text -> String) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Txt.unpack) Text
""
            else Maybe URI
forall a. Maybe a
Nothing,
        formEnctype :: Maybe Text
formEnctype = Text -> Cursor -> Maybe Text
mAttr Text
"formenctype" Cursor
el,
        formMethod :: Maybe Text
formMethod = Text -> Cursor -> Maybe Text
mAttr Text
"formmethod" Cursor
el,
        formValidate :: Bool
formValidate = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> Bool
hasAttr Name
"formnovalidate" Cursor
el,
        formTarget :: Maybe Text
formTarget = Text -> Cursor -> Maybe Text
mAttr Text
"formtarget" Cursor
el,
        inputName :: Text
inputName = Text -> Cursor -> Text -> Text
attr Text
"name" Cursor
el Text
"",
        -- Popover buttons should be handled by HTML engine, not form engine.
        inputType :: Text
inputType = Text -> Cursor -> Text -> Text
attr Text
"type" Cursor
el Text
"submit",
        value :: Text
value = Text -> Cursor -> Text -> Text
attr Text
"value" Cursor
el Text
"",
        title :: Text
title = Text -> Cursor -> Text -> Text
attr Text
"title" Cursor
el Text
"",
        -- Placeholder makes sense as a place to put the label...
        placeholder :: Text
placeholder = [Text] -> Text
Txt.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Cursor -> [Cursor]
forall node. Axis node
descendant (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Text]
content) Cursor
el,

        dirname :: Text
dirname = Text
"",
        inputAutocomplete :: Text
inputAutocomplete = Text
"",
        checked :: Bool
checked = Bool
False, -- Switch to true for the activated button!
        readonly :: Bool
readonly = Bool
False,
        multiple :: Bool
multiple = Bool
False,
        inputMode :: Text
inputMode = Text
"",
        list :: [OptionGroup]
list = [],
        range :: (Maybe Text, Maybe Text)
range = (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing),
        step :: Maybe Text
step = Maybe Text
forall a. Maybe a
Nothing,
        lengthRange :: (Maybe Int, Maybe Int)
lengthRange = (Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing),
        pattern :: Maybe Regex
pattern = Maybe Regex
forall a. Maybe a
Nothing,
        required :: Bool
required = Bool
False,
        size :: Maybe Int
size = Maybe Int
forall a. Maybe a
Nothing,
        fileData :: FileSelector
fileData = FileSelector
defaultFileData,
        imageData :: ImageData
imageData = ImageData
defaultImageData,
        textArea :: TextArea
textArea = TextArea
defaultTextArea
    }
    | Cursor
_:[Cursor]
_ <- Text -> Cursor -> [Cursor]
laxElement Text
"select" Cursor
el = Input -> Maybe Input
forall a. a -> Maybe a
Just Input {
        inputType :: Text
inputType = Text
"<select>",
        label :: Text
label = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Cursor -> Text -> Text
attr Text
"name" Cursor
el Text
"") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Txt.concat (Maybe [Text] -> Maybe Text) -> Maybe [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$
            (Cursor -> [Text]) -> Maybe Cursor -> Maybe [Text]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> [Text]
filterSelect Maybe Cursor
label',
        description :: Node
description = Node -> Maybe Node -> Node
forall a. a -> Maybe a -> a
fromMaybe (Text -> Node
mkEl (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text -> Text
attr Text
"title" Cursor
el Text
"") (Maybe Node -> Node) -> Maybe Node -> Node
forall a b. (a -> b) -> a -> b
$ (Cursor -> Node) -> Maybe Cursor -> Maybe Node
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cursor -> Node
forall node. Cursor node -> node
node (Maybe Cursor -> Maybe Node) -> Maybe Cursor -> Maybe Node
forall a b. (a -> b) -> a -> b
$
            Text -> Maybe Cursor
elByID (Text -> Maybe Cursor) -> Text -> Maybe Cursor
forall a b. (a -> b) -> a -> b
$ Text -> Cursor -> Text -> Text
attr Text
"aria-describedby" Cursor
el Text
"",

        inputAutocomplete :: Text
inputAutocomplete = Text -> Cursor -> Text -> Text
attr Text
"autocomplete" Cursor
el Text
"on",
        autofocus :: Bool
autofocus = Name -> Cursor -> Bool
hasAttr Name
"autofocus" Cursor
el,
        disabled :: Bool
disabled = Name -> Cursor -> Bool
hasAttr Name
"disabled" Cursor
el,
        multiple :: Bool
multiple = Name -> Cursor -> Bool
hasAttr Name
"multiple" Cursor
el,
        inputName :: Text
inputName = Text -> Cursor -> Text -> Text
attr Text
"name" Cursor
el Text
"",
        required :: Bool
required = Name -> Cursor -> Bool
hasAttr Name
"required" Cursor
el,
        size :: Maybe Int
size = Text -> Cursor -> (String -> Maybe Int) -> Text -> Maybe Int
forall a. Text -> Cursor -> (String -> a) -> Text -> a
attr'' Text
"size" Cursor
el String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Text
"",
        list :: [OptionGroup]
list = Cursor -> [OptionGroup]
parseOptions Cursor
el,
        title :: Text
title = Text -> Cursor -> Text -> Text
attr Text
"title" Cursor
el Text
"",

        dirname :: Text
dirname = Text
"",
        value :: Text
value = Text
"", -- Sourced from list...
        checked :: Bool
checked = Bool
False,
        readonly :: Bool
readonly = Bool
False,
        formAction :: Maybe URI
formAction = Maybe URI
forall a. Maybe a
Nothing,
        formEnctype :: Maybe Text
formEnctype = Maybe Text
forall a. Maybe a
Nothing,
        formMethod :: Maybe Text
formMethod = Maybe Text
forall a. Maybe a
Nothing,
        formValidate :: Bool
formValidate = Bool
False,
        formTarget :: Maybe Text
formTarget = Maybe Text
forall a. Maybe a
Nothing,
        inputMode :: Text
inputMode = Text
"",
        range :: (Maybe Text, Maybe Text)
range = (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing),
        step :: Maybe Text
step = Maybe Text
forall a. Maybe a
Nothing,
        lengthRange :: (Maybe Int, Maybe Int)
lengthRange = (Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing),
        pattern :: Maybe Regex
pattern = Maybe Regex
forall a. Maybe a
Nothing,
        placeholder :: Text
placeholder = Text
"",
        fileData :: FileSelector
fileData = FileSelector
defaultFileData,
        imageData :: ImageData
imageData = ImageData
defaultImageData,
        textArea :: TextArea
textArea = TextArea
defaultTextArea
      }
    | Bool
otherwise = Maybe Input
forall a. Maybe a
Nothing
  where
    elByAttr :: Name -> Text -> Maybe Cursor
elByAttr Name
k Text
v = [Cursor] -> Maybe Cursor
forall a. [a] -> Maybe a
listToMaybe ([Cursor] -> Maybe Cursor) -> [Cursor] -> Maybe Cursor
forall a b. (a -> b) -> a -> b
$ (Cursor -> [Cursor]
root (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Cursor]
forall node. Axis node
descendant (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Text -> Cursor -> [Cursor]
attributeIs Name
k Text
v) Cursor
el
    elByID :: Text -> Maybe Cursor
elByID = Name -> Text -> Maybe Cursor
elByAttr Name
"id"
    label' :: Maybe Cursor
label' = Name -> Text -> Maybe Cursor
elByAttr Name
"for" (Text -> Cursor -> Text -> Text
attr Text
"id" Cursor
el Text
"") Maybe Cursor -> Maybe Cursor -> Maybe Cursor
forall a. Maybe a -> Maybe a -> Maybe a
`orElse`
            [Cursor] -> Maybe Cursor
forall a. [a] -> Maybe a
listToMaybe ([Cursor] -> Maybe Cursor) -> [Cursor] -> Maybe Cursor
forall a b. (a -> b) -> a -> b
$ (Cursor -> [Cursor]
forall node. Axis node
ancestor (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Cursor -> [Cursor]
laxElement Text
"label") Cursor
el
    filterSelect :: Cursor -> [Text]
filterSelect = Cursor -> [Cursor]
forall node. Axis node
descendant (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall b. Boolean b => (Cursor -> b) -> Cursor -> [Cursor]
checkNot ((Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node. Axis node -> Axis node
orSelf Cursor -> [Cursor]
forall node. Axis node
ancestor (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Cursor -> [Cursor]
laxElement Text
"select") (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        Cursor -> [Text]
content
-- | Parse the options beneath a selected element.
parseOptions :: Cursor -> [OptionGroup]
parseOptions :: Cursor -> [OptionGroup]
parseOptions Cursor
el = [Cursor -> OptionGroup
parseGroup Cursor
opt
    | Cursor
opt <- (Cursor -> [Cursor]
forall node. Axis node
descendant (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Text] -> Cursor -> [Cursor]
laxElements [Text
"option", Text
"optgroup"] (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall b. Boolean b => (Cursor -> b) -> Cursor -> [Cursor]
checkNot (Cursor -> [Cursor]
forall node. Axis node
parent (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Cursor -> [Cursor]
laxElement Text
"optgroup")) Cursor
el]
  where
    parseGroup :: Cursor -> OptionGroup
parseGroup Cursor
opt
        | Cursor
_:[Cursor]
_ <- Text -> Cursor -> [Cursor]
laxElement Text
"option" Cursor
opt =
            Text -> Bool -> [Option] -> OptionGroup
OptGroup Text
"" Bool
False [Cursor -> Bool -> Option
parseOption Cursor
opt Bool
False]
        | Cursor
_:[Cursor]
_ <- Text -> Cursor -> [Cursor]
laxElement Text
"optgroup" Cursor
opt = OptGroup {
            optsLabel :: Text
optsLabel = Text -> Cursor -> Text -> Text
attr Text
"label" Cursor
opt Text
"",
            optsDisabled :: Bool
optsDisabled = Name -> Cursor -> Bool
hasAttr Name
"disabled" Cursor
opt,
            subopts :: [Option]
subopts = [Cursor -> Bool -> Option
parseOption Cursor
o (Bool -> Option) -> Bool -> Option
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> Bool
hasAttr Name
"disabled" Cursor
opt | Cursor
o <- Cursor -> [Cursor]
forall node. Axis node
child Cursor
opt]
          }
        | Bool
otherwise = Text -> Bool -> [Option] -> OptionGroup
OptGroup Text
"" Bool
True [] -- Shouldn't happen!
    parseOption :: Cursor -> Bool -> Option
parseOption Cursor
opt Bool
disabledOverride = Option {
        optLabel :: Text
optLabel = Text -> Cursor -> Text -> Text
attr Text
"label" Cursor
opt (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Cursor -> Text
text Cursor
opt,
        optValue :: Text
optValue = Text -> Cursor -> Text -> Text
attr Text
"value" Cursor
opt (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Cursor -> Text
text Cursor
opt,
        optSelected :: Bool
optSelected = Name -> Cursor -> Bool
hasAttr Name
"selected" Cursor
opt,
        optDisabled :: Bool
optDisabled = Name -> Cursor -> Bool
hasAttr Name
"disabled" Cursor
opt Bool -> Bool -> Bool
|| Bool
disabledOverride
      }

-- | Parse a named or numerically-indexed form from an HTML document.
parseDocument :: Document -> Text -> Maybe Form
parseDocument :: Document -> Text -> Maybe Form
parseDocument = Text -> Document -> Text -> Maybe Form
parseDocument' Text
"en"
parseDocument' :: Text -> Document -> Text -> Maybe Form
parseDocument' :: Text -> Document -> Text -> Maybe Form
parseDocument' Text
language Document
doc Text
n
    | Just Int
n' <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
n, Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Cursor] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Cursor -> [Cursor]
forms Cursor
doc') =
        Text -> Cursor -> Maybe Form
parseElement' Text
language (Cursor -> [Cursor]
forms Cursor
doc' [Cursor] -> Int -> Cursor
forall a. HasCallStack => [a] -> Int -> a
!! Int
n')
    | Cursor
el:[Cursor]
_ <- (Cursor -> [Cursor]
forms (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Text -> Cursor -> [Cursor]
attributeIs Name
"name" Text
n) Cursor
doc' = Text -> Cursor -> Maybe Form
parseElement' Text
language Cursor
el
    | Bool
otherwise = Maybe Form
forall a. Maybe a
Nothing
  where
    forms :: Cursor -> [Cursor]
forms = (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall node. Axis node -> Axis node
orSelf Cursor -> [Cursor]
forall node. Axis node
descendant (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Cursor -> [Cursor]
laxElement Text
"form"
    doc' :: Cursor
doc' = Document -> Cursor
fromDocument Document
doc

-- | Helper to select elements which fail a test.
checkNot :: Boolean b => (Cursor -> b) -> Axis
checkNot :: forall b. Boolean b => (Cursor -> b) -> Cursor -> [Cursor]
checkNot Cursor -> b
test = (Cursor -> Bool) -> Cursor -> [Cursor]
forall b. Boolean b => (Cursor -> b) -> Cursor -> [Cursor]
check (Bool -> Bool
not (Bool -> Bool) -> (Cursor -> Bool) -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Bool
forall a. Boolean a => a -> Bool
bool (b -> Bool) -> (Cursor -> b) -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> b
test)
-- | Helper to maybe-get the right side of an either.
rightToMaybe :: Either a b -> Maybe b
rightToMaybe :: forall a b. Either a b -> Maybe b
rightToMaybe (Left a
_)  = Maybe b
forall a. Maybe a
Nothing
rightToMaybe (Right b
x) = b -> Maybe b
forall a. a -> Maybe a
Just b
x
instance Eq Cursor where
    Cursor
a == :: Cursor -> Cursor -> Bool
== Cursor
b = Cursor -> Node
forall node. Cursor node -> node
node Cursor
a Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Cursor -> Node
forall node. Cursor node -> node
node Cursor
b
-- | Helper to return the 1st Just from its 2 arguments.
orElse :: Maybe a -> Maybe a -> Maybe a
orElse :: forall a. Maybe a -> Maybe a -> Maybe a
orElse ret :: Maybe a
ret@(Just a
_) Maybe a
_ = Maybe a
ret
orElse Maybe a
_ Maybe a
ret = Maybe a
ret
infixr 0 `orElse`
-- | Helper to retrieve the concatenated text under a selected element.
text :: Cursor -> Text
text :: Cursor -> Text
text = [Text] -> Text
Txt.concat ([Text] -> Text) -> (Cursor -> [Text]) -> Cursor -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cursor -> [Cursor]
forall node. Axis node
descendant (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Text]
content)
-- | Concise synonym for an XML text node.
mkEl :: Text -> Node
mkEl :: Text -> Node
mkEl = Text -> Node
NodeContent

-- | Add submit & reset buttons to a form if they were missing!
ensureButtons :: Form -> Form
ensureButtons :: Form -> Form
ensureButtons = Text -> Text -> Form -> Form
ensureButton Text
"submit" Text
"Submit" (Form -> Form) -> (Form -> Form) -> Form -> Form
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Form -> Form
ensureButton Text
"reset" Text
"Reset"
  where
    ensureButton :: Text -> Text -> Form -> Form
ensureButton Text
typ Text
label' Form
form
        | (Input -> Bool) -> [Input] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Input
x -> Input -> Text
inputType Input
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
typ) ([Input] -> Bool) -> [Input] -> Bool
forall a b. (a -> b) -> a -> b
$ Form -> [Input]
inputs Form
form = Form
form
        | Bool
otherwise = Form
form { inputs = inputs form ++ [button typ label'] }
    button :: Text -> Text -> Input
button Text
typ Text
label' = Input {
        label :: Text
label = Text
label',
        description :: Node
description = Text -> Node
mkEl Text
"",
        autofocus :: Bool
autofocus = Bool
False,
        disabled :: Bool
disabled = Bool
False,
        formAction :: Maybe URI
formAction = Maybe URI
forall a. Maybe a
Nothing,
        formMethod :: Maybe Text
formMethod = Maybe Text
forall a. Maybe a
Nothing,
        formEnctype :: Maybe Text
formEnctype = Maybe Text
forall a. Maybe a
Nothing,
        formValidate :: Bool
formValidate = Bool
True,
        formTarget :: Maybe Text
formTarget = Maybe Text
forall a. Maybe a
Nothing,
        inputName :: Text
inputName = Text
"",
        inputType :: Text
inputType = Text
typ,
        value :: Text
value = Text
"",
        title :: Text
title = Text
"",
        placeholder :: Text
placeholder = Text
"",
        dirname :: Text
dirname = Text
"",
        inputAutocomplete :: Text
inputAutocomplete = Text
"",
        checked :: Bool
checked = Bool
False, -- Switch to true for the activated button!
        readonly :: Bool
readonly = Bool
False,
        multiple :: Bool
multiple = Bool
False,
        inputMode :: Text
inputMode = Text
"",
        list :: [OptionGroup]
list = [],
        range :: (Maybe Text, Maybe Text)
range = (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing),
        step :: Maybe Text
step = Maybe Text
forall a. Maybe a
Nothing,
        lengthRange :: (Maybe Int, Maybe Int)
lengthRange = (Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing),
        pattern :: Maybe Regex
pattern = Maybe Regex
forall a. Maybe a
Nothing,
        required :: Bool
required = Bool
False,
        size :: Maybe Int
size = Maybe Int
forall a. Maybe a
Nothing,
        fileData :: FileSelector
fileData = FileSelector
defaultFileData,
        imageData :: ImageData
imageData = ImageData
defaultImageData,
        textArea :: TextArea
textArea = TextArea
defaultTextArea
      }