Pure Profunctor Lenses in Javascript (redux)

ProfunctorLens.js

/* eslint-disable new-cap */

/**
 * Lens types.
 * ===========
 *
 * a * b = {fst: a, snd: b}
 * a + b = {index: Boolean, value: a | b}
 *
 * Iso   s t a b = forall (~>) . Profunctor (~>) => (a ~> b) -> (s ~> t)
 * Lens  s t a b = forall (~>) . Strong (~>)     => (a ~> b) -> (s ~> t)
 * Prism s t a b = forall (~>) . Choice (~>)     => (a ~> b) -> (s ~> t)
 */

function flip(f) {
  var ff = function (a, b) {
    return f(b, a);
  };
  ff.name = f.name && f.name + "_flipped";
  return ff;
}

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

/** The constant functions. */
function k(a) {
  return function(b) { return a; };
}

/** The identity function. */
function i(a) {
  return a;
}

var Pair = (function () {

  function Mk(_fst, _snd) {
    return {
      fst: _fst,
      snd: _snd,
    };
  }

  function elim(cont) {
    return function (pair) {
      return cont(pair.fst, pair.snd);
    };
  }

  function fst(pair) {
    return pair.fst;
  }

  function snd(pair) {
    return pair.snd;
  }

  function map1(f) {
    return elim(function (a, b) {
      return Mk(f(a), b);
    });
  }

  function map2(f) {
    return elim(function (a, b) {
      return Mk(a, f(b));
    });
  }

  Mk.elim = elim;
  Mk.fst = fst;
  Mk.snd = snd;
  Mk.map1 = map1;
  Mk.map2 = map2;

  return Mk;
})();

var Sum = (function () {

  function InL(x) {
    return { index: true, val: x };
  }

  function InR(x) {
    return { index: false, val: x };
  }

  function elim(onLeft, onRight) {
    return function(sum) {
      return sum.index ? onLeft(sum.val) : onRight(sum.val);
    };
  }

  function mapL(f) {
    return elim(compose(InL, f), InR);
  }

  function mapR(f) {
    return elim(InL, compose(InR, f));
  }

  return {
    InL: InL,
    InR: InR,
    elim: elim,
    mapL: mapL,
    mapR: mapR,
  };
})();

/**
 * Lens interfaces.
 * ================
 *
 * Map i o {}
 *
 * Profunctor i o extends Map i o {
 *   dimap(fore : a -> i, hind : o -> b) : This a b
 * }
 *
 * Strong i o extends Profunctor i o {
 *   first() : This (i * c) (o * c)
 *   second() : This (c * i) (c * o)
 * }
 *
 * Choice i o extends Profunctor i o {
 *   left() : This (i + c) (o + c)
 *   right() : This (c + i) (c + o)
 * }
 *
 */

var Iso = (function () {

  /**
   * Construct an Iso from a witness to the isomorphism.
   */
  function of(fwd, bck) {
    return function(p) { return p.dimap(fwd, bck); };
  }

  /**
   * Decompose an Iso into its constituents
   *
   * @sig Iso s t a b -> (s -> a) * (b -> t)
   */
  function decompose(iso) {
    var _fore;
    var _hind;
    var probe = {
      dimap: function(fore, hind) {
        _fore = fore;
        _hind = hind;
      },
    };
    iso(probe);
    return Pair(_fore, _hind);
  }

  /**
   * Turns an Iso around. Any Iso works bidirectionally.
   *
   * @sig Iso s t a b -> Iso b a t s
   */
  function from(iso) {
    var parts = Iso.decompose(iso);
    return Pair.elim(flip(Iso.of))(parts);
  }

  return {
    of: of,
    decompose: decompose,
    from: from,
  };
})();

var Lens = (function () {

  /**
   * Constructs a lens out of a getter and a setter.
   *
   * @sig (s -> a) -> (b -> s -> t) -> Lens s t a b
   */
  function of(getter, setter) {
    return function(ab) {
      // NOTES
      //
      // ab.first() : (a * s ~> b * s)
      // fore : s -> a * s
      // hind : b * s -> t
      var fore = function(s) {
        return Pair(getter(s), s);
      };
      var hind = function(bs) {
        return Pair.elim(setter)(bs);
      };
      return ab.first().dimap(fore, hind);
    };
  }

  /** @sig Lens a b (a * x) (b * x) */
  var _1 = of(
    function(ax) { return Pair.fst(ax); },
    function(b, ax) { return Pair(b, Pair.snd(ax)); }
  );

  /** @sig Lens a b (x * a) (x * b) */
  var _2 = of(
    function(xa) { return Pair.snd(xa); },
    function(b, xa) { return Pair(Pair.fst(xa), b); }
  );

  return {
    of: of,
    _1: _1,
    _2: _2,
  };

})();

var Prism = (function () {

  /**
   * Construct a Prism from a selector and an injector.
   *
   * @sig (s -> a + t) -> (b -> t) -> Prism s t a b
   */
  function of(select, build) {
    return function(ab) {
      // NOTES
      //
      // ab.left() : (a + t ~> b + t)
      // fore : s -> a + t
      // hind : b + t -> t
      var fore = select;
      var hind = Sum.elim(build, i);
      return ab.left().dimap(fore, hind);
    };
  }

  /** @sig Lens a b (a + x) (b + x) */
  var _InL = of(
    Sum.elim(Sum.InL, compose(Sum.InR, Sum.InR)),
    Sum.InL
  );

  /** @sig Lens a b (x + a) (x + b) */
  var _InR = of(
    Sum.elim(compose(Sum.InR, Sum.InL), Sum.InL),
    Sum.InR
  );

  return {
    of: of,
    _InL: _InL,
    _InR: _InR,
  };

})();

/**
 * (KArrow c)s are arrows (a ~> b) which are actually arrows (a ~> c).
 * More specifically they're arrows (a -> Const c b) and since (Const c b) is
 * equivalent to merely (c).
 *
 * @instantiates Map, Profunctor, Strong
 */
function KArrow(fn) {
  this._fn = fn;
}

/**
 * Runs a KArrow.
 *
 * @sig KArrow c a b -> (a -> c)
 */
KArrow.prototype.run = function(a) {
  return this._fn(a);
};

KArrow.prototype.dimap = function(fore, hind) {
  return new KArrow(compose(this.run, fore));
};

KArrow.prototype.first = function () {
  return new KArrow(compose(this.run, Pair.fst));
};

KArrow.prototype.second = function () {
  return new KArrow(compose(this.run, Pair.snd));
};

/**
 * A trivial K arrow.
 *
 * @sig KArrow a a x
 */
KArrow.trivial = new KArrow(i);

/**
 * IArrow a b is an arrow (a ~> b) which is equivalent to (a -> b). More
 * specifically, it's an arrow (a -> Identity b) but (Identity b) is just (b).
 *
 * @instantiates Map, Profunctor, Strong, Choice
 */
function IArrow(fn) {
  this._fn = fn;
}

/**
 * Runs a IArrow.
 *
 * @sig IArrow a b -> (a -> b)
 */
IArrow.prototype.run = function (a) {
  return this._fn(a);
};

IArrow.prototype.dimap = function (fore, hind) {
  return new IArrow(function (x) {
    return hind(this.run(fore(x)));
  });
};

IArrow.prototype.first = function () {
  return new IArrow(Pair.map1(this.run));
};

IArrow.prototype.second = function () {
  return new IArrow(Pair.map2(this.run));
};

IArrow.prototype.left = function () {
  return new IArrow(Sum.mapL(this.run));
};

IArrow.prototype.right = function () {
  return new IArrow(Sum.mapR(this.run));
};

function view (optic) {
  return optic(KArrow.trivial).run;
}

function over (optic) {
  return function (f) {
    return optic(f).run;
  };
}

function set (optic) {
  return compose(over(optic), k);
}

module.exports = {
  Iso: Iso,
  Lens: Lens,
  Prism: Prism,
  KArrow: KArrow,
  IArrow: IArrow,
  view: view, over: over, set: set,
  i: i, k: k, compose: compose, flip: flip,
};