keyword maps syntax sugar and basic operations

km.cljs

(ns utils.km-light
  (:refer-clojure :exclude [get])
  (:require [utils.core :as u]
            [utils.check :as uc]
            [cljs.core :as c]))

(declare km? kset? kset->km normalize)

(defn catv [a b]
  (vec (concat a b)))

(defn normalize-entry
  [[k v]]

  (if (keyword? k)

    (reduce
      (fn [v k] {k v})
      (normalize v)
      (reverse (kw->path k)))

    (u/throw*
      "km/normalize-entry bad key format:\n"
      k)))


(defn merge-rec
  "Like merge, but merges maps recursively."
  [x y]

  (if (and (km? x) (km? y))
    (merge-with merge-rec x y)
    y))

(merge-rec {:a {:b 1}} {:a {:c 2}})

(defn normalize
  [x]
  (cond

    ;(nil? x) {}

    (kset? x) (kset->km x)

    (km? x)
    (reduce
      #(merge-rec %1 (normalize-entry %2))
      (empty x)
      x)

    :else x))

(normalize {:a.b 1})

(defn wrap-kvs
  "km varargs helper"
  [xs]

  (loop [ret []
         [x & nxt] xs]

    (cond

      (keyword? x)
      (recur (if (first nxt) (conj ret {x (first nxt)}) ret)
             (next nxt))

      (not x)
      (if (seq nxt)
        (recur ret nxt)
        ret)

      (sequential? x)
      (recur (catv ret (wrap-kvs x))
             nxt)

      :else
      (recur (conj ret x)
             nxt))))

;; tests ---------------

(do

  (uc/check-fn
    normalize
    {[{:a.e.r 1 :c {:m.n 1} :a.e {:m 42}}]
     {:a {:e {:r 1, :m 42}}, :c {:m {:n 1}}}

     [#{:aze :ert}]
     {:ert true, :aze true}})

  (uc/check-fn
    wrap-kvs
    {[[:a 1 {:b 2}]]
     [{:a 1} {:b 2}]}))



;; api ----------------------------------------------

(defn km? [x]
  (and (map? x)
       (every? keyword? (keys x))))

(defn kset? [x]
  (and (set? x)
       (every? keyword? x)))

(defn kset->km [x]
  (normalize
    (apply hash-map
           (interleave x (repeat true)))))

(defn km

  "syntactic sugar to create {keyword -> any} hashmaps
   ex:
   (km :a 1 :m.n 1 {:yo 12} #{:x :y.z})
   ;=> {:a 1
        :m {:n 1},
        :yo 12
        :x true,
        :y {:z true}}"

  [& xs]

  ;(println "km: " xs)

  (if-let [xs (seq (map normalize (wrap-kvs xs)))]

    (reduce

      (fn [a x]
        (cond
          (nil? x) a
          (km? x) (merge-rec a x)
          (seq x) (apply km a x)
          (fn? x) (x a)
          :else
          (u/throw*
            "km error:\nm:\n" a
            "\nx:\n" x)))

      xs)

    {}))

(def km*
  (partial apply km))

(defn get

  "a more expressive version of get for keymaps
  - dotted keyword syntax e.g :a.b.c (similar to get-in behavior)
  - key selection with set and map queries
  - get-in(ish) for sequence and vector
  - (get x nil) -> x
  - (get x f) -> (f x) (where f is a function)
  "

  [m x]

  (cond

    (keyword? x)
    (or (c/get m x) ;; simplest case
        (reduce c/get m (kw->path x))) ;; keyword case

    (nil? x) m

    (sequential? x)
    (reduce get m x)

    ;; select-keys(ish)
    (set? x)
    (reduce
      (fn [r e]
        (assoc r e (get m e)))
      {} x)

    ;; selection
    (map? x)
    (reduce
      (fn [r [k v]]
        (assoc r k (get (get m k) v)))
      {} x)

    ;; why not? it seems to make sense sometimes
    (fn? x) (x m)))


(do

  #_(let [km1 (km :a 1 :b 2 :c.d 3 :c.e 4 :c.f (km :p 1 :q 3))]
      [(time (dotimes [_ 100000] (c/get km1 :a)))
       (time (dotimes [_ 100000] (get km1 :a)))])

  (let [km1 (km :a 1 :b 2 :c.d 3 :c.e 4 :c.f (km :p 1 :q 3))
        id identity]
    (uc/check-fn
      get
      {[km1 nil] km1
       [km1 []] km1
       [km1 :c.f.q] 3
       [km1 [:c :f.q]] 3
       [km1 [:c :f :q]] 3
       [km1 :a] 1
       [km1 #{:a :b}] (km :a 1 :b 2)
       [km1 {:a id :b id}] (km :a 1 :b 2)
       [km1 {:c #{:d :e}}] {:c {:e 4, :d 3}}
       [km1 [:c.f.q inc]] 4})))


(defn upd [m x]
  #_(println "upd " m x)
  (cond
    (km? m)
    (cond
      (vector? x) (km m (first x) (upd (get m (first x)) (second x)))
      (km? x) (reduce upd m x)
      (nil? x) m
      (fn? x) (x m))
    m
    (cond
      (nil? x) m
      (fn? x) (x m)
      :else x)))

(uc/check-fn
  upd
  {[{:a 1} {:a inc}] {:a 2}
   [{:a 1} [:a inc]] {:a 2}
   [{:a {:b 1 :c 2}} (km :a.b inc)] {:a {:b 2 :c 2}}
   [{:a {:c 2}} (km :a.b inc)] {:a {:c 2}}
   [{:a 1 :b 2} {:a inc :b dec}] {:a 2 :b 1}
   [{:a 1} #(assoc % :b 2)] {:a 1 :b 2}})