{-# OPTIONS_GHC -Wno-missing-signatures #-}
module Graphics.UI.Threepenny.Attributes (
    -- * Synopsis
    -- | Element attributes.

    -- * Input elements
    checked, selection, enabled,

    -- * HTML attributes
    action, align, alink, alt, altcode, archive,
    background, base, bgcolor, border, bordercolor,
    cellpadding, cellspacing, checked_, class_, clear_, code_, codebase,
    color, cols, colspan, compact, content, coords,
    enctype, face, for, frameborder, height, href, hspace, httpequiv,
    id_, ismap, lang, marginheight, marginwidth, maxlength, method, multiple,
    name, nohref, noresize, noshade, nowrap,
    rel, rev, rows, rowspan, rules,
    scrolling, selected, shape, size, src,
    target, text_, title__, type_, usemap, valign, version, vlink, vspace, width,
    ) where

import qualified Data.Aeson                  as JSON
import           Graphics.UI.Threepenny.Core

{-----------------------------------------------------------------------------
    Attributes
------------------------------------------------------------------------------}
-- | The @checked@ status of an input element of type checkbox.
checked :: Attr Element Bool
checked :: Attr Element Bool
checked = String -> (Value -> Bool) -> (Bool -> Value) -> Attr Element Bool
forall a. String -> (Value -> a) -> (a -> Value) -> Attr Element a
fromJQueryProp String
"checked" (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
JSON.Bool Bool
True) Bool -> Value
JSON.Bool

-- | The @enabled@ status of an input element
enabled :: Attr Element Bool
enabled :: Attr Element Bool
enabled = String -> (Value -> Bool) -> (Bool -> Value) -> Attr Element Bool
forall a. String -> (Value -> a) -> (a -> Value) -> Attr Element a
fromJQueryProp String
"disabled" (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
JSON.Bool Bool
False) (Bool -> Value
JSON.Bool (Bool -> Value) -> (Bool -> Bool) -> Bool -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not)

-- | Index of the currently selected option of a @<select>@ element.
--
-- The index starts at @0@.
-- If no option is selected, then the selection is 'Nothing'.
selection :: Attr Element (Maybe Int)
selection :: Attr Element (Maybe Int)
selection = String
-> (Value -> Maybe Int)
-> (Maybe Int -> Value)
-> Attr Element (Maybe Int)
forall a. String -> (Value -> a) -> (a -> Value) -> Attr Element a
fromJQueryProp String
"selectedIndex" Value -> Maybe Int
forall {a}. (Eq a, Num a, FromJSON a) => Value -> Maybe a
from (Int -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (Int -> Value) -> (Maybe Int -> Int) -> Maybe Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) Int -> Int
forall a. a -> a
id)
    where
    from :: Value -> Maybe a
from Value
s = let JSON.Success a
x = Value -> Result a
forall a. FromJSON a => Value -> Result a
JSON.fromJSON Value
s in
        if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1 then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
x


{-----------------------------------------------------------------------------
    HTML atributes

    Taken from the HTML library (BSD3 license)
    http://hackage.haskell.org/package/html
------------------------------------------------------------------------------}
strAttr :: String -> WriteAttr Element String
strAttr :: String -> WriteAttr Element String
strAttr String
attrname = (String -> Element -> UI ()) -> WriteAttr Element String
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr (WriteAttr Element String -> String -> Element -> UI ()
forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' (String -> WriteAttr Element String
attr String
attrname))

intAttr :: String -> WriteAttr Element Int
intAttr :: String -> WriteAttr Element Int
intAttr String
attrname = (Int -> Element -> UI ()) -> WriteAttr Element Int
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr (WriteAttr Element String -> String -> Element -> UI ()
forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' (String -> WriteAttr Element String
attr String
attrname) (String -> Element -> UI ())
-> (Int -> String) -> Int -> Element -> UI ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show)

emptyAttr :: String -> WriteAttr Element Bool
emptyAttr :: String -> WriteAttr Element Bool
emptyAttr String
attrname = (Bool -> Element -> UI ()) -> WriteAttr Element Bool
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr (WriteAttr Element String -> String -> Element -> UI ()
forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' (String -> WriteAttr Element String
attr String
attrname) (String -> Element -> UI ())
-> (Bool -> String) -> Bool -> Element -> UI ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
f)
    where
    f :: Bool -> String
f Bool
True  = String
"1"
    f Bool
False = String
"0"

action :: WriteAttr Element String
action              =   String -> WriteAttr Element String
strAttr String
"action"
align :: WriteAttr Element String
align               =   String -> WriteAttr Element String
strAttr String
"align"
alink :: WriteAttr Element String
alink               =   String -> WriteAttr Element String
strAttr String
"alink"
alt :: WriteAttr Element String
alt                 =   String -> WriteAttr Element String
strAttr String
"alt"
altcode :: WriteAttr Element String
altcode             =   String -> WriteAttr Element String
strAttr String
"altcode"
archive :: WriteAttr Element String
archive             =   String -> WriteAttr Element String
strAttr String
"archive"
background :: WriteAttr Element String
background          =   String -> WriteAttr Element String
strAttr String
"background"
base :: WriteAttr Element String
base                =   String -> WriteAttr Element String
strAttr String
"base"
bgcolor :: WriteAttr Element String
bgcolor             =   String -> WriteAttr Element String
strAttr String
"bgcolor"
border :: WriteAttr Element Int
border              =   String -> WriteAttr Element Int
intAttr String
"border"
bordercolor :: WriteAttr Element String
bordercolor         =   String -> WriteAttr Element String
strAttr String
"bordercolor"
cellpadding :: WriteAttr Element Int
cellpadding         =   String -> WriteAttr Element Int
intAttr String
"cellpadding"
cellspacing :: WriteAttr Element Int
cellspacing         =   String -> WriteAttr Element Int
intAttr String
"cellspacing"
checked_ :: WriteAttr Element Bool
checked_            = String -> WriteAttr Element Bool
emptyAttr String
"checked"
clear_ :: WriteAttr Element String
clear_              =   String -> WriteAttr Element String
strAttr String
"clear"
code_ :: WriteAttr Element String
code_               =   String -> WriteAttr Element String
strAttr String
"code"
codebase :: WriteAttr Element String
codebase            =   String -> WriteAttr Element String
strAttr String
"codebase"
color :: WriteAttr Element String
color               =   String -> WriteAttr Element String
strAttr String
"color"
cols :: WriteAttr Element String
cols                =   String -> WriteAttr Element String
strAttr String
"cols"
colspan :: WriteAttr Element Int
colspan             =   String -> WriteAttr Element Int
intAttr String
"colspan"
compact :: WriteAttr Element Bool
compact             = String -> WriteAttr Element Bool
emptyAttr String
"compact"
content :: WriteAttr Element String
content             =   String -> WriteAttr Element String
strAttr String
"content"
coords :: WriteAttr Element String
coords              =   String -> WriteAttr Element String
strAttr String
"coords"
enctype :: WriteAttr Element String
enctype             =   String -> WriteAttr Element String
strAttr String
"enctype"
face :: WriteAttr Element String
face                =   String -> WriteAttr Element String
strAttr String
"face"
for :: WriteAttr Element String
for                 =   String -> WriteAttr Element String
strAttr String
"for"
frameborder :: WriteAttr Element Int
frameborder         =   String -> WriteAttr Element Int
intAttr String
"frameborder"
height :: WriteAttr Element Int
height              =   String -> WriteAttr Element Int
intAttr String
"height"
href :: WriteAttr Element String
href                =   String -> WriteAttr Element String
strAttr String
"href"
hspace :: WriteAttr Element Int
hspace              =   String -> WriteAttr Element Int
intAttr String
"hspace"
httpequiv :: WriteAttr Element String
httpequiv           =   String -> WriteAttr Element String
strAttr String
"http-equiv"
id_ :: WriteAttr Element String
id_                 =   String -> WriteAttr Element String
strAttr String
"id"
ismap :: WriteAttr Element Bool
ismap               = String -> WriteAttr Element Bool
emptyAttr String
"ismap"
lang :: WriteAttr Element String
lang                =   String -> WriteAttr Element String
strAttr String
"lang"
marginheight :: WriteAttr Element Int
marginheight        =   String -> WriteAttr Element Int
intAttr String
"marginheight"
marginwidth :: WriteAttr Element Int
marginwidth         =   String -> WriteAttr Element Int
intAttr String
"marginwidth"
maxlength :: WriteAttr Element Int
maxlength           =   String -> WriteAttr Element Int
intAttr String
"maxlength"
method :: WriteAttr Element String
method              =   String -> WriteAttr Element String
strAttr String
"method"
multiple :: WriteAttr Element Bool
multiple            = String -> WriteAttr Element Bool
emptyAttr String
"multiple"
name :: WriteAttr Element String
name                =   String -> WriteAttr Element String
strAttr String
"name"
nohref :: WriteAttr Element Bool
nohref              = String -> WriteAttr Element Bool
emptyAttr String
"nohref"
noresize :: WriteAttr Element Bool
noresize            = String -> WriteAttr Element Bool
emptyAttr String
"noresize"
noshade :: WriteAttr Element Bool
noshade             = String -> WriteAttr Element Bool
emptyAttr String
"noshade"
nowrap :: WriteAttr Element Bool
nowrap              = String -> WriteAttr Element Bool
emptyAttr String
"nowrap"
rel :: WriteAttr Element String
rel                 =   String -> WriteAttr Element String
strAttr String
"rel"
rev :: WriteAttr Element String
rev                 =   String -> WriteAttr Element String
strAttr String
"rev"
rows :: WriteAttr Element String
rows                =   String -> WriteAttr Element String
strAttr String
"rows"
rowspan :: WriteAttr Element Int
rowspan             =   String -> WriteAttr Element Int
intAttr String
"rowspan"
rules :: WriteAttr Element String
rules               =   String -> WriteAttr Element String
strAttr String
"rules"
scrolling :: WriteAttr Element String
scrolling           =   String -> WriteAttr Element String
strAttr String
"scrolling"
selected :: WriteAttr Element Bool
selected            = String -> WriteAttr Element Bool
emptyAttr String
"selected"
shape :: WriteAttr Element String
shape               =   String -> WriteAttr Element String
strAttr String
"shape"
size :: WriteAttr Element String
size                =   String -> WriteAttr Element String
strAttr String
"size"
src :: WriteAttr Element String
src                 =   String -> WriteAttr Element String
strAttr String
"src"
target :: WriteAttr Element String
target              =   String -> WriteAttr Element String
strAttr String
"target"
text_ :: WriteAttr Element String
text_               =   String -> WriteAttr Element String
strAttr String
"text"
class_ :: WriteAttr Element String
class_              =   String -> WriteAttr Element String
strAttr String
"class"
type_ :: WriteAttr Element String
type_               =   String -> WriteAttr Element String
strAttr String
"type"
title__ :: WriteAttr Element String
title__             =   String -> WriteAttr Element String
strAttr String
"title" -- ugly, but necessary to avoid conflicts with the window title and the title element
usemap :: WriteAttr Element String
usemap              =   String -> WriteAttr Element String
strAttr String
"usemap"
valign :: WriteAttr Element String
valign              =   String -> WriteAttr Element String
strAttr String
"valign"
version :: WriteAttr Element String
version             =   String -> WriteAttr Element String
strAttr String
"version"
vlink :: WriteAttr Element String
vlink               =   String -> WriteAttr Element String
strAttr String
"vlink"
vspace :: WriteAttr Element Int
vspace              =   String -> WriteAttr Element Int
intAttr String
"vspace"
width :: WriteAttr Element Int
width               =   String -> WriteAttr Element Int
intAttr String
"width"