new database
This commit is contained in:
+435
@@ -0,0 +1,435 @@
|
||||
;; Copyright © 2015-2017, JUXT LTD.
|
||||
|
||||
(ns aero.core
|
||||
(:require
|
||||
[aero.alpha.core :refer
|
||||
[expand expand-scalar-repeatedly expand-case eval-tagged-literal
|
||||
reassemble kv-seq]]
|
||||
[aero.impl.walk :refer [postwalk]]
|
||||
#?@(:clj [[clojure.edn :as edn]
|
||||
[aero.impl.macro :as macro]]
|
||||
:cljs [[cljs.tools.reader.edn :as edn]
|
||||
[cljs.tools.reader :refer [default-data-readers *data-readers*]]
|
||||
[cljs.tools.reader.reader-types
|
||||
:refer [source-logging-push-back-reader]
|
||||
:as tools.reader.reader-types]])
|
||||
#?@(:clj [[clojure.java.io :as io]]
|
||||
:cljs [[goog.string :as gstring]
|
||||
goog.string.format
|
||||
[goog.object :as gobj]
|
||||
["fs" :as fs]
|
||||
["path" :as path] ["os" :as os]]))
|
||||
#?(:clj (:import (java.io StringReader)))
|
||||
#?(:cljs (:require-macros [aero.impl.macro :as macro])))
|
||||
|
||||
(defrecord Deferred [delegate])
|
||||
|
||||
(macro/usetime
|
||||
(declare read-config)
|
||||
|
||||
(defmulti reader (fn [opts tag value] tag))
|
||||
|
||||
(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 (#?(:clj format :cljs gstring/format) "No reader for tag %s" tag) {:tag tag :value value}))))
|
||||
|
||||
(defn- get-env [s]
|
||||
#?(:clj (System/getenv (str s)))
|
||||
#?(:cljs (gobj/get js/process.env s)))
|
||||
|
||||
(defmethod reader 'env
|
||||
[opts tag value]
|
||||
(get-env value))
|
||||
|
||||
(defmethod reader 'envf
|
||||
[opts tag value]
|
||||
(let [[fmt & args] value]
|
||||
(apply #?(:clj format :cljs gstring/format) fmt
|
||||
(map #(str (get-env (str %))) args))))
|
||||
|
||||
(defmethod reader 'prop
|
||||
[opts tag value]
|
||||
#?(:clj (System/getProperty (str value))
|
||||
:cljs nil))
|
||||
|
||||
(defmethod reader 'long
|
||||
[opts tag value]
|
||||
#?(:clj (Long/parseLong (str value)))
|
||||
#?(:cljs (js/parseInt (str value))))
|
||||
|
||||
(defmethod reader 'double
|
||||
[opts tag value]
|
||||
#?(:clj (Double/parseDouble (str value)))
|
||||
#?(:cljs (js/parseFloat (str value))))
|
||||
|
||||
(defmethod reader 'keyword
|
||||
[opts tag value]
|
||||
(if (keyword? value)
|
||||
value
|
||||
(keyword (str value))))
|
||||
|
||||
(defmethod reader 'boolean
|
||||
[opts tag value]
|
||||
#?(:clj (Boolean/parseBoolean (str value)))
|
||||
#?(:cljs (= "true" (.toLowerCase (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))
|
||||
|
||||
#?(:clj
|
||||
(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}))))))
|
||||
|
||||
#?(:clj
|
||||
(defn resource-resolver [_ include]
|
||||
(or
|
||||
(io/resource include)
|
||||
(StringReader. (pr-str {:aero/missing-include include})))))
|
||||
|
||||
#?(:clj
|
||||
(defn root-resolver [_ include]
|
||||
include))
|
||||
|
||||
#?(:clj
|
||||
(defn adaptive-resolver [source include]
|
||||
(let [include (or (io/resource include)
|
||||
include)]
|
||||
(if (string? include)
|
||||
(relative-resolver source include)
|
||||
include)))
|
||||
:cljs
|
||||
(defn adaptive-resolver [source include]
|
||||
(let [fl (if (path/isAbsolute include)
|
||||
include
|
||||
(path/join source ".." include))]
|
||||
(if (fs/existsSync fl)
|
||||
fl
|
||||
(source-logging-push-back-reader
|
||||
(pr-str {:aero/missing-include include}))))))
|
||||
|
||||
|
||||
(def default-opts
|
||||
{:profile :default
|
||||
:resolver adaptive-resolver})
|
||||
|
||||
;; The rationale for deferreds is to realise some values after the
|
||||
;; config has been read. This allows certain expensive operations to
|
||||
;; be performed only after #profile has had a chance to filter out all
|
||||
;; other environments. For example, a :prod profile my do some
|
||||
;; expensive decryption of secrets (which may not be cheap to run for
|
||||
;; all environments which don't need them, and probably won't be
|
||||
;; possible to decrypt, therefore you want to defer until needed).
|
||||
|
||||
(defn- realize-deferreds
|
||||
[config]
|
||||
(postwalk (fn [x] (if (instance? Deferred x) @(:delegate x) x)) config))
|
||||
|
||||
(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- read-pr-into-tagged-literal
|
||||
[pr]
|
||||
(ref-meta-to-tagged-literal
|
||||
(edn/read
|
||||
{:eof nil
|
||||
;; Make a wrapper of all known readers, this permits mixing of
|
||||
;; post-processed tags with declared data readers
|
||||
:readers (into
|
||||
{}
|
||||
(map (fn [[k v]] [k #(tagged-literal k %)])
|
||||
(merge default-data-readers *data-readers*)))
|
||||
:default tagged-literal}
|
||||
pr)))
|
||||
|
||||
(defn read-config-into-tagged-literal
|
||||
[source]
|
||||
#?(:clj
|
||||
(with-open [pr (-> source io/reader clojure.lang.LineNumberingPushbackReader.)]
|
||||
(try
|
||||
(read-pr-into-tagged-literal pr)
|
||||
(catch Exception e
|
||||
(let [line (.getLineNumber pr)]
|
||||
(throw (ex-info (#?(:clj format :cljs gstring/format) "Config error on line %s" line) {:line line} e))))))
|
||||
:cljs
|
||||
(read-pr-into-tagged-literal
|
||||
(cond
|
||||
(tools.reader.reader-types/source-logging-reader? source)
|
||||
source
|
||||
|
||||
(implements? tools.reader.reader-types/Reader source)
|
||||
(source-logging-push-back-reader source)
|
||||
|
||||
:else
|
||||
(source-logging-push-back-reader
|
||||
(fs/readFileSync source "utf-8")
|
||||
1
|
||||
source)))))
|
||||
|
||||
(defn- rewrap
|
||||
[tl]
|
||||
(fn [v]
|
||||
(tagged-literal (:tag tl) v)))
|
||||
|
||||
(defmethod eval-tagged-literal :default
|
||||
[tl opts env ks]
|
||||
(let [{:keys [:aero.core/incomplete?] :as expansion}
|
||||
(expand (:form tl) opts env ks)]
|
||||
(if incomplete?
|
||||
(update expansion ::value (rewrap tl))
|
||||
(update expansion ::value #(reader opts (:tag tl) %)))))
|
||||
|
||||
(defmethod eval-tagged-literal 'ref
|
||||
[tl opts env ks]
|
||||
(let [{:keys [:aero.core/incomplete? :aero.core/env :aero.core/value
|
||||
:aero.core/incomplete]
|
||||
:or {env env}
|
||||
:as expansion} (expand (:form tl) opts env ks)]
|
||||
(if (or incomplete? (not (contains? env value)))
|
||||
(-> expansion
|
||||
(assoc ::incomplete? true)
|
||||
(update ::value (rewrap tl))
|
||||
(assoc ::incomplete (or incomplete
|
||||
{::path (pop ks)
|
||||
::value tl})))
|
||||
(assoc expansion ::value (get env value)))))
|
||||
|
||||
(defmethod eval-tagged-literal 'profile
|
||||
[tl opts env ks]
|
||||
(expand-case (:profile opts) tl opts env ks))
|
||||
|
||||
(defmethod eval-tagged-literal 'hostname
|
||||
[tl {:keys [hostname] :as opts} env ks]
|
||||
(expand-case (or hostname #?(:clj (env "HOSTNAME")
|
||||
:cljs (os/hostname)))
|
||||
tl opts env ks))
|
||||
|
||||
(defmethod eval-tagged-literal 'user
|
||||
[tl {:keys [user] :as opts} env ks]
|
||||
(expand-case (or user (get-env "USER"))
|
||||
tl opts env ks))
|
||||
|
||||
(defmethod eval-tagged-literal 'or
|
||||
[tl opts env ks]
|
||||
(let [{:keys [:aero.core/incomplete? :aero.core/value] :as expansion}
|
||||
(expand-scalar-repeatedly (:form tl) opts env ks)]
|
||||
(if incomplete?
|
||||
(update expansion ::value rewrap)
|
||||
(loop [[x & xs] value
|
||||
idx 0]
|
||||
(let [{:keys [:aero.core/incomplete? :aero.core/value]
|
||||
:as expansion}
|
||||
(expand x opts env (conj ks idx))]
|
||||
(cond
|
||||
;; We skipped a value, we cannot be sure whether it will be true in the future, so return with the remainder to check (including the skipped)
|
||||
incomplete?
|
||||
{::value (tagged-literal (:tag tl) (cons value xs))
|
||||
::incomplete? true
|
||||
::incomplete (::incomplete expansion)}
|
||||
|
||||
;; We found a value, and it's truthy, and we aren't skipped (because order), we successfully got one!
|
||||
value
|
||||
expansion
|
||||
|
||||
;; Run out of things to check
|
||||
(not (seq xs))
|
||||
nil
|
||||
|
||||
:else
|
||||
;; Falsey value, but not skipped, recur with the rest to try
|
||||
(recur xs (inc idx))))))))
|
||||
|
||||
(defn- assoc-in-kv-seq
|
||||
[x ks v]
|
||||
(let [[k & ks] ks]
|
||||
(let [steps (if (tagged-literal? x)
|
||||
(with-meta
|
||||
[[:tag (:tag x)]
|
||||
[:form (:form x)]]
|
||||
{`reassemble (fn [this queue]
|
||||
(let [{:keys [tag form]} (into {} queue)]
|
||||
(tagged-literal tag form)))})
|
||||
(kv-seq x))]
|
||||
(reassemble
|
||||
steps
|
||||
(map (fn [[stepk stepv :as kv]]
|
||||
(cond
|
||||
(and (not= (first ks) ::k)
|
||||
(= stepk k))
|
||||
(if (seq ks)
|
||||
[stepk (assoc-in-kv-seq stepv ks v)]
|
||||
[stepk v])
|
||||
|
||||
(and (= (first ks) ::k)
|
||||
(= stepk k))
|
||||
(if (seq (rest ks))
|
||||
[(assoc-in-kv-seq stepk (rest ks) v) stepv]
|
||||
[v stepv])
|
||||
|
||||
:else
|
||||
kv))
|
||||
steps)))))
|
||||
|
||||
(defn- dissoc-in-kv-seq
|
||||
[x ks]
|
||||
(let [[k & ks] ks]
|
||||
(if
|
||||
(or (not (seq ks))
|
||||
(= [::k] ks))
|
||||
(let [steps (kv-seq x)]
|
||||
(reassemble
|
||||
steps
|
||||
(filter (fn [[stepk stepv :as kv]]
|
||||
(not= stepk k))
|
||||
steps)) )
|
||||
|
||||
(let [steps (if (tagged-literal? x)
|
||||
(with-meta
|
||||
[[:tag (:tag x)]
|
||||
[:form (:form x)]]
|
||||
{`reassemble (fn [this queue]
|
||||
(let [{:keys [tag form]} (into {} queue)]
|
||||
(tagged-literal tag form)))})
|
||||
(kv-seq x))]
|
||||
(reassemble
|
||||
steps
|
||||
(map (fn [[stepk stepv :as kv]]
|
||||
(cond
|
||||
(and (not= (first ks) ::k)
|
||||
(= stepk k))
|
||||
(if (seq ks)
|
||||
[stepk (dissoc-in-kv-seq stepv ks)]
|
||||
[stepk stepv])
|
||||
|
||||
(and (= (first ks) ::k)
|
||||
(= stepk k))
|
||||
(if (seq (rest ks))
|
||||
[(dissoc-in-kv-seq stepk (rest ks)) stepv]
|
||||
[stepk stepv])
|
||||
|
||||
:else
|
||||
kv))
|
||||
steps))))))
|
||||
|
||||
(defn resolve-tagged-literals
|
||||
[wrapped-config opts]
|
||||
(let [{:keys [:aero.core/incomplete?
|
||||
:aero.core/value]
|
||||
:as expansion}
|
||||
(loop [attempts 0
|
||||
x {::value wrapped-config
|
||||
::incomplete? true}]
|
||||
(let [{:keys [:aero.core/incomplete]
|
||||
:as expansion}
|
||||
(expand (::value x)
|
||||
opts
|
||||
(::env x {})
|
||||
[])]
|
||||
(cond
|
||||
(not (::incomplete? x))
|
||||
expansion
|
||||
|
||||
(and (> attempts 0)
|
||||
(= (-> incomplete ::value :tag) 'ref))
|
||||
(do
|
||||
(binding [*out* #?(:clj *err*
|
||||
:cljs *out*)]
|
||||
(println "WARNING: Unable to resolve"
|
||||
(str \" (pr-str (-> incomplete ::value)) \")
|
||||
"at"
|
||||
(pr-str (-> incomplete ::path))))
|
||||
(recur
|
||||
0
|
||||
(if (= ::k (-> incomplete ::path last))
|
||||
(update expansion
|
||||
::value
|
||||
dissoc-in-kv-seq
|
||||
(-> incomplete ::path))
|
||||
(update expansion
|
||||
::value
|
||||
assoc-in-kv-seq
|
||||
(-> incomplete ::path)
|
||||
nil))))
|
||||
|
||||
(> attempts 1)
|
||||
(throw (ex-info "Max attempts exhausted"
|
||||
{:progress x
|
||||
:attempts attempts}))
|
||||
|
||||
:else
|
||||
(recur (if (= x expansion)
|
||||
(inc attempts)
|
||||
0)
|
||||
expansion))))]
|
||||
(if incomplete?
|
||||
(throw (ex-info "Incomplete resolution" expansion))
|
||||
value)))
|
||||
|
||||
(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 given-opts]
|
||||
(let [opts (merge default-opts given-opts {:source source})
|
||||
wrapped-config (read-config-into-tagged-literal source)]
|
||||
(-> wrapped-config
|
||||
(resolve-tagged-literals opts)
|
||||
(realize-deferreds))))
|
||||
([source] (read-config source {})))
|
||||
)
|
||||
|
||||
(macro/deftime
|
||||
(defmacro deferred [& expr]
|
||||
`(->Deferred (delay ~@expr))))
|
||||
Reference in New Issue
Block a user