module DOM.HTML.Indexed where

import Data.MediaType
import Data.Row
import Data.Text qualified as T
import Data.Time
import HPrelude hiding (Any)
import Web.Clipboard.ClipboardEvent
import Web.Event.Event
import Web.HTML.Event.DragEvent
import Web.UIEvent.FocusEvent
import Web.UIEvent.KeyboardEvent
import Web.UIEvent.MouseEvent
import Web.UIEvent.PointerEvent
import Web.UIEvent.TouchEvent
import Web.UIEvent.WheelEvent

--------------------------------------

data DirValue
  = DirLTR
  | DirRTL
  | DirAuto
  deriving (DirValue -> DirValue -> Bool
(DirValue -> DirValue -> Bool)
-> (DirValue -> DirValue -> Bool) -> Eq DirValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirValue -> DirValue -> Bool
== :: DirValue -> DirValue -> Bool
$c/= :: DirValue -> DirValue -> Bool
/= :: DirValue -> DirValue -> Bool
Eq, Eq DirValue
Eq DirValue =>
(DirValue -> DirValue -> Ordering)
-> (DirValue -> DirValue -> Bool)
-> (DirValue -> DirValue -> Bool)
-> (DirValue -> DirValue -> Bool)
-> (DirValue -> DirValue -> Bool)
-> (DirValue -> DirValue -> DirValue)
-> (DirValue -> DirValue -> DirValue)
-> Ord DirValue
DirValue -> DirValue -> Bool
DirValue -> DirValue -> Ordering
DirValue -> DirValue -> DirValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DirValue -> DirValue -> Ordering
compare :: DirValue -> DirValue -> Ordering
$c< :: DirValue -> DirValue -> Bool
< :: DirValue -> DirValue -> Bool
$c<= :: DirValue -> DirValue -> Bool
<= :: DirValue -> DirValue -> Bool
$c> :: DirValue -> DirValue -> Bool
> :: DirValue -> DirValue -> Bool
$c>= :: DirValue -> DirValue -> Bool
>= :: DirValue -> DirValue -> Bool
$cmax :: DirValue -> DirValue -> DirValue
max :: DirValue -> DirValue -> DirValue
$cmin :: DirValue -> DirValue -> DirValue
min :: DirValue -> DirValue -> DirValue
Ord)

renderDirValue :: DirValue -> Text
renderDirValue :: DirValue -> Text
renderDirValue = \case
  DirValue
DirLTR -> Text
"ltr"
  DirValue
DirRTL -> Text
"rtl"
  DirValue
DirAuto -> Text
"auto"

--------------------------------------

data PreloadValue
  = PreloadNone
  | PreloadAuto
  | PreloadMetadata
  deriving stock (PreloadValue -> PreloadValue -> Bool
(PreloadValue -> PreloadValue -> Bool)
-> (PreloadValue -> PreloadValue -> Bool) -> Eq PreloadValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PreloadValue -> PreloadValue -> Bool
== :: PreloadValue -> PreloadValue -> Bool
$c/= :: PreloadValue -> PreloadValue -> Bool
/= :: PreloadValue -> PreloadValue -> Bool
Eq, Eq PreloadValue
Eq PreloadValue =>
(PreloadValue -> PreloadValue -> Ordering)
-> (PreloadValue -> PreloadValue -> Bool)
-> (PreloadValue -> PreloadValue -> Bool)
-> (PreloadValue -> PreloadValue -> Bool)
-> (PreloadValue -> PreloadValue -> Bool)
-> (PreloadValue -> PreloadValue -> PreloadValue)
-> (PreloadValue -> PreloadValue -> PreloadValue)
-> Ord PreloadValue
PreloadValue -> PreloadValue -> Bool
PreloadValue -> PreloadValue -> Ordering
PreloadValue -> PreloadValue -> PreloadValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PreloadValue -> PreloadValue -> Ordering
compare :: PreloadValue -> PreloadValue -> Ordering
$c< :: PreloadValue -> PreloadValue -> Bool
< :: PreloadValue -> PreloadValue -> Bool
$c<= :: PreloadValue -> PreloadValue -> Bool
<= :: PreloadValue -> PreloadValue -> Bool
$c> :: PreloadValue -> PreloadValue -> Bool
> :: PreloadValue -> PreloadValue -> Bool
$c>= :: PreloadValue -> PreloadValue -> Bool
>= :: PreloadValue -> PreloadValue -> Bool
$cmax :: PreloadValue -> PreloadValue -> PreloadValue
max :: PreloadValue -> PreloadValue -> PreloadValue
$cmin :: PreloadValue -> PreloadValue -> PreloadValue
min :: PreloadValue -> PreloadValue -> PreloadValue
Ord)

renderPreloadValue :: PreloadValue -> Text
renderPreloadValue :: PreloadValue -> Text
renderPreloadValue = \case
  PreloadValue
PreloadNone -> Text
"none"
  PreloadValue
PreloadAuto -> Text
"auto"
  PreloadValue
PreloadMetadata -> Text
"metadata"

--------------------------------------

data ButtonType
  = ButtonButton
  | ButtonSubmit
  | ButtonReset

renderButtonType :: ButtonType -> Text
renderButtonType :: ButtonType -> Text
renderButtonType = \case
  ButtonType
ButtonButton -> Text
"button"
  ButtonType
ButtonSubmit -> Text
"submit"
  ButtonType
ButtonReset -> Text
"reset"

--------------------------------------

data AutocompleteType
  = AutocompleteOff
  | AutocompleteOn
  | AutocompleteName
  | AutocompleteHonorificPrefix
  | AutocompleteGivenName
  | AutocompleteAdditionalName
  | AutocompleteFamilyName
  | AutocompleteHonorificSuffix
  | AutocompleteNickname
  | AutocompleteEmail
  | AutocompleteUsername
  | AutocompleteNewPassword
  | AutocompleteCurrentPassword
  | AutocompleteOneTimeCode
  | AutocompleteOrganizationTitle
  | AutocompleteOrganization
  | AutocompleteStreetAddress
  | AutocompleteAddressLine1
  | AutocompleteAddressLine2
  | AutocompleteAddressLine3
  | AutocompleteAddressLevel1
  | AutocompleteAddressLevel2
  | AutocompleteAddressLevel3
  | AutocompleteAddressLevel4
  | AutocompleteCountry
  | AutocompleteCountryName
  | AutocompletePostalCode
  | AutocompleteCreditCardName
  | AutocompleteCreditCardGivenName
  | AutocompleteCreditCardAdditionalName
  | AutocompleteCreditCardFamilyName
  | AutocompleteCreditCardNumber
  | AutocompleteCreditCardExpiration
  | AutocompleteCreditCardExpirationMonth
  | AutocompleteCreditCardExpirationYear
  | AutocompleteCreditCardSecurityCode
  | AutocompleteCreditCardType
  | AutocompleteTransactionCurrency
  | AutocompleteTransactionAmount
  | AutocompleteLanguage
  | AutocompleteBirthday
  | AutocompleteBirthdayDay
  | AutocompleteBirthdayMonth
  | AutocompleteBirthdayYear
  | AutocompleteSex
  | AutocompleteTelephone
  | AutocompleteTelephoneCountryCode
  | AutocompleteTelephoneNational
  | AutocompleteTelephoneAreaCode
  | AutocompleteTelephoneLocal
  | AutocompleteTelephoneLocalPrefix
  | AutocompleteTelephoneLocalSuffix
  | AutocompleteTelephoneExtension
  | AutocompleteIMPP
  | AutocompleteURL
  | AutocompletePhoto
  deriving stock (AutocompleteType -> AutocompleteType -> Bool
(AutocompleteType -> AutocompleteType -> Bool)
-> (AutocompleteType -> AutocompleteType -> Bool)
-> Eq AutocompleteType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutocompleteType -> AutocompleteType -> Bool
== :: AutocompleteType -> AutocompleteType -> Bool
$c/= :: AutocompleteType -> AutocompleteType -> Bool
/= :: AutocompleteType -> AutocompleteType -> Bool
Eq, Eq AutocompleteType
Eq AutocompleteType =>
(AutocompleteType -> AutocompleteType -> Ordering)
-> (AutocompleteType -> AutocompleteType -> Bool)
-> (AutocompleteType -> AutocompleteType -> Bool)
-> (AutocompleteType -> AutocompleteType -> Bool)
-> (AutocompleteType -> AutocompleteType -> Bool)
-> (AutocompleteType -> AutocompleteType -> AutocompleteType)
-> (AutocompleteType -> AutocompleteType -> AutocompleteType)
-> Ord AutocompleteType
AutocompleteType -> AutocompleteType -> Bool
AutocompleteType -> AutocompleteType -> Ordering
AutocompleteType -> AutocompleteType -> AutocompleteType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AutocompleteType -> AutocompleteType -> Ordering
compare :: AutocompleteType -> AutocompleteType -> Ordering
$c< :: AutocompleteType -> AutocompleteType -> Bool
< :: AutocompleteType -> AutocompleteType -> Bool
$c<= :: AutocompleteType -> AutocompleteType -> Bool
<= :: AutocompleteType -> AutocompleteType -> Bool
$c> :: AutocompleteType -> AutocompleteType -> Bool
> :: AutocompleteType -> AutocompleteType -> Bool
$c>= :: AutocompleteType -> AutocompleteType -> Bool
>= :: AutocompleteType -> AutocompleteType -> Bool
$cmax :: AutocompleteType -> AutocompleteType -> AutocompleteType
max :: AutocompleteType -> AutocompleteType -> AutocompleteType
$cmin :: AutocompleteType -> AutocompleteType -> AutocompleteType
min :: AutocompleteType -> AutocompleteType -> AutocompleteType
Ord)

renderAutocompleteType :: AutocompleteType -> Text
renderAutocompleteType :: AutocompleteType -> Text
renderAutocompleteType = \case
  AutocompleteType
AutocompleteOff -> Text
"off"
  AutocompleteType
AutocompleteOn -> Text
"on"
  AutocompleteType
AutocompleteName -> Text
"name"
  AutocompleteType
AutocompleteHonorificPrefix -> Text
"honorific-prefix"
  AutocompleteType
AutocompleteGivenName -> Text
"given-name"
  AutocompleteType
AutocompleteAdditionalName -> Text
"additional-name"
  AutocompleteType
AutocompleteFamilyName -> Text
"family-name"
  AutocompleteType
AutocompleteHonorificSuffix -> Text
"honorific-suffix"
  AutocompleteType
AutocompleteNickname -> Text
"nickname"
  AutocompleteType
AutocompleteEmail -> Text
"email"
  AutocompleteType
AutocompleteUsername -> Text
"username"
  AutocompleteType
AutocompleteNewPassword -> Text
"new-password"
  AutocompleteType
AutocompleteCurrentPassword -> Text
"current-password"
  AutocompleteType
AutocompleteOneTimeCode -> Text
"one-time-code"
  AutocompleteType
AutocompleteOrganizationTitle -> Text
"organization-title"
  AutocompleteType
AutocompleteOrganization -> Text
"organization"
  AutocompleteType
AutocompleteStreetAddress -> Text
"street-address"
  AutocompleteType
AutocompleteAddressLine1 -> Text
"address-line1"
  AutocompleteType
AutocompleteAddressLine2 -> Text
"address-line2"
  AutocompleteType
AutocompleteAddressLine3 -> Text
"address-line3"
  AutocompleteType
AutocompleteAddressLevel1 -> Text
"address-level1"
  AutocompleteType
AutocompleteAddressLevel2 -> Text
"address-level2"
  AutocompleteType
AutocompleteAddressLevel3 -> Text
"address-level3"
  AutocompleteType
AutocompleteAddressLevel4 -> Text
"address-level4"
  AutocompleteType
AutocompleteCountry -> Text
"country"
  AutocompleteType
AutocompleteCountryName -> Text
"country-name"
  AutocompleteType
AutocompletePostalCode -> Text
"postal-code"
  AutocompleteType
AutocompleteCreditCardName -> Text
"cc-name"
  AutocompleteType
AutocompleteCreditCardGivenName -> Text
"cc-given-name"
  AutocompleteType
AutocompleteCreditCardAdditionalName -> Text
"cc-additional-name"
  AutocompleteType
AutocompleteCreditCardFamilyName -> Text
"cc-family-name"
  AutocompleteType
AutocompleteCreditCardNumber -> Text
"cc-number"
  AutocompleteType
AutocompleteCreditCardExpiration -> Text
"cc-exp"
  AutocompleteType
AutocompleteCreditCardExpirationMonth -> Text
"cc-exp-month"
  AutocompleteType
AutocompleteCreditCardExpirationYear -> Text
"cc-exp-year"
  AutocompleteType
AutocompleteCreditCardSecurityCode -> Text
"cc-csc"
  AutocompleteType
AutocompleteCreditCardType -> Text
"cc-type"
  AutocompleteType
AutocompleteTransactionCurrency -> Text
"transaction-currency"
  AutocompleteType
AutocompleteTransactionAmount -> Text
"transaction-amount"
  AutocompleteType
AutocompleteLanguage -> Text
"language"
  AutocompleteType
AutocompleteBirthday -> Text
"bday"
  AutocompleteType
AutocompleteBirthdayDay -> Text
"bday-day"
  AutocompleteType
AutocompleteBirthdayMonth -> Text
"bday-month"
  AutocompleteType
AutocompleteBirthdayYear -> Text
"bday-year"
  AutocompleteType
AutocompleteSex -> Text
"sex"
  AutocompleteType
AutocompleteTelephone -> Text
"tel"
  AutocompleteType
AutocompleteTelephoneCountryCode -> Text
"tel-country-code"
  AutocompleteType
AutocompleteTelephoneNational -> Text
"tel-national"
  AutocompleteType
AutocompleteTelephoneAreaCode -> Text
"telarea-code"
  AutocompleteType
AutocompleteTelephoneLocal -> Text
"tel-local"
  AutocompleteType
AutocompleteTelephoneLocalPrefix -> Text
"tel-local-prefix"
  AutocompleteType
AutocompleteTelephoneLocalSuffix -> Text
"tel-local-suffix"
  AutocompleteType
AutocompleteTelephoneExtension -> Text
"tel-extension"
  AutocompleteType
AutocompleteIMPP -> Text
"impp"
  AutocompleteType
AutocompleteURL -> Text
"url"
  AutocompleteType
AutocompletePhoto -> Text
"photo"

--------------------------------------

data CrossOriginValue
  = Anonymous
  | UseCredentials
  deriving stock (CrossOriginValue -> CrossOriginValue -> Bool
(CrossOriginValue -> CrossOriginValue -> Bool)
-> (CrossOriginValue -> CrossOriginValue -> Bool)
-> Eq CrossOriginValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CrossOriginValue -> CrossOriginValue -> Bool
== :: CrossOriginValue -> CrossOriginValue -> Bool
$c/= :: CrossOriginValue -> CrossOriginValue -> Bool
/= :: CrossOriginValue -> CrossOriginValue -> Bool
Eq, Eq CrossOriginValue
Eq CrossOriginValue =>
(CrossOriginValue -> CrossOriginValue -> Ordering)
-> (CrossOriginValue -> CrossOriginValue -> Bool)
-> (CrossOriginValue -> CrossOriginValue -> Bool)
-> (CrossOriginValue -> CrossOriginValue -> Bool)
-> (CrossOriginValue -> CrossOriginValue -> Bool)
-> (CrossOriginValue -> CrossOriginValue -> CrossOriginValue)
-> (CrossOriginValue -> CrossOriginValue -> CrossOriginValue)
-> Ord CrossOriginValue
CrossOriginValue -> CrossOriginValue -> Bool
CrossOriginValue -> CrossOriginValue -> Ordering
CrossOriginValue -> CrossOriginValue -> CrossOriginValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CrossOriginValue -> CrossOriginValue -> Ordering
compare :: CrossOriginValue -> CrossOriginValue -> Ordering
$c< :: CrossOriginValue -> CrossOriginValue -> Bool
< :: CrossOriginValue -> CrossOriginValue -> Bool
$c<= :: CrossOriginValue -> CrossOriginValue -> Bool
<= :: CrossOriginValue -> CrossOriginValue -> Bool
$c> :: CrossOriginValue -> CrossOriginValue -> Bool
> :: CrossOriginValue -> CrossOriginValue -> Bool
$c>= :: CrossOriginValue -> CrossOriginValue -> Bool
>= :: CrossOriginValue -> CrossOriginValue -> Bool
$cmax :: CrossOriginValue -> CrossOriginValue -> CrossOriginValue
max :: CrossOriginValue -> CrossOriginValue -> CrossOriginValue
$cmin :: CrossOriginValue -> CrossOriginValue -> CrossOriginValue
min :: CrossOriginValue -> CrossOriginValue -> CrossOriginValue
Ord)

renderCrossOriginValue :: CrossOriginValue -> Text
renderCrossOriginValue :: CrossOriginValue -> Text
renderCrossOriginValue = \case
  CrossOriginValue
Anonymous -> Text
"anonymous"
  CrossOriginValue
UseCredentials -> Text
"use-credentials"

--------------------------------------

newtype InputAcceptType = InputAcceptType [InputAcceptTypeAtom]
  deriving newtype (InputAcceptType -> InputAcceptType -> Bool
(InputAcceptType -> InputAcceptType -> Bool)
-> (InputAcceptType -> InputAcceptType -> Bool)
-> Eq InputAcceptType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputAcceptType -> InputAcceptType -> Bool
== :: InputAcceptType -> InputAcceptType -> Bool
$c/= :: InputAcceptType -> InputAcceptType -> Bool
/= :: InputAcceptType -> InputAcceptType -> Bool
Eq, Eq InputAcceptType
Eq InputAcceptType =>
(InputAcceptType -> InputAcceptType -> Ordering)
-> (InputAcceptType -> InputAcceptType -> Bool)
-> (InputAcceptType -> InputAcceptType -> Bool)
-> (InputAcceptType -> InputAcceptType -> Bool)
-> (InputAcceptType -> InputAcceptType -> Bool)
-> (InputAcceptType -> InputAcceptType -> InputAcceptType)
-> (InputAcceptType -> InputAcceptType -> InputAcceptType)
-> Ord InputAcceptType
InputAcceptType -> InputAcceptType -> Bool
InputAcceptType -> InputAcceptType -> Ordering
InputAcceptType -> InputAcceptType -> InputAcceptType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputAcceptType -> InputAcceptType -> Ordering
compare :: InputAcceptType -> InputAcceptType -> Ordering
$c< :: InputAcceptType -> InputAcceptType -> Bool
< :: InputAcceptType -> InputAcceptType -> Bool
$c<= :: InputAcceptType -> InputAcceptType -> Bool
<= :: InputAcceptType -> InputAcceptType -> Bool
$c> :: InputAcceptType -> InputAcceptType -> Bool
> :: InputAcceptType -> InputAcceptType -> Bool
$c>= :: InputAcceptType -> InputAcceptType -> Bool
>= :: InputAcceptType -> InputAcceptType -> Bool
$cmax :: InputAcceptType -> InputAcceptType -> InputAcceptType
max :: InputAcceptType -> InputAcceptType -> InputAcceptType
$cmin :: InputAcceptType -> InputAcceptType -> InputAcceptType
min :: InputAcceptType -> InputAcceptType -> InputAcceptType
Ord, NonEmpty InputAcceptType -> InputAcceptType
InputAcceptType -> InputAcceptType -> InputAcceptType
(InputAcceptType -> InputAcceptType -> InputAcceptType)
-> (NonEmpty InputAcceptType -> InputAcceptType)
-> (forall b.
    Integral b =>
    b -> InputAcceptType -> InputAcceptType)
-> Semigroup InputAcceptType
forall b. Integral b => b -> InputAcceptType -> InputAcceptType
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: InputAcceptType -> InputAcceptType -> InputAcceptType
<> :: InputAcceptType -> InputAcceptType -> InputAcceptType
$csconcat :: NonEmpty InputAcceptType -> InputAcceptType
sconcat :: NonEmpty InputAcceptType -> InputAcceptType
$cstimes :: forall b. Integral b => b -> InputAcceptType -> InputAcceptType
stimes :: forall b. Integral b => b -> InputAcceptType -> InputAcceptType
Semigroup, Semigroup InputAcceptType
InputAcceptType
Semigroup InputAcceptType =>
InputAcceptType
-> (InputAcceptType -> InputAcceptType -> InputAcceptType)
-> ([InputAcceptType] -> InputAcceptType)
-> Monoid InputAcceptType
[InputAcceptType] -> InputAcceptType
InputAcceptType -> InputAcceptType -> InputAcceptType
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: InputAcceptType
mempty :: InputAcceptType
$cmappend :: InputAcceptType -> InputAcceptType -> InputAcceptType
mappend :: InputAcceptType -> InputAcceptType -> InputAcceptType
$cmconcat :: [InputAcceptType] -> InputAcceptType
mconcat :: [InputAcceptType] -> InputAcceptType
Monoid)

mediaType :: MediaType -> InputAcceptType
mediaType :: MediaType -> InputAcceptType
mediaType MediaType
mt = [InputAcceptTypeAtom] -> InputAcceptType
InputAcceptType [MediaType -> InputAcceptTypeAtom
AcceptMediaType MediaType
mt]

extension :: Text -> InputAcceptType
extension :: Text -> InputAcceptType
extension Text
ext = [InputAcceptTypeAtom] -> InputAcceptType
InputAcceptType [Text -> InputAcceptTypeAtom
AcceptFileExtension Text
ext]

data InputAcceptTypeAtom
  = AcceptMediaType MediaType
  | AcceptFileExtension Text
  deriving stock (InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
(InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool)
-> (InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool)
-> Eq InputAcceptTypeAtom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
== :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
$c/= :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
/= :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
Eq, Eq InputAcceptTypeAtom
Eq InputAcceptTypeAtom =>
(InputAcceptTypeAtom -> InputAcceptTypeAtom -> Ordering)
-> (InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool)
-> (InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool)
-> (InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool)
-> (InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool)
-> (InputAcceptTypeAtom
    -> InputAcceptTypeAtom -> InputAcceptTypeAtom)
-> (InputAcceptTypeAtom
    -> InputAcceptTypeAtom -> InputAcceptTypeAtom)
-> Ord InputAcceptTypeAtom
InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
InputAcceptTypeAtom -> InputAcceptTypeAtom -> Ordering
InputAcceptTypeAtom -> InputAcceptTypeAtom -> InputAcceptTypeAtom
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Ordering
compare :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Ordering
$c< :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
< :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
$c<= :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
<= :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
$c> :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
> :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
$c>= :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
>= :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> Bool
$cmax :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> InputAcceptTypeAtom
max :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> InputAcceptTypeAtom
$cmin :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> InputAcceptTypeAtom
min :: InputAcceptTypeAtom -> InputAcceptTypeAtom -> InputAcceptTypeAtom
Ord)

renderInputAcceptType :: InputAcceptType -> Text
renderInputAcceptType :: InputAcceptType -> Text
renderInputAcceptType (InputAcceptType [InputAcceptTypeAtom]
atoms) =
  Text -> [Text] -> Text
T.intercalate Text
"," ((InputAcceptTypeAtom -> Text) -> [InputAcceptTypeAtom] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map InputAcceptTypeAtom -> Text
renderInputAcceptTypeAtom [InputAcceptTypeAtom]
atoms)

renderInputAcceptTypeAtom :: InputAcceptTypeAtom -> Text
renderInputAcceptTypeAtom :: InputAcceptTypeAtom -> Text
renderInputAcceptTypeAtom = \case
  AcceptMediaType (MediaType Text
mt) -> Text
mt
  AcceptFileExtension Text
ext -> Text
ext

--------------------------------------

data MenuType
  = MenuList
  | MenuContext
  | MenuToolbar
  deriving stock (MenuType -> MenuType -> Bool
(MenuType -> MenuType -> Bool)
-> (MenuType -> MenuType -> Bool) -> Eq MenuType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MenuType -> MenuType -> Bool
== :: MenuType -> MenuType -> Bool
$c/= :: MenuType -> MenuType -> Bool
/= :: MenuType -> MenuType -> Bool
Eq, Eq MenuType
Eq MenuType =>
(MenuType -> MenuType -> Ordering)
-> (MenuType -> MenuType -> Bool)
-> (MenuType -> MenuType -> Bool)
-> (MenuType -> MenuType -> Bool)
-> (MenuType -> MenuType -> Bool)
-> (MenuType -> MenuType -> MenuType)
-> (MenuType -> MenuType -> MenuType)
-> Ord MenuType
MenuType -> MenuType -> Bool
MenuType -> MenuType -> Ordering
MenuType -> MenuType -> MenuType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MenuType -> MenuType -> Ordering
compare :: MenuType -> MenuType -> Ordering
$c< :: MenuType -> MenuType -> Bool
< :: MenuType -> MenuType -> Bool
$c<= :: MenuType -> MenuType -> Bool
<= :: MenuType -> MenuType -> Bool
$c> :: MenuType -> MenuType -> Bool
> :: MenuType -> MenuType -> Bool
$c>= :: MenuType -> MenuType -> Bool
>= :: MenuType -> MenuType -> Bool
$cmax :: MenuType -> MenuType -> MenuType
max :: MenuType -> MenuType -> MenuType
$cmin :: MenuType -> MenuType -> MenuType
min :: MenuType -> MenuType -> MenuType
Ord)

renderMenuType :: MenuType -> Text
renderMenuType :: MenuType -> Text
renderMenuType = \case
  MenuType
MenuList -> Text
"list"
  MenuType
MenuContext -> Text
"context"
  MenuType
MenuToolbar -> Text
"toolbar"

--------------------------------------

data MenuitemType
  = MenuitemCommand
  | MenuitemCheckbox
  | MenuitemRadio
  deriving stock (MenuitemType -> MenuitemType -> Bool
(MenuitemType -> MenuitemType -> Bool)
-> (MenuitemType -> MenuitemType -> Bool) -> Eq MenuitemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MenuitemType -> MenuitemType -> Bool
== :: MenuitemType -> MenuitemType -> Bool
$c/= :: MenuitemType -> MenuitemType -> Bool
/= :: MenuitemType -> MenuitemType -> Bool
Eq, Eq MenuitemType
Eq MenuitemType =>
(MenuitemType -> MenuitemType -> Ordering)
-> (MenuitemType -> MenuitemType -> Bool)
-> (MenuitemType -> MenuitemType -> Bool)
-> (MenuitemType -> MenuitemType -> Bool)
-> (MenuitemType -> MenuitemType -> Bool)
-> (MenuitemType -> MenuitemType -> MenuitemType)
-> (MenuitemType -> MenuitemType -> MenuitemType)
-> Ord MenuitemType
MenuitemType -> MenuitemType -> Bool
MenuitemType -> MenuitemType -> Ordering
MenuitemType -> MenuitemType -> MenuitemType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MenuitemType -> MenuitemType -> Ordering
compare :: MenuitemType -> MenuitemType -> Ordering
$c< :: MenuitemType -> MenuitemType -> Bool
< :: MenuitemType -> MenuitemType -> Bool
$c<= :: MenuitemType -> MenuitemType -> Bool
<= :: MenuitemType -> MenuitemType -> Bool
$c> :: MenuitemType -> MenuitemType -> Bool
> :: MenuitemType -> MenuitemType -> Bool
$c>= :: MenuitemType -> MenuitemType -> Bool
>= :: MenuitemType -> MenuitemType -> Bool
$cmax :: MenuitemType -> MenuitemType -> MenuitemType
max :: MenuitemType -> MenuitemType -> MenuitemType
$cmin :: MenuitemType -> MenuitemType -> MenuitemType
min :: MenuitemType -> MenuitemType -> MenuitemType
Ord)

renderMenuitemType :: MenuitemType -> Text
renderMenuitemType :: MenuitemType -> Text
renderMenuitemType = \case
  MenuitemType
MenuitemCommand -> Text
"command"
  MenuitemType
MenuitemCheckbox -> Text
"checkbox"
  MenuitemType
MenuitemRadio -> Text
"radio"

--------------------------------------

data FormMethod
  = POST
  | GET
  deriving stock (FormMethod -> FormMethod -> Bool
(FormMethod -> FormMethod -> Bool)
-> (FormMethod -> FormMethod -> Bool) -> Eq FormMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormMethod -> FormMethod -> Bool
== :: FormMethod -> FormMethod -> Bool
$c/= :: FormMethod -> FormMethod -> Bool
/= :: FormMethod -> FormMethod -> Bool
Eq, Eq FormMethod
Eq FormMethod =>
(FormMethod -> FormMethod -> Ordering)
-> (FormMethod -> FormMethod -> Bool)
-> (FormMethod -> FormMethod -> Bool)
-> (FormMethod -> FormMethod -> Bool)
-> (FormMethod -> FormMethod -> Bool)
-> (FormMethod -> FormMethod -> FormMethod)
-> (FormMethod -> FormMethod -> FormMethod)
-> Ord FormMethod
FormMethod -> FormMethod -> Bool
FormMethod -> FormMethod -> Ordering
FormMethod -> FormMethod -> FormMethod
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FormMethod -> FormMethod -> Ordering
compare :: FormMethod -> FormMethod -> Ordering
$c< :: FormMethod -> FormMethod -> Bool
< :: FormMethod -> FormMethod -> Bool
$c<= :: FormMethod -> FormMethod -> Bool
<= :: FormMethod -> FormMethod -> Bool
$c> :: FormMethod -> FormMethod -> Bool
> :: FormMethod -> FormMethod -> Bool
$c>= :: FormMethod -> FormMethod -> Bool
>= :: FormMethod -> FormMethod -> Bool
$cmax :: FormMethod -> FormMethod -> FormMethod
max :: FormMethod -> FormMethod -> FormMethod
$cmin :: FormMethod -> FormMethod -> FormMethod
min :: FormMethod -> FormMethod -> FormMethod
Ord)

renderFormMethod :: FormMethod -> Text
renderFormMethod :: FormMethod -> Text
renderFormMethod = \case
  FormMethod
POST -> Text
"post"
  FormMethod
GET -> Text
"get"

--------------------------------------

data InputType
  = InputButton
  | InputCheckbox
  | InputColor
  | InputDate
  | InputDatetimeLocal
  | InputEmail
  | InputFile
  | InputHidden
  | InputImage
  | InputMonth
  | InputNumber
  | InputPassword
  | InputRadio
  | InputRange
  | InputReset
  | InputSearch
  | InputSubmit
  | InputTel
  | InputText
  | InputTime
  | InputUrl
  | InputWeek
  deriving stock (InputType -> InputType -> Bool
(InputType -> InputType -> Bool)
-> (InputType -> InputType -> Bool) -> Eq InputType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputType -> InputType -> Bool
== :: InputType -> InputType -> Bool
$c/= :: InputType -> InputType -> Bool
/= :: InputType -> InputType -> Bool
Eq, Eq InputType
Eq InputType =>
(InputType -> InputType -> Ordering)
-> (InputType -> InputType -> Bool)
-> (InputType -> InputType -> Bool)
-> (InputType -> InputType -> Bool)
-> (InputType -> InputType -> Bool)
-> (InputType -> InputType -> InputType)
-> (InputType -> InputType -> InputType)
-> Ord InputType
InputType -> InputType -> Bool
InputType -> InputType -> Ordering
InputType -> InputType -> InputType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputType -> InputType -> Ordering
compare :: InputType -> InputType -> Ordering
$c< :: InputType -> InputType -> Bool
< :: InputType -> InputType -> Bool
$c<= :: InputType -> InputType -> Bool
<= :: InputType -> InputType -> Bool
$c> :: InputType -> InputType -> Bool
> :: InputType -> InputType -> Bool
$c>= :: InputType -> InputType -> Bool
>= :: InputType -> InputType -> Bool
$cmax :: InputType -> InputType -> InputType
max :: InputType -> InputType -> InputType
$cmin :: InputType -> InputType -> InputType
min :: InputType -> InputType -> InputType
Ord)

renderInputType :: InputType -> Text
renderInputType :: InputType -> Text
renderInputType = \case
  InputType
InputButton -> Text
"button"
  InputType
InputCheckbox -> Text
"checkbox"
  InputType
InputColor -> Text
"color"
  InputType
InputDate -> Text
"date"
  InputType
InputDatetimeLocal -> Text
"datetime-local"
  InputType
InputEmail -> Text
"email"
  InputType
InputFile -> Text
"file"
  InputType
InputHidden -> Text
"hidden"
  InputType
InputImage -> Text
"image"
  InputType
InputMonth -> Text
"month"
  InputType
InputNumber -> Text
"number"
  InputType
InputPassword -> Text
"password"
  InputType
InputRadio -> Text
"radio"
  InputType
InputRange -> Text
"range"
  InputType
InputReset -> Text
"reset"
  InputType
InputSearch -> Text
"search"
  InputType
InputSubmit -> Text
"submit"
  InputType
InputTel -> Text
"tel"
  InputType
InputText -> Text
"text"
  InputType
InputTime -> Text
"time"
  InputType
InputUrl -> Text
"url"
  InputType
InputWeek -> Text
"week"

--------------------------------------

data StepValue
  = Any
  | Step Double
  deriving stock (StepValue -> StepValue -> Bool
(StepValue -> StepValue -> Bool)
-> (StepValue -> StepValue -> Bool) -> Eq StepValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StepValue -> StepValue -> Bool
== :: StepValue -> StepValue -> Bool
$c/= :: StepValue -> StepValue -> Bool
/= :: StepValue -> StepValue -> Bool
Eq, Eq StepValue
Eq StepValue =>
(StepValue -> StepValue -> Ordering)
-> (StepValue -> StepValue -> Bool)
-> (StepValue -> StepValue -> Bool)
-> (StepValue -> StepValue -> Bool)
-> (StepValue -> StepValue -> Bool)
-> (StepValue -> StepValue -> StepValue)
-> (StepValue -> StepValue -> StepValue)
-> Ord StepValue
StepValue -> StepValue -> Bool
StepValue -> StepValue -> Ordering
StepValue -> StepValue -> StepValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StepValue -> StepValue -> Ordering
compare :: StepValue -> StepValue -> Ordering
$c< :: StepValue -> StepValue -> Bool
< :: StepValue -> StepValue -> Bool
$c<= :: StepValue -> StepValue -> Bool
<= :: StepValue -> StepValue -> Bool
$c> :: StepValue -> StepValue -> Bool
> :: StepValue -> StepValue -> Bool
$c>= :: StepValue -> StepValue -> Bool
>= :: StepValue -> StepValue -> Bool
$cmax :: StepValue -> StepValue -> StepValue
max :: StepValue -> StepValue -> StepValue
$cmin :: StepValue -> StepValue -> StepValue
min :: StepValue -> StepValue -> StepValue
Ord)

renderStepValue :: StepValue -> Text
renderStepValue :: StepValue -> Text
renderStepValue = \case
  StepValue
Any -> Text
"any"
  Step Double
n -> Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Double
n

--------------------------------------

data CaseType
  = Uppercase
  | Lowercase
  deriving stock (CaseType -> CaseType -> Bool
(CaseType -> CaseType -> Bool)
-> (CaseType -> CaseType -> Bool) -> Eq CaseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CaseType -> CaseType -> Bool
== :: CaseType -> CaseType -> Bool
$c/= :: CaseType -> CaseType -> Bool
/= :: CaseType -> CaseType -> Bool
Eq, Eq CaseType
Eq CaseType =>
(CaseType -> CaseType -> Ordering)
-> (CaseType -> CaseType -> Bool)
-> (CaseType -> CaseType -> Bool)
-> (CaseType -> CaseType -> Bool)
-> (CaseType -> CaseType -> Bool)
-> (CaseType -> CaseType -> CaseType)
-> (CaseType -> CaseType -> CaseType)
-> Ord CaseType
CaseType -> CaseType -> Bool
CaseType -> CaseType -> Ordering
CaseType -> CaseType -> CaseType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CaseType -> CaseType -> Ordering
compare :: CaseType -> CaseType -> Ordering
$c< :: CaseType -> CaseType -> Bool
< :: CaseType -> CaseType -> Bool
$c<= :: CaseType -> CaseType -> Bool
<= :: CaseType -> CaseType -> Bool
$c> :: CaseType -> CaseType -> Bool
> :: CaseType -> CaseType -> Bool
$c>= :: CaseType -> CaseType -> Bool
>= :: CaseType -> CaseType -> Bool
$cmax :: CaseType -> CaseType -> CaseType
max :: CaseType -> CaseType -> CaseType
$cmin :: CaseType -> CaseType -> CaseType
min :: CaseType -> CaseType -> CaseType
Ord)

data NumeralType
  = NumeralDecimal
  | NumeralRoman CaseType
  deriving stock (NumeralType -> NumeralType -> Bool
(NumeralType -> NumeralType -> Bool)
-> (NumeralType -> NumeralType -> Bool) -> Eq NumeralType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumeralType -> NumeralType -> Bool
== :: NumeralType -> NumeralType -> Bool
$c/= :: NumeralType -> NumeralType -> Bool
/= :: NumeralType -> NumeralType -> Bool
Eq, Eq NumeralType
Eq NumeralType =>
(NumeralType -> NumeralType -> Ordering)
-> (NumeralType -> NumeralType -> Bool)
-> (NumeralType -> NumeralType -> Bool)
-> (NumeralType -> NumeralType -> Bool)
-> (NumeralType -> NumeralType -> Bool)
-> (NumeralType -> NumeralType -> NumeralType)
-> (NumeralType -> NumeralType -> NumeralType)
-> Ord NumeralType
NumeralType -> NumeralType -> Bool
NumeralType -> NumeralType -> Ordering
NumeralType -> NumeralType -> NumeralType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NumeralType -> NumeralType -> Ordering
compare :: NumeralType -> NumeralType -> Ordering
$c< :: NumeralType -> NumeralType -> Bool
< :: NumeralType -> NumeralType -> Bool
$c<= :: NumeralType -> NumeralType -> Bool
<= :: NumeralType -> NumeralType -> Bool
$c> :: NumeralType -> NumeralType -> Bool
> :: NumeralType -> NumeralType -> Bool
$c>= :: NumeralType -> NumeralType -> Bool
>= :: NumeralType -> NumeralType -> Bool
$cmax :: NumeralType -> NumeralType -> NumeralType
max :: NumeralType -> NumeralType -> NumeralType
$cmin :: NumeralType -> NumeralType -> NumeralType
min :: NumeralType -> NumeralType -> NumeralType
Ord)

data OrderedListType
  = OrderedListNumeric NumeralType
  | OrderedListAlphabetic CaseType
  deriving stock (OrderedListType -> OrderedListType -> Bool
(OrderedListType -> OrderedListType -> Bool)
-> (OrderedListType -> OrderedListType -> Bool)
-> Eq OrderedListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrderedListType -> OrderedListType -> Bool
== :: OrderedListType -> OrderedListType -> Bool
$c/= :: OrderedListType -> OrderedListType -> Bool
/= :: OrderedListType -> OrderedListType -> Bool
Eq, Eq OrderedListType
Eq OrderedListType =>
(OrderedListType -> OrderedListType -> Ordering)
-> (OrderedListType -> OrderedListType -> Bool)
-> (OrderedListType -> OrderedListType -> Bool)
-> (OrderedListType -> OrderedListType -> Bool)
-> (OrderedListType -> OrderedListType -> Bool)
-> (OrderedListType -> OrderedListType -> OrderedListType)
-> (OrderedListType -> OrderedListType -> OrderedListType)
-> Ord OrderedListType
OrderedListType -> OrderedListType -> Bool
OrderedListType -> OrderedListType -> Ordering
OrderedListType -> OrderedListType -> OrderedListType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OrderedListType -> OrderedListType -> Ordering
compare :: OrderedListType -> OrderedListType -> Ordering
$c< :: OrderedListType -> OrderedListType -> Bool
< :: OrderedListType -> OrderedListType -> Bool
$c<= :: OrderedListType -> OrderedListType -> Bool
<= :: OrderedListType -> OrderedListType -> Bool
$c> :: OrderedListType -> OrderedListType -> Bool
> :: OrderedListType -> OrderedListType -> Bool
$c>= :: OrderedListType -> OrderedListType -> Bool
>= :: OrderedListType -> OrderedListType -> Bool
$cmax :: OrderedListType -> OrderedListType -> OrderedListType
max :: OrderedListType -> OrderedListType -> OrderedListType
$cmin :: OrderedListType -> OrderedListType -> OrderedListType
min :: OrderedListType -> OrderedListType -> OrderedListType
Ord)

renderOrderedListType :: OrderedListType -> Text
renderOrderedListType :: OrderedListType -> Text
renderOrderedListType = \case
  OrderedListNumeric NumeralType
NumeralDecimal -> Text
"1"
  OrderedListNumeric (NumeralRoman CaseType
Lowercase) -> Text
"i"
  OrderedListNumeric (NumeralRoman CaseType
Uppercase) -> Text
"I"
  OrderedListAlphabetic CaseType
Lowercase -> Text
"a"
  OrderedListAlphabetic CaseType
Uppercase -> Text
"A"

--------------------------------------

data WrapValue
  = Hard
  | Soft
  deriving stock (WrapValue -> WrapValue -> Bool
(WrapValue -> WrapValue -> Bool)
-> (WrapValue -> WrapValue -> Bool) -> Eq WrapValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WrapValue -> WrapValue -> Bool
== :: WrapValue -> WrapValue -> Bool
$c/= :: WrapValue -> WrapValue -> Bool
/= :: WrapValue -> WrapValue -> Bool
Eq, Eq WrapValue
Eq WrapValue =>
(WrapValue -> WrapValue -> Ordering)
-> (WrapValue -> WrapValue -> Bool)
-> (WrapValue -> WrapValue -> Bool)
-> (WrapValue -> WrapValue -> Bool)
-> (WrapValue -> WrapValue -> Bool)
-> (WrapValue -> WrapValue -> WrapValue)
-> (WrapValue -> WrapValue -> WrapValue)
-> Ord WrapValue
WrapValue -> WrapValue -> Bool
WrapValue -> WrapValue -> Ordering
WrapValue -> WrapValue -> WrapValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WrapValue -> WrapValue -> Ordering
compare :: WrapValue -> WrapValue -> Ordering
$c< :: WrapValue -> WrapValue -> Bool
< :: WrapValue -> WrapValue -> Bool
$c<= :: WrapValue -> WrapValue -> Bool
<= :: WrapValue -> WrapValue -> Bool
$c> :: WrapValue -> WrapValue -> Bool
> :: WrapValue -> WrapValue -> Bool
$c>= :: WrapValue -> WrapValue -> Bool
>= :: WrapValue -> WrapValue -> Bool
$cmax :: WrapValue -> WrapValue -> WrapValue
max :: WrapValue -> WrapValue -> WrapValue
$cmin :: WrapValue -> WrapValue -> WrapValue
min :: WrapValue -> WrapValue -> WrapValue
Ord)

renderWrapValue :: WrapValue -> Text
renderWrapValue :: WrapValue -> Text
renderWrapValue = \case
  WrapValue
Hard -> Text
"hard"
  WrapValue
Soft -> Text
"soft"

--------------------------------------

data ScopeValue
  = ScopeRow
  | ScopeCol
  | ScopeRowGroup
  | ScopeColGroup
  | ScopeAuto
  deriving stock (ScopeValue -> ScopeValue -> Bool
(ScopeValue -> ScopeValue -> Bool)
-> (ScopeValue -> ScopeValue -> Bool) -> Eq ScopeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScopeValue -> ScopeValue -> Bool
== :: ScopeValue -> ScopeValue -> Bool
$c/= :: ScopeValue -> ScopeValue -> Bool
/= :: ScopeValue -> ScopeValue -> Bool
Eq, Eq ScopeValue
Eq ScopeValue =>
(ScopeValue -> ScopeValue -> Ordering)
-> (ScopeValue -> ScopeValue -> Bool)
-> (ScopeValue -> ScopeValue -> Bool)
-> (ScopeValue -> ScopeValue -> Bool)
-> (ScopeValue -> ScopeValue -> Bool)
-> (ScopeValue -> ScopeValue -> ScopeValue)
-> (ScopeValue -> ScopeValue -> ScopeValue)
-> Ord ScopeValue
ScopeValue -> ScopeValue -> Bool
ScopeValue -> ScopeValue -> Ordering
ScopeValue -> ScopeValue -> ScopeValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScopeValue -> ScopeValue -> Ordering
compare :: ScopeValue -> ScopeValue -> Ordering
$c< :: ScopeValue -> ScopeValue -> Bool
< :: ScopeValue -> ScopeValue -> Bool
$c<= :: ScopeValue -> ScopeValue -> Bool
<= :: ScopeValue -> ScopeValue -> Bool
$c> :: ScopeValue -> ScopeValue -> Bool
> :: ScopeValue -> ScopeValue -> Bool
$c>= :: ScopeValue -> ScopeValue -> Bool
>= :: ScopeValue -> ScopeValue -> Bool
$cmax :: ScopeValue -> ScopeValue -> ScopeValue
max :: ScopeValue -> ScopeValue -> ScopeValue
$cmin :: ScopeValue -> ScopeValue -> ScopeValue
min :: ScopeValue -> ScopeValue -> ScopeValue
Ord)

renderScopeValue :: ScopeValue -> Text
renderScopeValue :: ScopeValue -> Text
renderScopeValue = \case
  ScopeValue
ScopeRow -> Text
"row"
  ScopeValue
ScopeCol -> Text
"col"
  ScopeValue
ScopeRowGroup -> Text
"rowgroup"
  ScopeValue
ScopeColGroup -> Text
"colgroup"
  ScopeValue
ScopeAuto -> Text
"auto"

--------------------------------------

data KindValue
  = KindSubtitles
  | KindCaptions
  | KindDescriptions
  | KindChapters
  | KindMetadata
  deriving stock (KindValue -> KindValue -> Bool
(KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> Bool) -> Eq KindValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KindValue -> KindValue -> Bool
== :: KindValue -> KindValue -> Bool
$c/= :: KindValue -> KindValue -> Bool
/= :: KindValue -> KindValue -> Bool
Eq, Eq KindValue
Eq KindValue =>
(KindValue -> KindValue -> Ordering)
-> (KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> KindValue)
-> (KindValue -> KindValue -> KindValue)
-> Ord KindValue
KindValue -> KindValue -> Bool
KindValue -> KindValue -> Ordering
KindValue -> KindValue -> KindValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KindValue -> KindValue -> Ordering
compare :: KindValue -> KindValue -> Ordering
$c< :: KindValue -> KindValue -> Bool
< :: KindValue -> KindValue -> Bool
$c<= :: KindValue -> KindValue -> Bool
<= :: KindValue -> KindValue -> Bool
$c> :: KindValue -> KindValue -> Bool
> :: KindValue -> KindValue -> Bool
$c>= :: KindValue -> KindValue -> Bool
>= :: KindValue -> KindValue -> Bool
$cmax :: KindValue -> KindValue -> KindValue
max :: KindValue -> KindValue -> KindValue
$cmin :: KindValue -> KindValue -> KindValue
min :: KindValue -> KindValue -> KindValue
Ord)

renderKindValue :: KindValue -> Text
renderKindValue :: KindValue -> Text
renderKindValue = \case
  KindValue
KindSubtitles -> Text
"subtitles"
  KindValue
KindCaptions -> Text
"captions"
  KindValue
KindDescriptions -> Text
"descriptions"
  KindValue
KindChapters -> Text
"chapters"
  KindValue
KindMetadata -> Text
"metadata"

--------------------------------------

type CSSPixel = Int

type GlobalAttributes (r :: Row Type) =
  ( "id" .== Text
      .+ "title" .== Text
      .+ "class" .== Text
      .+ "style" .== Text
      .+ "spellcheck" .== Bool
      .+ "draggable" .== Bool
      .+ "lang" .== Text
      .+ "dir" .== DirValue
      .+ "hidden" .== Bool
      .+ "tabIndex" .== Int
      .+ "accessKey" .== Text
      .+ "contentEditable" .== Bool
      .+ r
  )

type GlobalEvents r =
  ( "onContextMenu" .== Event
      .+ "onInput" .== Event
      .+ "onBeforeInput" .== Event
      .+ r
  )

type MouseEvents r =
  ( "onDoubleClick" .== MouseEvent
      .+ "onClick" .== MouseEvent
      .+ "onAuxClick" .== MouseEvent
      .+ "onMouseDown" .== MouseEvent
      .+ "onMouseEnter" .== MouseEvent
      .+ "onMouseLeave" .== MouseEvent
      .+ "onMouseMove" .== MouseEvent
      .+ "onMouseOver" .== MouseEvent
      .+ "onMouseOut" .== MouseEvent
      .+ "onMouseUp" .== MouseEvent
      .+ r
  )

type DragEvents r =
  ( "onDrag" .== DragEvent
      .+ "onDragEnd" .== DragEvent
      .+ "onDragExit" .== DragEvent
      .+ "onDragEnter" .== DragEvent
      .+ "onDragLeave" .== DragEvent
      .+ "onDragOver" .== DragEvent
      .+ "onDragStart" .== DragEvent
      .+ "onDrop" .== DragEvent
      .+ r
  )

type TouchEvents r =
  ( "onTouchCancel" .== TouchEvent
      .+ "onTouchEnd" .== TouchEvent
      .+ "onTouchEnter" .== TouchEvent
      .+ "onTouchLeave" .== TouchEvent
      .+ "onTouchMove" .== TouchEvent
      .+ "onTouchStart" .== TouchEvent
      .+ r
  )

type PointerEvents r =
  ( "onPointerOver" .== PointerEvent
      .+ "onPointerEnter" .== PointerEvent
      .+ "onPointerDown" .== PointerEvent
      .+ "onPointerMove" .== PointerEvent
      .+ "onPointerUp" .== PointerEvent
      .+ "onPointerCancel" .== PointerEvent
      .+ "onPointerOut" .== PointerEvent
      .+ "onPointerLeave" .== PointerEvent
      .+ "onGotPointerCapture" .== PointerEvent
      .+ "onLostPointerCapture" .== PointerEvent
      .+ r
  )

type KeyEvents r =
  ( "onKeyDown" .== KeyboardEvent
      .+ "onKeyUp" .== KeyboardEvent
      .+ "onKeyPress" .== KeyboardEvent
      .+ r
  )

type TransitionEvents r =
  ( "onTransitionEnd" .== Event
      .+ r
  )

type FocusEvents r =
  ( "onBlur" .== FocusEvent
      .+ "onFocus" .== FocusEvent
      .+ "onFocusIn" .== FocusEvent
      .+ "onFocusOut" .== FocusEvent
      .+ r
  )

type ClipboardEvents r =
  ( "onCopy" .== ClipboardEvent
      .+ "onCut" .== ClipboardEvent
      .+ "onPaste" .== ClipboardEvent
      .+ r
  )

type InteractiveEvents r = ClipboardEvents (FocusEvents (TransitionEvents (KeyEvents (PointerEvents (TouchEvents (DragEvents (MouseEvents ("onWheel" .== WheelEvent .+ r))))))))

type GlobalProperties r = GlobalAttributes (GlobalEvents r)

type Interactive r = InteractiveEvents (GlobalProperties r)

type Noninteractive r = GlobalProperties r

type HTMLa =
  Interactive
    ( "download" .== Text
        .+ "href" .== Text
        .+ "hrefLang" .== Text
        .+ "rel" .== Text
        .+ "target" .== Text
        .+ "type" .== MediaType
    )

type HTMLabbr = Interactive Empty

type HTMLaddress = Interactive ("onScroll" .== Event)

type HTMLarea =
  Interactive
    ( "coords" .== Text
        .+ "download" .== Text
        .+ "href" .== Text
        .+ "hrefLang" .== Text
        .+ "media" .== Text
        .+ "rel" .== Text
        .+ "shape" .== Text
        .+ "target" .== Text
        .+ "type" .== MediaType
    )

type HTMLarticle = Interactive Empty

type HTMLaside = Interactive Empty

type HTMLaudio =
  Interactive
    ( "autoplay" .== Bool
        .+ "controls" .== Bool
        .+ "loop" .== Bool
        .+ "muted" .== Bool
        .+ "preload" .== PreloadValue
        .+ "src" .== Text
        .+ "onError" .== Event
    )

type HTMLb = Interactive Empty

type HTMLbase =
  Noninteractive
    ( "href" .== Text
        .+ "target" .== Text
    )

type HTMLbdi = Interactive Empty

type HTMLbdo = Noninteractive Empty

type HTMLblockquote =
  Interactive
    ( "cite" .== Text
        .+ "onScroll" .== Event
    )

type HTMLbody =
  Interactive
    ( "onBeforeUnload" .== Event
        .+ "onHashChange" .== Event
        .+ "onLoad" .== Event
        .+ "onPageShow" .== Event
        .+ "onPageHide" .== Event
        .+ "onResize" .== Event
        .+ "onScroll" .== Event
        .+ "onUnload" .== Event
    )

type HTMLbr = Noninteractive Empty

type HTMLbutton =
  Interactive
    ( "autofocus" .== Bool
        .+ "disabled" .== Bool
        .+ "form" .== Text
        .+ "formAction" .== Text
        .+ "formEncType" .== MediaType
        .+ "formMethod" .== FormMethod
        .+ "formNoValidate" .== Bool
        .+ "formTarget" .== Text
        .+ "name" .== Text
        .+ "type" .== ButtonType
        .+ "value" .== Text
    )

type HTMLcanvas =
  Interactive
    ( "width" .== CSSPixel
        .+ "height" .== CSSPixel
    )

type HTMLcaption = Interactive ("onScroll" .== Event)

type HTMLcite = Interactive Empty

type HTMLcode = Interactive Empty

type HTMLcol = Interactive Empty

type HTMLcolgroup = Interactive ("span" .== Int)

type HTMLcommand = Interactive Empty

type HTMLdatalist = Interactive Empty

type HTMLdd = Interactive ("onScroll" .== Event)

type HTMLdel =
  Interactive
    ( "cite" .== Text
        .+ "UTCTime" .== Text
    )

type HTMLdetails = Interactive ("open" .== Bool)

type HTMLdfn = Interactive Empty

type HTMLdialog = Interactive ("open" .== Bool)

type HTMLdiv = Interactive ("onScroll" .== Event)

type HTMLdl = Interactive ("onScroll" .== Event)

type HTMLdt = Interactive ("onScroll" .== Event)

type HTMLem = Interactive Empty

type HTMLembed =
  Interactive
    ( "height" .== CSSPixel
        .+ "src" .== Text
        .+ "type" .== MediaType
        .+ "width" .== CSSPixel
    )

type HTMLfieldset =
  Interactive
    ( "disabled" .== Bool
        .+ "form" .== Text
        .+ "name" .== Text
        .+ "onScroll" .== Event
    )

type HTMLfigcaption = Interactive Empty

type HTMLfigure = Interactive Empty

type HTMLfooter = Interactive Empty

type HTMLform =
  Interactive
    ( "acceptCharset" .== Text
        .+ "action" .== Text
        .+ "autocomplete" .== AutocompleteType
        .+ "enctype" .== MediaType
        .+ "method" .== FormMethod
        .+ "name" .== Text
        .+ "noValidate" .== Bool
        .+ "onReset" .== Event
        .+ "onScroll" .== Event
        .+ "onSubmit" .== Event
        .+ "target" .== Text
    )

type HTMLh1 = Interactive ("onScroll" .== Event)

type HTMLh2 = Interactive ("onScroll" .== Event)

type HTMLh3 = Interactive ("onScroll" .== Event)

type HTMLh4 = Interactive ("onScroll" .== Event)

type HTMLh5 = Interactive ("onScroll" .== Event)

type HTMLh6 = Interactive ("onScroll" .== Event)

type HTMLhead = Noninteractive Empty

type HTMLheader = Interactive Empty

type HTMLhr = Interactive Empty

type HTMLhtml =
  Interactive
    ( "manifest" .== Text
        .+ "onScroll" .== Event
        .+ "xmlns" .== Text
    )

type HTMLi = Interactive Empty

type HTMLiframe =
  Noninteractive
    ( "height" .== CSSPixel
        .+ "name" .== Text
        .+ "onLoad" .== Event
        .+ "sandbox" .== Text
        .+ "src" .== Text
        .+ "srcDoc" .== Text
        .+ "width" .== CSSPixel
    )

type HTMLimg =
  Interactive
    ( "alt" .== Text
        .+ "crossOrigin" .== CrossOriginValue
        .+ "height" .== CSSPixel
        .+ "isMap" .== Bool
        .+ "longDesc" .== Text
        .+ "onAbort" .== Event
        .+ "onError" .== Event
        .+ "onLoad" .== Event
        .+ "src" .== Text
        .+ "useMap" .== Text
        .+ "width" .== CSSPixel
    )

type HTMLinput =
  Interactive
    ( "accept" .== InputAcceptType
        .+ "autocomplete" .== AutocompleteType
        .+ "autofocus" .== Bool
        .+ "checked" .== Bool
        .+ "disabled" .== Bool
        .+ "form" .== Text
        .+ "formAction" .== Text
        .+ "formEncType" .== MediaType
        .+ "formMethod" .== FormMethod
        .+ "formNoValidate" .== Bool
        .+ "formTarget" .== Text
        .+ "height" .== CSSPixel
        .+ "list" .== Text
        .+ "max" .== Double
        .+ "min" .== Double
        .+ "maxLength" .== Int
        .+ "minLength" .== Int
        .+ "multiple" .== Bool
        .+ "name" .== Text
        .+ "onAbort" .== Event
        .+ "onChange" .== Event
        .+ "onError" .== Event
        .+ "onInvalid" .== Event
        .+ "onLoad" .== Event
        .+ "onSearch" .== Event
        .+ "onSelect" .== Event
        .+ "pattern" .== Text
        .+ "placeholder" .== Text
        .+ "readOnly" .== Bool
        .+ "required" .== Bool
        .+ "size" .== Int
        .+ "src" .== Text
        .+ "step" .== StepValue
        .+ "type" .== InputType
        .+ "value" .== Text
        .+ "width" .== CSSPixel
    )

type HTMLins =
  Interactive
    ( "cite" .== Text
        .+ "UTCTime" .== UTCTime
    )

type HTMLkbd = Interactive Empty

type HTMLlabel =
  Interactive
    ( "for" .== Text
        .+ "form" .== Text
    )

type HTMLlegend = Interactive Empty

type HTMLli =
  Interactive
    ( "value" .== Int
        .+ "onScroll" .== Event
    )

type HTMLlink =
  Noninteractive
    ( "crossOrigin" .== CrossOriginValue
        .+ "href" .== Text
        .+ "hreflang" .== Text
        .+ "media" .== Text
        .+ "onLoad" .== Event
        .+ "rel" .== Text
        .+ "sizes" .== Text
        .+ "type" .== MediaType
    )

type HTMLmain = Interactive Empty

type HTMLmap = Interactive ("name" .== Text)

type HTMLmark = Interactive Empty

type HTMLmenu =
  Interactive
    ( "label" .== Text
        .+ "onScroll" .== Event
        .+ "type" .== MenuType
    )

type HTMLmenuitem =
  Interactive
    ( "checked" .== Bool
        .+ "command" .== Text
        .+ "default" .== Bool
        .+ "disabled" .== Bool
        .+ "icon" .== Text
        .+ "label" .== Text
        .+ "radioGroup" .== Text
        .+ "type" .== MenuitemType
    )

type HTMLmeta =
  Noninteractive
    ( "charset" .== Text
        .+ "content" .== Text
        .+ "httpEquiv" .== Text
        .+ "name" .== Text
    )

type HTMLmeter =
  Interactive
    ( "form" .== Text
        .+ "high" .== Double
        .+ "low" .== Double
        .+ "max" .== Double
        .+ "min" .== Double
        .+ "optimum" .== Double
        .+ "value" .== Double
    )

type HTMLnav = Interactive Empty

type HTMLnoscript = Interactive Empty

type HTMLobject =
  Interactive
    ( "data" .== Text
        .+ "form" .== Text
        .+ "height" .== CSSPixel
        .+ "name" .== Text
        .+ "onError" .== Event
        .+ "onScroll" .== Event
        .+ "type" .== MediaType
        .+ "useMap" .== Text
        .+ "width" .== CSSPixel
    )

type HTMLol =
  Interactive
    ( "onScroll" .== Event
        .+ "reversed" .== Bool
        .+ "start" .== Int
        .+ "type" .== OrderedListType
    )

type HTMLoptgroup =
  Interactive
    ( "disabled" .== Bool
        .+ "label" .== Text
    )

type HTMLoption =
  Interactive
    ( "disabled" .== Bool
        .+ "label" .== Text
        .+ "selected" .== Bool
        .+ "value" .== Text
    )

type HTMLoutput =
  Interactive
    ( "for" .== Text
        .+ "form" .== Text
        .+ "name" .== Text
    )

type HTMLp = Interactive ("onScroll" .== Event)

type HTMLparam =
  Noninteractive
    ( "name" .== Text
        .+ "value" .== Text
    )

type HTMLpre = Interactive ("onScroll" .== Event)

type HTMLprogress =
  Interactive
    ( "max" .== Double
        .+ "value" .== Double
    )

type HTMLq = Interactive ("cite" .== Text)

type HTMLrp = Interactive Empty

type HTMLrt = Interactive Empty

type HTMLruby = Interactive Empty

type HTMLsamp = Interactive Empty

type HTMLscript =
  Noninteractive
    ( "async" .== Bool
        .+ "charset" .== Text
        .+ "defer" .== Bool
        .+ "onError" .== Event
        .+ "onLoad" .== Event
        .+ "src" .== Text
        .+ "type" .== MediaType
    )

type HTMLsection = Interactive Empty

type HTMLselect =
  Interactive
    ( "autofocus" .== Bool
        .+ "disabled" .== Bool
        .+ "form" .== Text
        .+ "multiple" .== Bool
        .+ "name" .== Text
        .+ "onChange" .== Event
        .+ "onScroll" .== Event
        .+ "required" .== Bool
        .+ "selectedIndex" .== Int
        .+ "size" .== Int
        .+ "value" .== Text
    )

type HTMLsmall = Interactive Empty

type HTMLsource =
  Interactive
    ( "media" .== Text
        .+ "src" .== Text
        .+ "type" .== MediaType
    )

type HTMLspan = Interactive Empty

type HTMLstrong = Interactive Empty

type HTMLstyle =
  Noninteractive
    ( "media" .== Text
        .+ "onError" .== Event
        .+ "onLoad" .== Event
        .+ "scoped" .== Bool
        .+ "type" .== MediaType
    )

type HTMLsub = Interactive Empty

type HTMLsummary = Interactive Empty

type HTMLsup = Interactive Empty

type HTMLtable = Interactive ("sortable" .== Bool)

type HTMLtbody = Interactive ("onScroll" .== Event)

type HTMLtd =
  Interactive
    ( "colSpan" .== Int
        .+ "headers" .== Text
        .+ "rowSpan" .== Int
    )

type HTMLtextarea =
  Interactive
    ( "autofocus" .== Bool
        .+ "cols" .== Int
        .+ "disabled" .== Bool
        .+ "form" .== Text
        .+ "maxLength" .== Int
        .+ "name" .== Text
        .+ "onChange" .== Event
        .+ "onScroll" .== Event
        .+ "onSelect" .== Event
        .+ "placeholder" .== Text
        .+ "readOnly" .== Bool
        .+ "required" .== Bool
        .+ "rows" .== Int
        .+ "value" .== Text
        .+ "wrap" .== WrapValue
    )

type HTMLtfoot = Interactive ("onScroll" .== Event)

type HTMLth =
  Interactive
    ( "abbr" .== Text
        .+ "colSpan" .== Int
        .+ "headers" .== Text
        .+ "rowSpan" .== Int
        .+ "scope" .== ScopeValue
        .+ "sorted" .== Bool
    )

type HTMLthead = Interactive Empty

type HTMLtime = Interactive ("UTCTime" .== UTCTime)

type HTMLtitle = Noninteractive Empty

type HTMLtr = Interactive Empty

type HTMLtrack =
  Interactive
    ( "default" .== Bool
        .+ "kind" .== KindValue
        .+ "label" .== Text
        .+ "src" .== Text
        .+ "srcLang" .== Text
    )

type HTMLu = Interactive Empty

type HTMLul = Interactive ("onScroll" .== Event)

type HTMLvar = Interactive Empty

type HTMLvideo =
  Interactive
    ( "autoplay" .== Bool
        .+ "controls" .== Bool
        .+ "height" .== CSSPixel
        .+ "loop" .== Bool
        .+ "muted" .== Bool
        .+ "poster" .== Text
        .+ "preload" .== PreloadValue
        .+ "src" .== Text
        .+ "width" .== CSSPixel
        .+ "type" .== MediaType
        .+ "onError" .== Event
    )

type HTMLwbr = Interactive Empty