
   0 | module Text.Html.Attribute
   1 | 
   2 | import Data.List
   3 | import Data.Maybe
   4 | import Data.String
   5 | import Text.Html.Event
   6 | 
   7 | %default total
   8 | 
   9 | public export
  10 | data Dir = LTR | RTL
  11 | 
  12 | export
  13 | Show Dir where
  14 |   show LTR = "ltr"
  15 |   show RTL = "rtl"
  16 | 
  17 | public export
  18 | data LoadType = Lzy | Eager
  19 | 
  20 | export
  21 | Show LoadType where
  22 |   show Lzy   = "lazy"
  23 |   show Eager = "eager"
  24 | 
  25 | public export
  26 | data InputType =
  27 |     Button
  28 |   | CheckBox
  29 |   | Color
  30 |   | Date
  31 |   | DateTime
  32 |   | Email
  33 |   | File
  34 |   | Image
  35 |   | Month
  36 |   | Number
  37 |   | Password
  38 |   | Radio
  39 |   | Range
  40 |   | Tel
  41 |   | Text
  42 |   | Time
  43 |   | URL
  44 |   | Week
  45 | 
  46 | export
  47 | Show InputType where
  48 |   show Button   = "button"
  49 |   show CheckBox = "checkbox"
  50 |   show Color    = "color"
  51 |   show Date     = "date"
  52 |   show DateTime = "datetime-local"
  53 |   show Email    = "email"
  54 |   show File     = "file"
  55 |   show Image    = "image"
  56 |   show Month    = "month"
  57 |   show Number   = "number"
  58 |   show Password = "password"
  59 |   show Radio    = "radio"
  60 |   show Range    = "range"
  61 |   show Tel      = "tel"
  62 |   show Text     = "text"
  63 |   show Time     = "time"
  64 |   show URL      = "url"
  65 |   show Week     = "week"
  66 | 
  67 | public export
  68 | data Attribute : (event : Type) -> Type where
  69 |   Id    : (value : String) -> Attribute event
  70 |   Str   : (name : String) -> (value : String) -> Attribute event
  71 |   Bool  : (name : String) -> (value : Bool) -> Attribute event
  72 |   Event : DOMEvent event -> Attribute event
  73 |   Empty : Attribute event
  74 | 
  75 | public export
  76 | Attributes : Type -> Type
  77 | Attributes = List . Attribute
  78 | 
  79 | export
  80 | displayAttribute : Attribute ev -> Maybe String
  81 | displayAttribute (Id va)        = Just #"id="\#{va}""#
  82 | displayAttribute (Str nm va)    = Just #"\#{nm}="\#{va}""#
  83 | displayAttribute (Bool nm True) = Just nm
  84 | displayAttribute (Bool _ False) = Nothing
  85 | displayAttribute (Event _)      = Nothing
  86 | displayAttribute Empty          = Nothing
  87 | 
  88 | export
  89 | displayAttributes : Attributes ev -> String
  90 | displayAttributes = fastConcat . intersperse " " . mapMaybe displayAttribute
  91 | 
  92 | export
  93 | getId : Attributes ev -> Maybe String
  94 | getId (Id v       :: _) = Just v
  95 | getId (Str "id" v :: t) = Just v
  96 | getId (_          :: t) = getId t
  97 | getId []                = Nothing
  98 | 
  99 | export
 100 | getEvents : Attributes ev -> List (DOMEvent ev)
 101 | getEvents = go Nil
 102 | 
 103 |   where
 104 |     go : List (DOMEvent ev) -> Attributes ev -> List (DOMEvent ev)
 105 |     go es []              = es
 106 |     go es (Event e :: xs) = go (e :: es) xs
 107 |     go es (_ :: xs)       = go es xs
 108 | 
 109 | export
 110 | dispAttr : String -> (a -> String) -> a -> Attribute ev
 111 | dispAttr nm f =  Str nm . f
 112 | 
 113 | export
 114 | showAttr : Show a => String -> a -> Attribute ev
 115 | showAttr nm = dispAttr nm show
 116 | 
 117 | export %inline
 118 | accesskey : String -> Attribute ev
 119 | accesskey = Str "accesskey"
 120 | 
 121 | export %inline
 122 | action : String -> Attribute ev
 123 | action = Str "action"
 124 | 
 125 | export %inline
 126 | alt : String -> Attribute ev
 127 | alt = Str "alt"
 128 | 
 129 | export %inline
 130 | autocapitalize : Bool -> Attribute ev
 131 | autocapitalize = Bool "autocapitalize"
 132 | 
 133 | export %inline
 134 | autocomplete : Bool -> Attribute ev
 135 | autocomplete = Bool "autocomplete"
 136 | 
 137 | export %inline
 138 | autofocus : Bool -> Attribute ev
 139 | autofocus = Bool "autofocus"
 140 | 
 141 | export %inline
 142 | autoplay : Bool -> Attribute ev
 143 | autoplay = Bool "autoplay"
 144 | 
 145 | export %inline
 146 | checked : Bool -> Attribute ev
 147 | checked = Bool "checked"
 148 | 
 149 | export %inline
 150 | cite : String -> Attribute ev
 151 | cite = Str "cite"
 152 | 
 153 | export %inline
 154 | class : String -> Attribute ev
 155 | class = Str "class"
 156 | 
 157 | export %inline
 158 | classes : List String -> Attribute ev
 159 | classes = dispAttr "class" (fastConcat . intersperse " ")
 160 | 
 161 | export %inline
 162 | cols : Bits32 -> Attribute ev
 163 | cols = showAttr "cols"
 164 | 
 165 | export %inline
 166 | colspan : Bits32 -> Attribute ev
 167 | colspan = showAttr "colspan"
 168 | 
 169 | export %inline
 170 | contenteditable : Bool -> Attribute ev
 171 | contenteditable = Bool "contenteditable"
 172 | 
 173 | export %inline
 174 | controls : Bool -> Attribute ev
 175 | controls = Bool "controls"
 176 | 
 177 | export %inline
 178 | data_ : String -> Attribute ev
 179 | data_ = Str "data"
 180 | 
 181 | export %inline
 182 | dir : Dir -> Attribute ev
 183 | dir = showAttr "dir"
 184 | 
 185 | export %inline
 186 | disabled : Bool -> Attribute ev
 187 | disabled = Bool "disabled"
 188 | 
 189 | export %inline
 190 | download : String -> Attribute ev
 191 | download = Str "download"
 192 | 
 193 | export %inline
 194 | draggable : Bool -> Attribute ev
 195 | draggable = Bool "draggable"
 196 | 
 197 | export %inline
 198 | for : String -> Attribute ev
 199 | for = Str "for"
 200 | 
 201 | export %inline
 202 | form : String -> Attribute ev
 203 | form = Str "form"
 204 | 
 205 | export %inline
 206 | height : Bits32 -> Attribute ev
 207 | height = showAttr "height"
 208 | 
 209 | export %inline
 210 | hidden : Bool -> Attribute ev
 211 | hidden = Bool "hidden"
 212 | 
 213 | export %inline
 214 | href : String -> Attribute ev
 215 | href = Str "href"
 216 | 
 217 | export %inline
 218 | hreflang : String -> Attribute ev
 219 | hreflang = Str "hreflang"
 220 | 
 221 | export %inline
 222 | id : String -> Attribute ev
 223 | id = Id
 224 | 
 225 | export %inline
 226 | label : String -> Attribute ev
 227 | label = Str "label"
 228 | 
 229 | export %inline
 230 | lang : String -> Attribute ev
 231 | lang = Str "lang"
 232 | 
 233 | export %inline
 234 | loading : LoadType -> Attribute ev
 235 | loading = showAttr "loading"
 236 | 
 237 | export %inline
 238 | list : String -> Attribute ev
 239 | list = Str "list"
 240 | 
 241 | export %inline
 242 | loop : Bool -> Attribute ev
 243 | loop = Bool "loop"
 244 | 
 245 | export %inline
 246 | maxlength : Bits32 -> Attribute ev
 247 | maxlength = showAttr "maxlength"
 248 | 
 249 | export %inline
 250 | minlength : Bits32 -> Attribute ev
 251 | minlength = showAttr "minlength"
 252 | 
 253 | export %inline
 254 | multiple : Bool -> Attribute ev
 255 | multiple = Bool "multiple"
 256 | 
 257 | export %inline
 258 | muted : Bool -> Attribute ev
 259 | muted = Bool "muted"
 260 | 
 261 | export %inline
 262 | name : String -> Attribute ev
 263 | name = Str "name"
 264 | 
 265 | export %inline
 266 | placeholder : String -> Attribute ev
 267 | placeholder = Str "placeholder"
 268 | 
 269 | export %inline
 270 | readonly : Bool -> Attribute ev
 271 | readonly = Bool "readonly"
 272 | 
 273 | export %inline
 274 | required : Bool -> Attribute ev
 275 | required = Bool "required"
 276 | 
 277 | export %inline
 278 | reverse : Bool -> Attribute ev
 279 | reverse = Bool "reverse"
 280 | 
 281 | export %inline
 282 | rows : Bits32 -> Attribute ev
 283 | rows = showAttr "rows"
 284 | 
 285 | export %inline
 286 | rowspan : Bits32 -> Attribute ev
 287 | rowspan = showAttr "rowspan"
 288 | 
 289 | export %inline
 290 | selected : Bool -> Attribute ev
 291 | selected = Bool "selected"
 292 | 
 293 | export %inline
 294 | spellcheck : Bool -> Attribute ev
 295 | spellcheck = Bool "spellcheck"
 296 | 
 297 | export %inline
 298 | src : String -> Attribute ev
 299 | src = Str "src"
 300 | 
 301 | export %inline
 302 | style : String -> Attribute ev
 303 | style = Str "style"
 304 | 
 305 | export %inline
 306 | tabindex : Int32 -> Attribute ev
 307 | tabindex = showAttr "tabindex"
 308 | 
 309 | export %inline
 310 | target : String -> Attribute ev
 311 | target = Str "target"
 312 | 
 313 | export %inline
 314 | title : String -> Attribute ev
 315 | title = Str "title"
 316 | 
 317 | export %inline
 318 | type : InputType -> Attribute ev
 319 | type = showAttr "type"
 320 | 
 321 | export %inline
 322 | value : String -> Attribute ev
 323 | value = Str "value"
 324 | 
 325 | export %inline
 326 | width : Bits32 -> Attribute ev
 327 | width = showAttr "width"
 328 | 
 329 | export %inline
 330 | wrap : Bool -> Attribute ev
 331 | wrap = Bool "wrap"
 332 | 
 333 | --------------------------------------------------------------------------------
 334 | --          Events
 335 | --------------------------------------------------------------------------------
 336 | 
 337 | export %inline
 338 | click : (MouseInfo -> Maybe ev) -> Attribute ev
 339 | click = Event . Click
 340 | 
 341 | export %inline
 342 | onClick : ev -> Attribute ev
 343 | onClick = click . const . Just
 344 | 
 345 | export
 346 | onLeftClick : ev -> Attribute ev
 347 | onLeftClick va = click $ \mi => toMaybe (mi.button == 0) va
 348 | 
 349 | export
 350 | onRightClick : ev -> Attribute ev
 351 | onRightClick va = click $ \mi => toMaybe (mi.button == 2) va
 352 | 
 353 | export
 354 | onMiddleClick : ev -> Attribute ev
 355 | onMiddleClick va = click $ \mi => toMaybe (mi.button == 1) va
 356 | 
 357 | export %inline
 358 | dblClick : (MouseInfo -> Maybe ev) -> Attribute ev
 359 | dblClick = Event . DblClick
 360 | 
 361 | export %inline
 362 | onDblClick : ev -> Attribute ev
 363 | onDblClick = dblClick . const . Just
 364 | 
 365 | export
 366 | onChange : (String -> ev) -> Attribute ev
 367 | onChange f = Event . Change $ Just . f . value
 368 | 
 369 | export
 370 | onChecked : (Bool -> ev) -> Attribute ev
 371 | onChecked f = Event . Change $ Just . f . checked
 372 | 
 373 | export
 374 | onInput : (String -> ev) -> Attribute ev
 375 | onInput f = Event . Input $ Just . f . value
 376 | 
 377 | export
 378 | onEnterDown : ev -> Attribute ev
 379 | onEnterDown va = Event . KeyDown $ \k => toMaybe (k.key == "Enter") va
 380 | 
 381 | export
 382 | onEscDown : ev -> Attribute ev
 383 | onEscDown va = Event . KeyDown $ \k => toMaybe (k.key == "Escape") va
 384 | 
 385 | export
 386 | onShiftDown : ev -> Attribute ev
 387 | onShiftDown va = Event . KeyDown $ \k => toMaybe (k.key == "Shift") va
 388 | 
 389 | export
 390 | onShiftUp : ev -> Attribute ev
 391 | onShiftUp va = Event . KeyUp $ \k => toMaybe (k.key == "Shift") va
 392 | 
 393 | export
 394 | onAltDown : ev -> Attribute ev
 395 | onAltDown va = Event . KeyDown $ \k => toMaybe (k.key == "Alt") va
 396 | 
 397 | export
 398 | onAltUp : ev -> Attribute ev
 399 | onAltUp va = Event . KeyUp $ \k => toMaybe (k.key == "Alt") va
 400 | 
 401 | export
 402 | onCtrlUp : ev -> Attribute ev
 403 | onCtrlUp va = Event . KeyUp $ \k => toMaybe (k.key == "Control") va
 404 | 
 405 | export
 406 | onCtrlDown : ev -> Attribute ev
 407 | onCtrlDown va = Event . KeyDown $ \k => toMaybe (k.key == "Control") va
 408 | 
 409 | export
 410 | onKeyUp : (KeyInfo -> ev) -> Attribute ev
 411 | onKeyUp f = Event . KeyUp $ Just . f
 412 | 
 413 | export
 414 | onBlur : ev -> Attribute ev
 415 | onBlur = Event . Blur
 416 | 
 417 | export
 418 | onFocus : ev -> Attribute ev
 419 | onFocus = Event . Focus
 420 |