Continuation Monad

continuation.js

console.log("\033[39mRunning tests…");
function assertEquals(actual, expected, description) {
    if(typeof(actual) === "undefined") {
        console.error("\033[31m" + description + " not implemented\033[39m");
    } else {
        if(actual !== expected) {
            console.error("\033[31m" + description + " failed, expected " + expected + ", got " + actual + "\033[39m");
        } else {
            console.log(description + " \033[32m ok\033[39m");
        }
    }
}


// A continuation is a computation that's been interrupted
// you give it a callback (function from a to r) and it will resume the
// computation by giving your callback a value of type a, eventually producing
// a value of type r
// So we can describe a continuation as a function from (a function from a to
// r) to r
// Cont r a :: (a -> r) -> r


// Let's define return :: a -> m a
// for Cont, it's
// a -> Cont r a
// that is
// a -> ((a -> r) -> r)
function returnCont(value) {
	return function(f){
		return f(value);
	};
}

// Helpers
// Curried add function to have more legible tests
function add(x) { return function(y) { return x + y; }; }
var add10 = add(10);
var add5 = add(5);
var cont4 = returnCont(4);

function runCont(continuation) {
    return continuation && continuation(add10);
}


assertEquals(runCont(cont4), 14, "returnContTest");



// Let's define map :: f a -> (a -> b) -> f b
// for Cont, it's
// Cont r a -> (a -> b) -> Cont r b
// that is
// ((a -> r) -> r) -> (a -> b) -> ((b -> r) -> r)
    //;
function mapCont(continuation, f) {
    // continuation has type (a -> r) -> r
    // f has type a -> b
    //
    // we have to construct a value of type (b -> r) -> r
		return function(g){
			return continuation(compose(g, f));
		};
}

function curriedMap(f) { return function(continuation) { return mapCont(continuation, f);}; }

function identity(x) { return x; }
function compose(f, g) { return function(x) { return f(g(x)); }; }
function curriedCompose(f) { return function(g) { return function(x) { return f(g(x)); }; }; }

console.log("=== Functor Laws ===");

// for all
//   m of type Cont r a
//   mapCont(m, identity) === m
assertEquals(runCont(mapCont(cont4, identity)), runCont(cont4), "mapCont identity");

// for all
//   m of type Cont r a
//   f of type a -> b
//   g of type b -> c
//   mapCont(m, compose(g,f)) === compose(curriedMap(g), curriedMap(f))(m)
assertEquals(
    runCont(mapCont(cont4, compose(add5, add10))),
    runCont(compose(
        curriedMap(add5),
        curriedMap(add10)
    )(cont4)), "mapCont composition");

// Let's define apply :: m (a -> b) -> m a -> m b
// Cont r (a -> b) -> Cont r a -> Cont r b
// that is
// (((a -> b) -> r) -> r) -> ((a -> r) -> r) -> ((b -> r) -> r)
function applyCont(fCont, cont) {
    // fCont has type ((a -> b) -> r) -> r
    // cont has type (a -> r) -> r
    //
    // we have to construct a value of type (b -> r) -> r
		
		return mapCont(fCont, cont);
}


console.log("=== Applicative Laws ===");

// for all
// u of type Cont r (a -> b)
// v of type Cont r (b -> c)
// w of type Cont r c
// applyCont(applyCont(applyCont(returnCont(curriedCompose), u), v), w)
//  ===
// applyCont(u, applyCont(v, w))
(function () {
    var u = returnCont(add10);
    var v = returnCont(add5);
    var w = returnCont(5);
    assertEquals(
        runCont(applyCont(applyCont(applyCont(returnCont(curriedCompose), u), v), w)),
        runCont(applyCont(u, applyCont(v, w))),
        "applyCont composition"
    );
})();

// for all
// f of type (a -> b)
// x of type a
// applyCont(returnCont(f), returnCont(x)) === returnCont(f(x))
assertEquals(
    runCont(applyCont(returnCont(add5), returnCont(4))),
    runCont(returnCont(add5(4))),
    "applyCont homomorphism"
);

// for all
// u of type Cont r (a -> b)
// y of type a
// applyCont(u, returnCont(y)) === applyCont(returnCont(function(f) { return f(y); }), u)
(function() {
    var u = returnCont(add10);
    function apply(value) { return function(f) { return f(value); }; }

    assertEquals(
        runCont(applyCont(u, returnCont(4))),
        runCont(applyCont(returnCont(apply(4)), u)),
        "applyCont interchange"
    );
})();

// Let's define join :: m (m a) -> m a
// Cont r (Cont r a) -> Cont r a
// that is
// ((Cont r a -> r) -> r) -> ((a -> r) -> r)
// ((((a -> r) -> r) -> r) -> r) -> ((a -> r) -> r)
function joinCont(outerContinuation) {
    // outerContinuation has type ((((a -> r) -> r) -> r) -> r) -> r
		return outerContinuation(identity);
}

// Let's define bind :: m a -> (a -> m b) -> m b
// for cont, it's
// Cont r a -> (a -> Cont r b) -> Cont r b
// that is
// ((a -> r) -> r) -> (a -> ((b -> r) -> r)) -> ((b -> r) -> r)
function bindCont(continuation, f) {
    return joinCont(mapCont(continuation, f));
}


console.log("=== Monad Laws ===");

// for all
//   a of type a
//   k of type a -> Cont r a
//   bindCont(returnCont(a), k) === k(a)
assertEquals(
    runCont(bindCont(cont4, function(x) { return returnCont(x); })),
    runCont(returnCont(4)),
    "bindCont left indentity"
);
// for all
//   m of type Cont r a
//   bindCont(m, returnCont) === m
assertEquals(
    runCont(bindCont(cont4, returnCont)),
    runCont(cont4),
    "bindCont right indentity"
);
// for all
//   m of type Cont r a
//   k of type a -> Cont r b
//   h of type b -> Cont r c
//   bindCont(m, function(x) { return bindCont(k(x), h); }) === bindCont(bindCont(m, k), h)
assertEquals(
    runCont(bindCont(cont4, function(x) { return bindCont(returnCont(x), returnCont); })),
    runCont(bindCont(bindCont(cont4, returnCont), returnCont)),
    "bindCont composition"
);


// Let's try to define extract :: m a -> a
// for cont, it's
// Cont r a -> a
// that is
// ((a -> r) -> r) -> a
function extractCont(continuation) {
    // continuation has type (a -> r) -> r
    //
    // we have to construct a value of type a

    // ToDo
}