1.0.0

.eslintrc.json

@@ -0,0 +1,28 @@
+{
+  "parserOptions": {
+    "ecmaVersion": 5
+  },
+  "extends": "eslint:recommended",
+  "env": {
+    "commonjs": true
+  },
+  "rules": {
+    "strict": [2, "global"],
+    "block-scoped-var": 2,
+    "consistent-return": 2,
+    "eqeqeq": [2, "smart"],
+    "guard-for-in": 2,
+    "no-caller": 2,
+    "no-extend-native": 2,
+    "no-loop-func": 2,
+    "no-new": 2,
+    "no-param-reassign": 2,
+    "no-return-assign": 2,
+    "no-unused-expressions": 2,
+    "no-use-before-define": 2,
+    "radix": [2, "always"],
+    "indent": [2, 2, { "SwitchCase": 1 }],
+    "quotes": [2, "double"],
+    "semi": [2, "always"]
+  }
+}

.gitignore

@@ -0,0 +1,7 @@
+/.*
+!/.gitignore
+!/.eslintrc.json
+!/.travis.yml
+/bower_components/
+/node_modules/
+/output/

.travis.yml

@@ -0,0 +1,23 @@
+language: node_js
+dist: trusty
+sudo: required
+node_js: stable
+env:
+  - PATH=$HOME/purescript:$PATH
+install:
+  - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p')
+  - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz
+  - tar -xvf $HOME/purescript.tar.gz -C $HOME/
+  - chmod a+x $HOME/purescript
+  - npm install -g bower
+  - npm install
+  - bower install --prod
+script:
+  - npm run -s build
+  - bower install
+  - npm run -s test
+after_success:
+- >-
+  test $TRAVIS_TAG &&
+  echo $GITHUB_TOKEN | pulp login &&
+  echo y | pulp publish --no-push

README.md

@@ -0,0 +1,20 @@
+# purescript-ef EXPERIMENTAL
+
+[![Latest release](http://img.shields.io/github/release/safareli/purescript-ef.svg)](https://github.com/safareli/purescript-ef/releases)
+[![Build status](https://travis-ci.org/safareli/purescript-ef.svg?branch=master)](https://travis-ci.org/safareli/purescript-ef)
+
+Faster and safer implementation of the Effect monad.
+
+## Ef vs Eff
+
+`Ef` is faster then `Eff`, plus it's stacksafe. Also it's faster to type :p
+
+## Installation
+
+```
+bower install purescript-ef
+```
+
+## Documentation
+
+Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-ef).

bench/Bench/Main.js

@@ -0,0 +1,20 @@
+"use strict";
+
+exports.mkArr = function(){
+  return { count: 0 };
+};
+
+exports.pushToArr = function(xs) {
+  return function(x) {
+    return function() {
+      xs.count += 1
+      return xs;
+    };
+  };
+};
+
+exports.log = function(x) {
+  return function(){
+    console.log(x)
+  }
+};

bench/Bench/Main.purs

@@ -0,0 +1,140 @@
+module Bench.Main where
+
+import Prelude
+
+import Control.Monad.Ef (Ef)
+import Control.Monad.Ef.Class (liftEf)
+import Control.Monad.Eff (Eff)
+import Control.Monad.Aff (Aff, launchAff_)
+import Control.Monad.Eff.Class (class MonadEff, liftEff)
+import Control.Monad.Eff.Console (CONSOLE)
+import Control.Monad.Eff.Unsafe (unsafePerformEff)
+import Data.Traversable (for_, intercalate)
+import Performance.Minibench (BenchResult, benchWith', withUnits)
+
+
+type BenchEff = (console :: CONSOLE)
+
+testApply :: forall m. MonadEff BenchEff m => Int -> m Unit
+testApply n' = do
+  arr <- liftEff mkArr
+  applyLoop (void <<< liftEff <<< pushToArr arr) n'
+  where
+  applyLoop :: Monad m => (Int -> m Unit) -> Int -> m Unit
+  applyLoop eff max = go (pure unit) 0
+    where 
+    go acc n | n == max = acc
+    go acc n = go (acc <* eff n) (n + 1)
+
+
+testBindRight :: forall m. MonadEff BenchEff m => Int -> m Unit
+testBindRight n' = do
+  arr <- liftEff mkArr
+  bindRightLoop (void <<< liftEff <<< pushToArr arr) n'
+  where
+  bindRightLoop :: Monad m => (Int -> m Unit)  -> Int -> m Unit
+  bindRightLoop eff max = go (pure unit) 0
+    where 
+    go acc n | n == max = acc
+    go acc n = go (eff (max - n - 1) >>= const acc) (n + 1)
+
+
+testBindLeft :: forall m. MonadEff BenchEff m => Int -> m Unit
+testBindLeft n' = do
+  arr <- liftEff mkArr
+  bindLeftLoop (void <<< liftEff <<< pushToArr arr) n'
+  where
+  bindLeftLoop :: Monad m => (Int -> m Unit)  -> Int -> m Unit
+  bindLeftLoop eff max = go (pure unit) 0
+    where 
+    go acc n | n == max = acc
+    go acc n = go (acc >>= const (eff n)) (n + 1)
+
+
+testMap :: forall m. MonadEff BenchEff m => Int -> m Unit
+testMap n = do
+  arr <- liftEff mkArr
+  res <- mapLoop n (liftEff $ pushToArr arr 0)
+  pure unit
+  where
+  mapLoop :: Monad m => Int -> m Int -> m Int
+  mapLoop max i = 
+    if max == 0 
+      then i 
+      else mapLoop (max - 1) (map (_ + 1) i)
+
+
+main :: Eff BenchEff Unit
+main = do
+  log header
+  bench3 ">>=R" testBindRight testBindRight testBindRight [100, 500, 1000, 2000, 4000, 8000, 10000]
+  bench3 ">>=L" testBindLeft testBindLeft testBindLeft [100, 500, 1000, 2000, 4000, 8000]
+  bench3 "map" testMap testMap testMap [100, 500, 1000, 2000, 4000, 5000]
+  bench3 "apply" testApply testApply testApply [100, 500, 1000, 2000, 4000, 5000]
+
+extended :: Eff BenchEff Unit
+extended = do
+  log header
+  bench2 ">>=R" testBindRight testBindRight [20000, 50000, 100000, 1000000]
+  bench2 ">>=L" testBindLeft testBindLeft [20000, 50000, 100000, 1000000]
+  bench2 "map" testMap testMap [10000, 20000, 50000, 100000, 1000000, 350000, 700000]
+  bench2 "apply" testApply testApply [10000, 20000, 50000, 100000, 1000000]
+
+header :: String
+header = 
+  "| bench | type | n | mean | stddev | min | max |\n" <>
+  "| ----- | ---- | - | ---- | ------ | --- | --- |"
+
+bench3
+  :: String
+  -> (Int -> Eff BenchEff Unit)
+  -> (Int -> Ef BenchEff Unit)
+  -> (Int -> Aff BenchEff Unit)
+  -> Array Int
+  -> Eff BenchEff Unit
+bench3 name buildEff buildEf buildAff vals = for_ vals \val -> do 
+  logBench [name <> " build", "Eff", show val] $ benchWith' 1000 \_ -> buildEff val
+  logBench [name <> " build", "Aff", show val] $ benchWith' 1000 \_ -> buildAff val
+  logBench' [name <> " build", "Ef", show val] $ benchWith' 1000 \_ -> buildEf val
+  let eff = liftEff $ buildEff val
+  logBench [name <> " run", "Eff", show val] $ benchWith' 1000 \_ -> unsafePerformEff eff
+  let aff = launchAff_ $ buildAff val
+  logBench [name <> " run", "Aff", show val] $ benchWith' 1000 \_ -> unsafePerformEff aff
+  let ef = liftEf $ buildEf val
+  logBench' [name <> " run", "Ef", show val] $ benchWith' 1000 \_ -> unsafePerformEff ef
+
+bench2
+  :: String
+  -> (Int -> Ef BenchEff Unit)
+  -> (Int -> Aff BenchEff Unit)
+  -> Array Int
+  -> Eff BenchEff Unit
+bench2 name buildEf buildAff vals = for_ vals \val -> do 
+  logBench [name <> " build", "Aff", show val] $ benchWith' 4 \_ -> buildAff val
+  logBench' [name <> " build", "Ef", show val] $ benchWith' 4 \_ -> buildEf val
+  let aff = launchAff_ $ buildAff val
+  logBench [name <> " run", "Aff", show val] $ benchWith' 4 \_ -> unsafePerformEff aff
+  let ef = liftEf $ buildEf val
+  logBench' [name <> " run", "Ef", show val] $ benchWith' 4 \_ -> unsafePerformEff ef
+
+logBench'' :: (String -> String) -> Array String -> Eff BenchEff BenchResult -> Eff BenchEff Unit
+logBench'' f msg benchEff = do
+  res <- benchEff
+  let 
+    logStr = intercalate " | " 
+      $ append msg 
+      $ map (f <<< withUnits) [res.mean, res.stdDev, res.min, res.max]
+  log $  "| "  <> logStr <>  " |"
+
+logBench :: Array String -> Eff BenchEff BenchResult -> Eff BenchEff Unit
+logBench = logBench'' id
+
+logBench' :: Array String -> Eff BenchEff BenchResult -> Eff BenchEff Unit
+logBench' = logBench'' \s -> "**" <> s <> "**"
+
+foreign import data Arr :: Type -> Type
+
+foreign import mkArr :: forall e a. Eff e (Arr a)
+foreign import pushToArr :: forall e a. Arr a -> a -> Eff e a
+foreign import log :: forall e a. a -> Eff e Unit
+

bower.json

@@ -0,0 +1,29 @@
+{
+  "name": "purescript-ef",
+  "homepage": "https://github.com/safareli/purescript-ef",
+  "description": "Faster and safer implementation of the Effect monad",
+  "license": "MIT",
+  "repository": {
+    "type": "git",
+    "url": "git://github.com/safareli/purescript-ef.git"
+  },
+  "ignore": [
+    "**/.*",
+    "bower_components",
+    "node_modules",
+    "output",
+    "test",
+    "bower.json",
+    "package.json"
+  ],
+  "dependencies": {
+    "purescript-prelude": "^3.0.0",
+    "purescript-eff": "^3.1.0",
+    "purescript-unsafe-coerce": "^3.0.0"
+  },
+  "devDependencies": {
+    "purescript-foldable-traversable": "^3.6.1",
+    "purescript-minibench": "safareli/purescript-minibench#un-log",
+    "purescript-aff": "^4.0.1"
+  }
+}

package.json

@@ -0,0 +1,19 @@
+{
+  "private": true,
+  "scripts": {
+    "clean": "rimraf output && rimraf .pulp-cache",
+    "build": "eslint src && pulp build -- --censor-lib --strict",
+    "test": "pulp test",
+    "bench:build": "purs compile 'bench/**/*.purs' 'src/**/*.purs' 'bower_components/*/src/**/*.purs'",
+    "bench:run": "node --expose-gc -e 'require(\"./output/Bench.Main/index.js\").main()'",
+    "bench:run:extended": "node --expose-gc -e 'require(\"./output/Bench.Main/index.js\").extended()'",
+    "bench:all": "npm run bench:build && npm run bench:run && npm run bench:run:extended",
+    "bench": "npm run bench:build && npm run bench:run"
+  },
+  "devDependencies": {
+    "eslint": "^3.17.1",
+    "pulp": "^11.0.0",
+    "purescript-psa": "^0.5.1",
+    "rimraf": "^2.6.1"
+  }
+}

src/Control/Monad/Ff.js

@@ -0,0 +1,92 @@
+"use strict";
+
+
+// Ef a
+// = () -> a
+// | { Ef a, tag: "PURE",   _0 :: a,         _1 :: Void  }
+// | { Ef a, tag: "MAP",    _0 :: b -> a,    _1 :: Ef b }
+// | { Ef a, tag: "APPLY",  _0 :: Ef b,      _1 :: Ef (b -> a) }
+// | { Ef a, tag: "BIND",   _0 :: b -> Ef a, _1 :: Ef b }
+
+// Operation a b
+// = { tag: "MAP",        _0 :: a -> b }
+// | { tag: "APPLY",      _0 :: Ef a }
+// | { tag: "APPLY_FUNC", _0 :: a -> b }
+// | { tag: "BIND",       _0 :: a -> Ef b }
+
+
+var PURE = "PURE";
+var MAP = "MAP";
+var APPLY = "APPLY";
+var BIND = "BIND";
+var APPLY_FUNC = "APPLY_FUNC";
+
+
+var toEff = function (inputEff) {
+  var operations = [];
+  var eff = inputEff;
+  var res;
+  var op;
+  var tag;
+  effLoop: for (;;) {
+    tag = eff.tag;
+    if (tag !== undefined) {
+      if (tag === MAP || tag === BIND || tag === APPLY) {
+        operations.push(eff);
+        eff = eff._1;
+        continue;
+      }
+      // here `tag === PURE`
+      res = eff._0;
+    } else {
+      // here `typeof eff == "function"`
+      res = eff();
+    }
+
+    while ((op = operations.pop())) {
+      if (op.tag === MAP) {
+        res = op._0(res);
+      } else if (op.tag === APPLY_FUNC) {
+        res = op._0(res);
+      } else if (op.tag === APPLY) {
+        eff = op._0;
+        operations.push({ tag: APPLY_FUNC, _0: res });
+        continue effLoop;
+      } else { // op.tag === BIND
+        eff = op._0(res);
+        continue effLoop;
+      }
+    }
+    return res;
+  }
+};
+
+var mkEf = function (tag, _0, _1) {
+  var eff = function eff_() { return toEff(eff_); };
+  eff.tag = tag;
+  eff._0 = _0;
+  eff._1 = _1;
+  return eff;
+};
+
+exports.pureE = function (x) {
+  return mkEf(PURE, x);
+};
+
+exports.mapE = function (f) {
+  return function (eff) {
+    return mkEf(MAP, f, eff);
+  };
+};
+
+exports.applyE = function (effF) {
+  return function (eff) {
+    return mkEf(APPLY, eff, effF);
+  };
+};
+
+exports.bindE = function (eff) {
+  return function (f) {
+    return mkEf(BIND, f, eff);
+  };
+};