lenses.clj

(ns enliven.lenses
  (:refer-clojure :exclude [get put update]))

(defprotocol Lens
  (-get [lens data])
  (-put [lens data v]))

(defprotocol Updatable
  (-update [lens data f]))

(defn get [data lens]
  (-get lens data))

(defn put [data lens v]
  (-put lens data v))

(defn update
  ([data lens f]
    (-update lens data f))
  ([data lens f & args]
    (-update lens data #(apply f % args))))

(extend-protocol Updatable
  Object
  (-update [lens data f]
    (put data lens (f (get data lens)))))

(extend-protocol Lens
  clojure.lang.Keyword
  (-get [kw data] (kw data))
  (-put [kw data v] (assoc data kw v))
  clojure.lang.AFn
  (-get [f data] (f data)))

(defrecord ValuedLens [getter setter]
  Lens
  (-get [lens data] (getter data))
  (-put [lens data v] (setter data v)))

(defn lens [get set]
  (ValuedLens. get set))

(defrecord Projection [lenses]
  Lens
  (-get [this data]
    (reduce-kv #(assoc %1 %2 (get data %3)) (empty lenses) lenses))
  (-put [this data v]
    (reduce-kv #(put %1 (lenses %2) %3) data v)))

(defn projection [m] (Projection. m))

(defrecord Path [path]
  Lens
  (-get [this data]
    (reduce get data path))
  (-put [this data v]
    (letfn [(u [data path]
              (if-let [[p & ps] path]
                (put data p (u (get data p) ps))
                v))]
      (u data (seq path))))
  Updatable
  (-update [this data f]
    (letfn [(u [data path]
              (if-let [[p & ps] path]
                (put data p (u (get data p) ps))
                (f data)))]
      (u data (seq path)))))

(defn in [accessors]
  (Path. accessors))

(defn focus 
  ([lens f]
    #(update % lens f))
  ([lens f & args]
    #(apply update % lens f args)))