
  0 | module Web.MVC.Event
  1 | 
  2 | import JS
  3 | import Text.HTML.Event
  4 | import Web.Dom
  5 | import Web.Raw.UIEvents
  6 | 
  7 | %default total
  8 | 
  9 | %foreign "browser:lambda:x=>x.target.value || x.target.innerHTML || ''"
 10 | prim__input : Event -> PrimIO String
 11 | 
 12 | %foreign "browser:lambda:x=>x.target.checked?1:0"
 13 | prim__checked : Event -> PrimIO Bits8
 14 | 
 15 | %foreign "browser:lambda:x=>x.target.files || []"
 16 | prim__files : Event -> PrimIO FileList
 17 | 
 18 | %foreign "browser:lambda:x=>x.length"
 19 | prim__length : FileList -> PrimIO Bits32
 20 | 
 21 | %foreign "browser:lambda:(x,y)=>x[y]"
 22 | prim__item : FileList -> Bits32 -> File
 23 | 
 24 | files : Event -> JSIO (List File)
 25 | files e = do
 26 |   fs <- primIO (prim__files e)
 27 |   l  <- primIO (prim__length fs)
 28 |   pure $ case l of
 29 |     0 => []
 30 |     x => prim__item fs <$> [0..x-1]
 31 | 
 32 | export
 33 | mouseInfo : MouseEvent -> JSIO MouseInfo
 34 | mouseInfo e =
 35 |   [| MkMouseInfo
 36 |      (button e)
 37 |      (buttons e)
 38 |      (clientX e)
 39 |      (clientY e)
 40 |      (offsetX e)
 41 |      (offsetY e)
 42 |      (pageX e)
 43 |      (pageY e)
 44 |      (screenX e)
 45 |      (screenY e)
 46 |      (altKey e)
 47 |      (ctrlKey e)
 48 |      (metaKey e)
 49 |      (shiftKey e)
 50 |   |]
 51 | 
 52 | export
 53 | keyInfo : KeyboardEvent -> JSIO KeyInfo
 54 | keyInfo e =
 55 |   [| MkKeyInfo
 56 |      (key e)
 57 |      (code e)
 58 |      (location e)
 59 |      (isComposing e)
 60 |      (altKey e)
 61 |      (ctrlKey e)
 62 |      (metaKey e)
 63 |      (shiftKey e)
 64 |   |]
 65 | 
 66 | export
 67 | changeInfo : Event -> JSIO InputInfo
 68 | changeInfo e =
 69 |   [| MkInputInfo
 70 |        (primIO (prim__input e))
 71 |        (files e)
 72 |        ((1 ==) <$> primIO (prim__checked e)) |]
 73 | 
 74 | export
 75 | inputInfo : InputEvent -> JSIO InputInfo
 76 | inputInfo e = changeInfo $ up e
 77 | 
 78 | export
 79 | elemScrollInfo : Element -> JSIO ScrollInfo
 80 | elemScrollInfo x =
 81 |   [| MkScrollInfo (get x scrollTop) (scrollHeight x) (clientHeight x) |]
 82 | 
 83 | export
 84 | scrollInfo : Event -> JSIO ScrollInfo
 85 | scrollInfo e = do
 86 |   Just et <- target e | Nothing => pure $ MkScrollInfo 0 0 0
 87 |   maybe (pure $ MkScrollInfo 0 0 0) elemScrollInfo (castTo Element et)
 88 | 
 89 | export
 90 | wheelInfo : WheelEvent -> JSIO WheelInfo
 91 | wheelInfo e =
 92 |   [| MkWheelInfo
 93 |      (deltaMode e)
 94 |      (deltaX e)
 95 |      (deltaY e)
 96 |      (deltaZ e) |]
 97 |