aero-with-flowing-env.clj

(ns aero2.core-with-path
  (:require
   [clojure.edn :as edn]
   [clojure.java.io :as io]
   [clojure.walk :as walk])
  (:import
   [java.io PushbackReader StringReader]))

;; An unpolished, crude re-implementation of Juxt's brilliant config
;; library Aero, in 200 fewer lines and more than twice as fast.
;;
;; Aero is excellent at doing one thing and doing it well. It is one
;; of my favorite utility libraries, but reading the source code I
;; struggled to follow the flow of execution. Thus, out of own
;; ignorance rather than need, I decided to rewrite the core routines
;; for expanding tagged literals, focusing on the JVM. There is no
;; meaningful error handling. Circular dependencies give a warning. It
;; passes the Aero test suite.
;;
;; ================
;; Three details of the design:
;; ================
;; 
;; 1) Instead of using a queue, we walk the entire config map
;; depth-first using modifed walk/postwalk, map and reduce that carry
;; along an environment map. This environment map contains info about
;; the original config, the current path, resolved tagged literals and
;; user options.
;;
;; 2) Each tagged literal is resolved upon first encounter, and the
;; value is cached at that path. I contemplated caching just the
;; return value, but Aero allows side-effecting expansion so this is
;; not possible.
;;
;; 3) The API for multimethods on aero.core/reader remains identical.
;; The API for aero.core/eval-tagged-literal is slightly different,
;; and there are some tradeoffs. The 'ref tag now does a little more
;; heavy lifting, but the 'or is significantly simpler and reads more
;; like one would expect. The case-based macros are almost identical
;; in implementation.
;;
;; ================
;; Drawbacks of this design:
;; ================

;; 1) This map-from-hell style of passing state around, though
;; convenient for quickly developing more features, can soon get
;; cumbersome. An earlier version that didn't detect circular
;; dependencies didn't need the :path key, but when I wanted track the
;; path it was trivial to add without breaking other stuff.
;; 
;; 2) No (recur) or iteration when walking nested structures, only
;; recursion. Deeply nested configs will consume a lot of stack.
;; However this depends only on the nesting factor, not size (number
;; of elements is seqs, maps, vectors) of the config.
;;
;; ================
;;
;; I wanted to use something like a state monad to avoid carrying the
;; whole env map around, instead saving up all effects till the end.
;; But because of the #ref tag this would probably require building up
;; a dependency graph, and I wanted to avoid that.


;;; utils
(defrecord Deferred [delegate])

(defmacro deferred [& expr]
  `(->Deferred (delay ~@expr)))

(defn string-reader [s]
  (-> s StringReader. PushbackReader.))

(defn- merge-in
  "The keys of m2 are keysets (as in arguments to assoc-in) pointing
  where to assoc in the corresponding values to m1."
  [m1 m2]
  (reduce-kv (fn [m k v]
               (assoc-in m k v))
             m1 m2))

(defn- get-opts
  ([env] (:opts env))
  ([env k & [default]] (get-in env [:opts k] default)))

(defn- get-in-opts
  [env ks & [default]]
  (get-in env (concat [:opts] ks) default))

(defn- get-env [s]
  (System/getenv (str s)))

(defn relative-resolver [source include]
  (let [fl
        (if (.isAbsolute (io/file include))
          (io/file include)
          (when-let [source-file
                     (try (io/file source)
                          ;; Handle the case where the source isn't file compatible:
                          (catch java.lang.IllegalArgumentException _ nil))]
            (io/file (.getParent ^java.io.File source-file) include)))]
    (if (and fl (.exists fl))
      fl
      (StringReader. (pr-str {:aero/missing-include include})))))

(defn resource-resolver [_ include]
  (or
   (io/resource include)
   (StringReader. (pr-str {:aero/missing-include include}))))

(defn root-resolver [_ include]
  include)

(defn adaptive-resolver [source include]
  (let [include (or (io/resource include)
                    include)]
    (if (string? include)
      (relative-resolver source include)
      include)))

(def default-opts
  {:profile :default
   :resolver adaptive-resolver})

;;;
;;; Multimethods for evaluating tagged literals
;;; 
#_(do                                   ;for repl use
    (def reader nil)
    (def eval-tagged-literal nil)
    )

(defmulti reader (fn [_opts tag _value] tag))

(defmulti eval-tagged-literal
  "The idea here is to allow macros to choose if/when to expand their
  arguments."
  (fn [[val _env]] (:tag val)))

;;;
;;; reader defmethods
;;;
(declare read-config)

(defmethod reader :default [_ tag value]
  (cond
    ;; Given tagification, we now must check data-readers
    (contains? *data-readers* tag)
    ((get *data-readers* tag) value)

    (contains? default-data-readers tag)
    ((get default-data-readers tag) value)
    :else
    (throw (ex-info (format "No reader for tag %s" tag) {:tag tag :value value}))))

(defmethod reader 'env [_opts _tag value]
  (get-env value))

(defmethod reader 'host [_opts _tag value]
  (get-env value))

(defmethod reader 'env
  [opts tag value]
  (get-env value))

(defmethod reader 'envf
  [opts tag value]
  (let [[fmt & args] value]
    (apply format fmt
           (map #(str (get-env (str %))) args))))

(defmethod reader 'prop
  [opts tag value]
  (System/getProperty (str value)))

(defmethod reader 'long
  [opts tag value]
  (Long/parseLong (str value)))

(defmethod reader 'double
  [opts tag value]
  (Double/parseDouble (str value)))

(defmethod reader 'keyword
  [opts tag value]
  (if (keyword? value)
    value
    (keyword (str value))))

(defmethod reader 'boolean
  [opts tag value]
  (Boolean/parseBoolean (str value)))

(defmethod reader 'include
  [{:keys [resolver source] :as opts} tag value]
  (read-config
   (if (map? resolver)
     (get resolver value)
     (resolver source value))
   opts))

(defmethod reader 'join
  [opts tag value]
  (apply str value))

(defmethod reader 'read-edn
  [opts tag value]
  (some-> value str edn/read-string))

(defmethod reader 'merge
  [opts tag values]
  (apply merge values))

(defmethod reader 'host [_opts _tag value]
  (get-env value))

;;;
;;; eval-tagged-literal defmethods
;;; 
(declare expand expand-tl)

(defmethod eval-tagged-literal :default
  [[{:keys [tag form] :as tl} env]]
  (let [[val env] (expand form env)]
    [(reader (get-opts env) tag val) env]))

(defn starts-with? [x y]
  (loop [[x & xnext] (seq x)
         [y & ynext] (seq y)]
    (cond
      (not y) true
      (= x y) (recur xnext ynext)
      :else false)))

(defmethod eval-tagged-literal 'ref
  [[{:keys [tag form] :as tl} {:keys [cur-path cur-refs] :as env}]]
  (let [[ks env] (expand form env)
        v (get-in (:config env) ks)]
    (if (seq (filter #(starts-with? % ks) cur-refs))
      (do       ;circular dependency
        (println "WARNING: Unable to resolve" tl "at" cur-path)
        [nil (assoc-in env (cons :config ks) nil)])
      (let [[res env]
            (expand v (-> env
                          (assoc :cur-path ks)
                          (update :cur-refs (fnil conj #{}) cur-path)))]
        [res (assoc env :cur-refs cur-refs)]))))

(defmethod eval-tagged-literal 'or
  [[{:keys [tag form] :as tl} env]]
  (loop [s (seq form)]
    (if-let [[x & more] s]
     (let [[res env] (expand x env)]
       (if res
         [res env]
         (recur more)))
     [nil env])))

(defn expand-set-keys [m]
  (reduce-kv (fn [m k v]
               (if (set? k)
                 (reduce #(assoc %1 %2 v) m k)
                 (assoc m k v)))
             {} m))

(defn expand-case [case-value form env]
  (let [set-keys-expanded (-> form
                              (update-keys #(first (expand %1 env)))
                              expand-set-keys)]
    (expand (get set-keys-expanded case-value
                 (get set-keys-expanded :default))
            env)))

(defmethod eval-tagged-literal 'profile
  [[{:keys [tag form] :as tl} env]]
  (expand-case (get-opts env :profile) form env))

(defmethod eval-tagged-literal 'hostname
  [[{:keys [tag form] :as tl} env]]
  (let [hostname (or (get-opts env :hostname)
                     (get-env "HOSTNAME"))]
    (expand-case hostname form env)))

(defmethod eval-tagged-literal 'user
  [[{:keys [tag form] :as tl} env]]
  (let [user (or (get-opts env :user)
                 (get-env "USER"))]
    (expand-case user form env)))

;;; ================================================================
;;; Core expand functionality

;; Result of inner has to return [val env]. And outer has to grab the
;; env, and insert the val into the structure.
;;
;; env always contains the original config under :config.

(defn- update-path-fn [x]
  (if (vector? x)
    (fn [path idx] (conj path idx))
    identity))

(defn- reduce-with-env
  "Given f, returns an env transform that transforms env over
  coll according to f, and returns [final-val env]."
  [f init coll env]
  (let [old-path (:cur-path env)
        [init-path update-path] (if (vector? init)
                                  [(conj old-path -1) #(conj (pop %) (inc (peek %)))]
                                  [old-path identity])
        [res env] (reduce
                   (fn [[res env] x]
                     (let [[val env] (f [x (update env :cur-path update-path)])]
                       [(conj res val) env]))
                   [init (assoc env :cur-path init-path)]
                   coll)]
    [res (assoc env :cur-path old-path)]))


(defn- map-entry-walk [inner k v env]
  (let [old-path (:cur-path env)
        [k-res env] (inner [k env])
        [v-res env] (inner [v (update env :cur-path conj k-res)])]
    [(clojure.lang.MapEntry/create k-res v-res) (assoc env :cur-path old-path)]))

(defn- map-with-env
  "Don't use this with associative things, only lists and seqs."
  [f coll env]
  (let [step (fn step [s env]
               (loop [res (), [x & more] s, env env]
                 (if x
                   (let [[val env] (f [x env])]
                     (recur (cons val res) more env))
                   [(reverse res) env])))]
    (step coll env)))

(defn- walk-with-env
  "Same as usual walk, except we carry an env around with us."
  [inner outer [form env]]
  (let [[res env]
        (cond
          (list? form) (outer (map-with-env inner form env))
          (instance? clojure.lang.IMapEntry form)
          (outer (map-entry-walk inner (key form) (val form) env))
          (seq? form) (outer (map-with-env inner form env))
          (instance? clojure.lang.IRecord form)
          (outer (reduce-with-env inner form form env))
          (coll? form) (reduce-with-env inner (empty form) form env)
          :else (outer [form env]))]
    (let [res (if (instance? clojure.lang.IObj res)
                (with-meta res (merge (meta form) (meta res)))
                res)]
      [res env])))

(defn- prewalk-with-env [f [form env]]
  ;;(println "trace pwe: " form)
  (walk-with-env (partial prewalk-with-env f) f [form env]))

(defn- expand-tl [[val {:keys [visited cur-path] :as env}]]
  (if (tagged-literal? val)
    (let [tag (:tag val)
          form (:form val)]
      (if-let [v (visited cur-path)]
        [v env]
        (let [[v env] (eval-tagged-literal [val env])]
          [v (-> env
                 (update :visited conj [(:cur-path env) v]) ;caching path val
                 (assoc :cur-path cur-path))])))
    [val env]))

(defn run-expand [config opts]
  (expand config {:config config
                  :cur-path []
                  :visited {}
                  :opts opts}))
(defn expand
  "config will be expanded according to the literal tags it contains.
  env is a map for internal use, and contains the following keys:
  :config     the original unexpanded config value
  :cur-path   the path at the current point of expansion
  :visited    paths within config that already have been expanded
  :opts       the opions provided by read-config, given to reader multimethods."
  ([config env]
   (prewalk-with-env expand-tl [config env])))

;;; ================================================================
;;; Reader functionality

(defn- realize-deferreds
  [config]
  (postwalk (fn [x] (if (instance? Deferred x) @(:delegate x) x)) config))

(defn- preserving-meta [f form]
  (fn [x]
    (let [res (f x)]
      (if (instance? clojure.lang.IObj res)
        (with-meta res (merge (meta form) (meta res)))
        res))))

(defn- postwalk
  "Same as walk/postwalk, but preserves meta."
  [f form]
  (walk/walk (partial postwalk f)
             (preserving-meta f form)
             form))

(defn- ref-meta-to-tagged-literal
  [config]
  (postwalk
   (fn [v]
     (cond (tagged-literal? v)
           (tagged-literal (:tag v) (ref-meta-to-tagged-literal (:form v)))

           (contains? (meta v) :ref)
           (tagged-literal 'ref v)

           :else v))
   config))

(defn tagged-literal-map
  []
  (reduce-kv (fn [res tag _]
               (assoc res tag (partial tagged-literal tag)))
             {} (merge default-data-readers *data-readers*)))

(defn- read-pr-into-tagged-literal
  [pr]
  (->> pr
       (edn/read
        {:eof nil
         :readers (tagged-literal-map)
         :default tagged-literal})
       ref-meta-to-tagged-literal))

(defn- read-config-into-tagged-literal
  ([source]
   (let [pr (-> source io/reader clojure.lang.LineNumberingPushbackReader.)]
     (read-pr-into-tagged-literal pr))))

(defn read-config
  "First argument is a string URL to the file. To read from the
  current directory just put the file name. To read from the classpath
  call clojure.java.io/resource on the string before passing it into
  this function.
  Optional second argument is a map that can include
  the following keys:
  :profile - indicates the profile to use for #profile extension
  :user - manually set the user for the #user extension
  :resolver - a function or map used to resolve includes."
  ([source] (read-config source {}))
  ([source opts]
   (let [config (read-config-into-tagged-literal source)
         opts (merge default-opts opts {:source source})]
     (-> (first (run-expand config opts))
         realize-deferreds))))