{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Miso.Html.Property -- Copyright : (C) 2016-2017 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- -- Construct custom properties on DOM elements -- -- > div_ [ prop "id" "foo" ] [ ] -- ---------------------------------------------------------------------------- module Miso.Html.Property ( -- * Construction textProp , stringProp , boolProp , intProp , integerProp , doubleProp -- * Common attributes , class_ , classList_ , id_ , title_ , hidden_ -- * Inputs , type_ , value_ , defaultValue_ , checked_ , placeholder_ , selected_ -- * Input Helpers , accept_ , acceptCharset_ , action_ , autocomplete_ , autofocus_ , autosave_ , disabled_ , enctype_ , formation_ , list_ , maxlength_ , minlength_ , method_ , multiple_ , name_ , novalidate_ , pattern_ , readonly_ , required_ , size_ , for_ , form_ -- * Input Ranges , max_ , min_ , step_ -- * Input Text areas , cols_ , rows_ , wrap_ -- * Links and areas , href_ , target_ , download_ , downloadAs_ , hreflang_ , media_ , ping_ , rel_ -- * Maps , ismap_ , usemap_ , shape_ , coords_ -- * Embedded Content , src_ , height_ , width_ , alt_ -- * Audio and Video , autoplay_ , controls_ , loop_ , preload_ , poster_ , default_ , kind_ , srclang_ -- * iframes , sandbox_ , seamless_ , srcdoc_ -- * Ordered lists , reversed_ , start_ -- * Tables , align_ , colspan_ , rowspan_ , headers_ , scope_ -- * Headers , async_ , charset_ , content_ , defer_ , httpEquiv_ , language_ , scoped_ ) where import Miso.Html.Internal import Miso.String (MisoString, intercalate) -- | Set field to `Bool` value boolProp :: MisoString -> Bool -> Attribute action boolProp = prop -- | Set field to `String` value stringProp :: MisoString -> String -> Attribute action stringProp = prop -- | Set field to `Text` value textProp :: MisoString -> MisoString -> Attribute action textProp = prop -- | Set field to `Int` value intProp :: MisoString -> Int -> Attribute action intProp = prop -- | Set field to `Integer` value integerProp :: MisoString -> Int -> Attribute action integerProp = prop -- | Set field to `Double` value doubleProp :: MisoString -> Double -> Attribute action doubleProp = prop -- | Define multiple classes conditionally -- -- > div_ [ classList_ [ ("empty", null items) ] [ ] -- classList_ :: [(MisoString, Bool)] -> Attribute action classList_ xs = textProp "class" $ intercalate (" " :: MisoString) [ t | (t, True) <- xs ] -- | title_ :: MisoString -> Attribute action title_ = textProp "title" -- | selected_ :: Bool -> Attribute action selected_ = boolProp "selected" -- |