simple-lens.clj

; the only reason for the protocol is to have keywords behave as lenses
; it could have been hard coded in fetch/putback
(defprotocol Lens
  (-fetch [l x])
  (-putback [l x v]))

(defn fetch [x l] (-fetch l x))
(defn putback [x l v] (-putback l x v))

(defn update [x l f & args] 
  (putback x l (apply f (fetch x l) args)))
(defn fmap "focused map :-)" [x l f & args] 
  (update x l (fn [s] (map #(apply f % args) s))))

(defn compose [la lb]
  (reify Lens
    (-fetch [l x]
      (-> x (fetch la) (fetch lb)))
    (-putback [l x v]
      (update x la putback lb v)))))

(defn pair [la lb]
  (reify Lens
    (-fetch [l x]
      [(fetch x la) (fetch x lb)])
    (-putback [l x [va vb]]
      (-> x (putback la va) (putback lb vb)))))

(extend-protocol Lens
  clojure.lang.Keyword
  (-fetch [k x] (k x))
  (-putback [k x v] (assoc x k v)))