@@ -0,0 +1,101 @@
1+module JavaScript
2+
3+%access public
4+
5+-- TODO: Get rid of this hack, and find a better way.
6+private
7+isUndefined : Ptr -> IO Bool
8+isUndefined p = do
9+ res <- mkForeign (
10+ FFun "(function(arg) { return arg === undefined;})" [FPtr] FString) p
11+ if res == "false"
12+ then (return False)
13+ else (return True)
14+
15+--------------------------------------------------------------------------------
16+-- Events
17+--------------------------------------------------------------------------------
18+abstract
19+data Event : Type where
20+ MkEvent : Ptr -> Event
21+
22+--------------------------------------------------------------------------------
23+-- Elements
24+--------------------------------------------------------------------------------
25+abstract
26+data Element : Type where
27+ MkElem : Ptr -> Element
28+
29+setText : Element -> String -> IO ()
30+setText (MkElem p) s =
31+ mkForeign (FFun ".textContent=" [FPtr, FString] FUnit) p s
32+
33+
34+setOnClick : Element -> (Event -> IO Bool) -> IO ()
35+setOnClick (MkElem e) f =
36+ mkForeign (
37+ FFun "['onclick']=" [ FPtr
38+ , FFunction (FAny Event) (FAny (IO Bool))
39+ ] FUnit) e f
40+--------------------------------------------------------------------------------
41+-- Nodelists
42+--------------------------------------------------------------------------------
43+abstract
44+data NodeList : Type where
45+ MkNodeList : Ptr -> NodeList
46+
47+elemAt : NodeList -> Nat -> IO (Maybe Element)
48+elemAt (MkNodeList p) i = do
49+ e <- mkForeign (FFun ".item" [FPtr, FInt] FPtr) p (cast i)
50+ d <- isUndefined e
51+ if d
52+ then return $ Just (MkElem e)
53+ else return Nothing
54+
55+--------------------------------------------------------------------------------
56+-- Intervals
57+--------------------------------------------------------------------------------
58+abstract
59+data Interval : Type where
60+ MkInterval : Ptr -> Interval
61+
62+setInterval : (() -> IO ()) -> Float -> IO Interval
63+setInterval f t = do
64+ e <- mkForeign (
65+ FFun "setInterval" [FFunction FUnit (FAny (IO ())), FFloat] FPtr) f t
66+ return (MkInterval e)
67+
68+clearInterval : Interval -> IO ()
69+clearInterval (MkInterval p) =
70+ mkForeign (FFun "clearInterval" [FPtr] FUnit) p
71+
72+--------------------------------------------------------------------------------
73+-- Timeouts
74+--------------------------------------------------------------------------------
75+data Timeout : Type where
76+ MkTimeout : Ptr -> Timeout
77+
78+setTimeout : (() -> IO ()) -> Float -> IO Timeout
79+setTimeout f t = do
80+ e <- mkForeign (
81+ FFun "setTimeout" [FFunction FUnit (FAny (IO ())), FFloat] FPtr) f t
82+ return (MkTimeout e)
83+
84+clearTimeout : Timeout -> IO ()
85+clearTimeout (MkTimeout p) =
86+ mkForeign (FFun "clearTimeout" [FPtr] FUnit) p
87+
88+--------------------------------------------------------------------------------
89+-- Basic IO
90+--------------------------------------------------------------------------------
91+alert : String -> IO ()
92+alert msg =
93+ mkForeign (FFun "alert" [FString] FUnit) msg
94+
95+--------------------------------------------------------------------------------
96+-- DOM
97+--------------------------------------------------------------------------------
98+query : String -> IO NodeList
99+query q = do
100+ e <- mkForeign (FFun "document.querySelectorAll" [FString] FPtr) q
101+ return (MkNodeList e)