update-in-matching.clj

(ns org.niskin.micha.update-in-matching
  (:require [clojure.core.match :as match]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; misc helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- cartesian-product
  "
    Example:
    (cartesian-product
      [[:a] [:b] [:c]]
      [[ 1] [ 2] [ 3]])
    ;;=> [[:a 1] [:a 2] [:a 3]
          [:b 1] [:b 2] [:b 3]
          [:c 1] [:c 2] [:c 3]]
  "
  [left right]
  (vec (for [x left y right] (into x y))))

(defn- paths
  "
    Example:
      (paths {:a [{:b {:c 1}} {:b {:c 2} :d 100}]})
      ;;=> #{[] [:a] [:a 0] [:a 1] [:a 0 :b] [:a 1 :b] [:a 1 :d] [:a 0 :b :c] [:a 1 :b :c]}
  "
  [coll]
  (if (coll? coll)
    (set (reduce-kv #(into %1 (into [[] [%2]] (cartesian-product [[%2]] (paths %3)))) [] coll))
    #{[]}))

(defn- matching-paths
  "
    Example:
      (matching-paths
        {:a {:b {:c 100}}}
        #(when (= % [:a :b]) :foo))
      ;;=> ([[:a :b] :foo])
  "
  [coll pred]
  (keep #(when-let [v (pred %)] [% v]) (paths coll)))

(defn- update-in-matching*
  "
    Example:
      (update-in-matching*
        {:a {:b {:c 100}}}
        [#(when (= % [:a :b :c]) inc)])
      ;;=> {:a {:b {:c 101}}}
  "
  [coll preds]
  (letfn [(reduce-preds
            [xs pred]
            (reduce reduce-paths xs (matching-paths xs pred)))
          (reduce-paths
            [xs [path f]]
            (let [f (if (fn? f) f (constantly f))]
              (if (seq path) (update-in xs path f) (f xs))))]
    (reduce reduce-preds coll preds)))

(defmacro matcher
  "
    Example:
      ((matcher
          [:a _ :c] :OK1
          [:a :x _] :OK2)
       [:a :x :d])
      ;;=> :OK2
  "
  [& rules]
  (let [rules (->> rules (partition 2) (mapcat #(update (vec %) 0 vector)))]
    `(fn [x#] (match/match [x#] ~@rules :else nil))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro update-in-matching
  "
    Example:
      (update-in-matching
        {:a {:b [{:c 100} {:c 200}]}}
        []            #(assoc % :z 1)
        [:z]          inc
        [:a :b _ _]   42
        [:a :b 0 _]   :foop)
      ;;=> {:a {:b [{:c :foop} {:c 42}]}, :z 2}
  "
  [coll & rules]
  `(update-in-matching* ~coll [~@(map (fn [x] `(matcher ~@x)) (partition 2 rules))]))