xform.clj

(ns org.niskin.micha.xform
  (:require [clojure.walk :as walk]))

(declare ^:dynamic *scope*)
(declare ^:dynamic *scopes*)

(def ^:private empty-env
  {::default {:defs [] :rules {} :scope {}}})

;; helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn assoc-not-nil
  "Like assoc but returns m unmodified if v is nil."
  [m k v]
  (if (nil? v) m (assoc m k v)))

(defn postwalk-preview
  "Like postwalk but applies the pre-fn to each form for side effects in a
   pre-order traversal."
  [pre-fn post-fn form]
  (walk/walk #(postwalk-preview pre-fn post-fn %) post-fn (doto form pre-fn)))

(defn not-empty?
  "True if x is not nil, an empty collection, or a map entry whose value part
   is nil or an empty collection."
  [x]
  (not (or (nil? x) (cond (map-entry? x)  (empty? (val x))
                          (seqable? x)    (empty? x)))))

(defn preserving-coll-type
  "Returns a function which performs the seq-op over the seqable collection
   coll, returning a collection of the same type as coll."
  [seq-op]
  (fn preserving-coll-type-impl
    ([f coll]
     (preserving-coll-type-impl nil f coll))
    ([allow-empty? f coll]
     (let [xs (seq-op f coll)
           xs (if allow-empty? xs (filter not-empty? xs))]
       (if (seq? coll) xs (reduce conj (empty coll) xs))))))

(def map-preserving     (preserving-coll-type map))
(def filter-preserving  (preserving-coll-type filter))
(def keep-preserving    (preserving-coll-type keep))
(def remove-preserving  (preserving-coll-type remove))

(defn select-rename-keys
  "A cross between select-keys and rename keys. Best explained by example:
   (select-rename-keys {:a 1 :b 2 :c 3} {:x :a :y :b}) ;;=> {:x 1 :y 2}"
  ([m spec]
   (select-rename-keys m spec nil))
  ([m spec allow-empty?]
   (-> (fn [xs k k']
         (let [v' (if (fn? k') (k' m) (get m k'))]
           (if (or allow-empty? (not-empty? v')) (assoc xs k v') xs)))
       (reduce-kv {} spec))))

(defn map-vals
  "Given a function f and a collection coll, returns a new collection whose
   values are the result of applying f to them.
   (map-vals inc {:a 1 :b 2}) ;;=> {:a 2 :b 3}"
  ([f m]
   (map-vals nil f m))
  ([allow-empty? f m]
   (if (map? m)
     (map-preserving allow-empty? #(update % 1 f) m)
     (map-preserving allow-empty? f m))))

(defn index-by
  "Like group-by but assumes that for each x in coll (f x) produces a unique
   key. The resulting map's values are not vectors because there is exactly
   one value associated with each key."
  [f coll]
  (->> coll (map (juxt f identity)) (reduce conj {})))

;; compiler ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- intern-named-xform
  "Adds the transform function xform named by the symbol name to the env."
  [env name xform]
  (update-in env [::default :defs] into [name xform]))

(defn- intern-rule
  "Adds a rule to the scope named by with-scope (or ::default) in the env, as-
   sociating the xform with the pattern in that scope. The push-scope index is
   also updated when the pattern is associated with a push-scope key."
  [env {:keys [with-scope push-scope] :or {with-scope ::default}} pattern xform]
  (-> (update-in env [with-scope :rules] assoc pattern xform)
      (update-in [with-scope :scope] assoc-not-nil pattern push-scope)))

(defn- compile-xform
  "Compiles spec into an anonymous function of one argument which transforms
   one value."
  [spec]
  (let [{allow-empty? :preserve-empty
         lookup?      :lookup
         merge?       :merge
         union?       :union
         fltr         :filter
         index        :indexby
         group        :groupby} (meta spec)]
    (cond
      ;; get value by key
      (not (coll? spec))
      `#(get % ~spec)

      ;; clojure thread-first expression
      (seq? spec)
      `#(-> % ~spec)

      ;; lookup value in table or select and rename keys in map
      (map? spec)
      (if lookup?
        `#(get ~spec % (::default ~spec))
        `#(select-rename-keys % ~spec ~allow-empty?))

      ;; combinators
      (vector? spec)
      (let [[spec1 & more :as specs] (map compile-xform spec)]
        (cond merge?      `#(apply merge ((juxt ~@specs) %))
              union?      `#(reduce into ((juxt ~@specs) %))
              (seq more)  `#(-> % ~@(map list specs))
              index       `#(->> % (index-by ~index) (map-vals ~allow-empty? ~spec1))
              group       `#(->> % (group-by ~group) (map-vals ~allow-empty? ~spec1))
              fltr        `#(->> % (filter-preserving ~fltr) (map-vals ~allow-empty? ~spec1))
              spec1       `#(map-vals ~allow-empty? ~spec1 %)))

      :else (throw (ex-info "invalid transform" {:transform spec})))))

(defn- compile-rule
  "Compiles a single [pattern spec] rule and adds it to the env."
  [env [pattern spec]]
  (let [xform (compile-xform spec)]
    (cond (symbol? pattern)
          (intern-named-xform env pattern xform)
          (and (vector? pattern) (not-any? nil? pattern))
          (reduce #(intern-rule %1 (meta pattern) %2 xform) env pattern)
          :else (throw (ex-info "invalid pattern" {:pattern pattern})))))

(defn- compile-rules
  "Compiles a sequence of [pattern spec] rules and returns an env."
  [rules]
  (reduce compile-rule empty-env rules))

;; runtime ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- push-scope*
  "Pushes the rules associated with scope-key scope onto the dynamic *scopes*
   vector and merges the scope's rules into the current *scope*. Shadowing of
   rules is possible."
  [env scope-key]
  (set! *scopes* (conj *scopes* (merge-with merge *scope* (env scope-key))))
  (set! *scope* (peek *scopes*)))

(defn- pop-scope*
  "Pops the dynamic *scopes* vector and resets the current *scope* to the scope
   at the top of the *scopes* stack."
  []
  (set! *scopes* (pop *scopes*))
  (set! *scope* (peek *scopes*)))

(defn- get-scope*
  "If form is a map entry whose key was set to trigger a scope push, the scope
   key to push is returned."
  [form]
  (and (map-entry? form) (get-in *scope* [:scope (key form)])))

(defn- push-scope!
  "If form is a map entry whose key was set to trigger a scope push, the scope
   associated with the scope key is pushed onto the stack."
  [env form]
  (when-let [s (get-scope* form)] (push-scope* env s)))

(defn- pop-scope!
  "If form is a map entry whose key was set to trigger a scope push, the scope
   stack is popped off the stack."
  [form]
  (when (get-scope* form) (pop-scope*)))

(defn- resolve-xform
  "Returns the transform associated with the pattern k from the current scope.
   If no transform is found the identity function is returned."
  ([k] (resolve-xform k identity))
  ([k default] (get-in *scope* [:rules k] default)))

(defn- xform-1
  "Performs the transformation on one single form."
  [form]
  (let [proc #(update % 1 (resolve-xform (key %)))]
    (if (map? form) (reduce #(conj %1 (proc %2)) {} form) form)))

(defn- xform
  "Transforms an entire structure according to the compiled rules in env."
  [env start-pattern m]
  (binding [*scopes* [] *scope* nil]
    (push-scope* env ::default)
    (when (and m (resolve-xform start-pattern nil))
      (-> {start-pattern m}
          (->> (postwalk-preview
                 #(push-scope! env %)
                 #(let [result (xform-1 %)] (pop-scope! %) result)))
          (get start-pattern)))))

;; api ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro xformer
  "Constructs an anonymous transform function of two arguments: the starting
   pattern and the input data. The input data is walked and transformed accord-
   ing to the rules, starting from the rule associated with the start pattern.
   See #'defxformer for more info about rules."
  [& rules]
  (let [env (compile-rules (partition 2 rules))]
    `(let [~@(get-in env [::default :defs]) env# ~env]
       (fn [start-pattern# m#] (#'xform env# start-pattern# m#)))))

(doto
  (defmacro defxformer
    "
     OVERVIEW
     --------------------------------------------------------------------------

     Defines a named function of two arguments which, when applied to a pattern
     and an input data map, walks the data with a post-order traversal trans-
     forming values according to rules, starting with the rule associated with
     the pattern argument, to produce the final transformed result map. The
     structure and organization of rules in the transformer definition is in-
     tended to reflect the structure and organization of clojure's spec, so it
     should be intuitive to define a transformer based on a clojure spec.

     As the transformer walks the input map, all maps visited are transformed
     by matching the keys of the map with patterns associated with rules in a
     rule set. If a rule exists with a pattern matching a key in the visited
     map the rule's transform is applied to the value associated with that key.

     A rule is a pattern and transform pair.

        (defxformer foo
          [:foo]          ;; <--- pattern     |___ rule
          {:bar :baz})    ;; <--- transform   |

     Patterns correspond to keys in the input map. Transforms are functions
     that transform the values associated with those keys to produce the re-
     sult map.

        (defxformer foo
          [:apple]                    ;; <--- pattern     |___ rule
          {:type ::fruit.cultivar})   ;; <--- transform   |

        (foo :apple {::fruit.cultivar :granny-smith})
        ;;=> {:type :granny-smith}

     Transformations are applied to map values in a post-order traversal, and
     nested maps are transformed according to the same set of rules.

        (defxformer foo
          [::fruit.cultivar]    ;; <--- nested pattern
          ::cultivar.name       ;; <--- nested transform

          [:apple]
          {:type ::fruit.cultivar})

        (foo :apple {::fruit.cultivar {::cultivar.name :granny-smith}})
        ;;=> {:type :granny-smith}

     PATTERNS
     --------------------------------------------------------------------------

     A pattern is a vector of one or more map keys. Whenever one of those map
     keys in the input data is visited the associated value is transformed by
     the transform associated with the pattern. The pattern vector may have
     the ^:with-scope and/or ^:push-scope metadata (see SCOPES below).

     TRANSFORMS
     --------------------------------------------------------------------------

     A rule's transform is applied to the map values associated with the keys
     in the rule's pattern. There are a number of ways to write a transform.

     1. LIST: A transform which is a list is interpreted as a thread-first
        expression through which the input value is threaded and the expres-
        sion evaluated to produce the result.

          (defxformer foo
            [:human]
            (-> ::age inc))   ;; <--- example

          (foo :human {::age 100})
          ;;=> 101

     2. KEY: A transform which is a non-collection value is compiled to a func-
        tion that gets the value associated with the key in the input map.

          (defxformer foo
            [:human]
            ::age)    ;; <--- example

          (foo :human {::age 100})
          ;;=> 100

     3. MAP: A transform which is a map specifies a mapping between keys in the
        input map and the corresponding keys in the output map. The result is a
        map whose keys are the keys of the transform map and whose values are
        the values of the input map associated with the values of the transform
        map. Extra keys of the input map not referenced in the transform are
        not included in the result.

          (defxformer foo
            [:human]
            {:name ::name})   ;; <--- example

          (foo :human {::age 100 ::name :alice})
          ;;=> {:name :alice}

        The right hand side of the map can also be a function. In this case the
        value associated with the left hand side key in the result map is the
        function applied to the input map.

          (defxformer foo
            [:human]
            {:props keys})    ;; <--- example

          (foo :human {::age 100 ::name :alice})
          ;;=> {:props (::age ::name)}

     4. MAP (lookup table): A transform which is a map with ^:lookup metadata
        on it performs a lookup in the transform map, returning the value as-
        sociated with the key matching the input value.

          (defxformer foo
            [::name]
            ^:lookup            ;; <--- example
            {:charles :chuck    ;; <--- example
             :robert  :bob}     ;; <--- example

            [:human]
            {:nickname ::name})

          (foo :human {::age 100 ::name :charles})
          ;;=> {:nickname :chuck}

     DEFINITIONS
     --------------------------------------------------------------------------

     A rule whose pattern is a symbol defines a function of one argument which
     performs the rule's transform. These named transforms may then be used in
     the transforms of other rules.

        (defxformer foo
          first-last              ;; <--- example
          {:first ::first-name    ;; <--- example
           :last  ::last-name}    ;; <--- example

          [:human]
          (first-last))

        (foo :human {::first-name :joe ::last-name :blow})
        ;;=> {:first :joe :last :blow}

     COMBINATORS
     --------------------------------------------------------------------------

     Transforms that are vectors are combinators -- they are higher order op-
     erations that modify and/or combine other transforms. Metadata is used to
     configure the combinators in different ways.

     1. APPLY-TO-ALL: Wrapping a single transform in a vector maps that trans-
        form over the input value, presumably a collection. If the input value
        is a map the transform is applied to its values, updating them in place.

          (defxformer foo
            [::ids]
            [::id]    ;; <--- example

            [:human]
            {:name ::name
             :ids  ::ids})

          (foo :human {::name :alice ::ids [{::id 1} {::id 2}]})
          ;;=> {:name :alice :ids [1 2]}

     2. COMPOSE: A transform which is a vector containing multiple forms (other
        transforms) composes the nested transforms such that the result of the
        first nested transform becomes the input to the second nested transform,
        and so on.

          (defxformer foo
            [:human]
            [::names      ;; <--- example
             (first)])    ;; <--- example

          (foo :human {::names [:alice :bob :charlie]})
          ;;=> :alice

     3. MERGE: A transform which is a vector with ^:merge metadata and contain-
        ing multiple forms (other transforms) evaluates the nested transform-
        ations in parallel and combines the results with #'clojure.core/merge
        from left to right (top to bottom).

          (defxformer foo
            [:human]
            ^:merge             ;; <--- example
            [{:name ::name}     ;; <--- example
             {:age  ::age}])    ;; <--- example

          (foo :human {::name :alice ::age 100})
          ;;=> {:name :alice :age 100}

     4. UNION: A transform which is a vector with ^:union metadata and contain-
        ing multiple forms (other transforms) evaluates the nested transform-
        ations in parallel and combines the results with #'clojure.core/into
        from left to right (top to bottom).

          (defxformer foo
            [:human]
            ^:union     ;; <--- example
            [::names    ;; <--- example
             ::ages])   ;; <--- example

          (foo :human {::names [:alice :bob] ::ages [100 200]})
          ;;=> [:alice :bob 100 200]

     5. FILTER: A transform which is a vector with ^:filter metadata and con-
        taining a single form (another transform) filters the input data ac-
        cording to the specified predicate and then applies the nested trans-
        form to the filtered input data.

          (defxformer foo
            [::jobs]
            ^{:filter (complement :retired?)}   ;; <--- example
            [::job.name]                        ;; <--- example

            [:human]
            {:name ::name
             :jobs ::jobs})

          (foo :human {::name :bob
                       ::jobs [{:retired? nil ::job.name :doctor}
                               {:retired? nil ::job.name :actor}
                               {:retired? true ::job.name :vet}]})
          ;;=> {:name :bob :jobs [:doctor :actor]}

     6. GROUP-BY: A transform which is a vector with ^:groupby metadata and
        containing a single form (another transform) performs a group-by on
        the input data according to the specified keyfn and then applies the
        nested transform to the values of the result map.

          (defxformer foo
            [::jobs]
            ^{:groupby (comp {true :ret false :act} :retired?)} ;; <--- example
            [[::job.name]]                                      ;; <--- example

            [:human]
            {:name ::name
             :jobs ::jobs})

          (foo :human {::name :bob
                       ::jobs [{:retired? false ::job.name :doctor}
                               {:retired? false ::job.name :actor}
                               {:retired? true  ::job.name :vet}]})
          ;;=> {:name :bob :jobs {:act [:doctor :actor] :ret [:vet]}}

     7. INDEX-BY: A transform which is a vector with ^:indexby metadata and
        containing a single form (another transform) performs an index-by on
        the input data according to the specified keyfn and then applies the
        nested transform to the values of the result map. Index-by is similar
        to group-by but the values of the result map are not vectors -- the
        input collection is assumed to be indexed by a primary key, so there
        will only be one value associated with each key in the result map.

          (defxformer foo
            [::jobs]
            ^{:indexby ::job.name}                    ;; <--- example
            [(-> :retired? {true :ret false :act})]   ;; <--- example

            [:human]
            {:name ::name
             :jobs ::jobs})

          (foo :human {::name :bob
                       ::jobs [{:retired? false ::job.name :doctor}
                               {:retired? false ::job.name :actor}
                               {:retired? true  ::job.name :vet}]})
          ;;=> {:name :bob :jobs {:doctor :act :actor :act :vet :ret}}

     EMPTY VALUES
     --------------------------------------------------------------------------

     By default map keys whose values are nil or empty collections are not in-
     cluded in the result. This behavior can be suppressed on a per-transform
     basis by adding the ^:preserve-empty metadata to the rule.

        (defxformer foo
          [::foods]
          [::name]

          [:human]
          ^:preserve-empty    ;; <--- example
          {:eats ::foods})

        (foo :human {::foods [{::style :french} {::style :italian}]})
        ;;=> {:eats []}

     Note that empty values are not removed from the results of the clojure
     thread-first transforms; the user is expected to handle it in that case.

     SCOPES
     --------------------------------------------------------------------------

     By default the transformer walks the input data and applies the transform-
     ation associated with a map key to the corresponding value. However, it
     sometimes happens that the transformation that needs to be done on the map
     value depends on the location (ie. the path from the root input object to
     the value being transformed) as well as the key itself.

     Scopes may be created such that the transformation for a given key in one
     scope is different from the transformation for that same key in a differ-
     ent scope. The mechanism provided is the ^:with-scope and/or ^:push-scope
     metadata on rule patterns.

        (defxformer foo
          ^{:with-scope :primate}   ;; <--- example
          [::info]
          {:irritable ::hungry}

          ^{:with-scope :mollusk}   ;; <--- example
          [::info]
          {:tasty ::edible}

          ^{:push-scope :primate}   ;; <--- example
          [:human]
          {:name ::species
           :mood ::info}

          ^{:push-scope :mollusk}   ;; <--- example
          [:mussel]
          {:name ::species
           :food ::info})

        (foo :human {::species :homosapiens ::info {::hungry true}})
        ;;=> {:name :homosapiens :mood {:irritable true}}

        (foo :mussel {::species :mylitus ::info {::edible true}})
        ;;=> {:name :mylitus :food {:tasty true}}

     The ^:with-scope metadata specifies that the rule should be interned in
     the specified scope. The ^:push-scope metadata pushes the specified scope
     onto the stack when that rule is applied, and pops the scope after the
     rule is completed.

     When a scope is pushed, all of its rules are merged into the existing
     environment, possibly shadowing existing rules. When the scope is popped
     the previous environment is restored.

     NOTES
     --------------------------------------------------------------------------

     1. It could be profitable to use spec to infer input map structure in the
        compiler. This could unlock performance optimizations and possibly im-
        plicit rules could be generated where appropriate.

     2. Can this all be replaced with some clever application s/conform? I sus-
        pect so but it wasn't clear how to do it."
    [name & [arg1 & more :as args]]
    (let [doc   (when (string? arg1) [arg1])
          rules (if doc more args)]
      `(doto (def ~name ~@doc (xformer ~@rules))
         (alter-meta! into {:arglists '([~'pattern ~'x])}))))
  (alter-meta! into {:arglists '([name doc-string? & rules])}))

(comment
  (defxformer min-job->entity*
    entity-base
    {:actions :action
     :job-id :job-id
     :bees ::bees}

    [:ad]
    (entity-base))

  (assert (= (min-job->entity* :ad {:action "add" :job-id 1234 ::bees "bs"})
             {:actions "add", :job-id 1234, :bees "bs"}))

  min-job->entity*
  )