├── .gitignore ├── README.md ├── examples ├── interval.idr ├── setyear.idr ├── foreach.idr ├── dates.idr ├── regexps.idr ├── objects.idr ├── json.idr └── new.idr ├── Makefile ├── IdrisScript ├── Functions │ └── Unpacked.idr ├── Objects │ └── Unpacked.idr ├── JSON.idr ├── Date │ ├── Months.idr │ ├── Types.idr │ └── Days.idr ├── Arrays │ └── Unpacked.idr ├── Timer.idr ├── Strings.idr ├── RegExps.idr ├── Functions.idr ├── Objects.idr ├── Arrays.idr └── Date.idr ├── idrisscript.ipkg ├── LICENSE └── IdrisScript.idr /.gitignore: -------------------------------------------------------------------------------- 1 | *.ibc 2 | *.js 3 | test.idr 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | IdrisScript 2 | =========== 3 | 4 | FFI Bindings to interact with the unsafe world of JavaScript 5 | -------------------------------------------------------------------------------- /examples/interval.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IdrisScript 4 | import IdrisScript.Timer 5 | 6 | main : JS_IO () 7 | main = do 8 | setInterval (\_ => print "PING!") 1000 9 | putStrLn "Done!" 10 | -------------------------------------------------------------------------------- /examples/setyear.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IdrisScript 4 | import IdrisScript.Date 5 | 6 | main : JS_IO () 7 | main = do 8 | date <- now 9 | log date 10 | date `setFullYear` (MkYear 2016) 11 | log date 12 | -------------------------------------------------------------------------------- /examples/foreach.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IdrisScript 4 | import IdrisScript.Arrays 5 | 6 | main : JS_IO () 7 | main = do 8 | arr <- toJSArray {from=Int} {to=JSNumber} [1..100] 9 | forEach (\elm => log (getProof !(pack elm))) arr 10 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | IDRIS := idris 2 | 3 | build: .PHONY 4 | $(IDRIS) --build idrisscript.ipkg 5 | 6 | install: 7 | $(IDRIS) --install idrisscript.ipkg 8 | 9 | clean: .PHONY 10 | $(IDRIS) --clean idrisscript.ipkg 11 | 12 | rebuild: clean build 13 | 14 | .PHONY: 15 | -------------------------------------------------------------------------------- /examples/dates.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IdrisScript 4 | import IdrisScript.Date 5 | 6 | main : JS_IO () 7 | main = do 8 | current <- now 9 | if !(getDay current) == Friday 10 | then putStrLn' "It's Friday! I'm in love!" 11 | else putStrLn' "Meh!" 12 | -------------------------------------------------------------------------------- /examples/regexps.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IdrisScript 4 | import IdrisScript.RegExps 5 | 6 | main : JS_IO () 7 | main = do 8 | let text = "The Cloud is where all the Cloud Computing happens!" 9 | regex <- newRegExp "Cloud" [Global] 10 | 11 | print !(replace text regex "Kitten") 12 | -------------------------------------------------------------------------------- /examples/objects.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IdrisScript 4 | import IdrisScript.Objects 5 | 6 | main : JS_IO () 7 | main = do 8 | obj <- empty 9 | 10 | setProperty "foo" (toJS {from=Int}{to=JSNumber} 666) obj 11 | setProperty "bar" (toJS {from=Int}{to=JSNumber} 1337) obj 12 | 13 | keys <- keys obj 14 | 15 | log keys 16 | log obj 17 | -------------------------------------------------------------------------------- /examples/json.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IdrisScript 4 | import IdrisScript.Objects 5 | import IdrisScript.JSON 6 | 7 | main : JS_IO () 8 | main = do 9 | let text = "{\"foo\":true,\"bar\":1337}" 10 | case !(parse text) of 11 | Just (_ ** obj) => 12 | case !(getProperty "bar" obj) of 13 | Just (_ ** res) => log res 14 | _ => pure () 15 | _ => pure () 16 | -------------------------------------------------------------------------------- /IdrisScript/Functions/Unpacked.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Functions.Unpacked 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | setProperty : ToJS from to 8 | => String 9 | -> from 10 | -> JSValue JSFunction 11 | -> JS_IO (JSValue JSFunction) 12 | setProperty {from} {to} prop val fun = do 13 | jscall "%0[%1] = %2" (Ptr -> String -> Ptr -> JS_IO Ptr) 14 | (unpack fun) prop (unpack (toJS {from}{to} val)) 15 | pure fun 16 | -------------------------------------------------------------------------------- /IdrisScript/Objects/Unpacked.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Objects.Unpacked 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | setProperty : ToJS from to 8 | => String 9 | -> from 10 | -> JSValue (JSObject c) 11 | -> JS_IO (JSValue (JSObject c)) 12 | setProperty {from} {to} prop val obj = do 13 | jscall "%0[%1] = %2" (Ptr -> String -> Ptr -> JS_IO Ptr) 14 | (unpack obj) prop (unpack (toJS {from}{to} val)) 15 | pure obj 16 | -------------------------------------------------------------------------------- /examples/new.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import IdrisScript 4 | import IdrisScript.RegExps 5 | import IdrisScript.Arrays 6 | 7 | main : JS_IO () 8 | main = do 9 | args <- with Arrays empty 10 | args `push` (toJS {to=JSString} "Pinkie Pie") 11 | args `push` (toJS {to=JSString} "g") 12 | 13 | regex <- new !RegExp args 14 | 15 | let text = "Pinkie Pie is best pony!" 16 | 17 | case regex of 18 | ("RegExp" ** r) => putStrLn !(replace text r "Rainbow Dash") 19 | _ => putStrLn "Whoops" 20 | 21 | -------------------------------------------------------------------------------- /idrisscript.ipkg: -------------------------------------------------------------------------------- 1 | package idrisscript 2 | 3 | modules = IdrisScript 4 | , IdrisScript.Arrays 5 | , IdrisScript.Arrays.Unpacked 6 | , IdrisScript.Date 7 | , IdrisScript.Date.Days 8 | , IdrisScript.Date.Months 9 | , IdrisScript.Date.Types 10 | , IdrisScript.Functions 11 | , IdrisScript.Functions.Unpacked 12 | , IdrisScript.Objects 13 | , IdrisScript.Objects.Unpacked 14 | , IdrisScript.RegExps 15 | , IdrisScript.Strings 16 | , IdrisScript.JSON 17 | , IdrisScript.Timer 18 | -------------------------------------------------------------------------------- /IdrisScript/JSON.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.JSON 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | ||| Converts an object into a JSON string 8 | stringfy : JSValue (JSObject c) -> JS_IO String 9 | stringfy obj = jscall "JSON.stringfy(%0)" (Ptr -> JS_IO String) (unpack obj) 10 | 11 | ||| Parses a JSON string 12 | parse : String -> JS_IO (Maybe (c ** JSValue (JSObject c))) 13 | parse str = do 14 | res <- jscall "JSON.parse(%0)" (String -> JS_IO Ptr) str 15 | case !(pack res) of 16 | (JSObject "Object" ** obj) => pure $ Just ("Object" ** obj) 17 | (JSObject "Array" ** obj) => pure $ Just ("Array" ** obj) 18 | _ => pure Nothing 19 | -------------------------------------------------------------------------------- /IdrisScript/Date/Months.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Date.Months 2 | 3 | %access public export 4 | 5 | data Month = January 6 | | February 7 | | March 8 | | April 9 | | May 10 | | June 11 | | July 12 | | August 13 | | September 14 | | October 15 | | November 16 | | December 17 | 18 | implementation Eq Month where 19 | January == January = True 20 | February == February = True 21 | March == March = True 22 | April == April = True 23 | May == May = True 24 | June == June = True 25 | July == July = True 26 | August == August = True 27 | September == September = True 28 | October == October = True 29 | November == November = True 30 | December == December = True 31 | _ == _ = False 32 | -------------------------------------------------------------------------------- /IdrisScript/Date/Types.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Date.Types 2 | 3 | import IdrisScript.Date.Months 4 | import IdrisScript.Date.Days 5 | 6 | %access public export 7 | 8 | record Year where 9 | constructor MkYear 10 | unYear : Int 11 | 12 | implementation Eq Year where 13 | year == year' = unYear year == unYear year' 14 | 15 | record Date where 16 | constructor MkDate 17 | unDate : Int 18 | 19 | implementation Eq Date where 20 | date == date' = unDate date == unDate date' 21 | 22 | record Hours where 23 | constructor MkHours 24 | unHours : Int 25 | 26 | implementation Eq Hours where 27 | hours == hours' = unHours hours == unHours hours' 28 | 29 | record Minutes where 30 | constructor MkMinutes 31 | unMinutes : Int 32 | 33 | implementation Eq Minutes where 34 | mins == mins' = unMinutes mins == unMinutes mins' 35 | 36 | record Seconds where 37 | constructor MkSeconds 38 | unSeconds : Int 39 | 40 | implementation Eq Seconds where 41 | secs == secs' = unSeconds secs == unSeconds secs' 42 | 43 | record Milliseconds where 44 | constructor MkMilliseconds 45 | unMilliseconds : Int 46 | 47 | implementation Eq Milliseconds where 48 | millis == millis' = unMilliseconds millis == unMilliseconds millis' 49 | -------------------------------------------------------------------------------- /IdrisScript/Date/Days.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Date.Days 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | data Day = Monday 8 | | Tuesday 9 | | Wednesday 10 | | Thursday 11 | | Friday 12 | | Saturday 13 | | Sunday 14 | 15 | implementation Eq Day where 16 | Monday == Monday = True 17 | Tuesday == Tuesday = True 18 | Wednesday == Wednesday = True 19 | Thursday == Thursday = True 20 | Friday == Friday = True 21 | Saturday == Saturday = True 22 | Sunday == Sunday = True 23 | _ == _ = False 24 | 25 | implementation Cast Day Int where 26 | cast Monday = 1 27 | cast Tuesday = 2 28 | cast Wednesday = 3 29 | cast Thursday = 4 30 | cast Friday = 5 31 | cast Saturday = 6 32 | cast Sunday = 7 33 | 34 | implementation Cast Day Integer where 35 | cast Monday = 1 36 | cast Tuesday = 2 37 | cast Wednesday = 3 38 | cast Thursday = 4 39 | cast Friday = 5 40 | cast Saturday = 6 41 | cast Sunday = 7 42 | 43 | implementation Cast Day Nat where 44 | cast Monday = 1 45 | cast Tuesday = 2 46 | cast Wednesday = 3 47 | cast Thursday = 4 48 | cast Friday = 5 49 | cast Saturday = 6 50 | cast Sunday = 7 51 | -------------------------------------------------------------------------------- /IdrisScript/Arrays/Unpacked.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Arrays.Unpacked 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | singleton : ToJS from to => from -> JS_IO (JSValue JSArray) 8 | singleton {from} {to} val = do 9 | arr <- jscall "[%0]" (Ptr -> JS_IO Ptr) (unpack (toJS {from}{to} val)) 10 | pure $ MkJSObject arr 11 | 12 | push : ToJS from to => JSValue JSArray -> from -> JS_IO () 13 | push {from} {to} arr val = 14 | jscall "%0.push(%1)" (Ptr -> Ptr -> JS_IO ()) 15 | (unpack arr) (unpack (toJS {from}{to} val)) 16 | 17 | insert : ToJS from to => Nat -> from -> JSValue JSArray -> JS_IO (JSValue JSArray) 18 | insert {from} {to} idx val arr = do 19 | jscall "%0[%1] = %2" (Ptr -> Int -> Ptr -> JS_IO ()) 20 | (unpack arr) (cast idx) (unpack (toJS {from}{to} val)) 21 | pure arr 22 | 23 | indexOf : ToJS from to => from -> JSValue JSArray -> JS_IO Int 24 | indexOf {from} {to} val arr = 25 | jscall "%0.indexOf(%1)" (Ptr -> Ptr -> JS_IO Int) 26 | (unpack arr) (unpack (toJS {from}{to} val)) 27 | 28 | unshift : ToJS from to => JSValue JSArray -> from -> JS_IO Nat 29 | unshift {from} {to} arr val = do 30 | res <- jscall "%0.unshift(%1)" (Ptr -> Ptr -> JS_IO Int) 31 | (unpack arr) (unpack (toJS {from}{to} val)) 32 | pure $ cast {to=Nat} res 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, raichoo All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 14 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 15 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 16 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 17 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 19 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 20 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 21 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 22 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | -------------------------------------------------------------------------------- /IdrisScript/Timer.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Timer 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | export 8 | record Timeout where 9 | constructor MkTimeout 10 | unTimeout : Ptr 11 | 12 | export 13 | record Interval where 14 | constructor MkInterval 15 | unInterval : Ptr 16 | 17 | ||| Executes a JS_IO action after `millis` milliseconds. 18 | setTimeout : (() -> JS_IO ()) -> (millis : Int) -> JS_IO Timeout 19 | setTimeout f millis = do 20 | timeout <- jscall "setTimeout(%0, %1)" 21 | (JsFn (() -> JS_IO ()) -> Int -> JS_IO Ptr) 22 | (MkJsFn f) millis 23 | pure $ MkTimeout timeout 24 | 25 | ||| Clears a timeout. 26 | export 27 | clearTimeout : Timeout -> JS_IO () 28 | clearTimeout timeout = 29 | jscall "clearTimeout(%0)" (Ptr -> JS_IO ()) (unTimeout timeout) 30 | 31 | ||| Periodically executes a JS_IO action after `millis` milliseconds. 32 | setInterval : (() -> JS_IO ()) -> Int -> JS_IO Interval 33 | setInterval f millis = do 34 | interval <- jscall "setInterval(%0, %1)" 35 | (JsFn (() -> JS_IO ()) -> Int -> JS_IO Ptr) 36 | (MkJsFn f) millis 37 | pure $ MkInterval interval 38 | 39 | ||| Clears an interval. 40 | export 41 | clearInterval : Interval -> JS_IO () 42 | clearInterval interval = 43 | jscall "clearInterval(%0)" (Ptr -> JS_IO ()) (unInterval interval) 44 | -------------------------------------------------------------------------------- /IdrisScript/Strings.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Strings 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | ||| Upper case a string. 8 | toUpperCase : String -> JS_IO String 9 | toUpperCase str = jscall "%0.toUpperCase()" (String -> JS_IO String) str 10 | 11 | ||| Lower case a string. 12 | toLowerCase : String -> JS_IO String 13 | toLowerCase str = jscall "%0.toLowerCase()" (String -> JS_IO String) str 14 | 15 | ||| Trims a string. 16 | trim : String -> JS_IO String 17 | trim str = jscall "%0.trim()" (String -> JS_IO String) str 18 | 19 | ||| Trims a string from the left. 20 | trimLeft : String -> JS_IO String 21 | trimLeft str = jscall "%0.trimLeft()" (String -> JS_IO String) str 22 | 23 | ||| Trims a string from the right. 24 | trimRight : String -> JS_IO String 25 | trimRight str = jscall "%0.trimRight()" (String -> JS_IO String) str 26 | 27 | ||| Returns the position of the string `search` in the string `str`. 28 | indexOf : (str : String) -> (search : String) -> JS_IO Int 29 | indexOf str search = 30 | jscall "%0.indexOf(%1)" (String -> String -> JS_IO Int) str search 31 | 32 | ||| Returns a substring from postion `start` with the length `length` from 33 | ||| the string `str`. 34 | substr : (str : String) 35 | -> (start : Int) 36 | -> (length : Int) 37 | -> JS_IO String 38 | substr str start length = 39 | jscall "%0.substr(%1,%2)" (String -> Int -> Int -> JS_IO String) 40 | str start length 41 | 42 | ||| Returns a substring from position `from` to postion `to` in the 43 | ||| string `str`. 44 | substring : (str : String) 45 | -> (from : Int) 46 | -> (to : Int) 47 | -> JS_IO String 48 | substring str from to = 49 | jscall "%0.substring(%1,%2)" (String -> Int -> Int -> JS_IO String) 50 | str from to 51 | -------------------------------------------------------------------------------- /IdrisScript/RegExps.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.RegExps 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | RegExp : JS_IO (JSValue JSFunction) 8 | RegExp = do 9 | regex <- jscall "RegExp" (JS_IO Ptr) 10 | pure $ MkJSFunction regex 11 | 12 | data RegExpFlags = Global 13 | | IgnoreCase 14 | | Multiline 15 | 16 | implementation Eq RegExpFlags where 17 | Global == Global = True 18 | IgnoreCase == IgnoreCase = True 19 | Multiline == Multiline = True 20 | _ == _ = False 21 | 22 | JSRegExp : JSType 23 | JSRegExp = JSObject "RegExp" 24 | 25 | ||| Creates a new RegExp with a list of flags. 26 | newRegExp : String -> List RegExpFlags -> JS_IO (JSValue JSRegExp) 27 | newRegExp patt flags = do 28 | regex <- jscall "new RegExp(%0, %1)" (String -> String -> JS_IO Ptr) 29 | patt (mkFlags . nub $ flags) 30 | pure $ MkJSObject regex 31 | where 32 | mkFlags : List RegExpFlags -> String 33 | mkFlags (Global :: fs) = "g" ++ mkFlags fs 34 | mkFlags (IgnoreCase :: fs) = "i" ++ mkFlags fs 35 | mkFlags (Multiline :: fs) = "m" ++ mkFlags fs 36 | mkFlags [] = "" 37 | 38 | ||| Uses a RegExp `regex` on the string `str`. 39 | match : (str : String) 40 | -> (regex : JSValue JSRegExp) 41 | -> JS_IO (JSValue JSArray) 42 | match str regex = do 43 | res <- jscall "%0.match(%1)" (String -> Ptr -> JS_IO Ptr) 44 | str (unpack regex) 45 | pure $ MkJSObject res 46 | 47 | ||| Replaces matches of `regex` with `rpl` in the string `str`. Modifies 48 | ||| the original value. 49 | replace : (str : String) 50 | -> (regex : JSValue JSRegExp) 51 | -> (rpl : String) 52 | -> JS_IO String 53 | replace str regex rpl = 54 | jscall "%0.replace(%1, %2)" (String -> Ptr -> String -> JS_IO String) 55 | str (unpack regex) rpl 56 | 57 | ||| Splits an array `str` at the occurences of `regex`. 58 | split : (str : String) 59 | -> (regex : JSValue JSRegExp) 60 | -> JS_IO (JSValue JSArray) 61 | split str regex = do 62 | res <- jscall "%0.split(%1)" (String -> Ptr -> JS_IO Ptr) 63 | str (unpack regex) 64 | pure $ MkJSObject res 65 | -------------------------------------------------------------------------------- /IdrisScript/Functions.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Functions 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | infixl 6 !! 8 | 9 | Function : JS_IO (JSValue JSFunction) 10 | Function = do 11 | fun <- jscall "Function" (JS_IO Ptr) 12 | pure $ MkJSFunction fun 13 | 14 | ||| Applys an array `args` as arguments to the function `fun` 15 | apply : (fun : JSValue JSFunction) 16 | -> (args : JSValue JSArray) 17 | -> JS_IO (t ** JSValue t) 18 | apply fun args = do 19 | res <- jscall "%0.apply(this, %1)" (Ptr -> Ptr -> JS_IO Ptr) 20 | (unpack fun) (unpack args) 21 | pack res 22 | 23 | ||| Sets the property `prop` to the value `val` for a function `fun`. Modifies 24 | ||| the original value. 25 | setProperty : (prop : String) 26 | -> (val : JSValue a) 27 | -> (fun : JSValue JSFunction) 28 | -> JS_IO (JSValue JSFunction) 29 | setProperty prop val fun = do 30 | jscall "%0[%1] = %2" (Ptr -> String -> Ptr -> JS_IO Ptr) 31 | (unpack fun) prop (unpack val) 32 | pure fun 33 | 34 | ||| Gets the property `prop` from a function `fun`. 35 | getProperty : (prop : String) 36 | -> (fun : JSValue JSFunction) 37 | -> JS_IO (Maybe (t ** JSValue t)) 38 | getProperty prop fun = do 39 | elm <- jscall "%0[%1]" (Ptr -> String -> JS_IO Ptr) (unpack fun) prop 40 | case !(typeOf elm) of 41 | JSUndefined => pure Nothing 42 | _ => pure $ Just !(pack elm) 43 | 44 | ||| Gets the property `prop` from a function `fun`. 45 | (!!) : (fun : JSValue JSFunction) 46 | -> (prop : String) 47 | -> JS_IO (Maybe (t : JSType ** JSValue t)) 48 | fun !! prop = getProperty prop fun 49 | 50 | ||| Checks if a function `fun` has the property `prop`. 51 | hasOwnProperty : (prop : String) 52 | -> (fun : JSValue JSFunction) 53 | -> JS_IO Bool 54 | hasOwnProperty prop fun = do 55 | res <- jscall "%0.hasOwnProperty(%1)" (Ptr -> String -> JS_IO Int) 56 | (unpack fun) prop 57 | pure $ res == 1 58 | 59 | ||| Returns the name of a function. 60 | name : JSValue JSFunction -> JS_IO String 61 | name fun = jscall "%0.name" (Ptr -> JS_IO String) (unpack fun) 62 | 63 | ||| Returns the constructor of a function. 64 | constr : JSValue JSFunction -> JS_IO (JSValue JSFunction) 65 | constr fun = do 66 | con <- jscall "%0.constructor" (Ptr -> JS_IO Ptr) (unpack fun) 67 | pure $ MkJSFunction con 68 | -------------------------------------------------------------------------------- /IdrisScript/Objects.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Objects 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | infixl 6 !! 8 | 9 | Object : JS_IO (JSValue JSFunction) 10 | Object = do 11 | obj <- jscall "Object" (JS_IO Ptr) 12 | pure $ MkJSFunction obj 13 | 14 | ||| Creates an empty JavaScript object. 15 | empty : JS_IO (JSValue (JSObject "Object")) 16 | empty = do 17 | obj <- jscall "new Object()" (JS_IO Ptr) 18 | pure $ MkJSObject obj 19 | 20 | ||| Sets the property `prop` to the value `val` for an object `obj`. Modifies 21 | ||| the original value. 22 | setProperty : (prop : String) 23 | -> (val : JSValue a) 24 | -> (obj : JSValue (JSObject c)) 25 | -> JS_IO (JSValue (JSObject c)) 26 | setProperty prop val obj = do 27 | jscall "%0[%1] = %2" (Ptr -> String -> Ptr -> JS_IO Ptr) 28 | (unpack obj) prop (unpack val) 29 | pure obj 30 | 31 | ||| Gets the property `prop` from an object `obj`. 32 | getProperty : (prop : String) 33 | -> (obj : JSValue (JSObject c)) 34 | -> JS_IO (Maybe (t ** JSValue t)) 35 | getProperty prop obj = do 36 | elm <- jscall "%0[%1]" (Ptr -> String -> JS_IO Ptr) (unpack obj) prop 37 | case !(typeOf elm) of 38 | JSUndefined => pure Nothing 39 | _ => pure $ Just !(pack elm) 40 | 41 | ||| Gets the property `prop` from an object `obj`. 42 | (!!) : (obj : JSValue (JSObject c)) 43 | -> (prop : String) 44 | -> JS_IO (Maybe (t : JSType ** JSValue t)) 45 | obj !! prop = getProperty prop obj 46 | 47 | ||| Checks if an object `obj` has the property `prop`. 48 | hasOwnProperty : (prop : String) 49 | -> (obj : JSValue (JSObject c)) 50 | -> JS_IO Bool 51 | hasOwnProperty prop obj = do 52 | res <- jscall "%0.hasOwnProperty(%1)" (Ptr -> String -> JS_IO Int) 53 | (unpack obj) prop 54 | pure $ res == 1 55 | 56 | ||| Returns the keys of an object. 57 | keys : JSValue (JSObject c) -> JS_IO (JSValue JSArray) 58 | keys obj = do 59 | keys <- jscall "Object.keys(%0)" (Ptr -> JS_IO Ptr) (unpack obj) 60 | pure $ MkJSObject keys 61 | 62 | ||| Returns the constructor of an object. 63 | constr : JSValue (JSObject c) -> JS_IO (JSValue JSFunction) 64 | constr obj = do 65 | con <- jscall "%0.constructor" (Ptr -> JS_IO Ptr) (unpack obj) 66 | pure $ MkJSFunction con 67 | 68 | ||| Transforms a `Traversable` to an object. 69 | toJSObject : (Traversable f, ToJS from to) 70 | => f (String, from) 71 | -> JS_IO (JSValue (JSObject "Object")) 72 | toJSObject {from} {to} xs = do 73 | obj <- empty 74 | traverse_ (\x => 75 | setProperty (fst x) (toJS {from} {to} (snd x)) obj 76 | ) xs 77 | pure obj 78 | -------------------------------------------------------------------------------- /IdrisScript/Arrays.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Arrays 2 | 3 | import IdrisScript 4 | 5 | %access public export 6 | 7 | infixr 7 ++ 8 | 9 | Array : JS_IO (JSValue JSFunction) 10 | Array = do 11 | arr <- jscall "Array" (JS_IO Ptr) 12 | pure $ MkJSFunction arr 13 | 14 | ||| Creates an empty JavaScript array. 15 | empty : JS_IO (JSValue JSArray) 16 | empty = do 17 | arr <- jscall "new Array()" (JS_IO Ptr) 18 | pure $ MkJSObject arr 19 | 20 | ||| Appends two JavaScript arrays. 21 | (++) : JSValue JSArray -> JSValue JSArray -> JS_IO (JSValue JSArray) 22 | arr ++ arr' = do 23 | res <- jscall "%0.concat(%1)" (Ptr -> Ptr -> JS_IO Ptr) 24 | (unpack arr) (unpack arr') 25 | pure $ MkJSObject res 26 | 27 | ||| Inserts a JavaScript value at position `idx`. Modifies the original value. 28 | ||| @ idx insert position. 29 | insert : (idx : Nat) -> JSValue t -> JSValue JSArray -> JS_IO (JSValue JSArray) 30 | insert idx val arr = do 31 | jscall "%0[%1] = %2" (Ptr -> Int -> Ptr -> JS_IO ()) 32 | (unpack arr) (cast idx) (unpack val) 33 | pure arr 34 | 35 | ||| Returns the position of `val` in the array `arr`. Returns -1 36 | ||| if `val` is not present. 37 | indexOf : (val : JSValue a) -> (arr : JSValue JSArray) -> JS_IO Int 38 | indexOf val arr = 39 | jscall "%0.indexOf(%1)" (Ptr -> Ptr -> JS_IO Int) 40 | (unpack arr) (unpack val) 41 | 42 | ||| Flatten nested arrays. 43 | join : JSValue JSArray -> JS_IO (JSValue JSArray) 44 | join arr = do 45 | res <- jscall "%0.join()" (Ptr -> JS_IO Ptr) (unpack arr) 46 | pure $ MkJSObject res 47 | 48 | ||| Reverse an array. Modifies the original value. 49 | reverse : JSValue JSArray -> JS_IO (JSValue JSArray) 50 | reverse arr = do 51 | res <- jscall "%0.reverse()" (Ptr -> JS_IO Ptr) (unpack arr) 52 | pure $ MkJSObject res 53 | 54 | ||| Sort an array. Modifies the original value. 55 | sort : JSValue JSArray -> JS_IO (JSValue JSArray) 56 | sort arr = do 57 | res <- jscall "%0.sort()" (Ptr -> JS_IO Ptr) (unpack arr) 58 | pure $ MkJSObject res 59 | 60 | ||| Pushes the value `val` to the end of a array. Modifies original value. 61 | push : JSValue JSArray -> (val : JSValue t) -> JS_IO () 62 | push arr val = 63 | jscall "%0.push(%1)" (Ptr -> Ptr -> JS_IO ()) 64 | (unpack arr) (unpack val) 65 | 66 | ||| Pops a value from a the end of an array. Modifies the original value. 67 | pop : JSValue JSArray -> JS_IO (Maybe (t : JSType ** JSValue t)) 68 | pop arr = do 69 | elm <- jscall "%0.pop()" (Ptr -> JS_IO Ptr) (unpack arr) 70 | case !(typeOf elm) of 71 | JSUndefined => pure Nothing 72 | _ => pure $ Just !(pack elm) 73 | 74 | infixl 6 !! 75 | (!!) : JSValue JSArray -> (idx : Nat) -> JS_IO (Maybe (t : JSType ** JSValue t)) 76 | arr !! idx = do 77 | elm <- jscall "%0[%1]" (Ptr -> Int -> JS_IO Ptr) 78 | (unpack arr) (cast idx) 79 | case !(typeOf elm) of 80 | JSUndefined => pure Nothing 81 | _ => pure $ Just !(pack elm) 82 | 83 | ||| Pops an element from the front of an array. Modifies the original value. 84 | shift : JSValue JSArray -> JS_IO (Maybe (t ** JSValue t)) 85 | shift arr = do 86 | elm <- jscall "%0.shift()" (Ptr -> JS_IO Ptr) (unpack arr) 87 | case !(typeOf elm) of 88 | JSUndefined => pure Nothing 89 | _ => pure $ Just !(pack elm) 90 | 91 | ||| Pushes an element to the front of an array. Modifies the original value. 92 | unshift : JSValue JSArray -> JSValue a -> JS_IO Nat 93 | unshift arr val = do 94 | res <- jscall "%0.unshift(%1)" (Ptr -> Ptr -> JS_IO Int) 95 | (unpack arr) (unpack val) 96 | pure $ cast {to=Nat} res 97 | 98 | ||| Return the head element of an array. 99 | head : JSValue JSArray -> JS_IO (Maybe (t ** JSValue t)) 100 | head arr = do 101 | elm <- jscall "%0[0]" (Ptr -> JS_IO Ptr) (unpack arr) 102 | case !(typeOf elm) of 103 | JSUndefined => pure Nothing 104 | _ => pure $ Just !(pack elm) 105 | 106 | ||| Return the tail of an array. Returns an empty array in case 107 | ||| of an empty array. 108 | tail : JSValue JSArray -> JS_IO (JSValue JSArray) 109 | tail arr = do 110 | elm <- jscall 111 | """(function(arr) { 112 | return arr.slice(1, arr.length); 113 | })(%0)""" (Ptr -> JS_IO Ptr) (unpack arr) 114 | 115 | pure (MkJSObject elm) 116 | 117 | ||| Slices out an array form position `form` to `to`. Modifies original value. 118 | slice : JSValue JSArray -> (from : Int) -> (to : Int) -> JS_IO (JSValue JSArray) 119 | slice arr from to = do 120 | res <- jscall "%0.slice(%1,%2)" (Ptr -> Int -> Int -> JS_IO Ptr) 121 | (unpack arr) from to 122 | pure $ MkJSObject res 123 | 124 | ||| Creates an array with a single element. 125 | singleton : JSValue t -> JS_IO (JSValue JSArray) 126 | singleton val = do 127 | arr <- jscall "[%0]" (Ptr -> JS_IO Ptr) (unpack val) 128 | pure $ MkJSObject arr 129 | 130 | ||| Return the length of an array. 131 | length : JSValue JSArray -> JS_IO Nat 132 | length arr = do 133 | len <- jscall "%0.length" (Ptr -> JS_IO Int) (unpack arr) 134 | pure $ cast len 135 | 136 | ||| Runs an `JS_IO` action for every element of an array. 137 | forEach : (JSRef -> JS_IO ()) -> JSValue JSArray -> JS_IO () 138 | forEach f arr = 139 | jscall "(function(arr,f){for(var i=0;i JsFn (Ptr -> JS_IO ()) -> JS_IO ()) 141 | (unpack arr) (MkJsFn f) 142 | 143 | ||| Creates an arry from a `Traversable` data structure. 144 | toJSArray : (Traversable f, ToJS from to) => f from -> JS_IO (JSValue JSArray) 145 | toJSArray {from} {to} xs = do 146 | arr <- empty 147 | traverse_ (\x => arr `push` (toJS {from} {to} x)) xs 148 | pure arr 149 | -------------------------------------------------------------------------------- /IdrisScript.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript 2 | 3 | %access public export 4 | 5 | JSRef : Type 6 | JSRef = Ptr 7 | 8 | %inline 9 | jscall : (fname : String) -> (ty : Type) -> 10 | {auto fty : FTy FFI_JS [] ty} -> ty 11 | jscall fname ty = foreign FFI_JS fname ty 12 | 13 | data JSType = JSNumber 14 | | JSString 15 | | JSBoolean 16 | | JSFunction 17 | | JSNull 18 | | JSObject String 19 | | JSUndefined 20 | 21 | implementation Eq JSType where 22 | JSNumber == JSNumber = True 23 | JSString == JSString = True 24 | JSBoolean == JSBoolean = True 25 | JSFunction == JSFunction = True 26 | JSNull == JSNull = True 27 | (JSObject c) == (JSObject c') = c == c' 28 | JSUndefined == JSUndefined = True 29 | _ == _ = False 30 | 31 | data JSValue : JSType -> Type where 32 | MkJSNumber : JSRef -> JSValue JSNumber 33 | MkJSString : JSRef -> JSValue JSString 34 | MkJSBoolean : JSRef -> JSValue JSBoolean 35 | MkJSFunction : JSRef -> JSValue JSFunction 36 | MkJSNull : JSRef -> JSValue JSNull 37 | MkJSObject : JSRef -> JSValue (JSObject con) 38 | MkJSUndefined : JSRef -> JSValue JSUndefined 39 | 40 | JSArray : JSType 41 | JSArray = JSObject "Array" 42 | 43 | typeOf : JSRef -> JS_IO JSType 44 | typeOf JSRef = do 45 | res <- jscall checkType (Ptr -> JS_IO Int) JSRef 46 | case res of 47 | 0 => pure JSNumber 48 | 1 => pure JSString 49 | 2 => pure JSBoolean 50 | 3 => pure JSFunction 51 | 4 => pure JSUndefined 52 | 5 => pure (JSObject !ctrName) 53 | _ => pure JSNull 54 | where 55 | ctrName : JS_IO String 56 | ctrName = 57 | jscall "%0.constructor.name" (Ptr -> JS_IO String) JSRef 58 | 59 | checkType : String 60 | checkType = 61 | """(function(arg) { 62 | if (typeof arg == 'number') 63 | return 0; 64 | else if (typeof arg == 'string') 65 | return 1; 66 | else if (typeof arg == 'boolean') 67 | return 2; 68 | else if (typeof arg == 'function') 69 | return 3; 70 | else if (typeof arg == 'undefined') 71 | return 4; 72 | else if (typeof arg == 'object') 73 | return 5; 74 | else 75 | return 6; 76 | })(%0)""" 77 | 78 | interface ToJS from (to : JSType) where 79 | toJS : from -> JSValue to 80 | 81 | implementation ToJS String JSString where 82 | toJS str = MkJSString (believe_me str) 83 | 84 | implementation ToJS Int JSNumber where 85 | toJS num = MkJSNumber (believe_me num) 86 | 87 | implementation ToJS Double JSNumber where 88 | toJS num = MkJSNumber (believe_me num) 89 | 90 | implementation ToJS Bool JSBoolean where 91 | toJS False = MkJSBoolean (believe_me 0) 92 | toJS True = MkJSBoolean (believe_me 1) 93 | 94 | interface FromJS (from : JSType) to where 95 | fromJS : JSValue from -> to 96 | 97 | implementation FromJS JSString String where 98 | fromJS (MkJSString str) = believe_me str 99 | 100 | implementation FromJS JSNumber Int where 101 | fromJS (MkJSNumber num) = cast {from=Double} {to=Int} (believe_me num) 102 | 103 | implementation FromJS JSNumber Double where 104 | fromJS (MkJSNumber num) = believe_me num 105 | 106 | implementation FromJS JSBoolean Bool where 107 | fromJS (MkJSBoolean b) = check (believe_me b) 108 | where 109 | check : Int -> Bool 110 | check b = b >= 1 111 | 112 | ||| Unpacks a JavaScript value 113 | total 114 | unpack : JSValue t -> JSRef 115 | unpack (MkJSNumber JSRef) = JSRef 116 | unpack (MkJSString JSRef) = JSRef 117 | unpack (MkJSBoolean JSRef) = JSRef 118 | unpack (MkJSFunction JSRef) = JSRef 119 | unpack (MkJSNull JSRef) = JSRef 120 | unpack (MkJSObject JSRef) = JSRef 121 | unpack (MkJSUndefined JSRef) = JSRef 122 | 123 | ||| Packs up a JavaScript referenc into a JSValue 124 | pack : JSRef -> JS_IO (t ** JSValue t) 125 | pack JSRef = 126 | case !(typeOf JSRef) of 127 | JSNumber => pure (JSNumber ** MkJSNumber JSRef) 128 | JSString => pure (JSString ** MkJSString JSRef) 129 | JSBoolean => pure (JSBoolean ** MkJSBoolean JSRef) 130 | JSFunction => pure (JSFunction ** MkJSFunction JSRef) 131 | JSNull => pure (JSNull ** MkJSNull JSRef) 132 | JSObject c => pure (JSObject c ** MkJSObject JSRef) 133 | _ => pure (JSUndefined ** MkJSUndefined JSRef) 134 | 135 | ||| Log a value to console 136 | log : JSValue t -> JS_IO () 137 | log js = jscall "console.log(%0)" (Ptr -> JS_IO ()) (unpack js) 138 | 139 | ||| Check if a value is undefined 140 | isUndefined : JSValue t -> JS_IO Bool 141 | isUndefined val = do 142 | ty <- typeOf (unpack val) 143 | pure $ ty == JSUndefined 144 | 145 | ||| Check if a value is null 146 | isNull : JSValue t -> JS_IO Bool 147 | isNull val = do 148 | ty <- typeOf (unpack val) 149 | pure $ ty == JSNull 150 | 151 | ||| Create a new object with a constructor function 152 | ||| @ con constructor function 153 | ||| @ args constructor arguments 154 | new : (con : JSValue JSFunction) 155 | -> (args : JSValue JSArray) 156 | -> JS_IO (c ** JSValue (JSObject c)) 157 | new con args = do 158 | obj <- jscall """(function(con,args) { 159 | function Con(con, args) { 160 | return con.apply(this, args); 161 | } 162 | Con.prototype = con.prototype; 163 | return new Con(con, args); 164 | })(%0, %1)""" (Ptr -> Ptr -> JS_IO Ptr) 165 | (unpack con) (unpack args) 166 | pure $ (!(ctrName obj) ** MkJSObject obj) 167 | where 168 | ctrName : JSRef -> JS_IO String 169 | ctrName JSRef = 170 | jscall "%0.constructor.name" (Ptr -> JS_IO String) JSRef 171 | -------------------------------------------------------------------------------- /IdrisScript/Date.idr: -------------------------------------------------------------------------------- 1 | module IdrisScript.Date 2 | 3 | import IdrisScript 4 | import public IdrisScript.Date.Months 5 | import public IdrisScript.Date.Days 6 | import public IdrisScript.Date.Types 7 | 8 | %access public export 9 | 10 | Date : JS_IO (JSValue JSFunction) 11 | Date = do 12 | date <- jscall "Date" (JS_IO Ptr) 13 | pure $ MkJSFunction date 14 | 15 | JSDate : JSType 16 | JSDate = JSObject "Date" 17 | 18 | ||| Creates a new `Date` object with the current time. 19 | now : JS_IO (JSValue JSDate) 20 | now = do 21 | res <- jscall "new Date()" (JS_IO Ptr) 22 | pure $ MkJSObject res 23 | 24 | ||| Creates a new `Date` object from milliseconds. 25 | newDateFromMilliseconds : Milliseconds -> JS_IO (JSValue JSDate) 26 | newDateFromMilliseconds (MkMilliseconds millis) = do 27 | res <- jscall "new Date(%0)" (Int -> JS_IO Ptr) millis 28 | pure $ MkJSObject res 29 | 30 | ||| Creates a new `Date` object from a string. 31 | newDateFromString : String -> JS_IO (JSValue JSDate) 32 | newDateFromString str = do 33 | res <- jscall "new Date(%0)" (String -> JS_IO Ptr) str 34 | pure $ MkJSObject res 35 | 36 | ||| Copies a `Date` object. 37 | copyDate : (JSValue JSDate) -> JS_IO (JSValue JSDate) 38 | copyDate date = do 39 | res <- jscall "new Date(%0)" (Ptr -> JS_IO Ptr) (unpack date) 40 | pure $ MkJSObject res 41 | 42 | ||| Gets the day of `Date` object. 43 | getDay : JSValue JSDate -> JS_IO Day 44 | getDay date = do 45 | day <- jscall "%0.getDay()" (Ptr -> JS_IO Int) (unpack date) 46 | pure $ toDay day 47 | where 48 | toDay : Int -> Day 49 | toDay 1 = Monday 50 | toDay 2 = Tuesday 51 | toDay 3 = Wednesday 52 | toDay 4 = Thursday 53 | toDay 5 = Friday 54 | toDay 6 = Saturday 55 | toDay _ = Sunday 56 | 57 | ||| Gets the milliseconds from a `Date` object. 58 | getMilliseconds : JSValue JSDate -> JS_IO Milliseconds 59 | getMilliseconds date = do 60 | millis <- jscall "%0.getMilliseconds()" (Ptr -> JS_IO Int) (unpack date) 61 | pure $ MkMilliseconds millis 62 | 63 | ||| Sets the milliseconds from a `Date` object. Modifies the original date. 64 | setMilliseconds : JSValue JSDate -> Milliseconds -> JS_IO (JSValue JSDate) 65 | setMilliseconds date millis = do 66 | jscall "%0.getMilliseconds(%1)" (Ptr -> Int -> JS_IO Int) 67 | (unpack date) (unMilliseconds millis) 68 | pure date 69 | 70 | ||| Gets the month from a `Date` object. 71 | getMonth : JSValue JSDate -> JS_IO Month 72 | getMonth date = do 73 | month <- jscall "%0.getMonth()" (Ptr -> JS_IO Int) (unpack date) 74 | pure $ toMonth month 75 | where 76 | toMonth : Int -> Month 77 | toMonth 0 = January 78 | toMonth 1 = February 79 | toMonth 2 = March 80 | toMonth 3 = April 81 | toMonth 4 = May 82 | toMonth 5 = June 83 | toMonth 6 = July 84 | toMonth 7 = August 85 | toMonth 8 = September 86 | toMonth 9 = October 87 | toMonth 10 = November 88 | toMonth _ = December 89 | 90 | ||| Sets the month from a `Date` object. Modifies the original date. 91 | setMonth : JSValue JSDate -> Month -> JS_IO (JSValue JSDate) 92 | setMonth date month = do 93 | jscall "%0.setMonth(%1)" (Ptr -> Int -> JS_IO Int) 94 | (unpack date) (fromMonth month) 95 | pure date 96 | where 97 | fromMonth : Month -> Int 98 | fromMonth January = 0 99 | fromMonth February = 1 100 | fromMonth March = 2 101 | fromMonth April = 3 102 | fromMonth May = 4 103 | fromMonth June = 5 104 | fromMonth July = 6 105 | fromMonth August = 7 106 | fromMonth September = 8 107 | fromMonth October = 9 108 | fromMonth November = 10 109 | fromMonth December = 11 110 | 111 | ||| Gets the year from a `Date` object. 112 | getYear : JSValue JSDate -> JS_IO Int 113 | getYear date = jscall "%0.getYear()" (Ptr -> JS_IO Int) (unpack date) 114 | 115 | ||| Sets the year from a `Date` object. Modifies the original date. 116 | setYear : JSValue JSDate -> Year -> JS_IO (JSValue JSDate) 117 | setYear date year = do 118 | jscall "%0.setYear(%1)" (Ptr -> Int -> JS_IO Int) 119 | (unpack date) (unYear year) 120 | pure date 121 | 122 | ||| Gets the date from a `Date` object. 123 | getDate : JSValue JSDate -> JS_IO Date 124 | getDate date = do 125 | date' <- jscall "%0.getDate()" (Ptr -> JS_IO Int) (unpack date) 126 | pure $ MkDate date' 127 | 128 | ||| Sets the date from a `Date` object. Modifies the original date. 129 | setDate : JSValue JSDate -> Date -> JS_IO (JSValue JSDate) 130 | setDate date date' = do 131 | jscall "%0.setDate(%1)" (Ptr -> Int -> JS_IO Int) 132 | (unpack date) (unDate date') 133 | pure date 134 | 135 | ||| Gets the hours from a `Date` object. 136 | getHours : JSValue JSDate -> JS_IO Hours 137 | getHours date = do 138 | hours <- jscall "%0.getHours()" (Ptr -> JS_IO Int) (unpack date) 139 | pure $ MkHours hours 140 | 141 | ||| Sets the hours from a `Date` object. Modifies the original date. 142 | setHours : JSValue JSDate -> Hours -> JS_IO (JSValue JSDate) 143 | setHours date hours = do 144 | jscall "%0.setHours(%1)" (Ptr -> Int -> JS_IO Int) 145 | (unpack date) (unHours hours) 146 | pure date 147 | 148 | ||| Gets the minutes from a `Date` object. 149 | getMinutes : JSValue JSDate -> JS_IO Minutes 150 | getMinutes date = do 151 | minutes <- jscall "%0.getMinutes()" (Ptr -> JS_IO Int) (unpack date) 152 | pure $ MkMinutes minutes 153 | 154 | ||| Sets the minutes from a `Date` object. Modifies the original date. 155 | setMinutes : JSValue JSDate -> Minutes -> JS_IO (JSValue JSDate) 156 | setMinutes date mins = do 157 | jscall "%0.setMinutes(%1)" (Ptr -> Int -> JS_IO Int) 158 | (unpack date) (unMinutes mins) 159 | pure date 160 | 161 | ||| Gets the seconds from a `Date` object. 162 | getSeconds : JSValue JSDate -> JS_IO Seconds 163 | getSeconds date = do 164 | seconds <- jscall "%0.getSeconds()" (Ptr -> JS_IO Int) (unpack date) 165 | pure $ MkSeconds seconds 166 | 167 | ||| Sets the seconds from a `Date` object. Modifies the original date. 168 | setSeconds : JSValue JSDate -> Seconds -> JS_IO (JSValue JSDate) 169 | setSeconds date secs = do 170 | jscall "%0.setSeconds(%1)" (Ptr -> Int -> JS_IO Int) 171 | (unpack date) (unSeconds secs) 172 | pure date 173 | 174 | ||| Gets the full year of a `Date` object. 175 | getFullYear : JSValue JSDate -> JS_IO Year 176 | getFullYear date = do 177 | year <- jscall "%0.getFullYear()" (Ptr -> JS_IO Int) (unpack date) 178 | pure $ MkYear year 179 | 180 | ||| Sets the full year of a `Date` object. Modifies the original date. 181 | setFullYear : JSValue JSDate -> Year -> JS_IO (JSValue JSDate) 182 | setFullYear date year = do 183 | jscall "%0.setFullYear(%1)" (Ptr -> Int -> JS_IO Int) 184 | (unpack date) (unYear year) 185 | pure date 186 | --------------------------------------------------------------------------------