"Pure-profunctor" lenses in Javascript (!)

Profunctor.js

/// PRELIMINARIES

/**
 * Generalized "products" of any size. For gluing things together. A tuple is a
 * "2"-meet.
 *
 * The type `Meet a b c d ...` indicates a `Meet` of the given size with values
 * at each type in the sequence.
 */
class Meet {
  constructor(...vals) {
    this._elems = vals;
  };

  /** Convenient access to members of the meet */
  at(index) {
    return this._elems[index];
  }

  /**
   * Pick a selected value from the meet and continue with it. Technically
   * somewhat weaker than the genuine elimination principle, but still useful.
   */
  fold(index, cont) {
    return cont(this._elems[index]);
  }
}

/**
 * Generalized "sums" of any size. For gluing choices together. An either is a
 * "2"-join.
 *
 * The type `Join a b c d ...` indicates a `Join` of the given size with values
 * at each type in the sequence.
 */
class Join {
  constructor(index, val) {
    this._location = index;
    this._value = value;
  }

  /**
   * For each possible location in the join, a continuation.
   */
  fold(...conts) {
    return conts[this._location](this._value, this._location);
  }
}

/// INTERFACES

/**
 * We introduce the following "interfaces".
 *
 * Map i o {}
 *
 * Profunctor i o extends Map i o {
 *   dimap(fore : a -> i, hind: o -> b) : Profunctor a b
 * }
 *
 * Strong i o extends Profunctor i o {
 *  first() : Strong (Meet i c) (Meet o c)
 *  second() : Strong (Meet c i) (Meet c o)
 * }
 *
 * Choice i o extends Profunctor i o {
 *  left() : Choice (Join i c) (Join o c)
 *  right() : Choice (Join c i) (Join c o)
 * }
 *
 */

function dimap(fore, hind) {
  return (p) => {
    if (typeof p === "function") {
      // (single argument) functions are trivially Profunctors
      return (x) => hind(p(fore(x)));
    } else {
      return p.dimap(fore, hind);
    }
  }
}

function first(p) {
  if (typeof p === "function") {
    // (single argument) functions are trivially Strong
    return (x) => Meet(p(x[0]), x[1]);
  } else {
    return p.first();
  }
}

function second(p) {
  if (typeof p === "function") {
    // (single argument) functions are trivially Strong
    return (x) => Meet(x[0], p(x[1]));
  } else {
    return p.second();
  }
}

function left(p) {
  if (typeof p === "function") {
    // (single argument) functions are trivially Choice
    return (x) => x.fold((l) => Join(0, p(l)), (r) => Join(1, r));
  } else {
    return p.left();
  }
}

function right(p) {
  if (typeof p === "function") {
    // (single argument) functions are trivially Choice
    return (x) => x.fold((l) => Join(0, l), (r) => Join(1, p(r)));
  } else {
    return p.right();
  }
}

/// CONSTRUCTIONS

/**
 * Isos are "Profuntor transformers".
 *
 * Iso s t a b = forall (~>) . Profunctor (~>) => (a ~> b) -> (s ~> t)
 */
class Iso {
  /** @sig (s -> a) -> (b -> t) -> Iso s t a b */
  static of(fwd, bck) {
    return (ab) => dimap(fwd, bck)(ab);
  }

  /**
   * Pulls an iso apart into its two constituents. Inverts `of`.
   *
   * @sig Iso s t a b -> Meet (s -> a) (b -> t)
   */
  static separate(iso) {
    class Catcher {
      dimap(fore, hind) {
        this.fore = fore;
        this.hind = hind;
      }
    };
    var catcher = iso(new Catcher());
    return Meet(catcher.fore, catcher.hind);
  }

  /**
   * Reverses an iso.
   *
   * @sig Iso s t a b -> Iso b a t s
   */
  static from(iso) {
    parts = separate(iso);
    return iso(parts.at(1), parts.at(0));
  }
}

/**
 * Lenses are "Strong transformers".
 *
 * Lens s t a b = forall (~>) . Strong (~>) => (a ~> b) -> (s ~> t)
 */
class Lens {
  /** @sig (s -> a) -> (b -> s -> t) -> Lens s t a b */
  static of(get, set) {
    // fore : s -> Meet a s
    // hind : Meet b s -> t
    const fore = (s) => Meet(get(s), s);
    const hind = (bs) => set(bs.at(0), bs.at(1));

    // Note that (first(ab) : Meet a s ~> Meet b s)
    return (ab) => dimap(fore, hind)(first(ab));
  }
}


/**
 * Prisms are "Choice transformers".
 *
 * Prism s t a b = forall (~>) . Choice (~>) => (a ~> b) -> (s ~> t)
 */
class Prism {
  /** @sig (b -> t) -> (s -> Join a t) -> Prism s t a b */
  static of(build, split) {
    // fore : s -> Join a t
    // hind : Join b t -> t
    const fore = split;
    const hind = (bt) => bt.fold(build, (t) => t);

    // Note that (left(ab) : Join a s ~> Join b s)
    return (ab) => dimap(fore, hind)(left(ab));
  }
}

/// ELIMINATION AND USE

/**
 * A (ConstA c) is a Map (a ~> b) which is actually an arrow (a -> c). More
 * specifically it's an arrow (a -> Const c b).
 */
class ConstA {
  constructor(f) {
    this.run = f;
  }

  /**
   * dimap just ignores the hind mapping since we never really operate on the
   * codomain.
   */
  dimap(fore, hind) {
    return constructor((x) => this.run(fore(x)));
  }

  /**
   * @sig (a -> Const c b) -> (Meet a x -> Const c (Meet b x))
   */
  first() { return constructor((ax) => this.run(ax.at(0))); }
  second() { return constructor((ax) => this.run(ax.at(1))); }

  /**
   * NOTE: Const arrows are not Choice because the following
   *       signature cannot be substantiated!
   *
   * @sig (a -> Const c b) -> (Join a x -> Const c (Join b x))
   */
}

/**
 * A very trivial ConstA value.
 *
 * @sig ConstA a a x
 * ConstA a a x ~ (a -> Const a x) ~ (a -> a)
 *
 */
ConstA.trivial = constructor((a) => a);

/**
 * Generalized to work on isos and lenses, but not prisms.
 *
 * @sig Thing s t a b -> (s -> a)
 */
function view(thing) {
  return (s) => thing(ConstA.trivial).run(s)
}

/**
 * Generalized to work on isos, lenses, and prisms.
 *
 * @sig Thing s t a b -> (a -> b) -> (s -> t)
 */
function over(thing) {
  // This has an amusingly simple implementation! Since ((a -> b) -> (s -> t))
  // is exactly the shape of all of our "things" once they're instantiated to
  // normal functions... we're immediately done!
  return thing;
}