Van Laarhoven lenses in Clojure

van-laarhoven-lenses.clj

;; lenses in Clojure again, van Laarhoven-style this time

(defprotocol Lens
  (through [lens x cont]))

(extend-protocol Lens
  clojure.lang.Keyword
  (through [k x cont]
    (cont #(assoc x k %) (k x))))

(defn- return [_ v] v)

(defn fetch [x l]
  (through l x return))

(defn putback [x l v]
  (through l x (fn [g _] (g v))))

(defn update [x l f & args]
  (through l x (fn [g v] (g (apply f v args)))))

(defn compose [l1 l2]
  (reify Lens
    (through [l1+l2 x f]
      (through l1 x (fn [g1 v1] (through l2 v1 (fn [g2 v2] (f (comp g1 g2) v2))))))))