fay 0.2.2.0 → 0.3.1.0

raw patch · 17 files changed

+714/−124 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• docs/beautify.js +4/−0
• docs/home.hs +186/−0
• docs/home.js +381/−54
• docs/snippets/ffi.hs +7/−4
• examples/canvaswater.hs +5/−5
• examples/dom.hs +1/−1
• fay.cabal +22/−5
• js/runtime.js +1/−1
• src/Docs.hs +10/−0
• src/Language/Fay.hs +52/−46
• src/Language/Fay/Compiler.hs +1/−1
• src/Language/Fay/FFI.hs +20/−4
• src/Language/Fay/Prelude.hs +2/−0
• src/Language/Fay/Print.hs +8/−1
• src/Language/Fay/Stdlib.hs +6/−1
• src/Language/Fay/Types.hs +3/−1
• src/Tests.hs +5/−0

@@ -58,6 +58,10 @@   +function $jsBeautify(source,indentSize) {+    return js_beautify(source, { indent_size: indentSize });+}+ function js_beautify(js_source_text, options) {      var input, output, token_text, last_type, last_text, last_last_text, last_word, flags, flag_store, indent_string;

@@ -0,0 +1,186 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | The home page script:+-- +--  1) Make sure that the language samples are highlighted.+--  2) Add a show/hide button for the JS output on all samples.+--  3) For code samples that are too large, hide them.+-- +-- Because dogfood. This is not necessarily a good example, indeed, it+-- may very well be a very bad example of how to write client+-- code. But that's the point, really. Even the quick scripts that+-- you'd just whip up in JS should be also done in Fay. Alright?+--++module Home (main) where++import Language.Fay.FFI+import Language.Fay.Prelude++-- | Main entry point.+main :: Fay ()+main = do+  ready (jquery [thedocument]) $ do+    samples <- query ".language-javascript"+    forM_ samples $ \this ->+      let sample = jquery [this]+      in do text <- getText sample+            setText sample+                    (beautify text 2)+    setTabReplace hljs "    "+    initHighlightingOnLoad hljs+    wrapwidth <- query ".wrap" >>= getWidth . jquery+    each ".example" $ \this -> do+      tr <- getFind this "tr"+      left <- getFind tr "td" >>= getFirst+      addClass left "left"+      right <- getNext left+      toggle <- makeElement "<a class='toggle' href='javascript:'>Show JavaScript</a>"+      toggleButton <- return $ do+        visible <- getIs right ":visible"+        if visible+           then do setText toggle "Hide JavaScript"+                   swapClasses toggle "toggle-hide" "toggle-show"+           else do setText toggle "Show JavaScript"+                   swapClasses toggle "toggle-show" "toggle-hide"+      setClick toggle $ fadeToggle right $ toggleButton+      width <- getWidth tr+      when (width > wrapwidth + 20*wrapwidth/100) $ hide right+      toggleButton+      panel <- getFind left ".panel"+      prepend panel toggle+      return ()++--------------------------------------------------------------------------------+-- Window object++-- | Console log.+print :: (Show a,Foreign a) => a -> Fay ()+print = foreignFay "console.log" FayNone++-- | Pop-up an alert.+alert :: String -> Fay ()+alert = foreignFay "window.alert" FayNone++--------------------------------------------------------------------------------+-- DOM++data Element+instance Foreign Element+instance Show Element++-- | The document.+thedocument :: Element+thedocument = foreignValue "window.document" FayNone++--------------------------------------------------------------------------------+-- jQuery++data JQuery+instance Foreign JQuery+instance Show JQuery++-- | Make a jQuery object out of an element.+jquery :: [Element] -> JQuery+jquery = foreignPure "window['jQuery']" FayNone++-- | Bind a handler for when the element is ready.+ready :: JQuery -> Fay () -> Fay ()+ready = foreignMethodFay "ready" FayNone++-- | Query for elements.+query :: String -> Fay [Element]+query = foreignFay "window['jQuery']" FayList++-- | Set the text of the given object.+setText :: JQuery -> String -> Fay ()+setText = foreignMethodFay "text" FayNone++-- | Set the click of the given object.+setClick :: JQuery -> Fay () -> Fay ()+setClick = foreignMethodFay "click" FayNone++-- | Toggle the visibility of an element, faded.+fadeToggle :: JQuery -> Fay () -> Fay ()+fadeToggle = foreignMethodFay "fadeToggle" FayNone++-- | Hide an element.+hide :: JQuery -> Fay ()+hide = foreignMethodFay "hide" FayNone++-- | Add a class to the given object.+addClass :: JQuery -> String -> Fay ()+addClass = foreignMethodFay "addClass" FayNone++-- | Remove a class from the given object.+removeClass :: JQuery -> String -> Fay ()+removeClass = foreignMethodFay "removeClass" FayNone++-- | Swap the given classes on the object.+swapClasses :: JQuery -> String -> String -> Fay ()+swapClasses obj addme removeme = do+  addClass obj addme+  removeClass obj removeme++-- | Get the text of the given object.+getText :: JQuery -> Fay String+getText = foreignMethodFay "text" FayString++-- | Get the text of the given object.+getIs :: JQuery -> String -> Fay Bool+getIs = foreignMethodFay "is" FayBool++-- | Get the next of the given object.+getNext :: JQuery -> Fay JQuery+getNext = foreignMethodFay "next" FayNone++-- | Get the first of the given object.+getFirst :: JQuery -> Fay JQuery+getFirst = foreignMethodFay "first" FayNone++-- | Get the find of the given object.+getFind :: JQuery -> String -> Fay JQuery+getFind = foreignMethodFay "find" FayNone++-- | Prepend an element to this one.+prepend :: JQuery -> JQuery -> Fay JQuery+prepend = foreignMethodFay "prepend" FayNone++-- | Make a new element.+makeElement :: String -> Fay JQuery+makeElement = foreignFay "window['jQuery']" FayNone++-- | Get the width of the given object.+getWidth :: JQuery -> Fay Double+getWidth = foreignMethodFay "width" FayNone++-- | For each element in a query set do something.+each :: String -> (JQuery -> Fay ()) -> Fay ()+each q go = do+  results <- query q+  forM_ results $ \result -> go (jquery [result])++--------------------------------------------------------------------------------+-- Pretty printing / highlighting++-- | Pretty print the given JS code.+beautify :: String -- ^ The JS code.+         -> Double -- ^ The indentation level.+         -> String -- ^ The reformatted JS code.+beautify = foreignPure "$jsBeautify" FayString++data Highlighter+instance Foreign Highlighter++-- | Get the highlighter.+hljs :: Highlighter+hljs = foreignValue "window['hljs']" FayNone++-- | Init syntax highlighting on load.+initHighlightingOnLoad :: Highlighter -> Fay ()+initHighlightingOnLoad = foreignMethodFay "initHighlightingOnLoad" FayNone++-- | Init syntax highlighting on load.+setTabReplace :: Highlighter -> String -> Fay ()+setTabReplace = foreignSetProp "tabReplace"

@@ -1,56 +1,383 @@-$(document).ready(function(){-    $('.language-javascript').each(function(){-        $(this).text(js_beautify($(this).text(),-                                 { indent_size: 2}));+/** @constructor+*/+var Home = function(){+var True = true;+var False = false;++/*******************************************************************************+* Thunks.+*/++// Force a thunk (if it is a thunk) until WHNF.+function _(thunkish,nocache){+  while (thunkish instanceof $) {+    thunkish = thunkish.force(nocache);+  }+  return thunkish;+}++// Apply a function to arguments (see method2 in Fay.hs).+function __(){+    var f = arguments[0];+    for (var i = 1, len = arguments.length; i < len; i++) {+        f = (f instanceof $? _(f) : f)(arguments[i]);+    }+    return f;+}++// Thunk object.+function $(value){+  this.forced = false;+  this.value = value;+}++// Force the thunk.+$.prototype.force = function(nocache){+  return nocache+    ? this.value()+    : this.forced+    ? this.value+    : (this.forced = true, this.value = this.value());+};++/*******************************************************************************+* Constructors.+*/++// A constructor.+function Fay$$Constructor(){+  this.name = arguments[0];+  this.fields = Array.prototype.slice.call(arguments,1);+}++// Eval in the context of the Haskell bindings.+function Fay$$eval(str){+  return eval(str);+}++/*******************************************************************************+* Monad.+*/++function Fay$$Monad(value){+  this.value = value;+}++// >>+function Fay$$then(a){+  return function(b){+    return new $(function(){+      _(a,true);+      return b;     });-    hljs.tabReplace = '    ';-    hljs.initHighlightingOnLoad();-    // Creates tabs from the code samples.-    // $('.example').each(function(){-    //     var example = $(this);-    //     var tabs = $('<div></div>');-    //     example.children('.lang').each(function(){-    //         var title = $(this).clone().click(function(){-    //             example.find('.pre').hide();-    //             pre.show();-    //             tabs.children().removeClass('tab-title-current');-    //             title.addClass('tab-title-current');-    //         });-    //         title.addClass('tab-title');-    //         var pre = $(this).next();-    //         tabs.append(title);-    //     }).remove();-    //     example.prepend(tabs);-    //     example.find('.pre').hide().first().show();-    //     tabs.children().first().addClass('tab-title-current');-    // });-    var wrapwidth = $('.wrap').width();-    $('.example').each(function(){-        var tr = $(this).find('tr');-        var left = tr.find('td').first();-        left.addClass('left');-        var right = left.next();-        var toggle = $('<a class="toggle" href="javascript:">Show JavaScript</a>');-        function toggleButton(){-            if(right.is(':visible')) {-                toggle.text("Hide JavaScript");-                toggle.addClass('toggle-hide');-                toggle.removeClass('toggle-show');-            }-            else {-                toggle.text("Show JavaScript");-                toggle.addClass('toggle-show');-                toggle.removeClass('toggle-hide');-            }-        }-        toggle.click(function(){-            right.fadeToggle(function(){-                toggleButton();-            });-        });-        if(tr.width() > wrapwidth + (20*wrapwidth/100))-            right.hide();-        toggleButton();-        left.find('.panel').prepend(toggle);+  };+}++// >>=+function Fay$$bind(m){+  return function(f){+    return new $(function(){+      var monad = _(m,true);+      return f(monad.value);     });-});+  };+}++var Fay$$unit = null;++// return+function Fay$$return(a){+  return new Fay$$Monad(a);+}++/*******************************************************************************+* FFI.+*/++// Serialize a Fay object to JS.+function Fay$$serialize(type,obj){+  type = _(type);+  if(type) type = type[0].name;+  if(type == "JsType"){+    return function(){+      return _(obj,true).value;+    };+  } else {+    obj = _(obj);+    if(type == "StringType" ||+       (obj instanceof Fay$$Cons && typeof obj.car == 'string')){+      var str = "";+      while(obj instanceof Fay$$Cons) {+        str += obj.car;+        obj = _(obj.cdr);+      }+      return str;      +    } else if(type == "FunctionType" || typeof obj == 'function'){+      return function(){+        var out = obj;+        for (var len = arguments.length, i = 0; i < len; i++){+          if(typeof out != 'function') {+            throw "Wrong number of arguments for callback: " + arguments.toString();+          }+          out = out(arguments[i]);+        }+        return _(out,true);+      };    +    } else if(type == "ListType" || (obj instanceof Fay$$Cons)){+      var arr = [];+      while(obj instanceof Fay$$Cons) {+        arr.push(Fay$$serialize(null,obj.car));+        obj = _(obj.cdr);+      }+      return arr;      +    } // else if(type == "BoolType || obj == _(True) || obj == _(False)) {+    //   return obj == _(True);+    // } +    else {+      return obj;+    }      +  }+}++// Encode a value to a Show representation+function Fay$$encodeShow(x){+  if (x instanceof $) x = _(x);+  if (x instanceof Array) {+    if (x.length == 0) {+      return "[]";+    } else {+      if (x[0] instanceof Fay$$Constructor) {+        if(x[0].fields.length > 0) {+          var args = x.slice(1);+          var fieldNames = x[0].fields;+          return "(" + x[0].name + " { " + args.map(function(x,i){+            return fieldNames[i] + ' = ' + Fay$$encodeShow(x);+          }).join(", ") + " })";+        } else {+          var args = x.slice(1);+          return "(" + [x[0].name].concat(args.map(Fay$$encodeShow)).join(" ") + ")";+        }+      } else {+        return "[" + x.map(Fay$$encodeShow).join(",") + "]";+      }+    }+  } else if (typeof x == 'string') {+    return JSON.stringify(x);+  } else if(x instanceof Fay$$Cons) {+    return Fay$$encodeShow(Fay$$serialize(ListType,x));+  } else if(x == null) {+    return '[]';+  } else {+    return x.toString();+  }+}++// Unserialize an object from JS to Fay.+function Fay$$unserialize(typ,obj){+  if(typ == 'string' || typ == 'array' || typ == 'list')+    return Fay$$list(obj);+  else if(typ == 'bool')+    return obj? True : False;+  else if(typ == 'data') {+    alert('Time to unserialize a data record!');+  }+  else return obj;+}++/*******************************************************************************+* Lists.+*/++// Cons object.+function Fay$$Cons(car,cdr){+  this.car = car;+  this.cdr = cdr;+}++// Make a list.+function Fay$$list(xs){+  var out = null;+  for(var i=xs.length-1; i>=0;i--)+    out = new Fay$$Cons(xs[i],out);+  return out;+}++// Built-in list cons.+function Fay$$cons(x){+  return function(y){+    return new Fay$$Cons(x,y);+  };+}++// List index.+function Fay$$index(index){+  return function(list){+    for(var i = 0; i < index; i++) {+      list = _(list).cdr;+    }+    return list.car;+  };+}++/*******************************************************************************+* Numbers.+*/++// Built-in *.+function Fay$$mult(x){+  return function(y){+    return _(x) * _(y);+  };+}++// Built-in +.+function Fay$$add(x){+  return function(y){+    return _(x) + _(y);+  };+}++// Built-in -.+function Fay$$sub(x){+  return function(y){+    return _(x) - _(y);+  };+}++// Built-in /.+function Fay$$div(x){+  return function(y){+    return _(x) / _(y);+  };+}++/*******************************************************************************+* Booleans.+*/++// Are two values equal?+function Fay$$equal(lit1,lit2){+  // Simple case+  lit1 = _(lit1);+  lit2 = _(lit2);+  if(lit1 === lit2) {+    return true;+  }+  // General case+  if(lit1 instanceof Array) {+    if(lit1.length!=lit2.length) return false;+    for(var len = lit1.length, i = 0; i < len; i++) {+      if(!Fay$$equal(lit1[i],lit2[i]))+        return false;+    }+    return true;+  } else if (lit1 instanceof Fay$$Cons) {+    while(lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons && Fay$$equal(lit1.car,lit2.car))+      lit1 = lit1.cdr, lit2 = lit2.cdr;+    return (lit1 === null && lit2 === null);+  } else return false;+}++// Built-in ==.+function Fay$$eq(x){+  return function(y){+    return Fay$$equal(x,y);+  };+}++// Built-in /=.+function Fay$$neq(x){+  return function(y){+    return !(Fay$$equal(x,y));+  };+}++// Built-in >.+function Fay$$gt(x){+  return function(y){+    return _(x) > _(y);+  };+}++// Built-in <.+function Fay$$lt(x){+  return function(y){+    return _(x) < _(y);+  };+}++// Built-in >=.+function Fay$$gte(x){+  return function(y){+    return _(x) >= _(y);+  };+}++// Built-in <=.+function Fay$$lte(x){+  return function(y){+    return _(x) <= _(y);+  };+}++// Built-in &&.+function Fay$$and(x){+  return function(y){+    return _(x) && _(y);+  };+}++// Built-in ||.+function Fay$$or(x){+  return function(y){+    return _(x) || _(y);+  };+}++/*******************************************************************************+* Mutable references.+*/++// Make a new mutable reference.+function Fay$$Ref(x){+  this.value = x;+}++// Write to the ref.+function Fay$$writeRef(ref,x){+  ref.value = x;+}++// Get the value from the ref.+function Fay$$readRef(ref,x){+  return ref.value;+}++/*******************************************************************************+* Dates.+*/+function Fay$$date(str){+  return window.Date.parse(str);+}++/*******************************************************************************+* Application code.+*/+++var main = new $(function(){return __($36$,__(ready,__(jquery,Fay$$list([thedocument]))),__(Fay$$bind,__(query,Fay$$list(".language-javascript")),function($_a){var samples = $_a;return __(Fay$$then,__($36$,__(forM_,samples),function($_a){var _$this = $_a;return (function(){var sample = new $(function(){return __(jquery,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("    ")),__(Fay$$then,__(initHighlightingOnLoad,hljs),__(Fay$$bind,__(Fay$$bind,__(query,Fay$$list(".wrap")),__($46$,getWidth,jquery)),function($_a){var wrapwidth = $_a;return __($36$,__(each,Fay$$list(".example")),function($_a){var _$this = $_a;return __(Fay$$bind,__(getFind,_$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("<a class='toggle' href='javascript:'>Show JavaScript</a>")),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 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 jquery = 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 query = function($_a){return new $(function(){return new Fay$$Monad(Fay$$unserialize("list",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 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 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 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 each = function($_a){return function($_b){return new $(function(){var go = $_b;var q = $_a;return __(Fay$$bind,__(query,q),function($_a){var results = $_a;return __($36$,__(forM_,results),function($_a){var result = $_a;return __(go,__(jquery,Fay$$list([result])));});});});};};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]];});};};+// Exports+this.main = main;++// Built-ins+this.$force      = _;+this.$           = $;+this.$list       = Fay$$list;+this.$encodeShow = Fay$$encodeShow;+this.$eval       = Fay$$eval;++};+;+var main = new Home();+main.$force(main.main);+

@@ -4,11 +4,14 @@ alert :: Foreign a => a -> Fay () alert = foreignFay "window.alert" "" -thebody :: Element-thebody = foreignPure "document.body" FayNone- getInnerHtml :: Element -> Fay String-getInnerHtml = foreignPropFay "innerHTML" FayString+getInnerHtml = foreignMethodFay "innerHTML" FayString  setInnerHtml :: Element -> String -> Fay () setInnerHtml = foreignSetProp "innerHTML"++thedocument :: Element+thedocument = foreignValue "window.document" FayNone++jquery :: Element -> JQuery+jquery = foreignPure "window.jQuery" FayNone

@@ -55,7 +55,7 @@  -- | Add an event listener to an element. addEventListener :: (Foreign a,Eventable a) => a -> String -> Fay () -> Bool -> Fay ()-addEventListener = foreignPropFay "addEventListener" FayNone+addEventListener = foreignMethodFay "addEventListener" FayNone  -- | Get an element by its ID. getElementById :: String -> Fay Element@@ -85,11 +85,11 @@  -- | Get an element by its ID. getContext :: Element -> String -> Fay Context-getContext = foreignPropFay "getContext" FayNone+getContext = foreignMethodFay "getContext" FayNone  -- | Draw an image onto a canvas rendering context. drawImage :: Context -> Image -> Double -> Double -> Fay ()-drawImage = foreignPropFay "drawImage" FayNone+drawImage = foreignMethodFay "drawImage" FayNone  -- | Draw an image onto a canvas rendering context. --@@ -101,7 +101,7 @@ drawImageSpecific :: Context -> Image                   -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double                   -> Fay ()-drawImageSpecific = foreignPropFay "drawImage" FayNone+drawImageSpecific = foreignMethodFay "drawImage" FayNone  -- | Set the fill style. setFillStyle :: Context -> String -> Fay ()@@ -109,7 +109,7 @@  -- | Set the fill style. setFillRect :: Context -> Double -> Double -> Double -> Double -> Fay ()-setFillRect = foreignPropFay "fillRect" FayNone+setFillRect = foreignMethodFay "fillRect" FayNone  -------------------------------------------------------------------------------- -- Ref

@@ -15,7 +15,7 @@   print result  print :: Foreign a => a -> Fay ()-print = foreignFay "console.log" ""+print = foreignFay "console.log" FayNone  data Element instance Foreign Element

@@ -1,5 +1,5 @@ name:                fay-version:             0.2.2.0+version:             0.3.1.0 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,14 +22,30 @@                      .                      /Release Notes/                      .-                     Some more compilation options.+                     * Rewrite home page/docs JS in Fay. Because dogfood.                      .-                     * Optional flat function application (-flatten-apps).+                     * Support bool unseralization.                      .-                     * Exporting-builtins is optional (-no-export-builtins).+                     * Export more functions from stdlib.                      .-                     * The main module is annotated as a Closure \@constructor.+                     * Add fixity to monad.                      .+                     * Replace home page JS with Fay.+                     .+                     * Another FFI change. BREAKING CHANGE, LOOK AT THE FFI AND EXAPLES AGAIN.+                     .+                     * Handle list unserializing.+                     .+                     * Fix dom.hs.+                     .+                     * Add simple sum benchmark, will expand later (refs #11).+                     .+                     * Fix auto-exports.+                     .+                     * Fix docs for silly haddock syntax.+                     .+                     * Support avoiding Google Closure name mangling.+                     .                      See full history at: <https://github.com/chrisdone/fay/commits> homepage:            http://fay-lang.org/ license:             BSD3@@ -69,6 +85,7 @@                      docs/snippets/lists.hs                      docs/snippets/patterns.hs                      docs/snippets/tail.hs+                     docs/home.hs                      -- Misc                      CHANGELOG 

@@ -171,7 +171,7 @@  // Unserialize an object from JS to Fay. function Fay$$unserialize(typ,obj){-  if(typ == 'string' || typ == 'array')+  if(typ == 'string' || typ == 'array' || typ == 'list')     return Fay$$list(obj);   else if(typ == 'bool')     return obj? True : False;

@@ -7,6 +7,7 @@ module Main where  import           Language.Fay (compileViaStr,compileModule)+import           Language.Fay.Compiler (compileFromTo)  import           Control.Exception import           Control.Monad@@ -28,6 +29,7 @@ main = do   let file = "docs" </> "index.html"   generate >>= L.writeFile file+  generateJs   putStrLn $ "Documentation file written to " ++ file    generate = do@@ -52,6 +54,14 @@         examples = map (("docs" </> "snippets") </>)                        (map (++".hs")                             (words "declarations conditions functions lists data enums patterns ffi dom tail"))++generateJs = do+  putStrLn $ "Compiling " ++ inp ++ " to " ++ out ++ " ..."+  compileFromTo def True inp out+    +  where docs = ("docs" </>)+        inp = (docs "home.hs")+        out = (docs "home.js")  page now analytics examples = do   docType

@@ -97,7 +97,7 @@                    }   mapM_ emitExport (fromMaybe [] exports)   imported <- fmap concat (mapM compileImport imports)-  current <- compileDecls decls+  current <- compileDecls True decls   return (imported ++ current) compileModule mod = throwError (UnsupportedModuleSyntax mod) @@ -117,26 +117,26 @@         "It was: " ++ show i  -- | Compile Haskell declaration.-compileDecls :: [Decl] -> Compile [JsStmt]-compileDecls decls = do+compileDecls :: Bool -> [Decl] -> Compile [JsStmt]+compileDecls toplevel decls = do   case decls of     [] -> return []-    (TypeSig _ _ sig:bind@PatBind{}:decls) -> appendM (compilePatBind (Just sig) bind)-                                                      (compileDecls decls)-    (decl:decls) -> appendM (compileDecl decl)-                            (compileDecls decls)+    (TypeSig _ _ sig:bind@PatBind{}:decls) -> appendM (compilePatBind toplevel (Just sig) bind)+                                                      (compileDecls toplevel decls)+    (decl:decls) -> appendM (compileDecl toplevel decl)+                            (compileDecls toplevel decls)    where appendM m n = do x <- m                          xs <- n                          return (x ++ xs)  -- | Compile a declaration.-compileDecl :: Decl -> Compile [JsStmt]-compileDecl decl =+compileDecl :: Bool -> Decl -> Compile [JsStmt]+compileDecl toplevel decl =   case decl of-    pat@PatBind{} -> compilePatBind Nothing pat-    FunBind matches -> compileFunCase matches-    DataDecl _ DataType _ _ _ constructors _ -> compileDataDecl decl constructors+    pat@PatBind{} -> compilePatBind toplevel Nothing pat+    FunBind matches -> compileFunCase toplevel matches+    DataDecl _ DataType _ _ _ constructors _ -> compileDataDecl toplevel decl constructors     -- Just ignore type aliases and signatures.     TypeDecl{} -> return []     TypeSig{} -> return []@@ -146,25 +146,24 @@     _ -> throwError (UnsupportedDeclaration decl)  -- | Compile a top-level pattern bind.-compilePatBind :: Maybe Type -> Decl -> Compile [JsStmt]-compilePatBind sig pat = do+compilePatBind :: Bool -> Maybe Type -> Decl -> Compile [JsStmt]+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 ident rhs+            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---                 | value binding  -> compileFFIValue sig ident detail                  | otherwise      -> throwError (FfiNeedsTypeSig pat)-        _ -> compileNormalPatBind ident rhs+        _ -> compileNormalPatBind toplevel ident rhs     _ -> throwError (UnsupportedDeclaration pat) -  where func = flip elem ["foreignFay","foreignPure"]-        method = flip elem ["foreignPropFay","foreignProp"]+  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)))@@ -179,10 +178,10 @@         ffiProp _ = Nothing  -- | Compile a normal simple pattern binding.-compileNormalPatBind :: Name -> Exp -> Compile [JsStmt]-compileNormalPatBind ident rhs = do+compileNormalPatBind :: Bool -> Name -> Exp -> Compile [JsStmt]+compileNormalPatBind toplevel ident rhs = do   body <- compileExp rhs-  bind <- bindToplevel (UnQual ident) (thunk body)+  bind <- bindToplevel toplevel (UnQual ident) (thunk body)   return [bind]  -- | Compile a foreign function.@@ -197,7 +196,7 @@   let args = zipWith const uniqueNames [1..typeArity sig]       jsargs = drop 1 args       obj = head args-  compileFFI sig ident detail (JsGetProp (force (JsName obj)) (fromString name)) args jsargs+  compileFFI sig ident detail (JsGetPropExtern (force (JsName obj)) (fromString name)) args jsargs  -- | Compile a foreign method. compileFFISetProp :: Type -> Name -> (String,String,FayReturnType) -> Compile [JsStmt]@@ -208,10 +207,10 @@   compileFFI sig              ident              detail-             (JsUpdateProp (force (JsName obj))-                           (fromString name)-                           (serialize (head (tail funcTypes))-                                      (JsName (head jsargs))))+             (JsUpdatePropExtern (force (JsName obj))+                                 (fromString name)+                                 (serialize (head (tail funcTypes))+                                            (JsName (head jsargs))))              args              []                @@ -227,12 +226,13 @@            -> Compile [JsStmt] compileFFI sig ident (binding,_,typ) exp params args = do   let innerexp-        | length args == 0 = exp+        | 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 (UnQual ident)+  bind <- bindToplevel True+                       (UnQual ident)                        (foldr (\name inner -> JsFun [name] [] (Just inner))                               (thunk                                (maybeMonad@@ -243,8 +243,10 @@   return [bind]    where (maybeMonad,types) | binding == "foreignFay"       = (monad,funcTypes)-                           | binding == "foreignPropFay"   = (monad,drop 1 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@@ -292,8 +294,8 @@     _              -> 0  -- | Compile a data declaration.-compileDataDecl :: Decl -> [QualConDecl] -> Compile [JsStmt]-compileDataDecl decl constructors = do+compileDataDecl :: Bool -> Decl -> [QualConDecl] -> Compile [JsStmt]+compileDataDecl toplevel decl constructors = do   fmap concat $     forM constructors $ \(QualConDecl _ _ _ condecl) ->       case condecl of@@ -319,7 +321,8 @@           fmap concat $             forM fields $ \(i,field) ->               forM field $ \name ->-                bindToplevel (UnQual name)+                bindToplevel toplevel+                             (UnQual name)                              (JsFun ["x"]                                     []                                     (Just (thunk (JsIndex i (force (JsName "x"))))))@@ -335,9 +338,9 @@ unname _ = error "Expected ident from uname." -- FIXME:  -- | Compile a function which pattern matches (causing a case analysis).-compileFunCase :: [Match] -> Compile [JsStmt]-compileFunCase [] = return []-compileFunCase matches@(Match _ name argslen _ _ _:_) = do+compileFunCase :: Bool -> [Match] -> Compile [JsStmt]+compileFunCase _toplevel [] = return []+compileFunCase toplevel matches@(Match _ name argslen _ _ _:_) = do   tco <- config configTCO   pats <- fmap optimizePatConditions $ forM matches $ \match@(Match _ _ pats _ rhs wheres) -> do     unless (noBinds wheres) $ do _ <- throwError (UnsupportedWhereInMatch match) -- TODO: Support `where'.@@ -347,7 +350,8 @@              compilePat (JsName arg) pat inner)           [JsEarlyReturn exp]           (zip args pats)-  bind <- bindToplevel (UnQual name)+  bind <- bindToplevel toplevel+                       (UnQual name)                        (foldr (\arg inner -> JsFun [arg] [] (Just inner))                               (stmtsThunk (let stmts = (concat pats ++ basecase)                                            in if tco@@ -412,13 +416,14 @@ compileRhs rhs                = throwError (UnsupportedRhs rhs)  -- | Compile a pattern match binding.-compileFunMatch :: Match -> Compile [JsStmt]-compileFunMatch match =+compileFunMatch :: Bool -> Match -> Compile [JsStmt]+compileFunMatch toplevel match =   case match of     (Match _ name args Nothing (UnGuardedRhs rhs) _) -> do       body <- compileExp rhs       args <- mapM patToArg args-      bind <- bindToplevel (UnQual name)+      bind <- bindToplevel toplevel+                           (UnQual name)                            (foldr (\arg inner -> JsFun [arg] [] (Just inner))                                   (thunk body)                                   args)@@ -428,7 +433,7 @@   where patToArg (PVar name) = return (UnQual name)         patToArg _           = throwError (UnsupportedMatchSyntax match) -instance CompilesTo Decl [JsStmt] where compileTo = compileDecl+instance CompilesTo Decl [JsStmt] where compileTo = compileDecl False  -- | Compile Haskell expression. compileExp :: Exp -> Compile JsExp@@ -695,8 +700,8 @@ compileLetDecl :: Decl -> Compile [JsStmt] compileLetDecl decl =   case decl of-    decl@PatBind{} -> compileDecls [decl]-    decl@FunBind{} -> compileDecls [decl]+    decl@PatBind{} -> compileDecls False [decl]+    decl@FunBind{} -> compileDecls False [decl]     _              -> throwError (UnsupportedLetBinding decl)  -- | Compile Haskell literal.@@ -793,6 +798,7 @@             FayArray -> "array"             FayList -> "list"             FayString -> "string"+            FayBool -> "bool"             FayNone -> ""  -- | Force an expression in a thunk.@@ -842,10 +848,10 @@ hjIdent = Qual (ModuleName "Fay") . Ident  -- | Make a top-level binding.-bindToplevel :: QName -> JsExp -> Compile JsStmt-bindToplevel name exp = do+bindToplevel :: Bool -> QName -> JsExp -> Compile JsStmt+bindToplevel toplevel name exp = do   exportAll <- gets stateExportAll-  when exportAll $ emitExport (EVar name)+  when (toplevel && exportAll) $ emitExport (EVar name)   return (JsVar name exp)  -- | Emit exported names.

@@ -68,7 +68,7 @@ -- | Print an this.x = x; export out. printExport :: Name -> String printExport name =-  printJS (JsSetProp "this"+  printJS (JsSetProp ":this"                      (UnQual name)                      (JsName (UnQual name))) 

@@ -52,21 +52,37 @@   -> 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 action.-foreignPropFay+foreignMethodFay   :: Foreign a   => String         -- ^ The foreign function name.   -> FayReturnType  -- ^ JS return type.   -> a              -- ^ Bottom.-foreignPropFay = error "Language.Fay.FFI.foreignPropFay: Used foreign function not in a JS engine context."+foreignMethodFay = error "Language.Fay.FFI.foreignMethodFay: Used foreign function not in a JS engine context."  -- | Declare a foreign function.-foreignProp+foreignMethod   :: 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."+foreignMethod = error "Language.Fay.FFI.foreignMethod: Used foreign function not in a JS engine context."  -- | Declare a foreign action. foreignSetProp

@@ -50,9 +50,11 @@  (>>) :: Fay a -> Fay b -> Fay b (>>) = error "Language.Fay.Prelude.(>>): Used (>>) outside JS."+infixl 1 >>  (>>=) :: Fay a -> (a -> Fay b) -> Fay b (>>=) = error "Language.Fay.Prelude.(>>=): Used (>>=) outside JS."+infixl 1 >>=  fail :: String -> Fay a fail = error "Language.Fay.Prelude.fail: Used fail outside JS."

@@ -153,6 +153,11 @@     (concat ["(",printJS name,".",printJS prop," = ",printJS expr,")"])   printJS (JsInfix op x y) =     printJS x ++ " " ++ op ++ " " ++ printJS y+  -- Externs: Careful, here be dragons! Or at least warm lizards.+  printJS (JsGetPropExtern exp prop) =+    printJS exp ++ "['" ++ printJS prop ++ "']"+  printJS (JsUpdatePropExtern name prop expr) =+    (concat ["(",printJS name,"['",printJS prop,"'] = ",printJS expr,")"])  -------------------------------------------------------------------------------- -- Utilities@@ -162,8 +167,10 @@ -- Special symbols: jsEncodeName ":tmp" = "$tmp" jsEncodeName ":thunk" = "$"+jsEncodeName ":this" = "this" -- Used keywords:-jsEncodeName "null" = "_null"+jsEncodeName "null" = "_$null"+jsEncodeName "this" = "_$this" -- Anything else. jsEncodeName name =   if isPrefixOf "$_" name

@@ -29,7 +29,9 @@   ,intersperse   ,prependToAll   ,intercalate-  ,forM_)+  ,forM_+  ,mapM_+  ,when)   where  import Prelude (Maybe(..),(==),(>>),return,(+),(<),(>),Bool(..),Ord,(||))@@ -153,3 +155,6 @@  forM_ (x:xs) m = m x >> forM_ xs m forM_ []     _ = return ()++mapM_ m (x:xs) = m x >> mapM_ m xs+mapM_ _ []     = return ()

@@ -133,6 +133,8 @@   | JsParen JsExp   | JsGetProp JsExp JsName   | JsUpdateProp JsExp JsName JsExp+  | JsGetPropExtern JsExp JsName+  | JsUpdatePropExtern JsExp JsName JsExp   | JsList [JsExp]   | JsNew JsName [JsExp]   | JsThrowExp JsExp@@ -151,5 +153,5 @@   | JsBool Bool   deriving (Show,Eq) -data FayReturnType = FayArray | FayList | FayString | FayNone+data FayReturnType = FayArray | FayList | FayString | FayBool | FayNone   deriving (Read,Show,Eq)

@@ -1,3 +1,8 @@+-- | Generate the web site/documentation for the Fay project.+--+-- This depends on the Fay compiler to generate examples and the+-- javascript of the page is also built with Fay.+ module Main where  import Language.Fay.Compiler