- using System;
- using System.Collections;
- using System.Collections.Generic;
- /*
- A basic lens library for the purpose of demonstration.
- Implements a lens as the costate comonad coalgebra.
- This library is not complete.
- A more complete lens library would take from
- Edward Kmett's to support polymorphic updates and traversal:
- http://hackage.haskell.org/package/lens
- */
- namespace Lens {
- public struct And<A, B> {
- public readonly A a;
- public readonly B b;
- private And(A a, B b) {
- this.a = a;
- this.b = b;
- }
- public And<X, B> First<X>(Func<A, X> f) {
- return And<X, B>.and(f(a), b);
- }
- public And<A, X> Second<X>(Func<B, X> f) {
- return And<A, X>.and(a, f(b));
- }
- public And<A, X> Select<X>(Func<B, X> f) {
- return Second(f);
- }
- public And<X, Y> BinarySelect<X, Y>(Func<A, X> f, Func<B, Y> g) {
- return And<X, Y>.and(f(a), g(b));
- }
- public C Apply<C>(Func<A, B, C> f) {
- return f(a, b);
- }
- public C ApplyFirst<C>(Func<A, C> f) {
- return f(a);
- }
- public C ApplySecond<C>(Func<B, C> f) {
- return f(b);
- }
- public X Fold<X>(Func<A, B, X> f) {
- return f(a, b);
- }
- public Store<B, A> ConstStore {
- get {
- var t = this;
- return Store<B, A>.store(_ => t.a, t.b);
- }
- }
- public static And<A, B> and(A a, B b) {
- return new And<A, B>(a, b);
- }
- }
- public struct Or<A, B> {
- private readonly bool l;
- private readonly A a;
- private readonly B b;
- private Or(bool l, A a, B b) {
- this.l = l;
- this.a = a;
- this.b = b;
- }
- public bool IsLeft {
- get {
- return l;
- }
- }
- public bool IsRight {
- get {
- return !l;
- }
- }
- public Or<B, A> Swap {
- get {
- return l ? Or<B, A>.Right(a) : Or<B, A>.Left(b);
- }
- }
- public X Fold<X>(Func<A, X> left, Func<B, X> right) {
- return l ? left(a) : right(b);
- }
- public Or<A, X> Select<X>(Func<B, X> f) {
- return Fold(a => Or<A, X>.Left(a), b => Or<A, X>.Right(f(b)));
- }
- public Or<A, X> SelectMany<X>(Func<B, Or<A, X>> f) {
- return Fold(a => Or<A, X>.Left(a), f);
- }
- public Or<A, Y> SelectMany<X, Y>(Func<B, Or<A, X>> f, Func<B, X, Y> g) {
- return SelectMany<Y>(b => f(b).Select<Y>(x => g(b, x)));
- }
- public Or<X, Y> BinarySelect<X, Y>(Func<A, X> f, Func<B, Y> g) {
- return Fold(a => Or<X, Y>.Left(f(a)), b => Or<X, Y>.Right(g(b)));
- }
- public B RightValue(Func<A, B> f) {
- return Fold(f, b => b);
- }
- public A LeftValue(Func<B, A> f) {
- return Fold(a => a, f);
- }
- public B RightOr(Func<B> d) {
- return RightValue(_ => d());
- }
- public A LeftOr(Func<A> d) {
- return LeftValue(_ => d());
- }
- public void ForEachRight(Action<B> q) {
- if(IsLeft)
- q(b);
- }
- public void ForEachLeft(Action<A> q) {
- if(IsRight)
- q(a);
- }
- public static Or<A, B> Left(A a) {
- return new Or<A, B>(true, a, default(B));
- }
- public static Or<A, B> Right(B b) {
- return new Or<A, B>(false, default(A), b);
- }
- }
- public class Store<A, B> {
- public readonly Func<A, B> Put;
- public readonly A Pos;
- private Store(Func<A, B> put, A pos) {
- this.Put = put;
- this.Pos = pos;
- }
- public Store<A, C> Select<C>(Func<B, C> f) {
- return Store<A, C>.store(a => f(Put(a)), Pos);
- }
- /*
- Store is a comonad.
- */
- public Store<A, C> CoSelectMany<C>(Func<Store<A, B>, C> f) {
- return Store<A, C>.store(a => f(Store<A, B>.store(Put, a)), Pos);
- }
- public B CoPoint {
- get {
- return Put(Pos);
- }
- }
- public Store<A, Store<A, B>> Duplicate {
- get {
- return Store<A, Store<A, B>>.store(a => Store<A, B>.store(Put, a), Pos);
- }
- }
- public Store<And<A, C>, And<B, D>> Product<C, D>(Store<C, D> s) {
- return Store<And<A, C>, And<B, D>>.store(
- x => And<B, D>.and(Put(x.a), s.Put(x.b))
- , And<A, C>.and(Pos, s.Pos)
- );
- }
- public static Store<A, B> store(Func<A, B> put, A pos) {
- return new Store<A, B>(put, pos);
- }
- }
- public struct Lens<A, B> {
- private readonly Func<A, Store<B, A>> q;
- private Lens(Func<A, Store<B, A>> q) {
- this.q = q;
- }
- public Store<B, A> Run(A a) {
- return q(a);
- }
- public B Get(A a) {
- return Run(a).Pos;
- }
- public A Set(A a, B b) {
- return Run(a).Put(b);
- }
- public Func<A, A> Modify(Func<B, B> f) {
- var t = this;
- return a => {
- var x = t.Run(a);
- return x.Put(f(x.Pos));
- };
- }
- /*
- Lenses compose.
- */
- public Lens<A, C> Then<C>(Lens<B, C> w) {
- var t = this;
- return Lens<A, C>.lens(a => {
- Store<B, A> y = t.Run(a);
- Store<C, B> z = w.Run(y.Pos);
- return Store<C, A>.store(c => y.Put(z.Put(c)), z.Pos);
- });
- }
- /*
- Lenses split on choice.
- */
- public Lens<Or<A, X>, B> Sum<X>(Lens<X, B> l) {
- var t = this;
- return Lens<Or<A, X>, B>.lens(e =>
- e.Fold<Store<B, Or<A, X>>>(a => t.Run(a).Select(j => Or<A, X>.Left(j)), x => l.Run(x).Select(j => Or<A, X>.Right(j)))
- );
- }
- /*
- Lenses are a tensor product.
- */
- public Lens<And<A, C>, And<B, D>> Product<C, D>(Lens<C, D> l) {
- var t = this;
- return Lens<And<A, C>, And<B, D>>.lens(v =>
- t.Run(v.a).Product(l.Run(v.b)));
- }
- public static Lens<A, B> lens(Func<A, Store<B, A>> f) {
- return new Lens<A, B>(f);
- }
- public static Lens<A, B> lens(Func<A, B, A> s, Func<A, B> g) {
- return new Lens<A, B>(a =>
- Store<B, A>.store(b => s(a, b), g(a)));
- }
- /*
- The lens identity for lens composition (Then method).
- */
- public static Lens<A, A> LensIdentity() {
- return Lens<A, A>.lens(a => Store<A, A>.store(v => v, a));
- }
- /*
- A predicate is a lens.
- */
- public static Lens<Store<A, bool>, Or<A, A>> PredicateLens() {
- return Lens<Store<A, bool>, Or<A, A>>.lens(s => {
- var g = s.Pos;
- return Store<Or<A, A>, Store<A, bool>>.store(o =>
- o.Fold<Store<A, bool>>(l => And<bool, A>.and(true, l).ConstStore, r => And<bool, A>.and(false, r).ConstStore)
- , s.Put(g) ? Or<A, A>.Left(g) : Or<A, A>.Right(g));
- });
- }
- /*
- Lens unzips.
- */
- public static And<Lens<X, A>, Lens<X, B>> UnzipLens<X>(Lens<X, And<A, B>> l) {
- return And<Lens<X, A>, Lens<X, B>>.and(
- Lens<X, A>.lens(x => {
- var c = l.Run(x);
- var i = c.Pos;
- return Store<A, X>.store(a => c.Put(And<A, B>.and(a, i.b)), i.a);
- })
- , Lens<X, B>.lens(x => {
- var c = l.Run(x);
- var i = c.Pos;
- return Store<B, X>.store(b => c.Put(And<A, B>.and(i.a, b)), i.b);
- })
- );
- }
- /*
- Lens factors.
- */
- public static Lens<Or<And<A, B>, And<A, C>>, And<A, Or<B, C>>> FactorLens<C>() {
- return Lens<Or<And<A, B>, And<A, C>>, And<A, Or<B, C>>>.lens(e =>
- Store<And<A, Or<B, C>>, Or<And<A, B>, And<A, C>>>.store(y =>
- y.b.BinarySelect(b => And<A, B>.and(y.a, b), c => And<A, C>.and(y.a, c))
- , e.Fold<And<A, Or<B, C>>>(
- b => And<A, Or<B, C>>.and(b.a, Or<B, C>.Left(b.b))
- , c => And<A, Or<B, C>>.and(c.a, Or<B, C>.Right(c.b)))));
- }
- /*
- Lens distributes.
- */
- public static Lens<And<A, Or<B, C>>, Or<And<A, B>, And<A, C>>> DistributLens<C>() {
- return Lens<And<A, Or<B, C>>, Or<And<A, B>, And<A, C>>>.lens(e =>
- Store<Or<And<A, B>, And<A, C>>, And<A, Or<B, C>>>.store(y =>
- y.Fold<And<A, Or<B, C>>>(
- l => And<A, Or<B, C>>.and(l.a, Or<B, C>.Left(l.b))
- , r => And<A, Or<B, C>>.and(r.a, Or<B, C>.Right(r.b)))
- , e.b.BinarySelect(b => And<A, B>.and(e.a, b), c => And<A, C>.and(e.a, c))
- ));
- }
- /*
- The lens for the first element of a pair.
- */
- public static Lens<And<A, B>, A> FirstLens() {
- return Lens<And<A, B>, A>.lens(v =>
- Store<A, And<A, B>>.store(a => And<A, B>.and(a, v.b), v.a));
- }
- /*
- The lens for the second element of a pair.
- */
- public static Lens<And<A, B>, B> SecondLens() {
- return Lens<And<A, B>, B>.lens(v =>
- Store<B, And<A, B>>.store(b => And<A, B>.and(v.a, b), v.b));
- }
- /*
- The three lens laws; identity, retention and double-set.
- All lenses must satisfy these laws.
- i.e. It must not be possible to have these laws return false.
- The two coalgebra laws given below follow from these three laws.
- */
- public bool IdentityLaw(A a) {
- var c = Run(a);
- return c.Put(c.Pos).Equals(a);
- }
- public bool RetentionLaw(A a, B b) {
- return Run(Run(a).Put(b)).Pos.Equals(b);
- }
- public bool DoubleSetLaw(A a, B b1, B b2) {
- var c = Run(a);
- return Run(c.Put(b1)).Put(b2).Equals(c.Put(b2));
- }
- /*
- The coalgebra laws.
- All lenses must satisfy these laws.
- i.e. It must not be possible to have these laws return false.
- The three lens laws above follow from these two laws.
- */
- public bool CoalgebraLaw1(A a) {
- return Run(a).CoPoint.Equals(a);
- }
- public bool CoalgebraLaw2(A a) {
- var t = this;
- return Run(a).Select(r => t.Run(r)).Equals(t.Run(a).Duplicate);
- }
- }
- }