
   0 | ||| A `Sink` is a monadic streaming function that consumes
   1 | ||| data but produces no relevant output.
   2 | module Rhone.JS.Sink
   3 | 
   4 | import Rhone.JS.ElemRef
   5 | import Data.Maybe
   6 | import Data.MSF
   7 | import JS
   8 | import Text.Html
   9 | import Web.Dom
  10 | import Web.Html
  11 | 
  12 | %default total
  13 | 
  14 | ||| Replaces the `innerHTML` property of the target with the
  15 | ||| given `String`. Warning: The string will not be escaped
  16 | ||| before being inserted, so don't use this with text from
  17 | ||| untrusted sources.
  18 | export
  19 | rawInnerHtmlAt : ElemRef t -> String -> JSIO ()
  20 | rawInnerHtmlAt ref str = do
  21 |   elem <- castElementByRef {t2 = Element} ref
  22 |   innerHTML elem .= str
  23 | 
  24 | ||| Sets the innerHTML property of the referenced node to
  25 | ||| the input string value.
  26 | export %inline
  27 | innerHtml : ElemRef t -> MSF JSIO String ()
  28 | innerHtml = arrM . rawInnerHtmlAt
  29 | 
  30 | ||| Replaces the target's child nodes with a `Text` node
  31 | ||| displaying the input `String`. The `String` will be
  32 | ||| properly escaped before being inserted.
  33 | export
  34 | text : ElemRef t -> MSF JSIO String ()
  35 | text ref = escape ^>> innerHtml ref
  36 | 
  37 | --------------------------------------------------------------------------------
  38 | --          Attributes
  39 | --------------------------------------------------------------------------------
  40 | 
  41 | ||| Sets or removes the attribute of the given name
  42 | ||| at the given target element.
  43 | export
  44 | attribute : (name : String) -> MSF JSIO (HList [ElemRef t, Maybe String]) ()
  45 | attribute name =
  46 |   arrM $ \[ref,m] => do
  47 |     el <- castElementByRef {t2 = Element} ref
  48 |     case m of
  49 |       Just s  => setAttribute el name s
  50 |       Nothing => removeAttribute el name
  51 | 
  52 | ||| Sets or unsets the attribute of the given element.
  53 | export %inline
  54 | attributeAt : (name : String) -> ElemRef t -> MSF JSIO (Maybe String) ()
  55 | attributeAt = firstArg . attribute
  56 | 
  57 | ||| Sets the attribute of the given name at the given target element.
  58 | export
  59 | attribute_ : (name : String) -> MSF JSIO (HList [ElemRef t, String]) ()
  60 | attribute_ name = (\[a,b] => [a,Just b]) ^>> attribute name
  61 | 
  62 | ||| Sets or unsets the attribute of the given element.
  63 | export %inline
  64 | attributeAt_ : (name : String) -> ElemRef t -> MSF JSIO String ()
  65 | attributeAt_ = firstArg . attribute_
  66 | 
  67 | ||| Sets or unsets the boolean attribute of the given name at
  68 | ||| the given target element.
  69 | export
  70 | boolAttribute : (name : String) -> MSF JSIO (HList [ElemRef t, Bool]) ()
  71 | boolAttribute name = (\[a,b] => [a,toMaybe b ""]) ^>> attribute name
  72 | 
  73 | ||| Sets or unsets the `disabled` attribute of the given element.
  74 | export %inline
  75 | disabled : MSF JSIO (HList [ElemRef t, Bool]) ()
  76 | disabled = boolAttribute "disabled"
  77 | 
  78 | ||| Sets or unsets the `disabled` attribute of the given element.
  79 | export %inline
  80 | disabledAt : ElemRef t -> MSF JSIO Bool ()
  81 | disabledAt = firstArg disabled
  82 | 
  83 | ||| Sets or unsets the `hidden` attribute of the given element.
  84 | export %inline
  85 | hidden : MSF JSIO (HList [ElemRef t, Bool]) ()
  86 | hidden = boolAttribute "hidden"
  87 | 
  88 | ||| Sets or unsets the `hidden` attribute of the given element.
  89 | export %inline
  90 | hiddenAt : ElemRef t -> MSF JSIO Bool ()
  91 | hiddenAt = firstArg hidden
  92 | 
  93 | ||| Sets the `class` attribute of the given element.
  94 | export %inline
  95 | class : MSF JSIO (HList [ElemRef t, String]) ()
  96 | class = attribute_ "class"
  97 | 
  98 | ||| Sets the `class` attribute of the given element.
  99 | export %inline
 100 | classAt : ElemRef t -> MSF JSIO String ()
 101 | classAt = firstArg class
 102 | 
 103 | --------------------------------------------------------------------------------
 104 | --          Input Validation
 105 | --------------------------------------------------------------------------------
 106 | 
 107 | ||| Interface for DOM elements that can have a custom
 108 | ||| validity message set.
 109 | public export
 110 | interface SafeCast t => SetValidity t where
 111 |   setValidityMessage : t -> String -> JSIO ()
 112 | 
 113 | export
 114 | SetValidity HTMLButtonElement where
 115 |   setValidityMessage = setCustomValidity
 116 | 
 117 | export
 118 | SetValidity HTMLFieldSetElement where
 119 |   setValidityMessage = setCustomValidity
 120 | 
 121 | export
 122 | SetValidity HTMLInputElement where
 123 |   setValidityMessage = setCustomValidity
 124 | 
 125 | export
 126 | SetValidity HTMLObjectElement where
 127 |   setValidityMessage = setCustomValidity
 128 | 
 129 | export
 130 | SetValidity HTMLOutputElement where
 131 |   setValidityMessage = setCustomValidity
 132 | 
 133 | export
 134 | SetValidity HTMLSelectElement where
 135 |   setValidityMessage = setCustomValidity
 136 | 
 137 | export
 138 | SetValidity HTMLTextAreaElement where
 139 |   setValidityMessage = setCustomValidity
 140 | 
 141 | export
 142 | setValidityMessageAt : SetValidity t => ElemRef t -> String -> JSIO ()
 143 | setValidityMessageAt ref s =
 144 |   getElementByRef ref >>= (`setValidityMessage` s)
 145 | 
 146 | ||| Sets a custom validity message at the given target element
 147 | export
 148 | validityMessageAt : SetValidity t => ElemRef t -> MSF JSIO String ()
 149 | validityMessageAt = arrM . setValidityMessageAt
 150 | 
 151 | ||| Sets or unsets a custom validity message at the given target element
 152 | ||| depending on whether the input value is a `Left`.
 153 | export
 154 | leftInvalid :
 155 |      {0 x : _}
 156 |   -> SetValidity t
 157 |   => ElemRef t
 158 |   -> MSF JSIO (Either String x) ()
 159 | leftInvalid ref = either id (const "") ^>> validityMessageAt ref
 160 | 
 161 | --------------------------------------------------------------------------------
 162 | --          Value
 163 | --------------------------------------------------------------------------------
 164 | 
 165 | public export
 166 | interface SafeCast t => SetValue t where
 167 |   setValue' : String -> t -> JSIO ()
 168 | 
 169 | public export
 170 | SetValue HTMLButtonElement where
 171 |   setValue' = (value =.)
 172 | 
 173 | public export
 174 | SetValue HTMLDataElement where
 175 |   setValue' = (value =.)
 176 | 
 177 | public export
 178 | SetValue HTMLInputElement where
 179 |   setValue' = (value =.)
 180 | 
 181 | public export
 182 | SetValue HTMLOptionElement where
 183 |   setValue' = (value =.)
 184 | 
 185 | public export
 186 | SetValue HTMLOutputElement where
 187 |   setValue' = (value =.)
 188 | 
 189 | public export
 190 | SetValue HTMLParamElement where
 191 |   setValue' = (value =.)
 192 | 
 193 | public export
 194 | SetValue HTMLSelectElement where
 195 |   setValue' = (value =.)
 196 | 
 197 | public export
 198 | SetValue HTMLTextAreaElement where
 199 |   setValue' = (value =.)
 200 | 
 201 | public export
 202 | SetValue RadioNodeList where
 203 |   setValue' = (value =.)
 204 | 
 205 | export
 206 | setValue : SetValue t => ElemRef t -> String -> JSIO ()
 207 | setValue r s = getElementByRef r >>= setValue' s
 208 | 
 209 | export
 210 | value : SetValue t => MSF JSIO (HList [ElemRef t,String]) ()
 211 | value = arrM $ \[r,s] => setValue r s
 212 | 
 213 | export %inline
 214 | valueOf : SetValue t => ElemRef t -> MSF JSIO String ()
 215 | valueOf = firstArg value
 216 | 
 217 | export
 218 | setChecked : Bool -> HTMLInputElement -> JSIO ()
 219 | setChecked b el = set (checked el) b
 220 | 
 221 | export
 222 | checked : MSF JSIO (HList [ElemRef HTMLInputElement,Bool]) ()
 223 | checked = arrM $ \[r,b] => getElementByRef r >>= setChecked b
 224 | 
 225 | export %inline
 226 | isChecked : ElemRef HTMLInputElement -> MSF JSIO Bool ()
 227 | isChecked = firstArg checked
 228 | 
 229 | namespace LocalStorage
 230 |   export
 231 |   setItem : MSF JSIO (HList [String,String]) ()
 232 |   setItem = arrM $ \[k,v] =>
 233 |     window >>= localStorage >>= (\s => setItem s k v)
 234 | 
 235 |   export %inline
 236 |   setItemAt : (key : String) -> MSF JSIO String ()
 237 |   setItemAt = firstArg setItem
 238 | 
 239 | --------------------------------------------------------------------------------
 240 | --          Focus
 241 | --------------------------------------------------------------------------------
 242 | 
 243 | export
 244 | setFocus :
 245 |      {auto 0 _ : JSType t}
 246 |   -> {auto 0 _ : Elem HTMLOrSVGElement (Types t)}
 247 |   -> {auto sc  : SafeCast t}
 248 |   -> t
 249 |   -> JSIO ()
 250 | setFocus v = HTMLOrSVGElement.focus v
 251 | 
 252 | export
 253 | focus :
 254 |      {auto 0 _ : JSType t}
 255 |   -> {auto 0 _ : Elem HTMLOrSVGElement (Types t)}
 256 |   -> {auto sc  : SafeCast t}
 257 |   -> MSF JSIO (ElemRef t) ()
 258 | focus = arrM $ \r => getElementByRef r >>= setFocus
 259 | 
 260 | export %inline
 261 | focusAt :
 262 |      {auto 0 _ : JSType t}
 263 |   -> {auto 0 _ : Elem HTMLOrSVGElement (Types t)}
 264 |   -> {auto sc  : SafeCast t}
 265 |   -> ElemRef t
 266 |   -> MSF JSIO i ()
 267 | focusAt r = const r >>> focus
 268 |