├── .gitignore ├── CONTRIBUTING.md ├── IQuery.idr ├── IQuery ├── Ajax.idr ├── Elements.idr ├── Event.idr ├── Interval.idr ├── Key.idr ├── State.idr └── Timeout.idr ├── Makefile ├── README.md ├── example ├── .gitignore ├── Makefile ├── state.html └── state.idr └── iquery.ipkg /.gitignore: -------------------------------------------------------------------------------- 1 | *.ibc -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | Pull requests are welcome! 2 | -------------------------------------------------------------------------------- /IQuery.idr: -------------------------------------------------------------------------------- 1 | module IQuery 2 | 3 | import IQuery.Timeout 4 | import IQuery.Interval 5 | import IQuery.Event 6 | import IQuery.Elements 7 | import IQuery.State 8 | 9 | %access public 10 | 11 | alert : String -> IO () 12 | alert msg = 13 | mkForeign (FFun "alert(%0)" [FString] FUnit) msg 14 | 15 | -------------------------------------------------------------------------------- /IQuery/Ajax.idr: -------------------------------------------------------------------------------- 1 | module Ajax 2 | 3 | %access private 4 | 5 | data XMLHttpRequest : Type where 6 | MkXHR : Ptr -> XMLHttpRequest 7 | 8 | data ReadyState : Type where 9 | Unsent : ReadyState 10 | Opened : ReadyState 11 | HeadersReceived : ReadyState 12 | Loading : ReadyState 13 | Done : ReadyState 14 | 15 | public 16 | data Method : Type where 17 | GET : Method 18 | POST : Method 19 | 20 | new : IO XMLHttpRequest 21 | new = [| MkXHR (mkForeign (FFun "new XMLHttpRequest" [] FPtr)) |] 22 | 23 | open : XMLHttpRequest -> Method -> String -> Bool -> IO () 24 | open (MkXHR xhr) method url async = 25 | mkForeign ( 26 | FFun "%0.open(%1,%2,%3)" [FPtr, FString, FString, FInt] FUnit 27 | ) xhr (toMethod method) url (toAsync async) 28 | where toMethod : Method -> String 29 | toMethod GET = "GET" 30 | toMethod POST = "POST" 31 | 32 | toAsync : Bool -> Int 33 | toAsync True = 1 34 | toAsync False = 0 35 | 36 | setRequestHeader : XMLHttpRequest -> String -> String -> IO () 37 | setRequestHeader (MkXHR xhr) name value = 38 | mkForeign ( 39 | FFun "%0.setRequestHeader(%1, %2)" [FPtr, FString, FString] FUnit 40 | ) xhr name value 41 | 42 | readyState : XMLHttpRequest -> IO ReadyState 43 | readyState (MkXHR xhr) = do 44 | r <- mkForeign (FFun "%0.readyState" [FPtr] FInt) xhr 45 | pure $ case r of 46 | 1 => Opened 47 | 2 => HeadersReceived 48 | 3 => Loading 49 | 4 => Done 50 | _ => Unsent 51 | 52 | responseText : XMLHttpRequest -> IO String 53 | responseText (MkXHR xhr) = mkForeign (FFun "%0.responseText" [FPtr] FString) xhr 54 | 55 | status : XMLHttpRequest -> IO Int 56 | status (MkXHR xhr) = mkForeign (FFun "%0.status" [FPtr] FInt) xhr 57 | 58 | onReadyStateChange : XMLHttpRequest -> IO () -> IO () 59 | onReadyStateChange (MkXHR x) f = 60 | mkForeign ( 61 | FFun "%0.onreadystatechange=%1" [FPtr, FFunction FUnit (FAny (IO ()))] FUnit 62 | ) x (const f) 63 | 64 | send : XMLHttpRequest -> String -> IO () 65 | send (MkXHR xhr) r = mkForeign (FFun "%0.send(%1)" [FPtr, FString] FUnit) xhr r 66 | 67 | public 68 | ajax : Method -> String -> Bool -> List (String, String) -> String -> 69 | (Either Int String -> IO ()) -> IO () 70 | ajax method url async headers dat callback = do 71 | xhr <- new 72 | open xhr method url async 73 | traverse (uncurry $ setRequestHeader xhr) headers 74 | onReadyStateChange xhr $ do rs <- readyState xhr 75 | case rs of 76 | Done => do s <- status xhr 77 | case s of 78 | 200 => do t <- responseText xhr 79 | callback $ Right t 80 | _ => callback $ Left s 81 | _ => return () 82 | send xhr dat 83 | 84 | -------------------------------------------------------------------------------- /IQuery/Elements.idr: -------------------------------------------------------------------------------- 1 | module Elements 2 | 3 | import IQuery.Event 4 | 5 | %access public 6 | 7 | abstract 8 | data Element : Type where 9 | MkElem : Ptr -> Element 10 | 11 | abstract 12 | data NodeList : Type where 13 | MkNodeList : Ptr -> NodeList 14 | 15 | newElement : String -> IO Element 16 | newElement t = 17 | map MkElem $ mkForeign (FFun "document.createElement(%0)" [FString] FPtr) t 18 | 19 | newElementNS : String -> String -> IO Element 20 | newElementNS ns t = 21 | map MkElem $ mkForeign 22 | (FFun "document.createElementNS(%0, %1)" [FString, FString] FPtr) ns t 23 | 24 | setProperty : Element -> String -> String -> IO () 25 | setProperty (MkElem e) name value = 26 | mkForeign ( 27 | FFun "%0[%1]=%2" [ FPtr 28 | , FString 29 | , FString 30 | ] FUnit 31 | ) e name value 32 | 33 | getProperty : Element -> String -> IO String 34 | getProperty (MkElem e) name = 35 | mkForeign ( 36 | FFun "%0[%1]" [ FPtr 37 | , FString 38 | ] FString 39 | ) e name 40 | 41 | setValue : Element -> String -> IO () 42 | setValue = flip setProperty "value" 43 | 44 | getValue : Element -> IO String 45 | getValue = flip getProperty "value" 46 | 47 | setAttribute : Element -> String -> String -> IO () 48 | setAttribute (MkElem e) name value = 49 | mkForeign ( 50 | FFun "%0.setAttribute(%1,%2)" [ FPtr 51 | , FString 52 | , FString 53 | ] FUnit 54 | ) e name value 55 | 56 | setAttributeNS : Element -> String -> String -> String -> IO () 57 | setAttributeNS (MkElem e) ns name value = 58 | mkForeign ( 59 | FFun "%0.setAttributeNS(%1,%2,%3)" [ FPtr 60 | , FString 61 | , FString 62 | , FString 63 | ] FUnit 64 | ) e ns name value 65 | 66 | getAttribute : Element -> String -> IO String 67 | getAttribute (MkElem e) name = 68 | mkForeign ( 69 | FFun "%0.getAttribute(%1)" [ FPtr 70 | , FString 71 | ] FString 72 | ) e name 73 | 74 | appendChild : Element -> Element -> IO () 75 | appendChild (MkElem p) (MkElem c) = 76 | mkForeign ( 77 | FFun "%0.appendChild(%1)" [ FPtr 78 | , FPtr 79 | ] FUnit 80 | ) p c 81 | 82 | removeChild : Element -> Element -> IO () 83 | removeChild (MkElem p) (MkElem c) = 84 | mkForeign ( 85 | FFun "%0.removeChild(%1)" [ FPtr 86 | , FPtr 87 | ] FUnit 88 | ) p c 89 | 90 | tagName : Element -> IO String 91 | tagName (MkElem e) = mkForeign (FFun "%0.tagName" [FPtr] FString) e 92 | 93 | getText : Element -> IO String 94 | getText (MkElem e) = 95 | mkForeign (FFun "%0.textContent" [FPtr] FString) e 96 | 97 | setText : Element -> String -> IO () 98 | setText (MkElem e) s = 99 | mkForeign (FFun "%0.textContent=%1" [FPtr, FString] FUnit) e s 100 | 101 | onEvent : EventType -> Element -> (Event -> IO Int) -> IO () 102 | onEvent ty (MkElem e) cb = 103 | let ev = show ty in 104 | mkForeign ( 105 | FFun "%0.addEventListener(%1, %2)" [ FPtr 106 | , FString 107 | , FFunction (FAny Event) (FAny (IO Int)) 108 | ] FUnit 109 | ) e ev cb 110 | 111 | onClick : Element -> (Event -> IO Int) -> IO () 112 | onClick = onEvent Click 113 | 114 | length : NodeList -> IO Int 115 | length (MkNodeList l) = 116 | mkForeign (FFun "%0.length" [FPtr] FInt) l 117 | 118 | elemAt : NodeList -> Int -> IO (Maybe Element) 119 | elemAt (MkNodeList l) i = 120 | if !(length $ MkNodeList l) > i then 121 | map (Just . MkElem) $ mkForeign (FFun "%0.item(%1)" [FPtr, FInt] FPtr) l i 122 | else 123 | return Nothing 124 | 125 | query : String -> IO NodeList 126 | query q = 127 | map MkNodeList $ mkForeign (FFun "document.querySelectorAll(%0)" [FString] FPtr) q 128 | 129 | childNodes : Element -> IO NodeList 130 | childNodes (MkElem e) = 131 | map MkNodeList $ mkForeign (FFun "%0.childNodes" [FPtr] FPtr) e 132 | 133 | 134 | -------------------------------------------------------------------------------- /IQuery/Event.idr: -------------------------------------------------------------------------------- 1 | module Event 2 | 3 | import IQuery.Key 4 | 5 | %access public 6 | 7 | abstract 8 | data Event : Type where 9 | MkEvent : Ptr -> Event 10 | 11 | public 12 | data EventType : Type where 13 | Click : EventType 14 | DoubleClick : EventType 15 | MouseDown : EventType 16 | MouseMove : EventType 17 | MouseOver : EventType 18 | MouseOut : EventType 19 | MouseUp : EventType 20 | KeyDown : EventType 21 | KeyUp : EventType 22 | KeyPress : EventType 23 | Abort : EventType 24 | Error : EventType 25 | Load : EventType 26 | Resize : EventType 27 | Scroll : EventType 28 | Unload : EventType 29 | Blur : EventType 30 | Change : EventType 31 | Focus : EventType 32 | Reset : EventType 33 | Select : EventType 34 | Submit : EventType 35 | 36 | instance Show EventType where 37 | show Click = "click" 38 | show DoubleClick = "dblclick" 39 | show MouseDown = "mousedown" 40 | show MouseMove = "mousemove" 41 | show MouseOver = "mouseover" 42 | show MouseOut = "mouseout" 43 | show MouseUp = "mouseup" 44 | show KeyDown = "keydown" 45 | show KeyUp = "keyup" 46 | show KeyPress = "keypress" 47 | show Abort = "abort" 48 | show Error = "error" 49 | show Load = "load" 50 | show Resize = "resize" 51 | show Scroll = "scroll" 52 | show Unload = "unload" 53 | show Blur = "blur" 54 | show Change = "change" 55 | show Focus = "focus" 56 | show Reset = "reset" 57 | show Select = "select" 58 | show Submit = "submit" 59 | 60 | private 61 | evProp : {fty : FTy} -> String -> Event -> IO (interpFTy fty) 62 | evProp {fty} propName (MkEvent e) = mkForeign ( 63 | FFun "%0[%1]" [ FPtr, FString ] fty 64 | ) e propName 65 | 66 | private 67 | boolProp : String -> Event -> IO Bool 68 | boolProp propName e = map toBool $ evProp {fty = FInt} propName e 69 | where toBool : Int -> Bool 70 | toBool 1 = True 71 | toBool _ = False 72 | 73 | key : Event -> IO (Maybe Key) 74 | key e = map fromKeyCode $ evProp {fty = FInt} "keyCode" e 75 | 76 | mouseButton : Event -> IO (Maybe MouseButton) 77 | mouseButton e = map fromButtonCode $ evProp {fty = FInt} "button" e 78 | 79 | clientX : Event -> IO Int 80 | clientX = evProp {fty = FInt} "clientX" 81 | 82 | clientY : Event -> IO Int 83 | clientY = evProp {fty = FInt} "clientY" 84 | 85 | altKey : Event -> IO Bool 86 | altKey = boolProp "altKey" 87 | 88 | ctrlKey : Event -> IO Bool 89 | ctrlKey = boolProp "ctrlKey" 90 | 91 | metaKey : Event -> IO Bool 92 | metaKey = boolProp "metaKey" 93 | 94 | shiftKey : Event -> IO Bool 95 | shiftKey = boolProp "shiftKey" 96 | -------------------------------------------------------------------------------- /IQuery/Interval.idr: -------------------------------------------------------------------------------- 1 | module Interval 2 | 3 | %access public 4 | 5 | abstract 6 | data Interval : Type where 7 | MkInterval : Ptr -> Interval 8 | 9 | setInterval : (() -> IO ()) -> Float -> IO Interval 10 | setInterval f t = do 11 | e <- mkForeign ( 12 | FFun "setInterval(%0,%1)" [FFunction FUnit (FAny (IO ())), FFloat] FPtr 13 | ) f t 14 | return (MkInterval e) 15 | 16 | clearInterval : Interval -> IO () 17 | clearInterval (MkInterval p) = 18 | mkForeign (FFun "clearInterval(%0)" [FPtr] FUnit) p 19 | 20 | -------------------------------------------------------------------------------- /IQuery/Key.idr: -------------------------------------------------------------------------------- 1 | module Key 2 | 3 | data MouseButton : Type where 4 | MouseLeft : MouseButton 5 | MouseMiddle : MouseButton 6 | MouseRight : MouseButton 7 | 8 | data Key : Type where 9 | KeySpace : Key 10 | KeyEnter : Key 11 | KeyTab : Key 12 | KeyEsc : Key 13 | KeyBackspace : Key 14 | KeyShift : Key 15 | KeyControl : Key 16 | KeyAlt : Key 17 | KeyCapsLock : Key 18 | KeyNumLock : Key 19 | KeyArrowLeft : Key 20 | KeyArrowUp : Key 21 | KeyArrowRight : Key 22 | KeyArrowDown : Key 23 | KeyIns : Key 24 | KeyDel : Key 25 | KeyHome : Key 26 | KeyEnd : Key 27 | KeyPgUp : Key 28 | KeyPgDown : Key 29 | KeyF1 : Key 30 | KeyF2 : Key 31 | KeyF3 : Key 32 | KeyF4 : Key 33 | KeyF5 : Key 34 | KeyF6 : Key 35 | KeyF7 : Key 36 | KeyF8 : Key 37 | KeyF9 : Key 38 | KeyF10 : Key 39 | KeyF11 : Key 40 | KeyF12 : Key 41 | KeyPadDel : Key 42 | KeyPadIns : Key 43 | KeyPadEnd : Key 44 | KeyPadDown : Key 45 | KeyPadPgDown : Key 46 | KeyPadLeft : Key 47 | KeyPadRight : Key 48 | KeyPadHome : Key 49 | KeyPadUp : Key 50 | KeyPadPgUp : Key 51 | KeyPadAdd : Key 52 | KeyPadSub : Key 53 | KeyPadMul : Key 54 | KeyPadDiv : Key 55 | KeyPadEnter : Key 56 | KeyPadDot : Key 57 | KeyPad0 : Key 58 | KeyPad1 : Key 59 | KeyPad2 : Key 60 | KeyPad3 : Key 61 | KeyPad4 : Key 62 | KeyPad5 : Key 63 | KeyPad6 : Key 64 | KeyPad7 : Key 65 | KeyPad8 : Key 66 | KeyPad9 : Key 67 | Key0 : Key 68 | Key1 : Key 69 | Key2 : Key 70 | Key3 : Key 71 | Key4 : Key 72 | Key5 : Key 73 | Key6 : Key 74 | Key7 : Key 75 | Key8 : Key 76 | Key9 : Key 77 | KeyA : Key 78 | KeyB : Key 79 | KeyC : Key 80 | KeyD : Key 81 | KeyE : Key 82 | KeyF : Key 83 | KeyG : Key 84 | KeyH : Key 85 | KeyI : Key 86 | KeyJ : Key 87 | KeyK : Key 88 | KeyL : Key 89 | KeyM : Key 90 | KeyN : Key 91 | KeyO : Key 92 | KeyP : Key 93 | KeyQ : Key 94 | KeyR : Key 95 | KeyS : Key 96 | KeyT : Key 97 | KeyU : Key 98 | KeyV : Key 99 | KeyW : Key 100 | KeyX : Key 101 | KeyY : Key 102 | KeyZ : Key 103 | 104 | toButtonCode : MouseButton -> Int 105 | toButtonCode MouseLeft = 0 106 | toButtonCode MouseMiddle = 1 107 | toButtonCode MouseRight = 2 108 | 109 | fromButtonCode : Int -> Maybe MouseButton 110 | fromButtonCode 0 = Just MouseLeft 111 | fromButtonCode 1 = Just MouseMiddle 112 | fromButtonCode 2 = Just MouseRight 113 | fromButtonCode _ = Nothing 114 | 115 | 116 | toKeyCode : Key -> Int 117 | toKeyCode KeySpace = 32 118 | toKeyCode KeyEnter = 13 119 | toKeyCode KeyTab = 9 120 | toKeyCode KeyEsc = 27 121 | toKeyCode KeyBackspace = 8 122 | toKeyCode KeyShift = 16 123 | toKeyCode KeyControl = 17 124 | toKeyCode KeyAlt = 18 125 | toKeyCode KeyCapsLock = 20 126 | toKeyCode KeyNumLock = 144 127 | toKeyCode KeyArrowLeft = 37 128 | toKeyCode KeyArrowUp = 38 129 | toKeyCode KeyArrowRight = 39 130 | toKeyCode KeyArrowDown = 40 131 | toKeyCode KeyIns = 45 132 | toKeyCode KeyDel = 46 133 | toKeyCode KeyHome = 36 134 | toKeyCode KeyEnd = 35 135 | toKeyCode KeyPgUp = 33 136 | toKeyCode KeyPgDown = 34 137 | toKeyCode KeyF1 = 112 138 | toKeyCode KeyF2 = 113 139 | toKeyCode KeyF3 = 114 140 | toKeyCode KeyF4 = 115 141 | toKeyCode KeyF5 = 116 142 | toKeyCode KeyF6 = 117 143 | toKeyCode KeyF7 = 118 144 | toKeyCode KeyF8 = 119 145 | toKeyCode KeyF9 = 120 146 | toKeyCode KeyF10 = 121 147 | toKeyCode KeyF11 = 122 148 | toKeyCode KeyF12 = 123 149 | toKeyCode KeyPadDel = 46 150 | toKeyCode KeyPadIns = 45 151 | toKeyCode KeyPadEnd = 35 152 | toKeyCode KeyPadDown = 40 153 | toKeyCode KeyPadPgDown = 34 154 | toKeyCode KeyPadLeft = 37 155 | toKeyCode KeyPadRight = 39 156 | toKeyCode KeyPadHome = 36 157 | toKeyCode KeyPadUp = 38 158 | toKeyCode KeyPadPgUp = 33 159 | toKeyCode KeyPadAdd = 107 160 | toKeyCode KeyPadSub = 109 161 | toKeyCode KeyPadMul = 106 162 | toKeyCode KeyPadDiv = 111 163 | toKeyCode KeyPadEnter = 13 164 | toKeyCode KeyPadDot = 46 165 | toKeyCode KeyPad0 = 48 166 | toKeyCode KeyPad1 = 49 167 | toKeyCode KeyPad2 = 50 168 | toKeyCode KeyPad3 = 51 169 | toKeyCode KeyPad4 = 52 170 | toKeyCode KeyPad5 = 53 171 | toKeyCode KeyPad6 = 54 172 | toKeyCode KeyPad7 = 55 173 | toKeyCode KeyPad8 = 56 174 | toKeyCode KeyPad9 = 57 175 | toKeyCode Key0 = 48 176 | toKeyCode Key1 = 49 177 | toKeyCode Key2 = 50 178 | toKeyCode Key3 = 51 179 | toKeyCode Key4 = 52 180 | toKeyCode Key5 = 53 181 | toKeyCode Key6 = 54 182 | toKeyCode Key7 = 55 183 | toKeyCode Key8 = 56 184 | toKeyCode Key9 = 57 185 | toKeyCode KeyA = 65 186 | toKeyCode KeyB = 66 187 | toKeyCode KeyC = 67 188 | toKeyCode KeyD = 68 189 | toKeyCode KeyE = 69 190 | toKeyCode KeyF = 70 191 | toKeyCode KeyG = 71 192 | toKeyCode KeyH = 72 193 | toKeyCode KeyI = 73 194 | toKeyCode KeyJ = 74 195 | toKeyCode KeyK = 75 196 | toKeyCode KeyL = 76 197 | toKeyCode KeyM = 77 198 | toKeyCode KeyN = 78 199 | toKeyCode KeyO = 79 200 | toKeyCode KeyP = 80 201 | toKeyCode KeyQ = 81 202 | toKeyCode KeyR = 82 203 | toKeyCode KeyS = 83 204 | toKeyCode KeyT = 84 205 | toKeyCode KeyU = 85 206 | toKeyCode KeyV = 86 207 | toKeyCode KeyW = 87 208 | toKeyCode KeyX = 88 209 | toKeyCode KeyY = 89 210 | toKeyCode KeyZ = 90 211 | 212 | fromKeyCode : Int -> Maybe Key 213 | fromKeyCode 32 = Just KeySpace 214 | fromKeyCode 13 = Just KeyEnter 215 | fromKeyCode 9 = Just KeyTab 216 | fromKeyCode 27 = Just KeyEsc 217 | fromKeyCode 8 = Just KeyBackspace 218 | fromKeyCode 16 = Just KeyShift 219 | fromKeyCode 17 = Just KeyControl 220 | fromKeyCode 18 = Just KeyAlt 221 | fromKeyCode 20 = Just KeyCapsLock 222 | fromKeyCode 144 = Just KeyNumLock 223 | fromKeyCode 37 = Just KeyArrowLeft 224 | fromKeyCode 38 = Just KeyArrowUp 225 | fromKeyCode 39 = Just KeyArrowRight 226 | fromKeyCode 40 = Just KeyArrowDown 227 | fromKeyCode 45 = Just KeyIns 228 | fromKeyCode 46 = Just KeyDel 229 | fromKeyCode 36 = Just KeyHome 230 | fromKeyCode 35 = Just KeyEnd 231 | fromKeyCode 33 = Just KeyPgUp 232 | fromKeyCode 34 = Just KeyPgDown 233 | fromKeyCode 112 = Just KeyF1 234 | fromKeyCode 113 = Just KeyF2 235 | fromKeyCode 114 = Just KeyF3 236 | fromKeyCode 115 = Just KeyF4 237 | fromKeyCode 116 = Just KeyF5 238 | fromKeyCode 117 = Just KeyF6 239 | fromKeyCode 118 = Just KeyF7 240 | fromKeyCode 119 = Just KeyF8 241 | fromKeyCode 120 = Just KeyF9 242 | fromKeyCode 121 = Just KeyF10 243 | fromKeyCode 122 = Just KeyF11 244 | fromKeyCode 123 = Just KeyF12 245 | fromKeyCode 107 = Just KeyPadAdd 246 | fromKeyCode 109 = Just KeyPadSub 247 | fromKeyCode 106 = Just KeyPadMul 248 | fromKeyCode 111 = Just KeyPadDiv 249 | fromKeyCode 48 = Just Key0 250 | fromKeyCode 49 = Just Key1 251 | fromKeyCode 50 = Just Key2 252 | fromKeyCode 51 = Just Key3 253 | fromKeyCode 52 = Just Key4 254 | fromKeyCode 53 = Just Key5 255 | fromKeyCode 54 = Just Key6 256 | fromKeyCode 55 = Just Key7 257 | fromKeyCode 56 = Just Key8 258 | fromKeyCode 57 = Just Key9 259 | fromKeyCode 65 = Just KeyA 260 | fromKeyCode 66 = Just KeyB 261 | fromKeyCode 67 = Just KeyC 262 | fromKeyCode 68 = Just KeyD 263 | fromKeyCode 69 = Just KeyE 264 | fromKeyCode 70 = Just KeyF 265 | fromKeyCode 71 = Just KeyG 266 | fromKeyCode 72 = Just KeyH 267 | fromKeyCode 73 = Just KeyI 268 | fromKeyCode 74 = Just KeyJ 269 | fromKeyCode 75 = Just KeyK 270 | fromKeyCode 76 = Just KeyL 271 | fromKeyCode 77 = Just KeyM 272 | fromKeyCode 78 = Just KeyN 273 | fromKeyCode 79 = Just KeyO 274 | fromKeyCode 80 = Just KeyP 275 | fromKeyCode 81 = Just KeyQ 276 | fromKeyCode 82 = Just KeyR 277 | fromKeyCode 83 = Just KeyS 278 | fromKeyCode 84 = Just KeyT 279 | fromKeyCode 85 = Just KeyU 280 | fromKeyCode 86 = Just KeyV 281 | fromKeyCode 87 = Just KeyW 282 | fromKeyCode 88 = Just KeyX 283 | fromKeyCode 89 = Just KeyY 284 | fromKeyCode 90 = Just KeyZ 285 | fromKeyCode _ = Nothing 286 | 287 | -------------------------------------------------------------------------------- /IQuery/State.idr: -------------------------------------------------------------------------------- 1 | module IQuery.State 2 | 3 | %access private 4 | 5 | public 6 | data StateTy : Type where 7 | STInt : StateTy 8 | STString : StateTy 9 | STMaybe : StateTy -> StateTy 10 | STList : StateTy -> StateTy 11 | -- STRecord : List (String,StateTy) -> StateTy 12 | -- STHash : StateTy -> StateTy 13 | 14 | public 15 | interpSTy : StateTy -> Type 16 | interpSTy STInt = Int 17 | interpSTy STString = String 18 | interpSTy (STMaybe a) = Maybe (interpSTy a) 19 | interpSTy (STList a) = List (interpSTy a) 20 | 21 | abstract 22 | data State : StateTy -> Type where 23 | MkState : (t : StateTy) -> Ptr -> State t 24 | 25 | abstract 26 | data StateC : StateTy -> Type where 27 | MkStateC : Int -> (t : StateTy) -> Ptr -> StateC t 28 | 29 | isObj : Ptr -> IO Bool 30 | isObj p = do 31 | "object" <- mkForeign (FFun "typeof %0" [FPtr] FString) p 32 | | _ => pure False 33 | pure True 34 | 35 | stateVarName : String 36 | stateVarName = "__IDR__IQUERY__STATE__" 37 | 38 | stateVarExists : IO Bool 39 | stateVarExists = do 40 | o <- mkForeign (FFun ("typeof " ++ stateVarName) [] FString) 41 | pure $ if o == "object" then True else False 42 | 43 | initStateVar : IO Ptr 44 | initStateVar = mkForeign (FFun (stateVarName ++ " = {count: 0}") [] FPtr) 45 | 46 | getStateVar : IO (Maybe Ptr) 47 | getStateVar = case !stateVarExists of 48 | True => map Just $ mkForeign (FFun stateVarName [] FPtr) 49 | False => pure Nothing 50 | 51 | getStateVar' : IO Ptr 52 | getStateVar' = case !getStateVar of 53 | Just s => pure s 54 | Nothing => initStateVar 55 | 56 | stateCExists : Ptr -> Int -> IO Bool 57 | stateCExists c n = do 58 | r <- mkForeign (FFun "typeof %0[%1]" [FPtr,FInt] FString) c n 59 | pure $ if r == "object" then True else False 60 | 61 | incCount : Ptr -> IO Int 62 | incCount c = do 63 | n <- mkForeign (FFun "%0.count" [FPtr] FInt) c 64 | mkForeign (FFun "%0.count++" [FPtr] FUnit) c 65 | pure n 66 | 67 | infixl 5 =>> 68 | public 69 | (=>>) : IO (Maybe (State a)) -> (State a -> IO (Maybe b)) 70 | -> IO (Maybe b) 71 | s =>> f = do 72 | (Just s') <- s 73 | | Nothing => pure Nothing 74 | f s' 75 | 76 | infixl 5 :=> 77 | public 78 | (:=>) : IO (Maybe (State a)) -> (State a -> IO ()) -> IO Bool 79 | (:=>) s f = do 80 | (Just s') <- s 81 | | Nothing => pure False 82 | f s' 83 | pure True 84 | 85 | public 86 | access : Nat -> State (STList t) -> IO (Maybe (State t)) 87 | access n (MkState (STList t) p) = do 88 | r <- mkForeign (FFun "%0.val[%1]" [FPtr,FInt] FPtr) p (fromNat n) 89 | True <- isObj r 90 | | False => pure Nothing 91 | pure $ Just $ MkState t r 92 | 93 | fromState' : State t -> IO (interpSTy t) 94 | fromState' (MkState STInt p) = mkForeign (FFun "%0.val" [FPtr] FInt) p 95 | fromState' (MkState STString p) = mkForeign (FFun "%0.val" [FPtr] FString) p 96 | fromState' (MkState (STMaybe a) p) = do 97 | isNull <- (mkForeign (FFun "(%0.val == null).toString()" [FPtr] FString) p) 98 | case isNull == "true" of 99 | True => pure Nothing 100 | False => pure $ Just !(fromState' (MkState a p)) 101 | fromState' (MkState (STList a) p) = do 102 | n <- mkForeign (FFun "%0.val.length" [FPtr] FInt) p 103 | ps <- sequence $ map 104 | (\n => mkForeign (FFun "%0.val[%1]" [FPtr,FInt] FPtr) p n) [0..(n-1)] 105 | sequence $ map (\p' => fromState' (MkState a p')) ps 106 | 107 | public 108 | fromState : State t -> IO (Maybe (interpSTy t)) 109 | fromState (MkState t p) = do 110 | True <- isObj p 111 | | False => pure Nothing 112 | map Just $ fromState' (MkState t p) 113 | 114 | public 115 | toState : {t : StateTy} -> interpSTy t -> State t -> IO () 116 | toState v (MkState STInt p) = 117 | mkForeign (FFun "%0.val = %1" [FPtr, FInt] FUnit) p v 118 | toState v (MkState STString p) = do 119 | mkForeign (FFun "%0.val = %1" [FPtr, FString] FUnit) p v 120 | toState Nothing (MkState (STMaybe a) p) = 121 | mkForeign (FFun "%0.val = null" [FPtr] FUnit) p 122 | toState (Just v) (MkState (STMaybe a) p) = toState v (MkState a p) 123 | toState xs (MkState (STList a) p) = do 124 | array <- mkForeign (FFun "%0.val = []" [FPtr] FPtr) p 125 | sequence_ $ map (\x => do 126 | n <- mkForeign (FFun "%0.push( {} )" [FPtr] FInt) array 127 | box <- mkForeign (FFun "%0[%1]" [FPtr, FInt] FPtr) array (n-1) 128 | toState x (MkState a box) 129 | ) xs 130 | 131 | public 132 | get : StateC t -> IO (Maybe (State t)) 133 | get (MkStateC _ t p) = do 134 | True <- isObj p 135 | | False => pure Nothing 136 | pure $ Just $ MkState t p 137 | 138 | public 139 | newState : (t : StateTy) -> interpSTy t -> IO (StateC t) 140 | newState t v = do 141 | c <- getStateVar' 142 | n <- incCount c 143 | p <- mkForeign (FFun "%0[%1] = {}" [FPtr,FInt] FPtr) c n 144 | toState v (MkState t p) 145 | pure $ MkStateC n t p 146 | 147 | public 148 | destroyState : StateC t -> IO () 149 | destroyState (MkStateC n _ _) = do 150 | c <- getStateVar' 151 | mkForeign (FFun "delete %0[%1]" [FPtr,FInt] FUnit) c n 152 | 153 | 154 | -------------------------------------------------------------------------------- /IQuery/Timeout.idr: -------------------------------------------------------------------------------- 1 | module Timeout 2 | 3 | %access public 4 | 5 | abstract 6 | data Timeout : Type where 7 | MkTimeout : Ptr -> Timeout 8 | 9 | setTimeout : (() -> IO ()) -> Float -> IO Timeout 10 | setTimeout f t = do 11 | e <- mkForeign ( 12 | FFun "setTimeout(%0,%1)" [FFunction FUnit (FAny (IO ())), FFloat] FPtr 13 | ) f t 14 | return (MkTimeout e) 15 | 16 | clearTimeout : Timeout -> IO () 17 | clearTimeout (MkTimeout p) = 18 | mkForeign (FFun "clearTimeout(%0)" [FPtr] FUnit) p 19 | 20 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | IDRIS := idris 2 | 3 | build: .PHONY 4 | $(IDRIS) --build iquery.ipkg 5 | 6 | install: 7 | $(IDRIS) --install iquery.ipkg 8 | 9 | clean: .PHONY 10 | $(IDRIS) --clean iquery.ipkg 11 | 12 | rebuild: clean build 13 | 14 | .PHONY: 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | iQuery 2 | ====== 3 | 4 | iQuery is an Idris library to interact with the DOM and Browser API with the 5 | Idris Javascript backend. 6 | -------------------------------------------------------------------------------- /example/.gitignore: -------------------------------------------------------------------------------- 1 | state.js -------------------------------------------------------------------------------- /example/Makefile: -------------------------------------------------------------------------------- 1 | IDRIS := idris 2 | 3 | build: .PHONY 4 | $(IDRIS) -p iquery --codegen javascript -o state.js state.idr 5 | 6 | clean: .PHONY 7 | rm -f *.ibc 8 | rm -f *.js 9 | 10 | .PHONY: 11 | -------------------------------------------------------------------------------- /example/state.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | iQuery State Example 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /example/state.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IQuery 4 | 5 | push : StateC (STList STString) -> Event -> IO Int 6 | push s e = do 7 | Just input <- query "input#pushVal" >>= (\x => elemAt x 0) 8 | Just xs <- get s =>> fromState 9 | text <- getValue input 10 | get s :=> toState (text :: xs) 11 | pure 1 12 | 13 | shift : StateC (STList STString) -> Event -> IO Int 14 | shift s e = do 15 | Just x <- get s =>> access 0 =>> fromState 16 | | Nothing => do 17 | alert "stack is empty" 18 | pure 1 19 | alert x 20 | Just (_::xs) <- get s =>> fromState 21 | get s :=> toState xs 22 | pure 1 23 | 24 | setV : Event -> IO Int 25 | setV e = do 26 | Just el <- !(query "input#val") `elemAt` 0 27 | setValue el "wohoo" 28 | pure 1 29 | 30 | main : IO () 31 | main = do 32 | queue <- newState (STList STString) Nil 33 | Just p <- !(query "input#pushAct") `elemAt` 0 34 | onClick p (push queue) 35 | Just s <- !(query "input#shiftAct") `elemAt` 0 36 | onClick s (shift queue) 37 | Just sv <- !(query "input#setVal") `elemAt` 0 38 | onClick sv setV 39 | pure () 40 | -------------------------------------------------------------------------------- /iquery.ipkg: -------------------------------------------------------------------------------- 1 | package iquery 2 | 3 | modules = IQuery, IQuery.Ajax, IQuery.Event, IQuery.Interval, IQuery.Key, IQuery.State, IQuery.Timeout, IQuery.Elements 4 | 5 | --------------------------------------------------------------------------------