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
=
|
|
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
= \case
MenuType
MenuList -> Text
"list"
MenuType
MenuContext -> Text
"context"
MenuType
MenuToolbar -> Text
"toolbar"
data
= MenuitemCommand
|
|
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
= \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 = 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 = 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 =
Interactive
( "label" .== Text
.+ "onScroll" .== Event
.+ "type" .== MenuType
)
type =
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 = 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