Type class emulation in JavaScript: Maybe and State

typeclasses.js

//
// Compile with Traceur, available online here:
// http://google.github.io/traceur-compiler/demo/repl.html
//
// Alternatively, load using node:
// $ node --harmony
// > .load filename.js
//

//
// Type classes
//
var Functor = (type, defs) => {
    // <$>
    type.prototype.fmap = defs.fmap;
};

var Applicative = (type, defs) => {
    // <*>
    type.prototype.ap = defs.ap;
    type.pure = defs.pure;
};

var Monad = (type, defs) => {
    // >>=
    type.prototype.bind = defs.bind;
    // >>
    type.prototype.then = defs.then || function(fn) {
        return this.bind(() => fn());
    };
};

//
// Prelude
//
// Functor f => (a -> b) -> f a -> f b
var fmap = fn => f => f.fmap(fn);

// Applicative f => a -> f a
var pure = val => m => m.pure(val);

// Applicative f => f (a -> b) -> f a -> f b
var ap = a => f => a.ap(f);

// Monad m => a -> m b -> m a -> m b
var bind = fn => m => m.bind(fn);

// Monad m => m => m (m a) => m a
var join = val => m => m.bind(id);

// a -> a
var id = x => x;

// a -> b -> a
var constant = a => _ => a;

//
// Instances
//
var Maybe = (function() {
    var Maybe = function(val) { this.val = val; };

    Maybe.some = val => new Maybe(val);
    Maybe.none = () => new Maybe(null);

    return Maybe;
}());

Functor(Maybe, {
    fmap: function(fn) {
        return this.val != null ? Maybe.some(fn(this.val)) : Maybe.none();
    }
});

Applicative(Maybe, {
    pure: val => Maybe.some(val),
    ap: function(f) {
        return this.val != null
            ? (f.val != null
               ? Maybe.some(this.val(f.val))
               : Maybe.none())
            : Maybe.none(); }
});

Monad(Maybe, {
    bind: function(fn) {
        return this.val != null ? fn(this.val) : Maybe.none();
    }
});

var Pair = (function() {
    var Pair = function(a, b) {
        this.fst = a;
        this.snd = b;
    };

    return Pair;
})();

// Simpler ctor
var pair = (a, b) => new Pair(a, b);

Functor(Pair, {
    fmap: function(fn) {
        return pair(this.fst, fn(this.snd));
    }
});

var State = (function() {
    //
    // The type of fn is `s -> (a, s)'
    // State's magic is that it threads the state in s.  Running the operations
    // on the the state gives back a pair of `a' and `s'.  `a' represents the
    // result of the computation while `s' contains the state.  This allows
    // running a stateful computation, extracting the result, and using the
    // final state later.
    //
    var State = function(fn) { this.fn = fn; };

    State.prototype.run = function(s) {
        return this.fn(s);
    };

    State.get = () => new State(s => pair(s, s));

    State.put = s => new State(_ => pair(null, s));

    State.modify = fn => new State(s => pair(null, fn(s)));

    return State;
})();

// Simpler ctor
var state = (fn) => new State(fn);

Functor(State, {
    fmap: function(fn) {
        var that = this;
        return state(s => {
            var p = that.run(s);
            return pair(fn(p.fst), p.snd);
        });
    }
});

Applicative(State, {
    pure: val => state(s => pair(val, s)),
    ap: function(f) {
        return this.bind(s1 => f.bind(s2 => State.pure(s1(s2))));
    }
});

Monad(State, {
    bind: function(fn) {
        var that = this;
        return state(s => {
            var p = that.run(s);
            return fn(p.fst).run(p.snd);
        });
    }
});

//
// Simple examples
//
var inputIncrementer =
        State.get().
        bind(a => State.put(a + 1)).
        then(_ => State.get());
// run(1)

var inputIgnoringIncrementer =
        State.put(5).
        then(_ => State.modify(x => x + 1)).
        then(_ => State.get());
// run(1337)

//
// More complex examples
//
// Classic use case: No explicit intermediate state
var launchMissiles = (s) => {
    // evil: interleaved IO
    console.log("State: " + s.toString());
    return s;
};

var pureState =
        State.get().
        fmap(launchMissiles).
        bind(a => State.put(Math.pow(a, 3)).
             then(_ => State.modify(s => Math.PI * s + Math.E)).
             then(_ => State.pure(a)));
// run(1793)

// Another case: non-destructive array-operations
var arrayOps =
        State.get().
        then(_ => State.modify(ary => ary.concat(4))).
        then(_ => State.modify(ary => ary.slice(-3))).
        then(_ => State.modify(ary => ary.concat(5, 6))).
        then(_ => State.get()).
        bind(a => State.pure(a[0]));
// run([1,2,3])

// Notice: `a' and `s' are different!  The latter `State.get()' pulls the
// result of the previous operations from `s' into `a' so that the last
// bind can return the first element; the state still contains the full array.

//
// Passing State around
//
// Even though this is a more complex example, it is still pretty trivial.
// The same effect could be achieved using partial function application.
//
// Capture some calculation
var circumference =
        State.get().
        then(_ => State.modify(r => 2 * Math.PI * r));

// Obtain some data
var height = 13.37;

// Add some more state
var businessProcess =
        circumference.then(_ => State.modify(c => c * Math.sqrt(height)));

// Run the computation
var complexResult = businessProcess.run(42);

//
// Some words on staircasing: as long as there is no need for binding something
// to a name, I advise using then().  This also avoids having to chain directly
// on the result.  The following example shows two different notations in x and
// y with equal results.
//
var x = State.get().
        then(_ => State.modify(s => s * Math.PI).
             then(_ => State.modify(s => [s]).
                  then(_ => State.get().
                       bind(a => State.modify(s => s.concat(17, 3, 49)).
                            then(_ => State.pure(a))))));

var y = State.get().
        then(_ => State.modify(s => s * Math.PI)).
        then(_ => State.modify(s => [s])).
        then(_ => State.get()).
        bind(a => State.modify(s => s.concat(17, 3, 49)).
             then(_ => State.pure(a)));

//
// TL;DR: -> Type class-style code is possible
//        -> Monads are awesome
//        -> Arrow-functions rock (suck it, VB!)
//        -> Do-notation is sorely missed
//