fay 0.1.0.0 → 0.1.1.0

raw patch · 29 files changed

+716/−159 lines, 29 filesdep +data-defaultdep +pretty-showdep −language-javascriptPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-default, pretty-show

Dependencies removed: language-javascript

API changes (from Hackage documentation)

Files

• CHANGELOG +40/−0
• docs/analytics.js +13/−0
• docs/home.css +28/−5
• docs/home.js +45/−15
• docs/snippets/tail.hs +4/−0
• examples/alert.hs +2/−2
• examples/console.hs +1/−1
• examples/data.hs +21/−0
• examples/dom.hs +10/−2
• examples/ref.hs +31/−0
• examples/tailrecursive.hs +37/−0
• fay.cabal +106/−12
• hs/stdlib.hs +7/−0
• js/runtime.js +52/−38
• src/Docs.hs +56/−23
• src/Language/Fay.hs +124/−35
• src/Language/Fay/Compiler.hs +12/−9
• src/Language/Fay/Prelude.hs +4/−1
• src/Language/Fay/Print.hs +8/−1
• src/Language/Fay/Show.hs +33/−0
• src/Language/Fay/Stdlib.hs +4/−1
• src/Language/Fay/Types.hs +17/−2
• src/Main.hs +8/−1
• src/System/Process/Extra.hs +16/−0
• src/Tests.hs +4/−11
• tests/27 +1/−0
• tests/27.hs +20/−0
• tests/28 +1/−0
• tests/28.hs +11/−0

@@ -0,0 +1,40 @@+2012-07-26+0.1.1.0: Lots of documentation updates, some runtime fixes, some more examples, tail-call optimization prototype.++cf6b848 Add analytics to .cabal.+13b8d0e Fix types for ghc.+4a021a3 Use continue (for now) for TCO (refs #19).+b43220c Tail recursive optimization prototype (refs #19).+137a702 Tail recursive example doc.+6ec356b Ref example.+e10023c fromInteger/fromRational in the runtime (closes #20).+7527aaa Add missing operators to Prelude and built-ins list (closes #16).+9ce6915 Throw error about unsupported `where' (closes #17).+406067c Fix silly enumFromTo mistake.+8c37842 A test-case that tail-recursive functions run iteratively.+1791e68 Optimize constant patterns slightly, shaves off some time.+f016d01 Add Fay.Show (preliminary implementation).+66cf298 Add data/show example.+486c4f3 Add note about generating docs.+15fd56c Add note that you need nodejs installed to run the tests.+ae207b7 Include google analytics in docs and generate index.html rather than home.html.+07f7f4a Updated dom example with onload handler.+e702218 Remove max-width to fix firefox.+aa5dc2b Mention minifying slightly in docs.+e53addc Remove language-javascript dependency.+f976ff6 Remove non-ascii character in runtime.js+2abd59d Don't print counts in fay-tests.+c0127c3 Add small note about livescript.+0d35867 Added fork on github for docs.+f6a0d62 Use === instead of == for jseq (closes #6).+7d1a382 Some word break on the pre's.+37e3d53 Rename modules from Main to X (closes #5).+6734221 Ignore more stuff.+4479709 Toggle examples.+3ddf795 Put examples side-by-side (closes #3).+5ae7cca s/strict/proper to avoid confusion.+a482a5b Convert from function expression assignments to function definitions++2012-07-21+0.1.0.0: First version.+

@@ -0,0 +1,13 @@+<script type="text/javascript">+if (window.location.href.match(/fay\-lang\.org/)) {+  var _gaq = _gaq || [];+  _gaq.push(['_setAccount', 'UA-33582139-1']);+  _gaq.push(['_trackPageview']);+  (function() {+    var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;+    ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';+    var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);+  })();+}++</script>

@@ -44,7 +44,8 @@  /* Syntax highlighting */ .example {  }-.example pre { margin-top:0 }+.example pre { margin-top:0; +word-wrap: break-word; } .example pre .diff { color:#555 } .example pre code .title { color:#333 } .example pre code .string { color:#366354 }@@ -60,14 +61,36 @@ .example pre code .addition { background-color:#FDD;color:#695B5B } .example pre code .deletion { background-color:#DFD;color:#000 } .example pre { margin:0 }-.example table { border-spacing: 20px; }-.example { vertical-align: top; padding: 1em; box-shadow: 0px 0px 20px #ccc; border-radius: 5px; }+.example table { border-spacing: 1em; }+.example {} .example .lang { font-size: small; margin-bottom: 1em; color: #999 } .example .tab-title { cursor: pointer; } .example .tab-title-current em { font-weight: bold; color: #555; font-style: normal } .example .tab-title { display: inline-block; margin-right: 1em; }-.example pre { overflow: auto }-+.example pre {  }+.example { float: left }+.example table { margin-left: -1em; }+.example td { vertical-align: top; box-shadow: 0px 0px 20px #ccc; border-radius: 5px; }+.example-heading { margin-bottom: 0; }+.example-clear + .example-heading { margin-top: 0; padding-top: 0 }+.example-clear { clear: both }+.example .panel { padding: 1em; position: relative; }+.example .toggle {+    background: #F40095;+    color: white;+    padding: 0.3em;+    border-bottom-left-radius: 0.2em;+    border-bottom-right-radius: 0.2em;+    position: absolute;+    top: -1px;+    right: 1em;+    font-size: 0.8em+}+.example .toggle-hide {+    opacity: 0.5;+    background: #eee;+    color: #999;+} .footer {     margin-top: 5em;     font-size: 0.9em;

@@ -5,22 +5,52 @@     });     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 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');+        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();             });-            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');+        });+        if(tr.width() > wrapwidth + (20*wrapwidth/100))+            right.hide();+        toggleButton();+        left.find('.panel').prepend(toggle);     }); });

@@ -0,0 +1,4 @@+-- Tail-recursive functions will use +-- constant stack space+sum 0 acc = acc+sum n acc = sum (n - 1) (acc + n)

@@ -1,11 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Main where+module Alert where  import Language.Fay.FFI import Language.Fay.Prelude -main :: IO ()+main :: Fay () main = alert "Hello, World!"  -- | Alert using window.alert.

@@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Main where+module Console where  import Language.Fay.FFI import Language.Fay.Prelude

@@ -0,0 +1,21 @@+-- Generate Show value.+-- +-- $ fay -autorun examples/data.hs+-- $ node examples/data.js+-- (Foo { x = 123, y = "abc", z = (Bar) })++{-# LANGUAGE NoImplicitPrelude #-}++module Data where++import Language.Fay.Prelude+import Language.Fay.FFI++data Foo = Foo { x :: Double, y :: String, z :: Foo } | Bar+  deriving (Show)+instance Foreign Foo++main = print (show (Foo 123 "abc" Bar))++print :: String -> Fay ()+print = foreignFay "console.log" ""

@@ -1,12 +1,16 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE NoImplicitPrelude #-} -module Main where+module Dom where  import Language.Fay.FFI import Language.Fay.Prelude -main = do+main :: Fay ()+main = addEventListener "load" printBody False++printBody :: Fay ()+printBody = do   result <- documentGetElements "body"   print result @@ -20,3 +24,7 @@ documentGetElements =   foreignFay "document.getElementsByTagName"              "array"++addEventListener :: String -> Fay () -> Bool -> Fay ()+addEventListener =+    foreignFay "window.addEventListener" ""

@@ -0,0 +1,31 @@+-- | Mutable references.++{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Ref where++import Language.Fay.FFI+import Language.Fay.Prelude++main :: Fay ()+main = do+  ref <- newRef "Hello, World!"+  readRef ref >>= print+  writeRef ref "Hai!"+  readRef ref >>= print++print :: String -> Fay ()+print = foreignFay "console.log" ""++data Ref a+instance Foreign a => Foreign (Ref a)++newRef :: Foreign a => a -> Fay (Ref a)+newRef = foreignFay "new Fay$$Ref" ""++writeRef :: Foreign a => Ref a -> a -> Fay ()+writeRef = foreignFay "Fay$$writeRef" ""++readRef :: Foreign a => Ref a -> Fay a+readRef = foreignFay "Fay$$readRef" ""

@@ -0,0 +1,37 @@+-- | A demo to show that a tail-recursive function will not increase+-- the JavaScript stack.+--+-- See the ticket about optimizing tail-recursive functions for future+-- work <https://github.com/chrisdone/fay/issues/19>++{-# LANGUAGE NoImplicitPrelude #-}++module Tailrecursive where++import Language.Fay.FFI+import Language.Fay.Prelude++main = do+  benchmark+  benchmark+  benchmark+  benchmark++benchmark = do+  start <- getSeconds+  printD (sum 1000000 0 :: Double)+  end <- getSeconds+  printS (show (end-start) ++ "ms")++-- tail recursive+sum 0 acc = acc+sum n acc = sum (n - 1) (acc + n)++getSeconds :: Fay Double+getSeconds = foreignFay "new Date" ""++printD :: Double -> Fay ()+printD = foreignFay "console.log" ""++printS :: String -> Fay ()+printS = foreignFay "console.log" ""

@@ -1,8 +1,94 @@ name:                fay-version:             0.1.0.0+version:             0.1.1.0 synopsis:            A compiler for Fay, a Haskell subset that compiles to JavaScript. description:         Fay is a strict subset of Haskell which can be compiled (type-checked)                       with GHC, and compiled to JavaScript.+                     .+                     /Documentation/+                     .+                     See documentation at <http://fay-lang.org/> or build your own documentation with:+                     .+                     > $ cabal build+                     > $ dist/build/fay-docs/fay-docs+                     .+                     . +                     /Examples/+                     .+                     See <http://fay-lang.org/#examples>.+                     .+                     /Release Notes/+                     .+                     Lots of documentation updates, some runtime+                     fixes, some more examples, tail-call optimization+                     prototype.+                     .+                     * Add analytics to .cabal.+                     .+                     * Fix types for ghc.+                     .+                     * Use continue (for now) for TCO (refs #19).+                     .+                     * Tail recursive optimization prototype (refs #19).+                     .+                     * Tail recursive example doc.+                     .+                     * Ref example.+                     .+                     * fromInteger/fromRational in the runtime (closes #20).+                     .+                     * Add missing operators to Prelude and built-ins list (closes #16).+                     .+                     * Throw error about unsupported `where' (closes #17).+                     .+                     * Fix silly enumFromTo mistake.+                     .+                     * A test-case that tail-recursive functions run iteratively.+                     .+                     * Optimize constant patterns slightly, shaves off some time.+                     .+                     * Add Fay.Show (preliminary implementation).+                     .+                     * Add data/show example.+                     .+                     * Add note about generating docs.+                     .+                     * Add note that you need nodejs installed to run the tests.+                     .+                     * Include google analytics in docs and generate index.html rather than home.html.+                     .+                     * Updated dom example with onload handler.+                     .+                     * Remove max-width to fix firefox.+                     .+                     * Mention minifying slightly in docs.+                     .+                     * Remove language-javascript dependency.+                     .+                     * Remove non-ascii character in runtime.js+                     .+                     * Don't print counts in fay-tests.+                     .+                     * Add small note about livescript.+                     .+                     * Added fork on github for docs.+                     .+                     * Use === instead of == for jseq (closes #6).+                     .+                     * Some word break on the pre's.+                     .+                     * Rename modules from Main to X (closes #5).+                     .+                     * Ignore more stuff.+                     .+                     * Toggle examples.+                     .+                     * Put examples side-by-side (closes #3).+                     .+                     * s/strict/proper to avoid confusion.+                     .+                     * Convert from function expression assignments to function definitions+                     .+                     See full history at: <https://github.com/chrisdone/fay/commits> homepage:            http://chrisdone.com/fay license:             BSD3 license-file:        LICENSE@@ -15,7 +101,8 @@ data-files:          js/runtime.js                      hs/stdlib.hs                      src/Language/Fay/Stdlib.hs-extra-source-files:  examples/alert.hs examples/alert.hs examples/console.hs examples/dom.hs+extra-source-files:  examples/ref.hs examples/alert.hs examples/console.hs examples/dom.hs+                     examples/tailrecursive.hs examples/data.hs                      -- 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@@ -23,9 +110,11 @@                      tests/2 tests/20 tests/20.hs tests/21 tests/21.hs tests/22 tests/22.hs                      tests/23 tests/23.hs tests/24 tests/24.hs tests/25.hs tests/26 tests/26.hs                      tests/2.hs tests/3 tests/3.hs tests/4 tests/4.hs tests/5 tests/5.hs tests/6-                     tests/6.hs tests/7 tests/7.hs tests/8 tests/8.hs tests/9 tests/9.hs+                     tests/6.hs tests/7 tests/7.hs tests/8 tests/8.hs tests/9 tests/9.hs tests/27+                     tests/27.hs tests/28 tests/28.hs                      -- Documentation files                      docs/beautify.js docs/highlight.pack.js docs/home.css docs/home.js docs/jquery.js+                     docs/analytics.js                      -- Documentation snippets                      docs/snippets/conditions.hs                      docs/snippets/data.hs@@ -36,17 +125,21 @@                      docs/snippets/functions.hs                      docs/snippets/lists.hs                      docs/snippets/patterns.hs+                     docs/snippets/tail.hs+                     -- Misc+                     CHANGELOG  library   hs-source-dirs:    src-  exposed-modules:   Language.Fay, Language.Fay.Types, Language.Fay.FFI, Language.Fay.Prelude-  other-modules:     Language.Fay.Print, Control.Monad.IO, Language.Fay.Stdlib+  exposed-modules:   Language.Fay, Language.Fay.Types, Language.Fay.FFI, Language.Fay.Prelude, Language.Fay.Show+  other-modules:     Language.Fay.Print, Control.Monad.IO, Language.Fay.Stdlib, System.Process.Extra   ghc-options:       -O2   build-depends:     base >= 4 && < 5,                      mtl,-                     language-javascript,                      haskell-src-exts,                      json,+                     pretty-show,+                     data-default,                       -- Requirements for the executables which                      -- `cabal-dev ghci' needs.@@ -65,9 +158,10 @@   main-is:           Main.hs   build-depends:     base >= 4 && < 5,                      mtl,-                     language-javascript,                      haskell-src-exts,-                     json+                     json,+                     process,+                     data-default  executable fay-tests   hs-source-dirs:    src@@ -76,13 +170,13 @@   other-modules:     Language.Fay.Compiler   build-depends:     base >= 4 && < 5,                      mtl,-                     language-javascript,                      haskell-src-exts,                      json,                      HUnit,                      process,                      filepath,-                     directory+                     directory,+                     data-default  executable fay-docs   hs-source-dirs:    src@@ -91,7 +185,6 @@   other-modules:     Text.Blaze.Extra   build-depends:     base >= 4 && < 5,                      mtl,-                     language-javascript,                      haskell-src-exts,                      json,                      HUnit,@@ -101,4 +194,5 @@                      blaze-html,                      blaze-markup,                      bytestring,-                     time+                     time,+                     data-default

@@ -11,3 +11,10 @@ data Maybe a   = Just a   | Nothing++show :: (Foreign a,Show a) => a -> String+show = foreignPure "Fay$$encodeShow" "string"++-- There is only Double in JS.+fromInteger x = x+fromRational x = x

@@ -6,18 +6,18 @@ */  // Force a thunk (if it is a thunk) until WHNF.-var _ = function(thunkish,nocache){+function _(thunkish,nocache){   while (thunkish instanceof $) {     thunkish = thunkish.force(nocache);   }   return thunkish;-};+}  // Thunk object. function $(value){   this.forced = false;   this.value = value;-};+}  // Force the thunk. $.prototype.force = function(nocache){@@ -52,31 +52,31 @@ }  // >>-var Fay$$then = function(a){+function Fay$$then(a){   return function(b){     return new $(function(){       _(a,true);       return b;     });   };-};+}  // >>=-var Fay$$bind = function(m){+function Fay$$bind(m){   return function(f){     return new $(function(){       var monad = _(m,true);       return f(monad.value);     });   };-};+}  var Fay$$unit = null;  // return-var Fay$$return = function(a){+function Fay$$return(a){   return new Fay$$Monad(a);-};+}  /******************************************************************************* * FFI.@@ -180,7 +180,7 @@ function Fay$$Cons(car,cdr){   this.car = car;   this.cdr = cdr;-};+}  // Make a list. function Fay$$list(xs){@@ -188,14 +188,14 @@   for(var i=xs.length-1; i>=0;i--)     out = new Fay$$Cons(xs[i],out);   return out;-};+}  // Built-in list cons.-var Fay$$cons = function(x){+function Fay$$cons(x){   return function(y){     return new Fay$$Cons(x,y);   };-};+}  // List index. function Fay$$index(index){@@ -211,33 +211,33 @@ * Numbers. */ -// Built-in ×.-var Fay$$mult = function(x){+// Built-in *.+function Fay$$mult(x){   return function(y){     return _(x) * _(y);   };-};+}  // Built-in +.-var Fay$$add = function(x){-  return function(y){ +function Fay$$add(x){+  return function(y){     return _(x) + _(y);   };-};+}  // Built-in -.-var Fay$$sub = function(x){+function Fay$$sub(x){   return function(y){     return _(x) - _(y);   };-};+}  // Built-in /.-var Fay$$div = function(x){+function Fay$$div(x){   return function(y){     return _(x) / _(y);   };-};+}  /******************************************************************************* * Booleans.@@ -248,7 +248,7 @@   // Simple case   lit1 = _(lit1);   lit2 = _(lit2);-  if(lit1 == lit2) {+  if(lit1 === lit2) {     return true;   }   // General case@@ -262,51 +262,65 @@   } 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);+    return (lit1 === null && lit2 === null);   } else return false; }  // Built-in ==.-var Fay$$eq = function(x){+function Fay$$eq(x){   return function(y){     return Fay$$equal(x,y);   };-};+}  // Built-in /=.-var Fay$$neq = function(x){+function Fay$$neq(x){   return function(y){     return !(Fay$$equal(x,y));   };-};+}  // Built-in >.-var Fay$$gt = function(x){+function Fay$$gt(x){   return function(y){     return _(x) > _(y);   };-};+}  // Built-in <.-var Fay$$lt = function(x){+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 &&.-var Fay$$and = function(x){+function Fay$$and(x){   return function(y){     return _(x) && _(y);   };-};+}  // Built-in ||.-var Fay$$or = function(x){+function Fay$$or(x){   return function(y){     return _(x) || _(y);   };-};+}  /******************************************************************************* * Mutable references.@@ -332,7 +346,7 @@ */ function Fay$$date(str){   return window.Date.parse(str);-};+}  /******************************************************************************* * Application code.

@@ -6,26 +6,27 @@  module Main where -import           Language.Fay+import           Language.Fay (compileViaStr,compileModule)  import           Control.Exception import           Control.Monad import qualified Data.ByteString.Lazy as L import           Data.Char+import           Data.Default import           Data.List (isSuffixOf,sort) import           Data.Time import           Prelude hiding (head,div) import           System.Directory import           System.FilePath import           Text.Blaze.Extra-import           Text.Blaze.Html5 as H hiding (contents,map)+import           Text.Blaze.Html5 as H hiding (contents,map,style) import           Text.Blaze.Html5.Attributes as A hiding (title) import           Text.Blaze.Renderer.Utf8 (renderMarkup)  -- | Main entry point. main :: IO () main = do-  let file = "docs" </> "home.html"+  let file = "docs" </> "index.html"   generate >>= L.writeFile file   putStrLn $ "Documentation file written to " ++ file   @@ -33,12 +34,15 @@   sources <- mapM readFile examples   javascripts <- mapM compile examples   now <- getCurrentTime-  return $ renderMarkup $ page now (zip3 (map titlize examples) sources javascripts)+  analytics <- readFile $ "docs" </> "analytics.js"+  return $ renderMarkup $ page now+                               analytics+                               (zip3 (map titlize examples) sources javascripts)        where compile file = do           contents <- readFile file           putStrLn $ "Compiling " ++ file ++ " ..."-          result <- compileViaStr compileModule contents+          result <- compileViaStr def compileModule contents           case result of             Right javascript -> return javascript             Left err -> throw err@@ -47,13 +51,13 @@                 upperize xs = xs         examples = map (("docs" </> "snippets") </>)                        (map (++".hs")-                            (words "declarations conditions functions lists data enums patterns ffi dom"))+                            (words "declarations conditions functions lists data enums patterns ffi dom tail")) -page now examples = do+page now analytics examples = do   docType   html $ do     head $ thehead-    body $ thebody now examples+    body $ thebody now analytics examples  thehead = do   title $ "The Fay Programming Language — A Haskell subset"@@ -64,7 +68,8 @@   script ! src "beautify.js" $ return ()   script ! src "home.js" $ return () -thebody now examples = do+thebody now analytics examples = do+  fork   div !. "wrap" $ do     theheading     theintro@@ -74,17 +79,23 @@     theexamples examples     thereference     thefooter now+  preEscapedToMarkup analytics +fork = +  a ! href "https://github.com/chrisdone/fay" $+    img ! style "position: absolute; top: 0; right: 0; border: 0;"+        ! src "https://s3.amazonaws.com/github/ribbons/forkme_right_darkblue_121621.png"+        ! alt "Fork me on GitHub"  theheading = do   h1 "Fay programming language"-  div !. "subheadline" $ "A strict subset of Haskell that compiles to JavaScript"+  div !. "subheadline" $ "A proper subset of Haskell that compiles to JavaScript"  theexamples examples = do   a ! name "examples" $ return ()   h2 "Examples"   p $ do "The following examples are generated from the "-         code "examples"+         code "docs/snippets"          " directory in the Fay project distribution. "          "The Fay tab of each example shows the original Fay code, and the "          " JavaScript tab shows the actual generated output of the compiler "@@ -93,16 +104,23 @@          "Thus, the symbol "; code "$"; " means “thunk”, and the symbol "; code "_"          " means “force”."   forM_ examples $ \(file,fay,javascript) -> do-    h3 $ toHtml file+    h3 !. "example-heading" $ toHtml file     div !. "example" $ do-      div !. "lang" $ em "Fay"-      pre !. "pre" $-        code !. "language-haskell" $-          toHtml fay-      div !. "lang" $ em "JavaScript"-      pre !. "pre" $-        code !. "language-javascript" $-          toHtml javascript+      table $ do+        tr $ do+          td $ do+            div !. "panel" $ do+              div !. "lang" $ em "Fay"+              pre !. "pre" $+                code !. "language-haskell" $+                  toHtml fay+          td $ do+            div !. "panel" $ do+              div !. "lang" $ em "JavaScript"+              pre !. "pre" $+                code !. "language-javascript" $+                  toHtml javascript+    div !. "example-clear" $ return ()  thefooter now =   div !. "footer" $ do@@ -117,13 +135,14 @@   h2 "Introduction"   p "Fay is a small programming language which has the following properties:"   ul $ do-    li $ do "A strict syntactic and semantic subset of "+    li $ do "A proper syntactic and semantic subset of "             a ! href "http://haskell.org/" $ "Haskell"     li $ "Statically typed"     li $ "Lazy"     li $ "Pure by default"     li $ "Compiles to JavaScript"     li $ "Has fundamental data types (Double, String, etc.) based upon what JS can support"+    li $ "Outputs minifier-aware code for small compressed size"     li $ "Has a trivial foreign function interface to JavaScript"   p $ do "Because Fay is intended to be small and simple, it relies on GHC, the Haskell compiler, "          "for static checking. So the workflow when working with Fay is: "@@ -148,7 +167,11 @@  thecomparisons = do   h2 "Comparisons to other methods"-  h3 "CoffeeScript"+  coffee+  royandelm++coffee = do+  h3 "CoffeeScript and LiveScript"   p $ do "CoffeeScript is a syntactic layer above JavaScript that does not change semantics. "          "It adds some additional syntactic constructs, but makes no fundamental changes, "          "you are still essentially working in JavaScript, but with more convenient "@@ -157,6 +180,11 @@          "different semantics. It is lazy, it has partial application and currying, "          "pattern matching for all data types, all expressions are pure and only "          "statements in the Fay monad can be impure."+  p $ do "LiveScript is also a similar approach in the wave of compile-to-JS projects "+         "that have developed in recent years. LiveScript's translation is also quite "+         "readable and predictable, this is also the only thing in common with Fay."++royandelm = do   h3 "Roy and Elm"   p $ do "Roy is an approach to bring functional programming to JavaScript, it has lots of "          "interesting features but it has different syntax and type-system semantics "@@ -193,13 +221,18 @@   p "And then install from the directory: "   pre $ code "$ cabal install"   h3 "Running"-  p "To check that everything is okay, run the tests:"+  p "To check that everything is okay, run the tests (you will need nodejs installed):"   pre $ code "$ fay-tests"   p "To compile a Fay program, run:"   pre $ code "$ fay -autorun foo.hs"   p $ do "The "; code "-autorun"; " flag will make sure that the "; code "main"; " function is called."   p "You can also install this via cabal-dev, but be sure to run the commands from the cabal-dev bin dir: "   pre $ code "$ cabal-dev install\n$ cabal-dev/bin/fay -autorun foo.hs"+  h3 "Generate this Documentation"+  p "This web page is generated by the following call in the project directory:"+  pre $ code "$ fay-docs"+  p $ do "If you are hacking on the project this can be useful to inspect, and "+         "if you add more features, please document them in "; code $ toHtml (takeFileName __FILE__); "."  thereference = do   h2 "Language Reference"

@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-}@@ -10,45 +11,73 @@ -- | The Haskell→Javascript compiler.  module Language.Fay-  (compile,compileViaStr,compileModule)+   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           Data.List-import           Data.String-import           Language.Haskell.Exts+import Control.Applicative+import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.IO+import Data.List+import Data.String+import Language.Haskell.Exts+-- import System.Process.Extra  -------------------------------------------------------------------------------- -- Top level entry points  -- | Compile something that compiles to something else.-compile :: CompilesTo from to => from -> IO (Either CompileError to)-compile = runCompile . compileTo+compile :: CompilesTo from to => Config -> from -> IO (Either CompileError to)+compile config = runCompile config . compileTo  -- | Run the compiler.-runCompile :: Compile a -> IO (Either CompileError a)-runCompile m = runErrorT m+runCompile :: Config -> Compile a -> IO (Either CompileError a)+runCompile config m = runErrorT (runReaderT m config)  -- | Compile a Haskell source string to a JavaScript source string. compileViaStr :: (Show from,Show to,CompilesTo from to)-              => (from -> Compile to)+              => Config+              -> (from -> Compile to)               -> String               -> IO (Either CompileError String)-compileViaStr with from =-  runCompile (parseResult (throwError . uncurry ParseError)+compileViaStr config with from =+  runCompile config+             (parseResult (throwError . uncurry ParseError)                           (fmap printJS . with)                           (parse from)) +-- | Compile a Haskell source string to a JavaScript source string.+compileToAst :: (Show from,Show to,CompilesTo from to)+              => Config+              -> (from -> Compile to)+              -> String+              -> IO (Either CompileError to)+compileToAst config with from =+  runCompile config+             (parseResult (throwError . uncurry ParseError)+                          with+                          (parse from))+ compileFromStr with from =   parseResult (throwError . uncurry ParseError)               (with)               (parse from) +-- printCompile :: (Show from,Show to,CompilesTo from to)+--               => Config+--               -> (from -> Compile to)+--               -> String+--               -> IO ()+-- printCompile config with from = do+--   result <- compileViaStr config with from+--   case result of+--     Left err -> putStrLn $ show err+--     Right ok -> do writeFile "/tmp/x.js" ok+--                    prettyPrintFile "/tmp/x.js" >>= putStr+ -------------------------------------------------------------------------------- -- Compilers @@ -103,7 +132,7 @@     InstDecl{} -> return [] -- FIXME: Ignore.     _ -> throwError (UnsupportedDeclaration decl) -compilePatBind :: Maybe Type -> Decl -> ErrorT CompileError IO [JsStmt]+compilePatBind :: Maybe Type -> Decl -> Compile [JsStmt] compilePatBind sig pat =   case pat of     PatBind _ (PVar ident) Nothing (UnGuardedRhs rhs) (BDecls []) ->@@ -251,7 +280,10 @@ compileFunCase :: [Match] -> Compile [JsStmt] compileFunCase [] = return [] compileFunCase matches@(Match _ name argslen _ _ _:_) = do-  pats <- fmap optimizePatConditions $ forM matches $ \(Match _ _ pats _ rhs _) -> do+  tco <- asks configTCO+  pats <- fmap optimizePatConditions $ forM matches $ \match@(Match _ _ pats _ rhs wheres) -> do+    unless (noBinds wheres) $ do throwError (UnsupportedWhereInMatch match) -- TODO: Support `where'.+                                 return ()     exp <- compileRhs rhs     foldM (\inner (arg,pat) -> do              compilePat (JsName arg) pat inner)@@ -259,7 +291,10 @@           (zip args pats)   return [JsVar (UnQual name)                 (foldr (\arg inner -> JsFun [arg] [] (Just inner))-                       (stmtsThunk (concat pats ++ basecase))+                       (stmtsThunk (let stmts = (concat pats ++ basecase)+                                    in if tco+                                          then optimizeTailCalls args name stmts+                                          else stmts))                        args)]   where args = zipWith const uniqueNames argslen         basecase = if any isWildCardMatch matches@@ -267,7 +302,48 @@                       else [throw ("unhandled case in " ++ show name)                                   (JsList (map JsName args))]         isWildCardMatch (Match _ _ pats _ _ _) = all isWildCardPat pats+        noBinds (BDecls []) = True+        noBinds (IPBinds []) = True+        noBinds _ = False +-- | Optimize functions in tail-call form.+optimizeTailCalls :: [JsParam] -- ^ The function parameters.+                  -> Name      -- ^ The function name.+                  -> [JsStmt]  -- ^ The body of the function.+                  -> [JsStmt]  -- ^ A new optimized function body.+optimizeTailCalls params name stmts = abandonIfNoChange $+  JsWhile (JsLit (JsBool True))+          (concatMap replaceTailStmt+                     (reverse (zip (reverse stmts) [0..])))+  +  where replaceTailStmt (JsIf cond sothen orelse,i) = [JsIf cond (concatMap (replaceTailStmt . (,i)) sothen)+                                                                 (concatMap (replaceTailStmt . (,i)) orelse)]+        replaceTailStmt (JsEarlyReturn exp,i) = expTailReplace i exp+        replaceTailStmt (x,_) = [x]+        expTailReplace i (flatten -> Just (JsName (UnQual call):args@(_:_)))+          | call == name = updateParamsInstead i args+        expTailReplace i original = [JsEarlyReturn original]+        updateParamsInstead i args = zipWith JsUpdate params args +++                                     [JsContinue | i /= 0]+        abandonIfNoChange new@(JsWhile _ newstmts)+          | newstmts == stmts = stmts+          | otherwise         = [new]++flatten :: JsExp -> Maybe [JsExp]+flatten (JsApp op@JsApp{} arg) = do+  inner <- expand op+  return (inner ++ arg)+flatten name@JsName{} = return [name]+flatten x = Nothing++expand (JsApp (JsName (UnQual (Ident "_"))) xs) = do+  fmap concat (mapM flatten xs)+expand x = Nothing++-- -- | Run a JS file.+-- prettyPrintFile :: String -> IO String+-- prettyPrintFile file = fmap (either id id) (readAllFromProcess "js-beautify" file)+ -- | Compile a right-hand-side expression. compileRhs :: Rhs -> Compile JsExp compileRhs (UnGuardedRhs exp) = compileExp exp@@ -316,7 +392,8 @@                                         return (JsApp (JsName "enumFrom") [e])     EnumFromTo i i'               -> do f <- compileExp i                                         t <- compileExp i'-                                        return (JsApp (JsName "enumFromTo") [f,t])+                                        return (JsApp (JsApp (JsName "enumFromTo") [f])+                                                      [t])     ExpTypeSig _ e _ -> compileExp e      exp -> throwError (UnsupportedExpression exp)@@ -338,13 +415,14 @@         name _        = False  compileInfixApp :: Exp -> QOp -> Exp -> Compile JsExp-compileInfixApp exp1 op exp2 =+compileInfixApp exp1 op exp2 = do+  config <- ask   case getOp op of     UnQual (Symbol symbol)       | symbol `elem` words "* + - / < > || &&" -> do           e1 <- compileExp exp1           e2 <- compileExp exp2-          return (JsInfix symbol (force e1) (force e2)) +          return (JsInfix symbol (forceInlinable config e1) (forceInlinable config e2))      _ -> do       var <- resolveOpToVar op       compileExp (App (App var exp1) exp2)@@ -374,7 +452,6 @@   case stmts of     [JsEarlyReturn fun@JsFun{}] -> return fun     _ -> error "Unexpected statements in compileLambda"---  return (JsApp (JsFun [] (stmts) Nothing) [])    where unhandledcase = throw "unhandled case" . JsName         allfree = all isWildCardPat pats@@ -446,11 +523,20 @@ compilePLit :: JsExp -> Literal -> [JsStmt] -> Compile [JsStmt] compilePLit exp literal body = do   lit <- compileLit literal-  return [JsIf (JsApp (JsName (hjIdent "equal"))-                      [exp,lit])+  return [JsIf (equalExps exp lit)                body                []] +equalExps a b +  | isConstant a && isConstant b = JsEq a b+  | isConstant a = JsEq a (force b)+  | isConstant b = JsEq (force a) b+  | otherwise =+     JsApp (JsName (hjIdent "equal")) [a,b]++isConstant JsLit{} = True+isConstant _       = False+ compilePApp :: QName -> [Pat] -> JsExp -> [JsStmt] -> Compile [JsStmt] compilePApp cons pats exp body = do   let forcedExp = force exp@@ -617,18 +703,19 @@  -- | Force an expression in a thunk. force :: JsExp -> JsExp-force exp =-  JsApp (JsName "_") [exp]---- | Force an expression in a thunk.-monadValue :: JsExp -> JsExp-monadValue exp =-  JsGetProp (forceNoMemoize exp) "value"+force exp+  | isConstant exp = exp+  | otherwise = JsApp (JsName "_") [exp]  -- | Force an expression in a thunk.-forceNoMemoize :: JsExp -> JsExp-forceNoMemoize exp =-  JsApp (JsName (hjIdent "force")) [exp,JsLit (JsBool True)]+forceInlinable :: Config -> JsExp -> JsExp+forceInlinable config exp+  | isConstant exp = exp+  | configInlineForce config =+    JsParen (JsTernaryIf (exp `JsInstanceOf` ":thunk")+                         (JsApp (JsName "_") [exp])+                         exp)+  | otherwise = JsApp (JsName "_") [exp]  -- | Resolve operators to only built-in (for now) functions. resolveOpToVar :: QOp -> Compile Exp@@ -643,6 +730,8 @@       | symbol == "/="  -> return (Var (hjIdent "neq"))       | symbol == ">"   -> return (Var (hjIdent "gt"))       | symbol == "<"   -> return (Var (hjIdent "lt"))+      | symbol == ">="  -> return (Var (hjIdent "gte"))+      | symbol == "<="  -> return (Var (hjIdent "lte"))       | symbol == "&&"  -> return (Var (hjIdent "and"))       | symbol == "||"  -> return (Var (hjIdent "or"))       | symbol == ">>=" -> return (Var (hjIdent "bind"))

@@ -1,15 +1,14 @@ {-# LANGUAGE ViewPatterns #-} module Language.Fay.Compiler where -import Language.Fay+import Control.Exception  (throw)+import Language.Fay (compileViaStr,compileModule) import Language.Fay.Types import Paths_fay -import Control.Exception  (throw)- -- | Compile file program to…-compileFromTo :: Bool -> FilePath -> FilePath -> IO ()-compileFromTo autorun filein fileout = do+compileFromTo :: Config -> Bool -> FilePath -> FilePath -> IO ()+compileFromTo config autorun filein fileout = do   runtime <- getDataFileName "js/runtime.js"   stdlibpath <- getDataFileName "hs/stdlib.hs"   stdlibpathprelude <- getDataFileName "src/Language/Fay/Stdlib.hs"@@ -17,7 +16,11 @@   stdlib <- readFile stdlibpath   stdlibprelude <- readFile stdlibpathprelude   hscode <- readFile filein-  result <- compileProgram autorun raw compileModule (hscode ++ "\n" ++ stdlib ++ "\n" ++ strip stdlibprelude)+  result <- compileProgram config+                           autorun+                           raw+                           compileModule+                           (hscode ++ "\n" ++ stdlib ++ "\n" ++ strip stdlibprelude)   case result of     Right out -> writeFile fileout out     Left  err -> throw err@@ -26,10 +29,10 @@  -- | Compile the given module to a runnable program. compileProgram :: (Show from,Show to,CompilesTo from to)-               => Bool -> String -> (from -> Compile to) -> String+               => Config -> Bool -> String -> (from -> Compile to) -> String                -> IO (Either CompileError String)-compileProgram autorun raw with hscode = do-  result <- compileViaStr with hscode+compileProgram config autorun raw with hscode = do+  result <- compileViaStr config with hscode   case result of     Left err -> return (Left err)     Right jscode -> return (Right (unlines ["var Fay = function(){"

@@ -22,6 +22,9 @@   ,(-)   ,(>)   ,(<)+  ,(>=)+  ,(<=)+  ,(/)   ,(||)   ,(&&)   ,fail@@ -33,7 +36,7 @@ import Language.Fay.Stdlib  import Prelude ((>),(<),(==),(||),(&&),Maybe(..),Double,Ord,Integer,error,String,(+),Bool(..),Char,Show(..)-               ,Read(..),read,(/=),(*),(-))+               ,Read(..),read,(/=),(*),(-),(<=),(>=),(/)) import GHC.Real (Ratio)  -- | Just to satisfy GHC.

@@ -79,6 +79,8 @@ instance Printable JsStmt where   printJS (JsVar name expr) =     (unwords ["var",printJS name,"=",printJS expr ++ ";"])+  printJS (JsUpdate name expr) =+    (unwords [printJS name,"=",printJS expr ++ ";"])   printJS (JsIf exp thens elses) =     concat       [("if (" ++ printJS exp ++ ") {")@@ -91,6 +93,11 @@     ("return " ++ printJS exp ++ ";")   printJS (JsThrow exp) =     ("throw " ++ printJS exp ++ ";")+  printJS (JsWhile cond stmts) =+    unwords ["while (" ++ printJS cond ++ ") {"+            ,printJS stmts+            ,"}"]+  printJS JsContinue = "continue;"  -- | Print an expression. instance Printable JsExp where@@ -137,7 +144,7 @@   printJS (JsIndex i exp) =      "(" ++ printJS exp ++ ")[" ++ show i ++ "]"   printJS (JsEq exp1 exp2) =-    printJS exp1 ++ " == " ++ printJS exp2+    printJS exp1 ++ " === " ++ printJS exp2   printJS (JsGetProp exp prop) =     printJS exp ++ "." ++ printJS prop   printJS (JsInfix op x y) =

@@ -0,0 +1,33 @@+-- | Convert a Haskell value to a Fay value.++module Language.Fay.Show where++import Data.List+import Text.JSON+import Text.Show.Pretty++-- | Convert a Haskell value to a Fay value. To read this in from JS,+-- use Fay.eval() which will evaluate the code in the context of Fay.+showToFay :: Show a => a -> String+showToFay a = case reify a of+  Nothing -> error $ "Unable to reify data type: " ++ show a+  Just a -> convert a+  +  where convert a = case a of+          Con "Date" [String s] -> "Fay$$date(" ++ encode (read s :: String) ++ ")"+          Con name [] -> name+          Con name values -> con name values+          Rec name [] -> name+          Rec name fields -> con name (map snd fields)+          Tuple xs -> "Fay$$tuple([" ++ intercalate "," (map convert xs) ++ "])"+          List xs -> "Fay$$list([" ++ intercalate "," (map convert xs) ++ "])"+          -- Not great:+          Neg v -> "-" ++ convert v+          Ratio x y -> convert x ++ "/" ++ convert y+          Integer x -> x+          Float x -> x+          Char x -> encode (read x :: Char)+          String x -> "Fay$$list(" ++ encode (read x :: String) ++ ")"+            +        con name values = foldr app name (reverse values) where+          app arg rest = rest ++ "(" ++ convert arg ++ ")"

@@ -95,7 +95,10 @@  enumFrom i = i : enumFrom (i + 1) -enumFromTo i n = if i == n then [] else i : enumFromTo (i + 1) n+enumFromTo i n =+  if i == n+     then [i]+     else i : enumFromTo (i + 1) n  zipWith :: (a->b->c) -> [a]->[b]->[c] zipWith f (a:as) (b:bs) = f a b : zipWith f as bs

@@ -15,20 +15,31 @@   ,Compile   ,CompilesTo(..)   ,Printable(..)-  ,Fay)+  ,Fay+  ,Config(..))   where  import Control.Exception import Control.Monad.Error (Error,ErrorT) import Control.Monad.Identity (Identity)+import Control.Monad.Reader import Data.Data+import Data.Default import Language.Haskell.Exts  -------------------------------------------------------------------------------- -- Compiler types +data Config = Config+  { configTCO         :: Bool+  , configInlineForce :: Bool+  } deriving (Show)++instance Default Config where+  def = Config False False+ -- | Convenience/doc type.-type Compile = ErrorT CompileError IO+type Compile = ReaderT Config (ErrorT CompileError IO)  -- | Convenience type for function parameters. type JsParam = JsName@@ -50,6 +61,7 @@   = ParseError SrcLoc String   | UnsupportedDeclaration Decl   | UnsupportedMatchSyntax Match+  | UnsupportedWhereInMatch Match   | UnsupportedExpression Exp   | UnsupportedLiteral Literal   | UnsupportedLetBinding Decl@@ -80,6 +92,9 @@   | JsIf JsExp [JsStmt] [JsStmt]   | JsEarlyReturn JsExp   | JsThrow JsExp+  | JsWhile JsExp [JsStmt]+  | JsUpdate JsName JsExp+  | JsContinue   deriving (Show,Eq)    -- | Expression type.

@@ -5,8 +5,10 @@ module Main where  import Language.Fay.Compiler+import Language.Fay.Types  import Control.Monad+import Data.Default import Data.List import System.Environment @@ -17,4 +19,9 @@   let files = filter (not . isPrefixOf "-") args       opts = map (drop 1) $ filter (isPrefixOf "-") args   forM_ files $ \file -> do-    compileFromTo (elem "autorun" opts) file (toJsName file)+    compileFromTo def { configTCO = elem "tco" opts+                      , configInlineForce = elem "inline-force" opts+                      }+                  (elem "autorun" opts)+                  file+                  (toJsName file)

@@ -0,0 +1,16 @@+-- | Extra process functions.++module System.Process.Extra where++import System.Exit+import System.IO+import System.Process++-- | Read all stuff from a process.+readAllFromProcess :: FilePath -> String -> IO (Either String String)+readAllFromProcess program file = do+  (_,out,err,pid) <- runInteractiveProcess program [file] Nothing Nothing+  code <- waitForProcess pid+  case code of+    ExitSuccess -> fmap Right (hGetContents out)+    ExitFailure _ -> fmap Left (hGetContents err)

@@ -2,17 +2,19 @@  import Language.Fay.Compiler +import Data.Default import Data.List import System.Directory import System.Exit import System.FilePath import System.IO import System.Process+import System.Process.Extra import Test.HUnit  -- | Main test runner. main :: IO ()-main = runUnitTests >>= print+main = runUnitTests >> return ()  -- | Run the case-by-case unit tests. runUnitTests :: IO Counts@@ -26,7 +28,7 @@               let root = (reverse . drop 1 . dropWhile (/='.') . reverse) file                   out = toJsName file               outExists <- doesFileExist root-              compileFromTo True file out+              compileFromTo def True file out               result <- runJavaScriptFile out               if outExists                  then do output <- readFile root@@ -36,12 +38,3 @@ -- | Run a JS file. runJavaScriptFile :: String -> IO (Either String String) runJavaScriptFile file = readAllFromProcess "node" file---- | Read all stuff from a process.-readAllFromProcess :: FilePath -> String -> IO (Either String String)-readAllFromProcess program file = do-  (_,out,err,pid) <- runInteractiveProcess program [file] Nothing Nothing-  code <- waitForProcess pid-  case code of-    ExitSuccess -> fmap Right (hGetContents out)-    ExitFailure _ -> fmap Left (hGetContents err)

@@ -0,0 +1,1 @@+5000050000

@@ -0,0 +1,20 @@+-- | This is to test tail-recursive calls are iterative.++{-# LANGUAGE NoImplicitPrelude #-}++module Fib where++import Language.Fay.FFI+import Language.Fay.Prelude++main = do+  print (sum 100000 0 :: Double)++sum 0 acc = acc+sum n acc = sum (n - 1) (acc + n)++getSeconds :: Fay Double+getSeconds = foreignFay "new Date" ""++print :: Foreign a => a -> Fay ()+print = foreignFay "console.log" ""

@@ -0,0 +1,1 @@+5

@@ -0,0 +1,11 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test where++import Language.Fay.Prelude+import Language.Fay.FFI++print :: Foreign a => a -> Fay ()+print = foreignFay "console.log" ""++main :: Fay ()+main = print $ show $ fromInteger 5