module Halogen.HTML.Properties where

import Clay qualified as C
import Clay.Render qualified as C
import DOM.HTML.Indexed qualified as I
import Data.Coerce
import Data.MediaType
import Data.Row
import Data.Text qualified as T
import HPrelude
import Halogen.HTML.Core (IsProp (..), Namespace)
import Halogen.HTML.Core qualified as Core
import Halogen.Query.Input
import Halogen.VDom.DOM.Prop
import Web.DOM.Element
import Web.HTML.Common

newtype IProp (r :: Row Type) msg = IProp (Prop (Input msg))

prop :: forall value r msg. (IsProp value) => PropName value -> value -> IProp r msg
prop :: forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName value
_name value
val = Prop (Input msg) -> IProp r msg
forall (r :: Row (*)) msg. Prop (Input msg) -> IProp r msg
IProp (Prop (Input msg) -> IProp r msg)
-> Prop (Input msg) -> IProp r msg
forall a b. (a -> b) -> a -> b
$ PropName value -> PropValue value -> Prop (Input msg)
forall msg val. PropName val -> PropValue val -> Prop msg
Property PropName value
_name (value -> PropValue value
forall a. IsProp a => a -> PropValue a
toPropValue value
val)

attr :: AttrName -> Text -> IProp r msg
attr :: forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr AttrName
_name Text
val = Prop (Input msg) -> IProp r msg
forall (r :: Row (*)) msg. Prop (Input msg) -> IProp r msg
IProp (Prop (Input msg) -> IProp r msg)
-> Prop (Input msg) -> IProp r msg
forall a b. (a -> b) -> a -> b
$ Maybe Namespace -> AttrName -> Text -> Prop (Input msg)
forall msg. Maybe Namespace -> AttrName -> Text -> Prop msg
Attribute Maybe Namespace
forall a. Maybe a
Nothing AttrName
_name Text
val

attrNS :: Namespace -> AttrName -> Text -> IProp r i
attrNS :: forall (r :: Row (*)) i. Namespace -> AttrName -> Text -> IProp r i
attrNS Namespace
ns AttrName
_name Text
val = Prop (Input i) -> IProp r i
forall (r :: Row (*)) msg. Prop (Input msg) -> IProp r msg
IProp (Prop (Input i) -> IProp r i) -> Prop (Input i) -> IProp r i
forall a b. (a -> b) -> a -> b
$ Maybe Namespace -> AttrName -> Text -> Prop (Input i)
forall msg. Maybe Namespace -> AttrName -> Text -> Prop msg
Attribute (Namespace -> Maybe Namespace
forall a. a -> Maybe a
Just Namespace
ns) AttrName
_name Text
val

rows :: (HasType "rows" Int r) => Int -> IProp r msg
rows :: forall (r :: Row (*)) msg.
HasType "rows" Int r =>
Int -> IProp r msg
rows = PropName Int -> Int -> IProp r msg
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Int
"rows"

-- cast property from smaller row to greater row
castProp :: (Subset r1 r2) => IProp r1 msg -> IProp r2 msg
castProp :: forall (r1 :: Row (*)) (r2 :: Row (*)) msg.
Subset r1 r2 =>
IProp r1 msg -> IProp r2 msg
castProp = IProp r1 msg -> IProp r2 msg
forall a b. Coercible a b => a -> b
coerce

-- | The `ref` property allows an input to be raised once a `HTMLElement` has
-- | been created or destroyed in the DOM for the element that the property is
-- | attached to.
ref :: forall r i. RefLabel -> IProp r i
ref :: forall (r :: Row (*)) i. RefLabel -> IProp r i
ref = Prop (Input i) -> IProp r i
forall (r :: Row (*)) msg. Prop (Input msg) -> IProp r msg
IProp (Prop (Input i) -> IProp r i)
-> (RefLabel -> Prop (Input i)) -> RefLabel -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Element -> Maybe (Input i)) -> Prop (Input i)
forall i. (Maybe Element -> Maybe i) -> Prop i
Core.ref ((Maybe Element -> Maybe (Input i)) -> Prop (Input i))
-> (RefLabel -> Maybe Element -> Maybe (Input i))
-> RefLabel
-> Prop (Input i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefLabel -> Maybe Element -> Maybe (Input i)
go
  where
    go :: RefLabel -> Maybe Element -> Maybe (Input i)
    go :: RefLabel -> Maybe Element -> Maybe (Input i)
go RefLabel
p Maybe Element
mel = Input i -> Maybe (Input i)
forall a. a -> Maybe a
Just (RefLabel -> Maybe Element -> Input i
forall msg. RefLabel -> Maybe Element -> Input msg
RefUpdate RefLabel
p Maybe Element
mel)

alt :: (HasType "alt" Text r) => Text -> IProp r i
alt :: forall (r :: Row (*)) i. HasType "alt" Text r => Text -> IProp r i
alt = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"alt"

charset :: (HasType "charset" Text r) => Text -> IProp r i
charset :: forall (r :: Row (*)) i.
HasType "charset" Text r =>
Text -> IProp r i
charset = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"charset"

class_ :: (HasType "class" Text r) => ClassName -> IProp r i
class_ :: forall (r :: Row (*)) i.
HasType "class" Text r =>
ClassName -> IProp r i
class_ (ClassName Text
txt) = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"className" Text
txt

classes :: (HasType "class" Text r) => [ClassName] -> IProp r i
classes :: forall (r :: Row (*)) i.
HasType "class" Text r =>
[ClassName] -> IProp r i
classes = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"className" (Text -> IProp r i)
-> ([ClassName] -> Text) -> [ClassName] -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text) -> ([ClassName] -> [Text]) -> [ClassName] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ClassName] -> [Text]
forall a b. Coercible a b => a -> b
coerce

cols :: (HasType "cols" Int r) => Int -> IProp r i
cols :: forall (r :: Row (*)) i. HasType "cols" Int r => Int -> IProp r i
cols = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Int
"cols"

colSpan :: (HasType "colSpan" Int r) => Int -> IProp r i
colSpan :: forall (r :: Row (*)) i.
HasType "colSpan" Int r =>
Int -> IProp r i
colSpan = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Int
"colSpan"

rowSpan :: (HasType "rowSpan" Int r) => Int -> IProp r i
rowSpan :: forall (r :: Row (*)) i.
HasType "rowSpan" Int r =>
Int -> IProp r i
rowSpan = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Int
"rowSpan"

for :: (HasType "for" Text r) => Text -> IProp r i
for :: forall (r :: Row (*)) i. HasType "for" Text r => Text -> IProp r i
for = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"htmlFor"

height :: (HasType "height" I.CSSPixel r) => I.CSSPixel -> IProp r i
height :: forall (r :: Row (*)) i. HasType "height" Int r => Int -> IProp r i
height = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Int
"height"

width :: (HasType "width" I.CSSPixel r) => I.CSSPixel -> IProp r i
width :: forall (r :: Row (*)) i. HasType "width" Int r => Int -> IProp r i
width = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Int
"width"

href :: (HasType "href" Text r) => Text -> IProp r i
href :: forall (r :: Row (*)) i. HasType "href" Text r => Text -> IProp r i
href = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"href"

id :: (HasType "id" Text r) => Text -> IProp r i
id :: forall (r :: Row (*)) i. HasType "id" Text r => Text -> IProp r i
id = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"id"

name :: (HasType "name" Text r) => Text -> IProp r i
name :: forall (r :: Row (*)) i. HasType "name" Text r => Text -> IProp r i
name = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"name"

rel :: (HasType "rel" Text r) => Text -> IProp r i
rel :: forall (r :: Row (*)) i. HasType "rel" Text r => Text -> IProp r i
rel = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"rel"

src :: (HasType "src" Text r) => Text -> IProp r i
src :: forall (r :: Row (*)) i. HasType "src" Text r => Text -> IProp r i
src = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"src"

srcDoc :: (HasType "srcDoc" Text r) => Text -> IProp r i
srcDoc :: forall (r :: Row (*)) i.
HasType "srcDoc" Text r =>
Text -> IProp r i
srcDoc = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop PropName Text
"srcdoc"

style :: (HasType "style" Text r) => C.Css -> IProp r i
style :: forall (r :: Row (*)) i. HasType "style" Text r => Css -> IProp r i
style = Text -> IProp r i
forall (r :: Row (*)) i.
HasType "style" Text r =>
Text -> IProp r i
styleText (Text -> IProp r i) -> (Css -> Text) -> Css -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a b. ConvertText a b => a -> b
toS (Text -> Text) -> (Css -> Text) -> Css -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [App] -> Css -> Text
C.renderWith Config
C.htmlInline []

styleText :: (HasType "style" Text r) => Text -> IProp r i
styleText :: forall (r :: Row (*)) i.
HasType "style" Text r =>
Text -> IProp r i
styleText = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
AttrName Text
"style")

scope :: (HasType "scope" I.ScopeValue r) => I.ScopeValue -> IProp r i
scope :: forall (r :: Row (*)) i.
HasType "scope" ScopeValue r =>
ScopeValue -> IProp r i
scope = PropName ScopeValue -> ScopeValue -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName ScopeValue
forall {k} (value :: k). Text -> PropName value
PropName Text
"scope")

target :: (HasType "target" Text r) => Text -> IProp r i
target :: forall (r :: Row (*)) i.
HasType "target" Text r =>
Text -> IProp r i
target = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Text
forall {k} (value :: k). Text -> PropName value
PropName Text
"target")

title :: (HasType "title" Text r) => Text -> IProp r i
title :: forall (r :: Row (*)) i.
HasType "title" Text r =>
Text -> IProp r i
title = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Text
forall {k} (value :: k). Text -> PropName value
PropName Text
"title")

download :: (HasType "download" Text r) => Text -> IProp r i
download :: forall (r :: Row (*)) i.
HasType "download" Text r =>
Text -> IProp r i
download = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Text
forall {k} (value :: k). Text -> PropName value
PropName Text
"download")

method :: (HasType "method" I.FormMethod r) => I.FormMethod -> IProp r i
method :: forall (r :: Row (*)) i.
HasType "method" FormMethod r =>
FormMethod -> IProp r i
method = PropName FormMethod -> FormMethod -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName FormMethod
forall {k} (value :: k). Text -> PropName value
PropName Text
"method")

action :: (HasType "action" Text r) => Text -> IProp r i
action :: forall (r :: Row (*)) i.
HasType "action" Text r =>
Text -> IProp r i
action = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Text
forall {k} (value :: k). Text -> PropName value
PropName Text
"action")

enctype :: (HasType "enctype" MediaType r) => MediaType -> IProp r i
enctype :: forall (r :: Row (*)) i.
HasType "enctype" MediaType r =>
MediaType -> IProp r i
enctype = PropName MediaType -> MediaType -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName MediaType
forall {k} (value :: k). Text -> PropName value
PropName Text
"enctype")

noValidate :: (HasType "noValidate" Bool r) => Bool -> IProp r i
noValidate :: forall (r :: Row (*)) i.
HasType "noValidate" Bool r =>
Bool -> IProp r i
noValidate = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"noValidate")

type_ :: forall value r i. (HasType "type" value r, IsProp value) => value -> IProp r i
type_ :: forall value (r :: Row (*)) i.
(HasType "type" value r, IsProp value) =>
value -> IProp r i
type_ = PropName value -> value -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName value
forall {k} (value :: k). Text -> PropName value
PropName Text
"type")

value :: forall value r i. (HasType "value" value r, IsProp value) => value -> IProp r i
value :: forall value (r :: Row (*)) i.
(HasType "value" value r, IsProp value) =>
value -> IProp r i
value = PropName value -> value -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName value
forall {k} (value :: k). Text -> PropName value
PropName Text
"value")

min :: (HasType "min" Double r) => Double -> IProp r i
min :: forall (r :: Row (*)) i.
HasType "min" Double r =>
Double -> IProp r i
min = PropName Double -> Double -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Double
forall {k} (value :: k). Text -> PropName value
PropName Text
"min")

minLength :: (HasType "minLength" Int r) => Int -> IProp r i
minLength :: forall (r :: Row (*)) i.
HasType "minLength" Int r =>
Int -> IProp r i
minLength = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Int
forall {k} (value :: k). Text -> PropName value
PropName Text
"minLength")

max :: (HasType "max" Double r) => Double -> IProp r i
max :: forall (r :: Row (*)) i.
HasType "max" Double r =>
Double -> IProp r i
max = PropName Double -> Double -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Double
forall {k} (value :: k). Text -> PropName value
PropName Text
"max")

maxLength :: (HasType "maxLength" Int r) => Int -> IProp r i
maxLength :: forall (r :: Row (*)) i.
HasType "maxLength" Int r =>
Int -> IProp r i
maxLength = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Int
forall {k} (value :: k). Text -> PropName value
PropName Text
"maxLength")

step :: (HasType "step" I.StepValue r) => I.StepValue -> IProp r i
step :: forall (r :: Row (*)) i.
HasType "step" StepValue r =>
StepValue -> IProp r i
step = PropName StepValue -> StepValue -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName StepValue
forall {k} (value :: k). Text -> PropName value
PropName Text
"step")

enabled :: (HasType "disabled" Bool r) => Bool -> IProp r i
enabled :: forall (r :: Row (*)) i.
HasType "disabled" Bool r =>
Bool -> IProp r i
enabled = Bool -> IProp r i
forall (r :: Row (*)) i.
HasType "disabled" Bool r =>
Bool -> IProp r i
disabled (Bool -> IProp r i) -> (Bool -> Bool) -> Bool -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not

disabled :: (HasType "disabled" Bool r) => Bool -> IProp r i
disabled :: forall (r :: Row (*)) i.
HasType "disabled" Bool r =>
Bool -> IProp r i
disabled = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"disabled")

required :: (HasType "required" Bool r) => Bool -> IProp r i
required :: forall (r :: Row (*)) i.
HasType "required" Bool r =>
Bool -> IProp r i
required = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"required")

readOnly :: (HasType "readOnly" Bool r) => Bool -> IProp r i
readOnly :: forall (r :: Row (*)) i.
HasType "readOnly" Bool r =>
Bool -> IProp r i
readOnly = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"readOnly")

spellcheck :: (HasType "spellcheck" Bool r) => Bool -> IProp r i
spellcheck :: forall (r :: Row (*)) i.
HasType "spellcheck" Bool r =>
Bool -> IProp r i
spellcheck = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"spellcheck")

checked :: (HasType "checked" Bool r) => Bool -> IProp r i
checked :: forall (r :: Row (*)) i.
HasType "checked" Bool r =>
Bool -> IProp r i
checked = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"checked")

selected :: (HasType "selected" Bool r) => Bool -> IProp r i
selected :: forall (r :: Row (*)) i.
HasType "selected" Bool r =>
Bool -> IProp r i
selected = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"selected")

selectedIndex :: (HasType "selectedIndex" Int r) => Int -> IProp r i
selectedIndex :: forall (r :: Row (*)) i.
HasType "selectedIndex" Int r =>
Int -> IProp r i
selectedIndex = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Int
forall {k} (value :: k). Text -> PropName value
PropName Text
"selectedIndex")

placeholder :: (HasType "placeholder" Text r) => Text -> IProp r i
placeholder :: forall (r :: Row (*)) i.
HasType "placeholder" Text r =>
Text -> IProp r i
placeholder = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Text
forall {k} (value :: k). Text -> PropName value
PropName Text
"placeholder")

autocomplete :: (HasType "autocomplete" I.AutocompleteType r) => I.AutocompleteType -> IProp r i
autocomplete :: forall (r :: Row (*)) i.
HasType "autocomplete" AutocompleteType r =>
AutocompleteType -> IProp r i
autocomplete = PropName AutocompleteType -> AutocompleteType -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName AutocompleteType
forall {k} (value :: k). Text -> PropName value
PropName Text
"autocomplete")

list :: (HasType "list" Text r) => Text -> IProp r i
list :: forall (r :: Row (*)) i. HasType "list" Text r => Text -> IProp r i
list = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
AttrName Text
"list")

autofocus :: (HasType "autofocus" Bool r) => Bool -> IProp r i
autofocus :: forall (r :: Row (*)) i.
HasType "autofocus" Bool r =>
Bool -> IProp r i
autofocus = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"autofocus")

multiple :: (HasType "multiple" Bool r) => Bool -> IProp r i
multiple :: forall (r :: Row (*)) i.
HasType "multiple" Bool r =>
Bool -> IProp r i
multiple = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"multiple")

accept :: (HasType "accept" I.InputAcceptType r) => I.InputAcceptType -> IProp r i
accept :: forall (r :: Row (*)) i.
HasType "accept" InputAcceptType r =>
InputAcceptType -> IProp r i
accept = PropName InputAcceptType -> InputAcceptType -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName InputAcceptType
forall {k} (value :: k). Text -> PropName value
PropName Text
"accept")

pattern_ :: (HasType "pattern" Text r) => Text -> IProp r i
pattern_ :: forall (r :: Row (*)) i.
HasType "pattern" Text r =>
Text -> IProp r i
pattern_ = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Text
forall {k} (value :: k). Text -> PropName value
PropName Text
"pattern")

autoplay :: (HasType "autoplay" Bool r) => Bool -> IProp r i
autoplay :: forall (r :: Row (*)) i.
HasType "autoplay" Bool r =>
Bool -> IProp r i
autoplay = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"autoplay")

controls :: (HasType "controls" Bool r) => Bool -> IProp r i
controls :: forall (r :: Row (*)) i.
HasType "controls" Bool r =>
Bool -> IProp r i
controls = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"controls")

loop :: (HasType "loop" Bool r) => Bool -> IProp r i
loop :: forall (r :: Row (*)) i. HasType "loop" Bool r => Bool -> IProp r i
loop = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"loop")

muted :: (HasType "muted" Bool r) => Bool -> IProp r i
muted :: forall (r :: Row (*)) i.
HasType "muted" Bool r =>
Bool -> IProp r i
muted = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"muted")

poster :: (HasType "poster" Text r) => Text -> IProp r i
poster :: forall (r :: Row (*)) i.
HasType "poster" Text r =>
Text -> IProp r i
poster = PropName Text -> Text -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Text
forall {k} (value :: k). Text -> PropName value
PropName Text
"poster")

preload :: (HasType "preload" I.PreloadValue r) => I.PreloadValue -> IProp r i
preload :: forall (r :: Row (*)) i.
HasType "preload" PreloadValue r =>
PreloadValue -> IProp r i
preload = PropName PreloadValue -> PreloadValue -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName PreloadValue
forall {k} (value :: k). Text -> PropName value
PropName Text
"preload")

draggable :: (HasType "draggable" Bool r) => Bool -> IProp r i
draggable :: forall (r :: Row (*)) i.
HasType "draggable" Bool r =>
Bool -> IProp r i
draggable = PropName Bool -> Bool -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Bool
forall {k} (value :: k). Text -> PropName value
PropName Text
"draggable")

tabIndex :: (HasType "tabIndex" Int r) => Int -> IProp r i
tabIndex :: forall (r :: Row (*)) i.
HasType "tabIndex" Int r =>
Int -> IProp r i
tabIndex = PropName Int -> Int -> IProp r i
forall value (r :: Row (*)) msg.
IsProp value =>
PropName value -> value -> IProp r msg
prop (Text -> PropName Int
forall {k} (value :: k). Text -> PropName value
PropName Text
"tabIndex")