diff --git a/docs/home.hs b/docs/home.hs --- a/docs/home.hs +++ b/docs/home.hs @@ -88,13 +88,17 @@ -------------------------------------------------------------------------------- -- Window object +-- | Print something. +print :: Show a => a -> Fay () +print = consolelog . show + -- | Console log. -print :: (Show a,Foreign a) => a -> Fay () -print = foreignFay "console.log" FayNone +consolelog :: String -> Fay () +consolelog = ffi "console.log(%1)" FayNone -- | Pop-up an alert. alert :: String -> Fay () -alert = foreignFay "window.alert" FayNone +alert = ffi "window.alert(%1)" FayNone -------------------------------------------------------------------------------- -- DOM @@ -105,12 +109,12 @@ -- | The document. thedocument :: Element -thedocument = foreignValue "window.document" FayNone +thedocument = ffi "window.document" FayNone -- | Get the size of the given jquery array. getTagName :: Element -> Fay String -getTagName = foreignPropFay "tagName" FayString - +getTagName = ffi "%1['tagName']" FayString + -------------------------------------------------------------------------------- -- jQuery @@ -120,47 +124,47 @@ -- | Make a jQuery object out of an element. wrap :: [Element] -> JQuery -wrap = foreignPure "window['jQuery']" FayNone +wrap = ffi "window['jQuery'](%1)" FayNone -- | Bind a handler for when the element is ready. ready :: JQuery -> Fay () -> Fay () -ready = foreignMethodFay "ready" FayNone +ready = ffi "%1['ready'](%2)" FayNone -- | Bind a handler for when the element is ready. each :: JQuery -> (Double -> Element -> Fay ()) -> Fay () -each = foreignMethodFay "each" FayNone +each = ffi "%1['each'](%2)" FayNone -- | Query for elements. query :: String -> Fay JQuery -query = foreignFay "window['jQuery']" FayNone +query = ffi "window['jQuery'](%1)" FayNone -- | Set the text of the given object. setText :: JQuery -> String -> Fay () -setText = foreignMethodFay "text" FayNone +setText = ffi "%1['text'](%2)" FayNone -- | Set the text of the given object. attr :: JQuery -> String -> String -> Fay () -attr = foreignMethodFay "attr" FayNone +attr = ffi "%1['attr'](%2,%3)" FayNone -- | Set the click of the given object. setClick :: JQuery -> Fay () -> Fay () -setClick = foreignMethodFay "click" FayNone +setClick = ffi "%1['click'](%2)" FayNone -- | Toggle the visibility of an element, faded. fadeToggle :: JQuery -> Fay () -> Fay () -fadeToggle = foreignMethodFay "fadeToggle" FayNone +fadeToggle = ffi "%1['fadeToggle'](%2)" FayNone -- | Hide an element. hide :: JQuery -> Fay () -hide = foreignMethodFay "hide" FayNone +hide = ffi "%1['hide']()" FayNone -- | Add a class to the given object. addClass :: JQuery -> String -> Fay () -addClass = foreignMethodFay "addClass" FayNone +addClass = ffi "%1['addClass'](%2)" FayNone -- | Remove a class from the given object. removeClass :: JQuery -> String -> Fay () -removeClass = foreignMethodFay "removeClass" FayNone +removeClass = ffi "%1['removeClass'](%2)" FayNone -- | Swap the given classes on the object. swapClasses :: JQuery -> String -> String -> Fay () @@ -170,51 +174,51 @@ -- | Get the text of the given object. getText :: JQuery -> Fay String -getText = foreignMethodFay "text" FayString +getText = ffi "%1['text']()" FayString -- | Get the text of the given object. getIs :: JQuery -> String -> Fay Bool -getIs = foreignMethodFay "is" FayBool +getIs = ffi "%1['is'](%2)" FayBool -- | Get the size of the given jquery array. getSize :: JQuery -> Fay Double -getSize = foreignPropFay "length" FayNone +getSize = ffi "%1['length']" FayNone -- | Get the next of the given object. getNext :: JQuery -> Fay JQuery -getNext = foreignMethodFay "next" FayNone +getNext = ffi "%1['next']()" FayNone -- | Get the first of the given object. getFirst :: JQuery -> Fay JQuery -getFirst = foreignMethodFay "first" FayNone +getFirst = ffi "%1['first']()" FayNone -- | Get the find of the given object. getFind :: JQuery -> String -> Fay JQuery -getFind = foreignMethodFay "find" FayNone +getFind = ffi "%1['find'](%2)" FayNone -- | Prepend an element to this one. prepend :: JQuery -> JQuery -> Fay JQuery -prepend = foreignMethodFay "prepend" FayNone +prepend = ffi "%1['prepend'](%2)" FayNone -- | Append an element /after/ this one. after :: JQuery -> JQuery -> Fay JQuery -after = foreignMethodFay "after" FayNone +after = ffi "%1['after'](%2)" FayNone -- | Append an element to this one. append :: JQuery -> JQuery -> Fay JQuery -append = foreignMethodFay "append" FayNone +append = ffi "%1['append'](%2)" FayNone -- | Append this to an element. appendTo :: JQuery -> JQuery -> Fay JQuery -appendTo = foreignMethodFay "appendTo" FayNone +appendTo = ffi "%1['appendTo'](%2)" FayNone -- | Make a new element. makeElement :: String -> Fay JQuery -makeElement = foreignFay "window['jQuery']" FayNone +makeElement = ffi "window['jQuery'](%1)" FayNone -- | Get the width of the given object. getWidth :: JQuery -> Fay Double -getWidth = foreignMethodFay "width" FayNone +getWidth = ffi "%1['width']()" FayNone -------------------------------------------------------------------------------- -- Pretty printing / highlighting @@ -223,19 +227,19 @@ beautify :: String -- ^ The JS code. -> Double -- ^ The indentation level. -> String -- ^ The reformatted JS code. -beautify = foreignPure "$jsBeautify" FayString +beautify = ffi "$jsBeautify(%1,%2)" FayString data Highlighter instance Foreign Highlighter -- | Get the highlighter. hljs :: Highlighter -hljs = foreignValue "window['hljs']" FayNone +hljs = ffi "window['hljs']" FayNone -- | Init syntax highlighting on load. initHighlightingOnLoad :: Highlighter -> Fay () -initHighlightingOnLoad = foreignMethodFay "initHighlightingOnLoad" FayNone +initHighlightingOnLoad = ffi "%1['initHighlightingOnLoad']()" FayNone -- | Init syntax highlighting on load. setTabReplace :: Highlighter -> String -> Fay () -setTabReplace = foreignSetProp "tabReplace" +setTabReplace = ffi "%1['tabReplace']=%2" FayNone diff --git a/docs/home.js b/docs/home.js --- a/docs/home.js +++ b/docs/home.js @@ -365,7 +365,7 @@ */ -var main = new $(function(){return _(_($36$)(_(ready)(_(wrap)(Fay$$list([thedocument])))))(_(_(Fay$$then)(indentAndHighlight))(_(_(Fay$$then)(setupExpanders))(setupTableOfContents)));});var indentAndHighlight = new $(function(){return _(_(Fay$$bind)(_(query)(Fay$$list(".language-javascript"))))(function($_a){var samples = $_a;return _(_(Fay$$then)(_(_($36$)(_(each)(samples)))(function($_a){var i = $_a;return function($_b){var _$this = $_b;return (function(){var sample = new $(function(){return _(wrap)(Fay$$list([_$this]));});return _(_(Fay$$bind)(_(getText)(sample)))(function($_a){var text = $_a;return _(_(setText)(sample))(_(_(beautify)(text))(2));});})();};})))(_(_(Fay$$then)(_(_(setTabReplace)(hljs))(Fay$$list(" "))))(_(initHighlightingOnLoad)(hljs)));});});var setupExpanders = new $(function(){return _(_(Fay$$bind)(_(_(Fay$$bind)(_(query)(Fay$$list(".wrap"))))(getWidth)))(function($_a){var wrapwidth = $_a;return _(_(Fay$$bind)(_(query)(Fay$$list(".example"))))(function($_a){var examples = $_a;return _(_($36$)(_(each)(examples)))(function($_a){var i = $_a;return function($_b){var _$this = $_b;return _(_(Fay$$bind)(_(_(getFind)(_(wrap)(Fay$$list([_$this]))))(Fay$$list("tr"))))(function($_a){var tr = $_a;return _(_(Fay$$bind)(_(_(Fay$$bind)(_(_(getFind)(tr))(Fay$$list("td"))))(getFirst)))(function($_a){var left = $_a;return _(_(Fay$$then)(_(_(addClass)(left))(Fay$$list("left"))))(_(_(Fay$$bind)(_(getNext)(left)))(function($_a){var right = $_a;return _(_(Fay$$bind)(_(makeElement)(Fay$$list("Show JavaScript"))))(function($_a){var toggle = $_a;return _(_(Fay$$bind)(_(_($36$)(Fay$$return))(_(_(Fay$$bind)(_(_(getIs)(right))(Fay$$list(":visible"))))(function($_a){var visible = $_a;return _(visible) ? _(_(Fay$$then)(_(_(setText)(toggle))(Fay$$list("Hide JavaScript"))))(_(_(_(swapClasses)(toggle))(Fay$$list("toggle-hide")))(Fay$$list("toggle-show"))) : _(_(Fay$$then)(_(_(setText)(toggle))(Fay$$list("Show JavaScript"))))(_(_(_(swapClasses)(toggle))(Fay$$list("toggle-show")))(Fay$$list("toggle-hide")));}))))(function($_a){var toggleButton = $_a;return _(_(Fay$$then)(_(_($36$)(_(setClick)(toggle)))(_(_($36$)(_(fadeToggle)(right)))(toggleButton))))(_(_(Fay$$bind)(_(getWidth)(tr)))(function($_a){var width = $_a;return _(_(Fay$$then)(_(_($36$)(_(when)(_(width) > _(_(wrapwidth) + _(_(20 * _(wrapwidth)) / 100)))))(_(hide)(right))))(_(_(Fay$$then)(toggleButton))(_(_(Fay$$bind)(_(_(getFind)(left))(Fay$$list(".panel"))))(function($_a){var panel = $_a;return _(_(Fay$$then)(_(_(prepend)(panel))(toggle)))(_(Fay$$return)(Fay$$unit));})));}));});});}));});});};});});});});var setupTableOfContents = new $(function(){return _(_(Fay$$bind)(_(makeElement)(Fay$$list("

Table of Contents

"))))(function($_a){var toc = $_a;return _(_(Fay$$then)(_(_(Fay$$bind)(_(query)(Fay$$list(".subheadline"))))(_(_(flip)(after))(toc))))(_(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list(""))))(_(_(flip)(appendTo))(toc))))(function($_a){var ul = $_a;return _(_(Fay$$bind)(_(query)(Fay$$list("h2"))))(function($_a){var headings = $_a;return _(_($36$)(_(each)(headings)))(function($_a){var i = $_a;return function($_b){var heading = $_b;return (function(){var anchor = new $(function(){return _(_($43$$43$)(Fay$$list("section-")))(_(show)(i));});var h = new $(function(){return _(wrap)(Fay$$list([heading]));});return _(_(Fay$$then)(_(_(_(attr)(h))(Fay$$list("id")))(anchor)))(_(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list("
  • "))))(_(_(flip)(appendTo))(ul))))(function($_a){var li = $_a;return _(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list(""))))(_(_(flip)(appendTo))(li))))(function($_a){var a = $_a;return _(_(Fay$$then)(_(_(Fay$$bind)(_(getText)(h)))(_(setText)(a))))(_(_(Fay$$then)(_(_(_(attr)(a))(Fay$$list("href")))(_(_($43$$43$)(Fay$$list("#")))(anchor))))(_(_(Fay$$bind)(_(getTagName)(heading)))(_(addClass)(li))));});}));})();};});});}));});});var print = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",console.log(Fay$$serialize(UnknownType,$_a))));});};var alert = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",window.alert(Fay$$serialize(StringType,$_a))));});};var thedocument = new $(function(){return Fay$$unserialize("",window.document);});var getTagName = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("string",_($_a)['tagName']));});};var wrap = function($_a){return new $(function(){return Fay$$unserialize("",window['jQuery'](Fay$$serialize(ListType,$_a)));});};var ready = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['ready'](Fay$$serialize(JsType,$_b))));});};};var each = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['each'](Fay$$serialize(UnknownType,$_b))));});};};var query = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",window['jQuery'](Fay$$serialize(StringType,$_a))));});};var setText = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['text'](Fay$$serialize(StringType,$_b))));});};};var attr = function($_a){return function($_b){return function($_c){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['attr'](Fay$$serialize(StringType,$_b),Fay$$serialize(StringType,$_c))));});};};};var setClick = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['click'](Fay$$serialize(JsType,$_b))));});};};var fadeToggle = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['fadeToggle'](Fay$$serialize(JsType,$_b))));});};};var hide = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['hide']()));});};var addClass = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['addClass'](Fay$$serialize(StringType,$_b))));});};};var removeClass = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['removeClass'](Fay$$serialize(StringType,$_b))));});};};var swapClasses = function($_a){return function($_b){return function($_c){return new $(function(){var removeme = $_c;var addme = $_b;var obj = $_a;return _(_(Fay$$then)(_(_(addClass)(obj))(addme)))(_(_(removeClass)(obj))(removeme));});};};};var getText = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("string",_($_a)['text']()));});};var getIs = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("bool",_($_a)['is'](Fay$$serialize(StringType,$_b))));});};};var getSize = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['length']));});};var getNext = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['next']()));});};var getFirst = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['first']()));});};var getFind = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['find'](Fay$$serialize(StringType,$_b))));});};};var prepend = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['prepend'](Fay$$serialize(UnknownType,$_b))));});};};var after = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['after'](Fay$$serialize(UnknownType,$_b))));});};};var append = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['append'](Fay$$serialize(UnknownType,$_b))));});};};var appendTo = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['appendTo'](Fay$$serialize(UnknownType,$_b))));});};};var makeElement = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",window['jQuery'](Fay$$serialize(StringType,$_a))));});};var getWidth = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['width']()));});};var beautify = function($_a){return function($_b){return new $(function(){return Fay$$unserialize("string",$jsBeautify(Fay$$serialize(StringType,$_a),Fay$$serialize(DoubleType,$_b)));});};};var hljs = new $(function(){return Fay$$unserialize("",window['hljs']);});var initHighlightingOnLoad = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['initHighlightingOnLoad']()));});};var setTabReplace = function($_a){return function($_b){return new $(function(){return new Fay$$Monad((_($_a)['tabReplace'] = Fay$$serialize(StringType,$_b)));});};};var DateType = new $(function(){return [new Fay$$Constructor("DateType")];});var FunctionType = new $(function(){return [new Fay$$Constructor("FunctionType")];});var JsType = new $(function(){return [new Fay$$Constructor("JsType")];});var StringType = new $(function(){return [new Fay$$Constructor("StringType")];});var DoubleType = new $(function(){return [new Fay$$Constructor("DoubleType")];});var ListType = new $(function(){return [new Fay$$Constructor("ListType")];});var BoolType = new $(function(){return [new Fay$$Constructor("BoolType")];});var UnknownType = new $(function(){return [new Fay$$Constructor("UnknownType")];});var Just = function(slot1){return new $(function(){return [new Fay$$Constructor("Just"),slot1];});};var Nothing = new $(function(){return [new Fay$$Constructor("Nothing")];});var show = function($_a){return new $(function(){return Fay$$unserialize("string",Fay$$encodeShow(Fay$$serialize(UnknownType,$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {var p = $_a;return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {var p = $_a;return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var _$null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var GT = new $(function(){return [new Fay$$Constructor("GT")];});var LT = new $(function(){return [new Fay$$Constructor("LT")];});var EQ = new $(function(){return [new Fay$$Constructor("EQ")];});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if ((_($tmp))[0].name === "GT") {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_(Fay$$then)(m))(_(Fay$$return)(Fay$$unit)) : _(Fay$$return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if ((_($_c))[0].name === "Nothing") {var f = $_b;var m = $_a;return m;}if ((_($_c))[0].name === "Just") {var x = (_($_c))[1];var f = $_b;var m = $_a;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;var f = $_a;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;var f = $_a;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$then)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _(Fay$$return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_(Fay$$then)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _(Fay$$return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};}; +var main = new $(function(){return _(_($36$)(_(ready)(_(wrap)(Fay$$list([thedocument])))))(_(_(Fay$$then)(indentAndHighlight))(_(_(Fay$$then)(setupExpanders))(setupTableOfContents)));});var indentAndHighlight = new $(function(){return _(_(Fay$$bind)(_(query)(Fay$$list(".language-javascript"))))(function($_a){var samples = $_a;return _(_(Fay$$then)(_(_($36$)(_(each)(samples)))(function($_a){var i = $_a;return function($_b){var _$this = $_b;return (function(){var sample = new $(function(){return _(wrap)(Fay$$list([_$this]));});return _(_(Fay$$bind)(_(getText)(sample)))(function($_a){var text = $_a;return _(_(setText)(sample))(_(_(beautify)(text))(2));});})();};})))(_(_(Fay$$then)(_(_(setTabReplace)(hljs))(Fay$$list(" "))))(_(initHighlightingOnLoad)(hljs)));});});var setupExpanders = new $(function(){return _(_(Fay$$bind)(_(_(Fay$$bind)(_(query)(Fay$$list(".wrap"))))(getWidth)))(function($_a){var wrapwidth = $_a;return _(_(Fay$$bind)(_(query)(Fay$$list(".example"))))(function($_a){var examples = $_a;return _(_($36$)(_(each)(examples)))(function($_a){var i = $_a;return function($_b){var _$this = $_b;return _(_(Fay$$bind)(_(_(getFind)(_(wrap)(Fay$$list([_$this]))))(Fay$$list("tr"))))(function($_a){var tr = $_a;return _(_(Fay$$bind)(_(_(Fay$$bind)(_(_(getFind)(tr))(Fay$$list("td"))))(getFirst)))(function($_a){var left = $_a;return _(_(Fay$$then)(_(_(addClass)(left))(Fay$$list("left"))))(_(_(Fay$$bind)(_(getNext)(left)))(function($_a){var right = $_a;return _(_(Fay$$bind)(_(makeElement)(Fay$$list("Show JavaScript"))))(function($_a){var toggle = $_a;return _(_(Fay$$bind)(_(_($36$)(Fay$$return))(_(_(Fay$$bind)(_(_(getIs)(right))(Fay$$list(":visible"))))(function($_a){var visible = $_a;return _(visible) ? _(_(Fay$$then)(_(_(setText)(toggle))(Fay$$list("Hide JavaScript"))))(_(_(_(swapClasses)(toggle))(Fay$$list("toggle-hide")))(Fay$$list("toggle-show"))) : _(_(Fay$$then)(_(_(setText)(toggle))(Fay$$list("Show JavaScript"))))(_(_(_(swapClasses)(toggle))(Fay$$list("toggle-show")))(Fay$$list("toggle-hide")));}))))(function($_a){var toggleButton = $_a;return _(_(Fay$$then)(_(_($36$)(_(setClick)(toggle)))(_(_($36$)(_(fadeToggle)(right)))(toggleButton))))(_(_(Fay$$bind)(_(getWidth)(tr)))(function($_a){var width = $_a;return _(_(Fay$$then)(_(_($36$)(_(when)(_(width) > _(_(wrapwidth) + _(_(20 * _(wrapwidth)) / 100)))))(_(hide)(right))))(_(_(Fay$$then)(toggleButton))(_(_(Fay$$bind)(_(_(getFind)(left))(Fay$$list(".panel"))))(function($_a){var panel = $_a;return _(_(Fay$$then)(_(_(prepend)(panel))(toggle)))(_(Fay$$return)(Fay$$unit));})));}));});});}));});});};});});});});var setupTableOfContents = new $(function(){return _(_(Fay$$bind)(_(makeElement)(Fay$$list("

    Table of Contents

    "))))(function($_a){var toc = $_a;return _(_(Fay$$then)(_(_(Fay$$bind)(_(query)(Fay$$list(".subheadline"))))(_(_(flip)(after))(toc))))(_(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list(""))))(_(_(flip)(appendTo))(toc))))(function($_a){var ul = $_a;return _(_(Fay$$bind)(_(query)(Fay$$list("h2"))))(function($_a){var headings = $_a;return _(_($36$)(_(each)(headings)))(function($_a){var i = $_a;return function($_b){var heading = $_b;return (function(){var anchor = new $(function(){return _(_($43$$43$)(Fay$$list("section-")))(_(show)(i));});var h = new $(function(){return _(wrap)(Fay$$list([heading]));});return _(_(Fay$$then)(_(_(_(attr)(h))(Fay$$list("id")))(anchor)))(_(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list("
  • "))))(_(_(flip)(appendTo))(ul))))(function($_a){var li = $_a;return _(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list(""))))(_(_(flip)(appendTo))(li))))(function($_a){var a = $_a;return _(_(Fay$$then)(_(_(Fay$$bind)(_(getText)(h)))(_(setText)(a))))(_(_(Fay$$then)(_(_(_(attr)(a))(Fay$$list("href")))(_(_($43$$43$)(Fay$$list("#")))(anchor))))(_(_(Fay$$bind)(_(getTagName)(heading)))(_(addClass)(li))));});}));})();};});});}));});});var print = new $(function(){return _(_($46$)(consolelog))(show);});var consolelog = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",console.log(Fay$$serialize(StringType,$_a))));});};var alert = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",window.alert(Fay$$serialize(StringType,$_a))));});};var thedocument = new $(function(){return Fay$$unserialize("",window.document);});var getTagName = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("string",_($_a)['tagName']));});};var wrap = function($_a){return new $(function(){return Fay$$unserialize("",window['jQuery'](Fay$$serialize(ListType,$_a)));});};var ready = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['ready'](Fay$$serialize(JsType,$_b))));});};};var each = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['each'](Fay$$serialize(FunctionType,$_b))));});};};var query = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",window['jQuery'](Fay$$serialize(StringType,$_a))));});};var setText = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['text'](Fay$$serialize(StringType,$_b))));});};};var attr = function($_a){return function($_b){return function($_c){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['attr'](Fay$$serialize(StringType,$_b),Fay$$serialize(StringType,$_c))));});};};};var setClick = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['click'](Fay$$serialize(JsType,$_b))));});};};var fadeToggle = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['fadeToggle'](Fay$$serialize(JsType,$_b))));});};};var hide = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['hide']()));});};var addClass = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['addClass'](Fay$$serialize(StringType,$_b))));});};};var removeClass = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['removeClass'](Fay$$serialize(StringType,$_b))));});};};var swapClasses = function($_a){return function($_b){return function($_c){return new $(function(){var removeme = $_c;var addme = $_b;var obj = $_a;return _(_(Fay$$then)(_(_(addClass)(obj))(addme)))(_(_(removeClass)(obj))(removeme));});};};};var getText = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("string",_($_a)['text']()));});};var getIs = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("bool",_($_a)['is'](Fay$$serialize(StringType,$_b))));});};};var getSize = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['length']));});};var getNext = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['next']()));});};var getFirst = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['first']()));});};var getFind = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['find'](Fay$$serialize(StringType,$_b))));});};};var prepend = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['prepend'](_($_b))));});};};var after = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['after'](_($_b))));});};};var append = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['append'](_($_b))));});};};var appendTo = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['appendTo'](_($_b))));});};};var makeElement = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",window['jQuery'](Fay$$serialize(StringType,$_a))));});};var getWidth = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['width']()));});};var beautify = function($_a){return function($_b){return new $(function(){return Fay$$unserialize("string",$jsBeautify(Fay$$serialize(StringType,$_a),Fay$$serialize(DoubleType,$_b)));});};};var hljs = new $(function(){return Fay$$unserialize("",window['hljs']);});var initHighlightingOnLoad = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['initHighlightingOnLoad']()));});};var setTabReplace = function($_a){return function($_b){return new $(function(){return new Fay$$Monad(Fay$$unserialize("",_($_a)['tabReplace']=Fay$$serialize(StringType,$_b)));});};};var DateType = new $(function(){return [new Fay$$Constructor("DateType")];});var FunctionType = new $(function(){return [new Fay$$Constructor("FunctionType")];});var JsType = new $(function(){return [new Fay$$Constructor("JsType")];});var StringType = new $(function(){return [new Fay$$Constructor("StringType")];});var DoubleType = new $(function(){return [new Fay$$Constructor("DoubleType")];});var ListType = new $(function(){return [new Fay$$Constructor("ListType")];});var BoolType = new $(function(){return [new Fay$$Constructor("BoolType")];});var UnknownType = new $(function(){return [new Fay$$Constructor("UnknownType")];});var Just = function(slot1){return new $(function(){return [new Fay$$Constructor("Just"),slot1];});};var Nothing = new $(function(){return [new Fay$$Constructor("Nothing")];});var show = function($_a){return new $(function(){return Fay$$unserialize("string",Fay$$encodeShow(_($_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {var p = $_a;return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {var p = $_a;return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var _$null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var GT = new $(function(){return [new Fay$$Constructor("GT")];});var LT = new $(function(){return [new Fay$$Constructor("LT")];});var EQ = new $(function(){return [new Fay$$Constructor("EQ")];});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if ((_($tmp))[0].name === "GT") {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_(Fay$$then)(m))(_(Fay$$return)(Fay$$unit)) : _(Fay$$return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if ((_($_c))[0].name === "Nothing") {var f = $_b;var m = $_a;return m;}if ((_($_c))[0].name === "Just") {var x = (_($_c))[1];var f = $_b;var m = $_a;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;var f = $_a;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;var f = $_a;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$then)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _(Fay$$return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_(Fay$$then)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _(Fay$$return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};}; // Exports this.main = main; diff --git a/docs/snippets/ffi.hs b/docs/snippets/ffi.hs --- a/docs/snippets/ffi.hs +++ b/docs/snippets/ffi.hs @@ -1,17 +1,17 @@ print :: Foreign a => a -> Fay () -print = foreignFay "window.console.log" "" +print = ffi "window.console.log(%1)" "" alert :: Foreign a => a -> Fay () -alert = foreignFay "window.alert" "" +alert = ffi "window.alert(%1)" "" getInnerHtml :: Element -> Fay String -getInnerHtml = foreignMethodFay "innerHTML" FayString +getInnerHtml = ffi "%1.innerHTML(%2)" FayString setInnerHtml :: Element -> String -> Fay () -setInnerHtml = foreignSetProp "innerHTML" +setInnerHtml = ffi "%1.innerHTML=%2" thedocument :: Element -thedocument = foreignValue "window.document" FayNone +thedocument = ffi "window.document" FayNone jquery :: Element -> JQuery -jquery = foreignPure "window.jQuery" FayNone +jquery = ffi "window.jQuery(%1)" FayNone diff --git a/examples/alert.hs b/examples/alert.hs --- a/examples/alert.hs +++ b/examples/alert.hs @@ -10,4 +10,4 @@ -- | Alert using window.alert. alert :: Foreign a => a -> Fay () -alert = foreignFay "window.alert" FayNone +alert = ffi "window.alert(%1)" FayNone diff --git a/examples/canvas.water.html b/examples/canvas.water.html deleted file mode 100644 --- a/examples/canvas.water.html +++ /dev/null @@ -1,10 +0,0 @@ - - - - Canvas demo -- water effect - - - - - - diff --git a/examples/canvaswater.hs b/examples/canvaswater.hs --- a/examples/canvaswater.hs +++ b/examples/canvaswater.hs @@ -55,11 +55,11 @@ -- | Add an event listener to an element. addEventListener :: (Foreign a,Eventable a) => a -> String -> Fay () -> Bool -> Fay () -addEventListener = foreignMethodFay "addEventListener" FayNone +addEventListener = ffi "%1['addEventListener'](%2,%3,%4)" FayNone -- | Get an element by its ID. getElementById :: String -> Fay Element -getElementById = foreignFay "document.getElementById" FayNone +getElementById = ffi "document['getElementById'](%1)" FayNone -------------------------------------------------------------------------------- -- Images @@ -70,11 +70,11 @@ -- | Make a new image. newImage :: Fay Image -newImage = foreignFay "new Image" FayNone +newImage = ffi "new Image()" FayNone -- | Make a new image. setSrc :: Image -> String -> Fay () -setSrc = foreignSetProp "src" +setSrc = ffi "%1['src'] = %2" FayNone -------------------------------------------------------------------------------- -- Canvas @@ -85,11 +85,11 @@ -- | Get an element by its ID. getContext :: Element -> String -> Fay Context -getContext = foreignMethodFay "getContext" FayNone +getContext = ffi "%1['getContext'](%2)" FayNone -- | Draw an image onto a canvas rendering context. drawImage :: Context -> Image -> Double -> Double -> Fay () -drawImage = foreignMethodFay "drawImage" FayNone +drawImage = ffi "%1['drawImage'](%2,%3,%4)" FayNone -- | Draw an image onto a canvas rendering context. -- @@ -101,15 +101,15 @@ drawImageSpecific :: Context -> Image -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> Fay () -drawImageSpecific = foreignMethodFay "drawImage" FayNone +drawImageSpecific = ffi "%1['drawImage'](%2,%3,%4,%5,%6,%7,%8,%9,%10)" FayNone -- | Set the fill style. setFillStyle :: Context -> String -> Fay () -setFillStyle = foreignSetProp "fillStyle" +setFillStyle = ffi "%1['fillStyle']=%2" FayNone -- | Set the fill style. setFillRect :: Context -> Double -> Double -> Double -> Double -> Fay () -setFillRect = foreignMethodFay "fillRect" FayNone +setFillRect = ffi "%1['fillRect'](%2,%3,%4,%5)" FayNone -------------------------------------------------------------------------------- -- Ref @@ -120,35 +120,35 @@ -- | Make a new mutable reference. newRef :: Foreign a => a -> Fay (Ref a) -newRef = foreignFay "new Fay$$Ref" FayNone +newRef = ffi "new Fay$$Ref(%1)" FayNone -- | Replace the value in the mutable reference. writeRef :: Foreign a => Ref a -> a -> Fay () -writeRef = foreignFay "Fay$$writeRef" FayNone +writeRef = ffi "Fay$$writeRef(%1,%2)" FayNone -- | Get the referred value from the mutable value. readRef :: Foreign a => Ref a -> Fay a -readRef = foreignFay "Fay$$readRef" FayNone +readRef = ffi "Fay$$readRef(%1)" FayNone -------------------------------------------------------------------------------- -- Misc -- | Alert using window.alert. alert :: Foreign a => a -> Fay () -alert = foreignFay "window.alert" FayNone +alert = ffi "window['alert'](%1)" FayNone -- | Alert using window.alert. print :: Double -> Fay () -print = foreignFay "console.log" FayNone +print = ffi "console['log'](%1)" FayNone -- | Alert using window.alert. log :: String -> Fay () -log = foreignFay "console.log" FayNone +log = ffi "console['log'](%1)" FayNone -- | Alert using window.alert. sin :: Double -> Double -sin = foreignPure "Math.sin" FayNone +sin = ffi "window.Math['sin'](%1)" FayNone -- | Alert using window.alert. setInterval :: Fay () -> Double -> Fay () -setInterval = foreignFay "window.setInterval" FayNone +setInterval = ffi "window['setInterval'](%1,%2)" FayNone diff --git a/examples/canvaswater.html b/examples/canvaswater.html new file mode 100644 --- /dev/null +++ b/examples/canvaswater.html @@ -0,0 +1,10 @@ + + + + Canvas demo -- water effect + + + + + + diff --git a/examples/console.hs b/examples/console.hs --- a/examples/console.hs +++ b/examples/console.hs @@ -9,4 +9,4 @@ -- | Print using console.log. print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print = ffi "console.log(%1)" FayNone diff --git a/examples/data.hs b/examples/data.hs --- a/examples/data.hs +++ b/examples/data.hs @@ -18,4 +18,4 @@ main = print (show (Foo 123 "abc" Bar)) print :: String -> Fay () -print = foreignFay "console.log" FayNone +print = ffi "console.log(%1)" FayNone diff --git a/examples/dom.hs b/examples/dom.hs --- a/examples/dom.hs +++ b/examples/dom.hs @@ -14,17 +14,14 @@ result <- documentGetElements "body" print result -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone data Element instance Foreign Element documentGetElements :: String -> Fay [Element] -documentGetElements = - foreignFay "document.getElementsByTagName" - FayArray +documentGetElements = ffi "document.getElementsByTagName(%1)" FayArray addEventListener :: String -> Fay () -> Bool -> Fay () -addEventListener = - foreignFay "window.addEventListener" FayNone +addEventListener = ffi "window['addEventListener'](%1,%2,%3)" FayNone diff --git a/examples/ref.hs b/examples/ref.hs --- a/examples/ref.hs +++ b/examples/ref.hs @@ -11,21 +11,22 @@ main :: Fay () main = do ref <- newRef "Hello, World!" - readRef ref >>= print + x <- readRef ref writeRef ref "Hai!" readRef ref >>= print -print :: String -> Fay () -print = foreignFay "console.log" "" - data Ref a +instance Show (Ref a) instance Foreign a => Foreign (Ref a) newRef :: Foreign a => a -> Fay (Ref a) -newRef = foreignFay "new Fay$$Ref" FayNone +newRef = ffi "new Fay$$Ref(%1)" FayNone writeRef :: Foreign a => Ref a -> a -> Fay () -writeRef = foreignFay "Fay$$writeRef" FayNone +writeRef = ffi "Fay$$writeRef(%1,%2)" FayNone readRef :: Foreign a => Ref a -> Fay a -readRef = foreignFay "Fay$$readRef" FayNone +readRef = ffi "Fay$$readRef(%1)" FayNone + +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/fay.cabal b/fay.cabal --- a/fay.cabal +++ b/fay.cabal @@ -1,5 +1,5 @@ name: fay -version: 0.3.1.1 +version: 0.4.0.1 synopsis: A compiler for Fay, a Haskell subset that compiles to JavaScript. description: Fay is a proper subset of Haskell which can be compiled (type-checked) with GHC, and compiled to JavaScript. It is lazy, pure, with a Fay monad, @@ -22,7 +22,8 @@ . /Release Notes/ . - * Fix FFI detection. + * Collapse all the FFI types by using the type signature instead using UHC + approach. Check the docs and examples. . See full history at: homepage: http://fay-lang.org/ @@ -39,7 +40,7 @@ src/Language/Fay/Stdlib.hs extra-source-files: examples/ref.hs examples/alert.hs examples/console.hs examples/dom.hs examples/tailrecursive.hs examples/data.hs examples/canvaswater.hs - examples/canvas.water.html examples/haskell.png + examples/canvaswater.html examples/haskell.png -- Test cases tests/10 tests/10.hs tests/11 tests/11.hs tests/12 tests/12.hs tests/13 tests/13.hs tests/14 tests/14.hs tests/15 tests/15.hs tests/16 tests/16.hs @@ -78,6 +79,8 @@ json, pretty-show, data-default, + safe, + language-javascript, -- Requirements for the executables which -- `cabal-dev ghci' needs. @@ -99,7 +102,9 @@ haskell-src-exts, json, process, - data-default + data-default, + safe, + language-javascript executable fay-tests hs-source-dirs: src @@ -114,7 +119,9 @@ process, filepath, directory, - data-default + data-default, + safe, + language-javascript executable fay-docs hs-source-dirs: src @@ -133,4 +140,6 @@ blaze-markup, bytestring, time, - data-default + data-default, + safe, + language-javascript diff --git a/hs/stdlib.hs b/hs/stdlib.hs --- a/hs/stdlib.hs +++ b/hs/stdlib.hs @@ -13,7 +13,7 @@ | Nothing show :: (Foreign a,Show a) => a -> String -show = foreignPure "Fay$$encodeShow" FayString +show = ffi "Fay$$encodeShow(%1)" FayString -- There is only Double in JS. fromInteger x = x diff --git a/src/Language/Fay.hs b/src/Language/Fay.hs --- a/src/Language/Fay.hs +++ b/src/Language/Fay.hs @@ -14,19 +14,23 @@ where -import Language.Fay.Print () -import Language.Fay.Types +import Language.Fay.Print () +import Language.Fay.Types -import Control.Applicative -import Control.Monad.Error -import Control.Monad.IO -import Control.Monad.State -import Data.List -import Data.Maybe -import Data.String -import Language.Haskell.Exts -import System.Process.Extra +import Control.Applicative +import Control.Monad.Error +import Control.Monad.IO +import Control.Monad.State +import Data.Char +import Data.List +import Data.Maybe +import Data.String +import Language.Haskell.Exts +import Safe +import qualified Language.JavaScript.Parser as JS +import System.Process.Extra + -------------------------------------------------------------------------------- -- Top level entry points @@ -150,120 +154,81 @@ compilePatBind toplevel sig pat = do case pat of PatBind _ (PVar ident) Nothing (UnGuardedRhs rhs) (BDecls []) -> - case ffiExp rhs <|> ffiProp rhs of - Just detail@(binding,_,_) -> - case sig of - Nothing -> compileNormalPatBind toplevel ident rhs - Just sig -> case () of - () | func binding -> compileFFIFunc sig ident detail - | method binding -> compileFFIMethod sig ident detail - | setprop binding -> compileFFISetProp sig ident detail - | otherwise -> throwError (FfiNeedsTypeSig pat) + case ffiExp rhs of + Just (formatstr,typ) -> case sig of + Just sig -> compileFFI ident formatstr typ sig + Nothing -> throwError (FfiNeedsTypeSig pat) _ -> compileNormalPatBind toplevel ident rhs _ -> throwError (UnsupportedDeclaration pat) - where func = flip elem ["foreignFay","foreignPure","foreignValue"] - method = flip elem ["foreignMethodFay","foreignProp","foreignPropFay","foreignMethod"] - setprop = flip elem ["foreignSetProp"] - - ffiExp (App (App (Var (UnQual (Ident ident))) - (Lit (String name))) + where ffiExp (App (App (Var (UnQual (Ident "ffi"))) + (Lit (String formatstr))) (Con (UnQual (Ident (reads -> [(typ,"")]))))) - | func ident || method ident || setprop ident = Just (ident,name,typ) + = Just (formatstr,typ) ffiExp _ = Nothing - ffiProp (App (Var (UnQual (Ident ident))) - (Lit (String name))) - | func ident || method ident || setprop ident = Just (ident,name,FayNone) - ffiProp _ = Nothing - --- | Compile a normal simple pattern binding. -compileNormalPatBind :: Bool -> Name -> Exp -> Compile [JsStmt] -compileNormalPatBind toplevel ident rhs = do - body <- compileExp rhs - bind <- bindToplevel toplevel (UnQual ident) (thunk body) - return [bind] - --- | Compile a foreign function. -compileFFIFunc :: Type -> Name -> (String,String,FayReturnType) -> Compile [JsStmt] -compileFFIFunc sig ident detail@(_,name,_) = do - let args = zipWith const uniqueNames [1..typeArity sig] - compileFFI sig ident detail (JsRawName name) args args - --- | Compile a foreign method. -compileFFIMethod :: Type -> Name -> (String,String,FayReturnType) -> Compile [JsStmt] -compileFFIMethod sig ident detail@(_,name,_) = do - let args = zipWith const uniqueNames [1..typeArity sig] - jsargs = drop 1 args - obj = head args - compileFFI sig ident detail (JsGetPropExtern (force (JsName obj)) (fromString name)) args jsargs - --- | Compile a foreign method. -compileFFISetProp :: Type -> Name -> (String,String,FayReturnType) -> Compile [JsStmt] -compileFFISetProp sig ident detail@(_,name,_) = do - let args = zipWith const uniqueNames [1..typeArity sig] - jsargs = drop 1 args - obj = head args - compileFFI sig - ident - detail - (JsUpdatePropExtern (force (JsName obj)) - (fromString name) - (serialize (head (tail funcTypes)) - (JsName (head jsargs)))) - args - [] - - where funcTypes = functionTypeArgs sig - -- | Compile an FFI call. -compileFFI :: Type - -> Name - -> (String,String,FayReturnType) - -> JsExp - -> [JsName] - -> [JsName] +compileFFI :: Name -- ^ Name of the to-be binding. + -> String -- ^ The format string. + -> FayReturnType -- ^ The return type. + -> Type -- ^ Type signature. -> Compile [JsStmt] -compileFFI sig ident (binding,_,typ) exp params args = do - let innerexp - | length args == 0 && elem binding ["foreignProp","foreignPropFay","foreignValue"] = exp - | binding == "foreignSetProp" = exp - | otherwise = JsApp exp - (map (\(typ,name) -> serialize typ (JsName name)) - (zip types args)) - bind <- bindToplevel True - (UnQual ident) - (foldr (\name inner -> JsFun [name] [] (Just inner)) - (thunk - (maybeMonad - (if binding == "foreignSetProp" - then innerexp - else unserialize typ innerexp))) - params) - return [bind] - - where (maybeMonad,types) | binding == "foreignFay" = (monad,funcTypes) - | binding == "foreignProp" = (id,drop 1 funcTypes) - | binding == "foreignMethodFay" = (monad,drop 1 funcTypes) - | binding == "foreignPropFay" = (monad,drop 1 funcTypes) - | binding == "foreignMethod" = (id,drop 1 funcTypes) - | binding == "foreignSetProp" = (monad,[]) - | otherwise = (id,funcTypes) - funcTypes = functionTypeArgs sig +compileFFI name formatstr returnType sig = do + inner <- formatFFI formatstr (zip params funcArgTypes) + case JS.parse (printJS (wrapReturn inner)) (prettyPrint name) of + Left err -> throwError (FfiFormatInvalidJavaScript inner err) + Right{} -> fmap return (bindToplevel True (UnQual name) (body inner)) + + where body inner = foldr wrapParam (wrapReturn inner) params + wrapParam name inner = JsFun [name] [] (Just inner) + params = zipWith const uniqueNames [1..typeArity sig] + wrapReturn inner = thunk $ + case lastMay funcArgTypes of + -- Fay action: + Just JsType -> monad (unserialize returnType (JsRawExp inner)) + -- Returns a “pure” value; + Just{} -> unserialize returnType (JsRawExp inner) + -- Base case: + Nothing -> JsRawExp inner + funcArgTypes = functionTypeArgs sig --- | These are the data types that are serializable directly to native --- JS data types. Strings, floating points and arrays. The others are: --- actiosn in the JS monad, which are thunks that shouldn't be forced --- when serialized but wrapped up as JS zero-arg functions, and --- unknown types can't be converted but should at least be forced. -data ArgType = FunctionType | JsType | StringType | DoubleType | ListType | BoolType | UnknownType - deriving (Show,Eq) +-- | Format the FFI format string with the given arguments. +formatFFI :: String -- ^ The format string. + -> [(JsParam,ArgType)] -- ^ Arguments. + -> Compile String -- ^ The JS code. +formatFFI formatstr args = go formatstr where + go ('%':'*':xs) = do + these <- mapM inject (zipWith const [1..] args) + rest <- go xs + return (intercalate "," these ++ rest) + go ('%':'%':xs) = do + rest <- go xs + return ('%' : rest) + go ['%'] = throwError FfiFormatIncompleteArg + go ('%':(span isDigit -> (op,xs))) = do + case readMay op of + Nothing -> throwError (FfiFormatBadChars op) + Just n -> do + this <- inject n + rest <- go xs + return (this ++ rest) + go (x:xs) = do rest <- go xs + return (x : rest) + go [] = return [] + + inject n = + case listToMaybe (drop (n-1) args) of + Nothing -> throwError (FfiFormatNoSuchArg n) + Just (arg,typ) -> do + return (printJS (serialize typ (JsName arg))) -- | Serialize a value to native JS, if possible. serialize :: ArgType -> JsExp -> JsExp serialize typ exp = - JsApp (JsName (hjIdent "serialize")) - [JsName (fromString (show typ)),exp] + case typ of + UnknownType -> force exp + _ -> JsApp (JsName (hjIdent "serialize")) + [JsName (fromString (show typ)),exp] -- | Get arg types of a function type. functionTypeArgs :: Type -> [ArgType] @@ -272,26 +237,36 @@ TyForall _ _ i -> functionTypeArgs i TyFun a b -> argType a : functionTypeArgs b TyParen st -> functionTypeArgs st - _ -> [] + r -> [argType r] - where argType t = - case t of - TyApp (TyCon "Fay") _ -> JsType - TyCon "String" -> StringType - TyCon "Double" -> DoubleType - TyCon "Bool" -> BoolType - TyFun{} -> FunctionType - TyList _ -> ListType - _ -> UnknownType +-- | Convert a Haskell type to an internal FFI representation. +argType :: Type -> ArgType +argType t = + case t of + TyApp (TyCon "Fay") _ -> JsType + TyCon "String" -> StringType + TyCon "Double" -> DoubleType + TyCon "Bool" -> BoolType + TyFun{} -> FunctionType + TyList _ -> ListType + TyParen st -> argType st + _ -> UnknownType -- | Get the arity of a type. -typeArity :: Type -> Integer +typeArity :: Type -> Int typeArity t = case t of TyForall _ _ i -> typeArity i TyFun _ b -> 1 + typeArity b TyParen st -> typeArity st _ -> 0 + +-- | Compile a normal simple pattern binding. +compileNormalPatBind :: Bool -> Name -> Exp -> Compile [JsStmt] +compileNormalPatBind toplevel ident rhs = do + body <- compileExp rhs + bind <- bindToplevel toplevel (UnQual ident) (thunk body) + return [bind] -- | Compile a data declaration. compileDataDecl :: Bool -> Decl -> [QualConDecl] -> Compile [JsStmt] diff --git a/src/Language/Fay/FFI.hs b/src/Language/Fay/FFI.hs --- a/src/Language/Fay/FFI.hs +++ b/src/Language/Fay/FFI.hs @@ -37,66 +37,9 @@ instance (Foreign a,Foreign b) => Foreign (a -> b) -- | Declare a foreign action. -foreignFay - :: Foreign a - => String -- ^ The foreign function name. - -> FayReturnType -- ^ JS return type. - -> a -- ^ Bottom. -foreignFay = error "Language.Fay.FFI.foreignFay: Used foreign function not in a JS engine context." - --- | Declare a foreign function. -foreignPure - :: Foreign a - => String -- ^ The foreign function name. - -> FayReturnType -- ^ JS return type. - -> a -- ^ Bottom. -foreignPure = error "Language.Fay.FFI.foreign: Used foreign function not in a JS engine context." - --- | Declare a foreign function. -foreignValue - :: Foreign a - => String -- ^ The foreign function name. - -> FayReturnType -- ^ JS return type. - -> a -- ^ Bottom. -foreignValue = error "Language.Fay.FFI.foreignValue: Used foreign function not in a JS engine context." - --- | Declare a foreign function. -foreignProp - :: Foreign a - => String -- ^ The foreign function name. - -> FayReturnType -- ^ JS return type. - -> a -- ^ Bottom. -foreignProp = error "Language.Fay.FFI.foreignProp: Used foreign function not in a JS engine context." - --- | Declare a foreign function. -foreignPropFay - :: Foreign a - => String -- ^ The foreign function name. - -> FayReturnType -- ^ JS return type. - -> a -- ^ Bottom. -foreignPropFay = error "Language.Fay.FFI.foreignProp: Used foreign function not in a JS engine context." - --- | Declare a foreign action. -foreignMethodFay - :: Foreign a - => String -- ^ The foreign function name. - -> FayReturnType -- ^ JS return type. - -> a -- ^ Bottom. -foreignMethodFay = error "Language.Fay.FFI.foreignMethodFay: Used foreign function not in a JS engine context." - --- | Declare a foreign function. -foreignMethod +ffi :: Foreign a - => String -- ^ The foreign function name. - -> FayReturnType -- ^ JS return type. + => String -- ^ The foreign value. + -> FayReturnType -- ^ JS return type (if any). -> a -- ^ Bottom. -foreignMethod = error "Language.Fay.FFI.foreignMethod: Used foreign function not in a JS engine context." - --- | Declare a foreign action. -foreignSetProp - :: (Foreign object,Foreign value) - => String -- ^ The property. - -> object -- ^ The object. - -> value -- ^ The value. - -> Fay () -- ^ Bottom. -foreignSetProp = error "Language.Fay.FFI.foreignSetProp: Used foreign function not in a JS engine context." +ffi = error "Language.Fay.FFI.foreignFay: Used foreign function not in a JS engine context." diff --git a/src/Language/Fay/Print.hs b/src/Language/Fay/Print.hs --- a/src/Language/Fay/Print.hs +++ b/src/Language/Fay/Print.hs @@ -103,7 +103,7 @@ -- | Print an expression. instance Printable JsExp where - printJS (JsRawName name) = name + printJS (JsRawExp name) = name printJS (JsThrowExp exp) = "(function(){ throw (" ++ printJS exp ++ "); })()" printJS (JsFun params stmts ret) = diff --git a/src/Language/Fay/Types.hs b/src/Language/Fay/Types.hs --- a/src/Language/Fay/Types.hs +++ b/src/Language/Fay/Types.hs @@ -18,7 +18,8 @@ ,Fay ,CompileConfig(..) ,CompileState(..) - ,FayReturnType(..)) + ,FayReturnType(..) + ,ArgType(..)) where import Control.Exception @@ -97,6 +98,10 @@ | InvalidDoBlock | RecursiveDoUnsupported | FfiNeedsTypeSig Decl + | FfiFormatBadChars String + | FfiFormatNoSuchArg Int + | FfiFormatIncompleteArg + | FfiFormatInvalidJavaScript String String deriving (Show,Eq,Data,Typeable) instance Error CompileError instance Exception CompileError @@ -123,7 +128,7 @@ -- | Expression type. data JsExp = JsName JsName - | JsRawName String + | JsRawExp String | JsFun [JsParam] [JsStmt] (Maybe JsExp) | JsLit JsLit | JsApp JsExp [JsExp] @@ -155,3 +160,11 @@ data FayReturnType = FayArray | FayList | FayString | FayBool | FayNone deriving (Read,Show,Eq) + +-- | These are the data types that are serializable directly to native +-- JS data types. Strings, floating points and arrays. The others are: +-- actiosn in the JS monad, which are thunks that shouldn't be forced +-- when serialized but wrapped up as JS zero-arg functions, and +-- unknown types can't be converted but should at least be forced. +data ArgType = FunctionType | JsType | StringType | DoubleType | ListType | BoolType | UnknownType + deriving (Show,Eq) diff --git a/tests/10.hs b/tests/10.hs --- a/tests/10.hs +++ b/tests/10.hs @@ -8,5 +8,5 @@ append (x:xs) ys = x : append xs ys append [] ys = ys -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/11 b/tests/11 --- a/tests/11 +++ b/tests/11 @@ -1,1 +1,1 @@ -[ 1, 2, 3, 4, 5 ] +[1,2,3,4,5] diff --git a/tests/11.hs b/tests/11.hs --- a/tests/11.hs +++ b/tests/11.hs @@ -1,4 +1,4 @@ -main = print (take 5 (let ns = 1 : map (\x -> x + 1) ns in ns)) +main = print (show (take 5 (let ns = 1 : map (\x -> x + 1) ns in ns))) take 0 _ = [] take n (x:xs) = x : take (n - 1) xs @@ -6,5 +6,5 @@ map f [] = [] map f (x:xs) = f x : map f xs -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/12.hs b/tests/12.hs --- a/tests/12.hs +++ b/tests/12.hs @@ -1,8 +1,5 @@ main = print (show (take 5 (let ns = 1 : map (foo 123) ns in ns))) -show :: Foreign a => a -> String -show = foreignPure "JSON.stringify" FayString - foo x y = x * y / 2 take 0 _ = [] @@ -11,5 +8,8 @@ map f [] = [] map f (x:xs) = f x : map f xs -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone + +show :: String -> String +show = ffi "JSON.stringify(%1)" FayString diff --git a/tests/13.hs b/tests/13.hs --- a/tests/13.hs +++ b/tests/13.hs @@ -2,5 +2,5 @@ True -> "Hello!" False -> "Ney!") -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/14.hs b/tests/14.hs --- a/tests/14.hs +++ b/tests/14.hs @@ -2,5 +2,5 @@ True -> "Hello!" False -> "Ney!") -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/15.hs b/tests/15.hs --- a/tests/15.hs +++ b/tests/15.hs @@ -2,5 +2,5 @@ True -> "Hello!" _ -> "Ney!") -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/16.hs b/tests/16.hs --- a/tests/16.hs +++ b/tests/16.hs @@ -3,5 +3,5 @@ main = print (case Person "Chris" "Done" 13 of Person "Chris" "Done" 13 -> "Hello!") -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/17.hs b/tests/17.hs --- a/tests/17.hs +++ b/tests/17.hs @@ -4,5 +4,5 @@ Person "Chris" "Done" 13 -> "Hello!" _ -> "World!") -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/18.hs b/tests/18.hs --- a/tests/18.hs +++ b/tests/18.hs @@ -6,5 +6,5 @@ Person "Chris" "Done" 14 -> "Hello!" _ -> "World!") -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/19.hs b/tests/19.hs --- a/tests/19.hs +++ b/tests/19.hs @@ -7,5 +7,5 @@ foo (Person "Chris" "Done" 14) = "Hello!" foo _ = "World!" -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/20.hs b/tests/20.hs --- a/tests/20.hs +++ b/tests/20.hs @@ -1,4 +1,4 @@ main = print "Hello," >> print "World!" -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/21.hs b/tests/21.hs --- a/tests/21.hs +++ b/tests/21.hs @@ -1,4 +1,4 @@ main = do print "Hello,"; print "World!" -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/22.hs b/tests/22.hs --- a/tests/22.hs +++ b/tests/22.hs @@ -2,5 +2,5 @@ x <- return "Hello, World!" >>= return print x -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/23.hs b/tests/23.hs --- a/tests/23.hs +++ b/tests/23.hs @@ -2,5 +2,5 @@ [1,2] <- return [1,2] print "OK." -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/24.hs b/tests/24.hs --- a/tests/24.hs +++ b/tests/24.hs @@ -4,5 +4,5 @@ [1,2,3,4,5] -> "OK." _ -> "Broken.") -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/25.hs b/tests/25.hs --- a/tests/25.hs +++ b/tests/25.hs @@ -1,4 +1,4 @@ main = print ((\a 'a' -> "OK.") 0 'b') -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/26.hs b/tests/26.hs --- a/tests/26.hs +++ b/tests/26.hs @@ -1,4 +1,4 @@ main = print (5 * 3 / 2) -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: Double -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/27.hs b/tests/27.hs --- a/tests/27.hs +++ b/tests/27.hs @@ -16,5 +16,5 @@ getSeconds :: Fay Double getSeconds = foreignFay "new Date" FayNone -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: Double -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/28.hs b/tests/28.hs --- a/tests/28.hs +++ b/tests/28.hs @@ -4,8 +4,8 @@ import Language.Fay.Prelude import Language.Fay.FFI -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone main :: Fay () main = print $ show $ fromInteger 5 diff --git a/tests/3.hs b/tests/3.hs --- a/tests/3.hs +++ b/tests/3.hs @@ -1,4 +1,4 @@ main = print 1 -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: Double -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/4.hs b/tests/4.hs --- a/tests/4.hs +++ b/tests/4.hs @@ -1,4 +1,4 @@ main = print "Hello, World!" -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: String -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/5.hs b/tests/5.hs --- a/tests/5.hs +++ b/tests/5.hs @@ -1,4 +1,4 @@ main = print (2 * 4 / 2) -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: Double -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/6.hs b/tests/6.hs --- a/tests/6.hs +++ b/tests/6.hs @@ -1,4 +1,4 @@ main = print (10 + (2 * (4 / 2))) -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: Double -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/7.hs b/tests/7.hs --- a/tests/7.hs +++ b/tests/7.hs @@ -1,4 +1,4 @@ main = print True -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: Double -> Fay () +print = ffi "console.log(%1)" FayNone diff --git a/tests/8.hs b/tests/8.hs --- a/tests/8.hs +++ b/tests/8.hs @@ -2,8 +2,8 @@ main = print (head (fix (\xs -> 123 : xs))) -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: Double -> Fay () +print = ffi "console.log(%1)" FayNone head (x:xs) = x diff --git a/tests/9.hs b/tests/9.hs --- a/tests/9.hs +++ b/tests/9.hs @@ -1,7 +1,7 @@ main = print (head (tail (fix (\xs -> 123 : xs)))) -print :: Foreign a => a -> Fay () -print = foreignFay "console.log" FayNone +print :: Double -> Fay () +print = ffi "console.log(%1)" FayNone head (x:xs) = x