
   0 | module Rhone.JS.Reactimate
   1 | 
   2 | import Control.Monad.Either.Extra
   3 | import Data.IORef
   4 | import Data.MSF
   5 | import Data.Nat
   6 | import JS
   7 | import Rhone.JS.ElemRef
   8 | import Rhone.JS.Event
   9 | import Text.CSS
  10 | import Text.Html
  11 | import Web.Dom
  12 | import Web.Html
  13 | 
  14 | %default total
  15 | 
  16 | ||| Low level method for registering `DOMEvents` at
  17 | ||| HTML elements.
  18 | |||
  19 | ||| Use this, for instance, to register `DOMEvents` at
  20 | ||| a HTMLElement of a static document.
  21 | export
  22 | registerDOMEvent : Handler JSIO e => EventTarget -> DOMEvent e -> JSIO ()
  23 | registerDOMEvent el de = case de of
  24 |   Input f      => inst "input" inputInfo f
  25 |   Change f     => inst "change" changeInfo f
  26 |   Click f      => inst "click" mouseInfo f
  27 |   DblClick f   => inst "dblclick" mouseInfo f
  28 |   KeyDown f    => inst "keydown" keyInfo f
  29 |   KeyUp f      => inst "keyup" keyInfo f
  30 |   Blur v       => inst "blur" {a = Event} (const $ pure v) Just
  31 |   Focus v      => inst "focus" {a = Event} (const $ pure v) Just
  32 |   MouseDown f  => inst "mousedown" mouseInfo f
  33 |   MouseUp f    => inst "mouseup" mouseInfo f
  34 |   MouseEnter f => inst "mouseenter" mouseInfo f
  35 |   MouseLeave f => inst "mouseleave" mouseInfo f
  36 |   MouseOver f  => inst "mouseover" mouseInfo f
  37 |   MouseOut f   => inst "mouseout" mouseInfo f
  38 |   MouseMove f  => inst "mousemove" mouseInfo f
  39 |   HashChange v => inst "hashchange" {a = Event} (const $ pure v) Just
  40 |   Wheel f      => inst "wheel" wheelInfo f
  41 | 
  42 |   where
  43 |     inst :
  44 |          {0 a,b : _}
  45 |       -> {auto c : SafeCast a}
  46 |       -> String
  47 |       -> (a -> JSIO b)
  48 |       -> (b -> Maybe e)
  49 |       -> JSIO ()
  50 |     inst s conv f = do
  51 |       c <- callback {cb = EventListener} $ \e => do
  52 |         va <- tryCast_ a "Control.Monad.Dom.Interface.inst" e
  53 |         conv va >>= maybe (pure ()) handle . f
  54 | 
  55 |       addEventListener el s (Just c)
  56 | 
  57 | parameters {0    e : Type}
  58 |            {auto h : Handler JSIO e}
  59 | 
  60 |   ||| Manually register an event handler at the given element
  61 |   export
  62 |   handleEvent : ElemRef t -> DOMEvent e -> JSIO ()
  63 |   handleEvent ref de = do
  64 |     el  <- castElementByRef ref
  65 |     registerDOMEvent el de
  66 | 
  67 |   export
  68 |   setAttribute : Element -> Attribute e -> JSIO ()
  69 |   setAttribute el (Id value)        = setAttribute el "id" value
  70 |   setAttribute el (Str name value)  = setAttribute el name value
  71 |   setAttribute el (Bool name value) = case value of
  72 |     True  => setAttribute el name ""
  73 |     False => removeAttribute el name
  74 |   setAttribute el (Event ev) = registerDOMEvent (up el) ev
  75 |   setAttribute el Empty      = pure ()
  76 | 
  77 |   export
  78 |   setAttributeRef : ElemRef t -> Attribute e -> JSIO ()
  79 |   setAttributeRef ref a = do
  80 |     el <- castElementByRef {t2 = Element} ref
  81 |     setAttribute el a
  82 | 
  83 |   export
  84 |   setAttributesRef : ElemRef t -> List (Attribute e) -> JSIO ()
  85 |   setAttributesRef el = traverseList_ (setAttributeRef el)
  86 | 
  87 | --------------------------------------------------------------------------------
  88 | --          DOM Update
  89 | --------------------------------------------------------------------------------
  90 | 
  91 | nodeList : DocumentFragment -> List (HSum [Node,String])
  92 | nodeList df = [inject $ df :> Node]
  93 | 
  94 | ||| Replaces all children of the given node with a new document fragment.
  95 | export %inline
  96 | replaceChildren : Element -> DocumentFragment -> JSIO ()
  97 | replaceChildren elem = replaceChildren elem . nodeList
  98 | 
  99 | ||| Appends the given document fragment to a DOM element's children
 100 | export %inline
 101 | appendDF : Element -> DocumentFragment -> JSIO ()
 102 | appendDF elem = append elem . nodeList
 103 | 
 104 | ||| Prepends the given document fragment to a DOM element's children
 105 | export %inline
 106 | prependDF : Element -> DocumentFragment -> JSIO ()
 107 | prependDF elem = prepend elem . nodeList
 108 | 
 109 | ||| Inserts the given document fragment after a DOM element.
 110 | export %inline
 111 | afterDF : Element -> DocumentFragment -> JSIO ()
 112 | afterDF elem = after elem . nodeList
 113 | 
 114 | ||| Inserts the given document fragment before a DOM element.
 115 | export %inline
 116 | beforeDF : Element -> DocumentFragment -> JSIO ()
 117 | beforeDF elem = before elem . nodeList
 118 | 
 119 | ||| Inserts the given document fragment before a DOM element.
 120 | export %inline
 121 | replaceDF : Element -> DocumentFragment -> JSIO ()
 122 | replaceDF elem = replaceWith elem . nodeList
 123 | 
 124 | public export
 125 | data DOMUpdate : Type -> Type where
 126 |   Children : ElemRef t -> (ns : List (Node e)) -> DOMUpdate e
 127 |   Replace  : ElemRef t -> (ns : List (Node e)) -> DOMUpdate e
 128 |   Append   : ElemRef t -> (ns : List (Node e)) -> DOMUpdate e
 129 |   Prepend  : ElemRef t -> (ns : List (Node e)) -> DOMUpdate e
 130 |   After    : ElemRef t -> (ns : List (Node e)) -> DOMUpdate e
 131 |   Before   : ElemRef t -> (ns : List (Node e)) -> DOMUpdate e
 132 |   Attr     : ElemRef t -> Attribute e -> DOMUpdate e
 133 |   Remove   : ElemRef t -> DOMUpdate e
 134 | 
 135 | --------------------------------------------------------------------------------
 136 | --          Node Preparation
 137 | --------------------------------------------------------------------------------
 138 | 
 139 | parameters {0    e : Type}           -- event type
 140 |            {auto h : Handler JSIO e} -- event handler
 141 | 
 142 |   createNode : Document -> String -> List (Attribute e) -> JSIO Element
 143 |   createNode doc str xs = do
 144 |     el <- createElement doc str
 145 |     traverseList_ (setAttribute el) xs
 146 |     pure el
 147 | 
 148 |   addNodes :
 149 |        {auto 0 _ : JSType t}
 150 |     -> {auto 0 _ : Elem ParentNode (Types t)}
 151 |     -> (doc      : Document)
 152 |     -> (parent   : t)
 153 |     -> (nodes    : List (Node e))
 154 |     -> JSIO ()
 155 | 
 156 |   addNode :
 157 |        {auto 0 _ : JSType t}
 158 |     -> {auto 0 _ : Elem ParentNode (Types t)}
 159 |     -> (doc      : Document)
 160 |     -> (parent   : t)
 161 |     -> (node     : Node e)
 162 |     -> JSIO ()
 163 |   addNode doc p (El tag xs ys) = do
 164 |     n <- createNode doc tag xs
 165 |     append p [inject $ n :> Node]
 166 |     addNodes doc n ys
 167 |   addNode doc p (Raw str) = do
 168 |     el <- createElement doc "template"
 169 |     Just temp <- pure (castTo HTMLTemplateElement el) | Nothing => pure ()
 170 |     innerHTML temp .= str
 171 |     c         <- content temp
 172 |     append p [inject $ c :> Node]
 173 | 
 174 |   addNode doc p (Text str) = append p [inject str]
 175 | 
 176 |   addNode doc p Empty      = pure ()
 177 | 
 178 |   addNodes doc p = assert_total $ traverseList_ (addNode doc p)
 179 | 
 180 |   setupNodes :
 181 |        (Element -> DocumentFragment -> JSIO ())
 182 |     -> ElemRef t
 183 |     -> List (Node e)
 184 |     -> JSIO ()
 185 |   setupNodes adj ref ns = do
 186 |     doc  <- document
 187 |     elem <- castElementByRef {t2 = Element} ref
 188 |     df   <- createDocumentFragment doc
 189 |     addNodes doc df ns
 190 |     adj elem df
 191 | 
 192 |   %inline
 193 |   setupNode :
 194 |        (Element -> DocumentFragment -> JSIO ())
 195 |     -> ElemRef t
 196 |     -> Node e
 197 |     -> JSIO ()
 198 |   setupNode adj ref n = setupNodes adj ref [n]
 199 | 
 200 |   ||| Sets up the reactive behavior of the given `Node`s and
 201 |   ||| inserts them as the children of the given target.
 202 |   export %inline
 203 |   innerHtmlAtN : ElemRef t -> List (Node e) -> JSIO ()
 204 |   innerHtmlAtN = setupNodes replaceChildren
 205 | 
 206 |   ||| Sets up the reactive behavior of the given `Node` and
 207 |   ||| inserts it as the only child of the given target.
 208 |   export %inline
 209 |   innerHtmlAt : ElemRef t -> Node e -> JSIO ()
 210 |   innerHtmlAt = setupNode replaceChildren
 211 | 
 212 |   ||| Sets up the reactive behavior of the given `Node`s and
 213 |   ||| inserts them after the given child node.
 214 |   export %inline
 215 |   afterN : ElemRef t -> List (Node e) -> JSIO ()
 216 |   afterN = setupNodes afterDF
 217 | 
 218 |   ||| Sets up the reactive behavior of the given `Node` and
 219 |   ||| inserts it after the given child node.
 220 |   export %inline
 221 |   after : ElemRef t -> Node e -> JSIO ()
 222 |   after = setupNode afterDF
 223 | 
 224 |   ||| Sets up the reactive behavior of the given `Node`s and
 225 |   ||| inserts them before the given child node.
 226 |   export %inline
 227 |   beforeN : ElemRef t -> List (Node e) -> JSIO ()
 228 |   beforeN = setupNodes beforeDF
 229 | 
 230 |   ||| Sets up the reactive behavior of the given `Node` and
 231 |   ||| inserts it before the given child node.
 232 |   export %inline
 233 |   before : ElemRef t -> Node e -> JSIO ()
 234 |   before = setupNode beforeDF
 235 | 
 236 |   ||| Sets up the reactive behavior of the given `Node`s and
 237 |   ||| appends them to the given element's list of children
 238 |   export %inline
 239 |   appendN : ElemRef t -> List (Node e) -> JSIO ()
 240 |   appendN = setupNodes appendDF
 241 | 
 242 |   ||| Sets up the reactive behavior of the given `Node` and
 243 |   ||| appends it to the given element's list of children
 244 |   export %inline
 245 |   append : ElemRef t -> Node e -> JSIO ()
 246 |   append = setupNode appendDF
 247 | 
 248 |   ||| Sets up the reactive behavior of the given `Node`s and
 249 |   ||| prepends them to the given element's list of children
 250 |   export %inline
 251 |   prependN : ElemRef t -> List (Node e) -> JSIO ()
 252 |   prependN = setupNodes prependDF
 253 | 
 254 |   ||| Sets up the reactive behavior of the given `Node` and
 255 |   ||| prepends it to the given element's list of children
 256 |   export %inline
 257 |   prepend : ElemRef t -> Node e -> JSIO ()
 258 |   prepend = setupNode prependDF
 259 | 
 260 |   ||| Sets up the reactive behavior of the given `Node`s and
 261 |   ||| replaces the given element.
 262 |   export %inline
 263 |   replaceN : ElemRef t -> List (Node e) -> JSIO ()
 264 |   replaceN = setupNodes replaceDF
 265 | 
 266 |   ||| Sets up the reactive behavior of the given `Node` and
 267 |   ||| replaces the given element.
 268 |   export %inline
 269 |   replace : ElemRef t -> Node e -> JSIO ()
 270 |   replace = setupNode replaceDF
 271 | 
 272 |   ||| Execute a single DOM update instruction
 273 |   export
 274 |   updateDOM1 : DOMUpdate e -> JSIO ()
 275 |   updateDOM1 (Children x ns) = innerHtmlAtN x ns
 276 |   updateDOM1 (Replace x ns)  = replaceN x ns
 277 |   updateDOM1 (Append x ns)   = appendN x ns
 278 |   updateDOM1 (Prepend x ns)  = prependN x ns
 279 |   updateDOM1 (After x ns)    = afterN x ns
 280 |   updateDOM1 (Before x ns)   = beforeN x ns
 281 |   updateDOM1 (Attr x a)      = setAttributeRef x a
 282 |   updateDOM1 (Remove x)      = castElementByRef {t2 = Element} x >>= remove
 283 | 
 284 |   ||| Execute several DOM update instructions
 285 |   export %inline
 286 |   updateDOM : List (DOMUpdate e) -> JSIO ()
 287 |   updateDOM = traverseList_ updateDOM1
 288 |