Pure Profunctor Lenses in ES6

ProfunctorLens.js

/**
 * 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)
 */

const flip = f => (a, b) => f(b, a);

const compose = (f, g) => x => f(g(x));

const compose3 = (f, g, h) => x => f(g(h(x)));

const constant = a => b => a;

const id = a => a;

const product = (_fst, _snd) => ({
  fst: _fst,
  snd: _snd,  
});

const fst = prod => prod.fst;

const snd = prod => prod.snd;

const elimProd = cont => pair => cont(pair.fst, pair.snd);

const mapProd1 = f => elimProd((a, b) => product(f(a), b));

const mapProd2 = f => elimProd((a, b) => product(a, f(b)));

const elimSum = (onLeft, onRight) => sum => sum.index ? onLeft(sum.val) : onRight(sum.val);

const left = val => { index: true, val };

const right = val => { index: false, val };

const mapSumL = f => elimSum(compose(left, f), right);

const mapSumR = f => elimSum(left, compose(right, f)); 

const mkIso = (fwd, back) => p => p.dimap(fwd, back);

const decomposeIso = iso => {
  let _fore, _hind;
  const probe = { 
    dimap: (f, h) => { _fore = f; _hind = h; }
  }
  iso(probe);
  return product(_fore, _hind);
};

const flipIso = iso => elimProd(flip(mkIso))(product(decompose(iso)));

const mkLens = (getter, setter) => ab => {
  const fore = s => product(getter(s), s);
  const hind = elimProd(setter);
  
  return ab.first().dimap(fore, hind);
}

const _1 = mkLens(
  fst,
  (b, ax) => product(b, snd(ax))
);

const _2 = mkLens(
  snd,
  (b, xa) => product(fst(xa), b)
);

const mkPrism = (select, build) => ab => {
  const fore = select;
  const hind = elimSum(build, id);
  
  return ab.left().dimap(fore, hind);
}

const _InL = mkPrism(
  elimSum(left, compose(right, right)),
  left
);

const _InR = mkPrism(
  elimSum(compose(right, left), left),
  right
);

class KArrow {
  constructor(fn) {
    this._fn = fn;
  }
  
  run(x) {
    return this._fn(x);
  }
  
  dimap(fore, hind) {
    return new KArrow(compose(this.run, fore));
  }
  
  first() {
    return new KArrow(compose(this.run, fst));
  }
  
  second() {
    return new KArrow(compose(this.run, snd));
  }
}

const trivialK = new KArrow(id);

/**
 * 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
 */

class IArrow {
  constructor(fn) {
    this._fn = fn;
  }
  
  run(x) {
    return this._fn(x);
  }
  
  dimap(fore, hind) {
    return new IArrow(compose3(hind, this.run, fore));
  }
  
  first() {
    return new IArrow(mapProd1(this.run));
  }
  
  second() {
    return new IArrow(mapProd2(this.run));
  }
  
  left() {
    return new IArrow(mapSumL(this.run));
  }
  
  right() {
    return new IArrow(mapSumR(this.run));
  }
}

const view = optic => optic(trivialK).run;

const over = optic => f => optic(f).run;

const set = optic => compose(over(optic), constant);