diff --git a/CHANGELOG b/CHANGELOG
new file mode 100644
--- /dev/null
+++ b/CHANGELOG
@@ -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.
+
diff --git a/docs/analytics.js b/docs/analytics.js
new file mode 100644
--- /dev/null
+++ b/docs/analytics.js
@@ -0,0 +1,13 @@
+
diff --git a/docs/home.css b/docs/home.css
--- a/docs/home.css
+++ b/docs/home.css
@@ -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;
diff --git a/docs/home.js b/docs/home.js
--- a/docs/home.js
+++ b/docs/home.js
@@ -5,22 +5,52 @@
});
hljs.tabReplace = ' ';
hljs.initHighlightingOnLoad();
+ // Creates tabs from the code samples.
+ // $('.example').each(function(){
+ // var example = $(this);
+ // var tabs = $('');
+ // 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 = $('');
- 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 = $('Show JavaScript');
+ 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);
});
});
diff --git a/docs/snippets/tail.hs b/docs/snippets/tail.hs
new file mode 100644
--- /dev/null
+++ b/docs/snippets/tail.hs
@@ -0,0 +1,4 @@
+-- Tail-recursive functions will use
+-- constant stack space
+sum 0 acc = acc
+sum n acc = sum (n - 1) (acc + n)
diff --git a/examples/alert.hs b/examples/alert.hs
--- a/examples/alert.hs
+++ b/examples/alert.hs
@@ -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.
diff --git a/examples/console.hs b/examples/console.hs
--- a/examples/console.hs
+++ b/examples/console.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE NoImplicitPrelude #-}
-module Main where
+module Console where
import Language.Fay.FFI
import Language.Fay.Prelude
diff --git a/examples/data.hs b/examples/data.hs
new file mode 100644
--- /dev/null
+++ b/examples/data.hs
@@ -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" ""
diff --git a/examples/dom.hs b/examples/dom.hs
--- a/examples/dom.hs
+++ b/examples/dom.hs
@@ -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" ""
diff --git a/examples/ref.hs b/examples/ref.hs
new file mode 100644
--- /dev/null
+++ b/examples/ref.hs
@@ -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" ""
diff --git a/examples/tailrecursive.hs b/examples/tailrecursive.hs
new file mode 100644
--- /dev/null
+++ b/examples/tailrecursive.hs
@@ -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
+
+{-# 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" ""
diff --git a/fay.cabal b/fay.cabal
--- a/fay.cabal
+++ b/fay.cabal
@@ -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 or build your own documentation with:
+ .
+ > $ cabal build
+ > $ dist/build/fay-docs/fay-docs
+ .
+ .
+ /Examples/
+ .
+ See .
+ .
+ /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:
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
diff --git a/hs/stdlib.hs b/hs/stdlib.hs
--- a/hs/stdlib.hs
+++ b/hs/stdlib.hs
@@ -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
diff --git a/js/runtime.js b/js/runtime.js
--- a/js/runtime.js
+++ b/js/runtime.js
@@ -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.
diff --git a/src/Docs.hs b/src/Docs.hs
--- a/src/Docs.hs
+++ b/src/Docs.hs
@@ -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"
diff --git a/src/Language/Fay.hs b/src/Language/Fay.hs
--- a/src/Language/Fay.hs
+++ b/src/Language/Fay.hs
@@ -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"))
diff --git a/src/Language/Fay/Compiler.hs b/src/Language/Fay/Compiler.hs
--- a/src/Language/Fay/Compiler.hs
+++ b/src/Language/Fay/Compiler.hs
@@ -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(){"
diff --git a/src/Language/Fay/Prelude.hs b/src/Language/Fay/Prelude.hs
--- a/src/Language/Fay/Prelude.hs
+++ b/src/Language/Fay/Prelude.hs
@@ -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.
diff --git a/src/Language/Fay/Print.hs b/src/Language/Fay/Print.hs
--- a/src/Language/Fay/Print.hs
+++ b/src/Language/Fay/Print.hs
@@ -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) =
diff --git a/src/Language/Fay/Show.hs b/src/Language/Fay/Show.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Fay/Show.hs
@@ -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 ++ ")"
diff --git a/src/Language/Fay/Stdlib.hs b/src/Language/Fay/Stdlib.hs
--- a/src/Language/Fay/Stdlib.hs
+++ b/src/Language/Fay/Stdlib.hs
@@ -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
diff --git a/src/Language/Fay/Types.hs b/src/Language/Fay/Types.hs
--- a/src/Language/Fay/Types.hs
+++ b/src/Language/Fay/Types.hs
@@ -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.
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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)
diff --git a/src/System/Process/Extra.hs b/src/System/Process/Extra.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Process/Extra.hs
@@ -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)
diff --git a/src/Tests.hs b/src/Tests.hs
--- a/src/Tests.hs
+++ b/src/Tests.hs
@@ -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)
diff --git a/tests/27 b/tests/27
new file mode 100644
--- /dev/null
+++ b/tests/27
@@ -0,0 +1,1 @@
+5000050000
diff --git a/tests/27.hs b/tests/27.hs
new file mode 100644
--- /dev/null
+++ b/tests/27.hs
@@ -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" ""
diff --git a/tests/28 b/tests/28
new file mode 100644
--- /dev/null
+++ b/tests/28
@@ -0,0 +1,1 @@
+5
diff --git a/tests/28.hs b/tests/28.hs
new file mode 100644
--- /dev/null
+++ b/tests/28.hs
@@ -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