StateMonad for js Promise

mpromise.ts

// vim: expandtab ts=4 sw=4:

// Please compile using 'gulp', and 'gulp-typescript'
// This is the core of this library.

/*************************
Copyright (c) 2016 Zhongzhi Yu

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
**************************/

'use strict';

import {Promise} from 'es6-promise';

let trace = TAG => (x) => {
    //console.log(TAG, " :: ", x);
    return x;
}

let debug = TAG => x => {}; //console.log(TAG, " :: ", x);

/*
// For member method: fmap, >>=, bind: Please use Promise.prototype.then
// For member method: unit, return: Please use Promise.resolve

// lift for Promise: Curri-able. Type: (X -> Y) -> (X -> Monad Y)
export let lift = <X, Y>(f: (t: X) => Y): ((src: X) => Promise<Y>) => {
    return (src: X) => new Promise<Y>((resolve, fail) => resolve(f(src)));
}

// lift for StatePromise: Curri-able. Type: (X -> Y) -> (X -> StateMonad any Y) (Eventual return type means StateMonad of value type=Y, state type=any)
// You can also use StatePromise.lift
export let liftStatePromise = <S, X, Y>(f: (t: X) => Y): ((src: X) => StatePromise<S, Y>) => {
    return (src: X) => new StatePromise<S, Y>((resolve, fail) => resolve(f(src)));
}
*/

// A StateMonad implementation
// S: the state to be hidden from "then, fmap, and bind"
// V: the value type visible in "then, fmap, and bind" pipeline
export class StatePromise<S, V> {

    // The promise will not be started, until "runState(...)" is run.
    // Type info: <[ Fall-back state, Actual Promise containing [curr state, curr value]]>
    //      The "fall-back state" is needed in case of ".catch"
    private _promise: (initState: S) =>  Promise<[S, Promise<[S, V]>]>;

    constructor(a: Promise<V> | ((resolve: Function, reject: Function) => any)) {
        if(typeof(a) === 'function')
            this._promise = state => new Promise<[S, Promise<[S, V]>]>((res, fail) => {
                let sub = new Promise<[S, V]>((res2, fail2) => {
                    let res3 = v => res2([state, v]);
                    (<any> a)(res3, fail2);
                });
                res([state, sub]);
            });
        else this._promise = state => new Promise<[S, Promise<[S, V]>]>((res, fail) => {
                let sub = (<any> a).then(v => [state, v]);
                res([state, sub]);
            });
    }

    // return a new StateMonad that executes f to change the state and value from this Monad
    private helpChange<U>(f: ((s: S, t: V) => [S, U] | Promise<[S, U]>)): StatePromise<S, U> {
        let self = this;
        let ans = <StatePromise<S, U>> Object.create(StatePromise.prototype);
        ans._promise = (init: S) => self._promise(init).then(([fallback, actual]) => {
            let sub = actual.then((pipe) => f(pipe[0], pipe[1]));
            return <Promise<[S, Promise<[S, U]>]>> sub
            .then(res => [res[0] , sub])
            .catch(_ => [fallback, sub])
            .then(trace("helpChange sub"));
        });
        return ans;// new StatePromise(this._promise.then(f));
    }

    // State manipulation interface:
    state<U>(f: (s: S) => [S, U]) : StatePromise<S, U> {
        return this.helpChange((state, value) => f(state));
    }
    loadState(): StatePromise<S, S> {
        return this.helpChange((state, value) => [state, state]);
    }
    modState(f: (s: S) => S): StatePromise<S, V> {
        return this.helpChange((state, value) => [f(state), value]);
    }
    static putState<S>(s: S): StatePromise<S, Unit> {
        // This function should be used as a parameter of "StatePromise.replace"
        return PromiseUnit<S>().modState(_ => s);
    }
    static put = (x) => StatePromise.putState(x);

    // Haskell's runState
    run(init: S | Promise<S>) {
        return Promise.resolve()
            .then(x => init)
            .then(x => this._promise(x))
            .then(([_, actual]) => actual)
            .then(([_, value]) => value);
    }

    // Basic Monad stuff: these are only exposed to Value part.
    fmap<U>(f: (t: V) => U): StatePromise<S, U> {
        return this.helpChange((state, value) => [state, f(value)]);
    }
    map<U>(f: (t: V) => U): StatePromise<S, U> {
        return this.fmap(f);
    }

    // TODO: Add do-block by using dictionary as V.

    // Similar to Haskell Control.Exception.handle.
    /*
    handle<U>(f: (t: any) => StatePromise<S, U>): StatePromise<S, U> {
        let ans = <StatePromise<S, U>> Object.create(StatePromise.prototype);
        ans._promise = (init: S) => this._promise(init).then(([fallback, actual]) => {
            //let sub = actual.then((pipe) => f(pipe[0], pipe[1]));
            let sub = actual.catch(err => f(err)._promise(fallback));
            return <Promise<[S, Promise<[S, U]>]>> sub
            .catch(_ => [fallback, sub]);
        });
        return ans;// new StatePromise(this._promise.then(f));
    }
    catch<U>(f: (t: any) => StatePromise<S, U>): StatePromise<S, U> {
        return handle(f);
    }
    */

    static unit<S, U>(t: U): StatePromise<S, U> {
        return new StatePromise<S,U>(Promise.resolve(t));
    }
    
    bind<U>(f: (t: V) => StatePromise<S, U>): StatePromise<S, U> {
        debugger;
        let self = this;
        let ans = <StatePromise<S, U>> Object.create(StatePromise.prototype);
        ans._promise = (init: S) => self._promise(init).then(([fallback, actual]) => {
            let sub = actual.then((pipe) => {
                debug("before bind")(pipe);
                return f(pipe[1])._promise(pipe[0])
                .then(([newFallback, newActual]) => newActual)
            });
            return <Promise<[S, Promise<[S, U]>]>> sub
            .then(res => [res[0], sub])
            .catch(_ => [fallback, sub])
            .then(trace("sub of Bind"));
        }).catch(x => trace("Bind catch")(x.stack));
        return ans;// new StatePromise(this._promise.then(f));
    }
    chain<U>(f: (t: V) => StatePromise<S, U>): StatePromise<S, U> {
        return this.bind(f);
    }

    // Replace the value in this monad with the value in the provided . <=> Haskell ">>"
    replace<U>(value: StatePromise<S, U>): StatePromise<S, U> {
        return this.bind(_ => value);
    }

}

export class Unit {}

Object.freeze(Unit);

// The most useful class exported: PromiseUnit
// This is a StatePromise without a visible value.
// It's a great starting point. You can still replace the value "Unit" with something else using functions like "bind()".
export let PromiseUnit = <S> () => new StatePromise<S, Unit>(Promise.resolve(new Unit())); 

// Generate a StatePromise, that will update State of any other StatePromise (by using .replace())
export let StateUpdater = <S> (f: (state: S, resolve: Function, fail: Function) => void) =>
    PromiseUnit<S>()
    .loadState()
    .bind(s => new StatePromise<S, S>(new Promise<S>((res, fail) => f(s, res, fail))))
    .bind(StatePromise.put);        // It's very easy to forget this last sentence.


// For RESTful apps, it might seem unnatural to have a PIPE (The value visible from Monad rather than preserved as State) (The "V" of "StatePromise<S,V>").
// Because RESTful apps should have no memory states other than the socket.
// However, after some digging, we will find out that:
//      In order to wait for the Promisified result of some API,
//      the API must be called inside StatePromise.bind() or replace().
//          and State will be updated by ".bind((x) => StatePromise.putState(x))",
//          which can be shorten as ".bind(StatePromise.put)".
//      And during this operation, we heavily relied on PIPE.
//          Basically, in order to benefit from Promise for Async callbacks, we need PIPE.
//      This design comes from Haskell. Please refer to function signature of "state" and "modify"

test.ts

// this is a basic test.
// More tests to come later. I also plan to convert this into a standalone git repo.
// Please compile using 'gulp', and 'gulp-typescript'

"use strict";
import * as child_process from 'child_process';
import * as _ from 'lodash';
import { PromiseUnit, StatePromise, StateUpdater } from './mpromise';

let traceState = <S> (tag: string) => PromiseUnit<S>().modState(state => {
  console.log(tag, ' :: ', state);
  return state;
});

type GameValue = number

interface GameState {
  on: boolean
  score: number
}

let playGame = (input: String) => {
  // Base case (input == [])
  if(!input || input.length == 0)
    return PromiseUnit<GameState>()
    .loadState()
    .fmap(({score}) => score);

  // Recursive case
  else return PromiseUnit<GameState>()
  .replace(traceState("before mod"))
  .modState(({on, score}) => {
    if(input[0] == 'a' && on)
      return {on, score: score + 1};
    else if(input[0] == 'b' && on)
      return {on, score: score - 1};
    else if(input[0] == 'c')
      return {on:! on, score};
    else return {on, score};
  })
  .replace(traceState("after mod"))
  .replace(playGame(input.slice(1)));
}

let initial = {on: false, score: 0};

traceState("")
.replace(playGame("abcaaacbbcabbab"))
.run(initial)
.then(console.log);

test.ts.hs

-- This is the source of test.hs
-- This example code came from HaskellWiki: https://wiki.haskell.org/State_Monad

module StateGame where
 
import Control.Monad.State
 
-- Example use of State monad
-- Passes a string of dictionary {a,b,c}
-- Game is to produce a number from the string.
-- By default the game is off, a C toggles the
-- game on and off. A 'a' gives +1 and a b gives -1.
-- E.g 
-- 'ab'    = 0
-- 'ca'    = 1
-- 'cabca' = 0
-- State = game is on or off & current score
--       = (Bool, Int)
 
type GameValue = Int
type GameState = (Bool, Int)
 
playGame :: String -> State GameState GameValue
playGame []     = do
    (_, score) <- get
    return score
 
playGame (x:xs) = do
    (on, score) <- get
    case x of
         'a' | on -> put (on, score + 1)
         'b' | on -> put (on, score - 1)
         'c'      -> put (not on, score)
         _        -> put (on, score)
    playGame xs
 
startState = (False, 0)
 
main = print $ evalState (playGame "abcaaacbbcabbab") startState