diff options
Diffstat (limited to 'users/grfn/bbbg/src/bbbg/util')
-rw-r--r-- | users/grfn/bbbg/src/bbbg/util/core.clj | 138 | ||||
-rw-r--r-- | users/grfn/bbbg/src/bbbg/util/dev_secrets.clj | 59 | ||||
-rw-r--r-- | users/grfn/bbbg/src/bbbg/util/display.clj | 23 | ||||
-rw-r--r-- | users/grfn/bbbg/src/bbbg/util/spec.clj | 16 | ||||
-rw-r--r-- | users/grfn/bbbg/src/bbbg/util/sql.clj | 5 | ||||
-rw-r--r-- | users/grfn/bbbg/src/bbbg/util/time.clj | 152 |
6 files changed, 393 insertions, 0 deletions
diff --git a/users/grfn/bbbg/src/bbbg/util/core.clj b/users/grfn/bbbg/src/bbbg/util/core.clj new file mode 100644 index 000000000000..d458aa5592d2 --- /dev/null +++ b/users/grfn/bbbg/src/bbbg/util/core.clj @@ -0,0 +1,138 @@ +(ns bbbg.util.core + (:require + [clojure.java.shell :refer [sh]] + [clojure.string :as str]) + (:import + java.util.UUID)) + +(defn remove-nils + "Remove all keys with nil values from m" + [m] + (let [!m (transient m)] + (doseq [[k v] m] + (when (nil? v) + (dissoc! !m k))) + (persistent! !m))) + + +(defn alongside + "Apply a pair of functions to the first and second element of a two element + vector, respectively. The two argument form partially applies, such that: + + ((alongside f g) xy) ≡ (alongside f g xy) + + This is equivalent to (***) in haskell's Control.Arrow" + ([f g] (partial alongside f g)) + ([f g [x y]] [(f x) (g y)])) + +(defn map-kv + "Map a pair of functions over the keys and values of a map, respectively. + Preserves metadata on the incoming map. + The two argument form returns a transducer that yields map-entries. + + (partial map-kv identity identity) ≡ identity" + ([kf vf] + (map (fn [[k v]] + ;; important to return a map-entry here so that callers down the road + ;; can use `key` or `val` + (first {(kf k) (vf v)})))) + ([kf vf m] + (into (empty m) (map-kv kf vf) m))) + +(defn filter-kv + "Returns a map containing the elements of m for which (f k v) returns logical + true. The one-argument form returns a transducer that yields map entries" + ([f] (filter (partial apply f))) + ([f m] + (into (empty m) (filter-kv f) m))) + +(defn map-keys + "Map f over the keys of m. Preserves metadata on the incoming map. The + one-argument form returns a transducer that yields map-entries." + ([f] (map-kv f identity)) + ([f m] (map-kv f identity m))) + +(defn keep-keys + "Map f over the keys of m, keeping only those entries for which f does not + return nil. Preserves metadata on the incoming map. The one-argument form + returns a transducer that yields map-entries." + ([f] (keep (fn [[k v]] (when-let [k' (f k)] + (first {k' v}))))) + ([f m] (into (empty m) (keep-keys f) m))) + +(defn map-vals + "Map f over the values of m. Preserves metadata on the incoming map. The + one-argument form returns a transducer that yields map-entries." + ([f] (map-kv identity f)) + ([f m] (map-kv identity f m))) + +(defn map-keys-recursive [f x] + (cond + (map? x) (map-kv f (partial map-keys-recursive f) x) + (sequential? x) (map (partial map-keys-recursive f) x) + :else x)) + +(defn denamespace [x] + (if (keyword? x) + (keyword (name x)) + (map-keys-recursive denamespace x))) + +(defn reverse-merge + "Like `clojure.core/merge`, except duplicate keys from maps earlier in the + argument list take precedence + + => (merge {:x 1} {:x 2}) + {:x 2} + + => (sut/reverse-merge {:x 1} {:x 2}) + {:x 1}" + [& ms] + (apply merge (reverse ms))) + +(defn invert-map + "Invert the keys and vals of m. Behavior with duplicate vals is undefined. + + => (sut/invert-map {:x 1 :y 2}) + {1 :x 2 :y}" + [m] + (into {} (map (comp vec reverse)) m)) + +(defn ->uuid + "Converts x to uuid, returning nil if x is nil or empty" + [x] + (cond + (not x) nil + (uuid? x) x + (and (string? x) (seq x)) + (UUID/fromString x))) + +(defn key-by + "Create a map from a seq obtaining keys via f + + => (sut/key-by :x [{:x 1} {:x 2 :y 3}]) + {1 {:x 1}, 2 {:x 2 :y 3}}" + [f l] + (into {} (map (juxt f identity)) l)) + +(defn distinct-by + "Like clojure.core/distinct, but can take a function f by which + distinctiveness is calculated" + [distinction-fn coll] + (let [step (fn step [xs seen] + (lazy-seq + ((fn [[f :as xs] seen] + (when-let [s (seq xs)] + (if (contains? seen (distinction-fn f)) + (recur (rest s) seen) + (cons f (step (rest s) (conj seen (distinction-fn f))))))) + xs seen)))] + (step coll #{}))) + +(defn pass [n] + (let [{:keys [exit out err]} (sh "pass" n)] + (if (= 0 exit) + (str/trim out) + (throw (Exception. + (format "`pass` command failed\nStandard output:%s\nStandard Error:%s" + out + err)))))) diff --git a/users/grfn/bbbg/src/bbbg/util/dev_secrets.clj b/users/grfn/bbbg/src/bbbg/util/dev_secrets.clj new file mode 100644 index 000000000000..88f1b50caaa8 --- /dev/null +++ b/users/grfn/bbbg/src/bbbg/util/dev_secrets.clj @@ -0,0 +1,59 @@ +(ns bbbg.util.dev-secrets + "Utility library for loading secrets during development from multiple + backends. + + # Supported backends + + - [Pass][0] (the default) + + (bbbg.util.dev-secrets/set-backend! :pass) + + Loads all secrets by shelling out to `pass <secret-name>` + + [0]: https://www.passwordstore.org/ + + - Directory + + (bbbg.util.dev-secrets/set-backend! [:dir \"/path/to/secret/directory\"]) + + Loads all secrets by reading the secret name as a (plaintext!) file rooted + at the given directory" + (:require [bbbg.util.core :as u] + [clojure.string :as str] + [clojure.java.io :as io])) + +(def ^:dynamic *secret-backend* :pass) + +(defn set-backend! + "Change the default secret-backend" + [backend] + (alter-var-root #'*secret-backend* (constantly backend))) + +(defmulti ^:private load-secret + (fn [backend _secret] + (if (coll? backend) (first backend) backend))) + +(defmethod load-secret :pass [_ secret] + (u/pass secret)) + +(defmethod load-secret :dir [[_ dir] secret] + (str/trim (slurp (io/file dir secret)))) + +(defn secret + "Load the value for the given `secret-name' from the currently selected + backend" + [secret-name] + (load-secret *secret-backend* secret-name)) + +(comment + (secret "bbbg/discord-client-id") + + (binding [*secret-backend* [:dir "/tmp/bbbg-secrets"]] + (secret "bbbg/discord-client-id")) + + (set-backend! [:dir "/tmp/bbbg-secrets"]) + (secret "bbbg/discord-client-id") + + (set-backend! :pass) + (secret "bbbg/discord-client-id") + ) diff --git a/users/grfn/bbbg/src/bbbg/util/display.clj b/users/grfn/bbbg/src/bbbg/util/display.clj new file mode 100644 index 000000000000..40716632a3c9 --- /dev/null +++ b/users/grfn/bbbg/src/bbbg/util/display.clj @@ -0,0 +1,23 @@ +(ns bbbg.util.display + (:require + [bbbg.util.time :as t]) + (:import + [java.time.format DateTimeFormatter FormatStyle])) + +(defn format-date + ([d] (format-date d FormatStyle/MEDIUM)) + ([d ^FormatStyle format-style] + (let [formatter (DateTimeFormatter/ofLocalizedDate format-style)] + (.format (t/->LocalDate d) formatter)))) + +(defn pluralize + ([n sing plur] + (str (or n 0) " " (if (= 1 n) sing plur))) + ([n sing] + (pluralize n sing (str sing "s")))) + +(comment + (format-date #inst "2021-12-19T05:00:00.000-00:00") + (format-date #inst "2021-12-19T05:00:00.000-00:00" + FormatStyle/FULL) + ) diff --git a/users/grfn/bbbg/src/bbbg/util/spec.clj b/users/grfn/bbbg/src/bbbg/util/spec.clj new file mode 100644 index 000000000000..89ac92669914 --- /dev/null +++ b/users/grfn/bbbg/src/bbbg/util/spec.clj @@ -0,0 +1,16 @@ +(ns bbbg.util.spec + (:require [expound.alpha :as exp] + [clojure.spec.alpha :as s])) + +(defn assert! + ([spec s] (assert! "Spec assertion failed" spec s)) + ([message spec x] + (if (s/valid? spec x) + x + (throw (ex-info + (str message + "\n" + (exp/expound-str spec x)) + (assoc (s/explain-data spec x) + ::s/failure + ::s/assertion-failed)))))) diff --git a/users/grfn/bbbg/src/bbbg/util/sql.clj b/users/grfn/bbbg/src/bbbg/util/sql.clj new file mode 100644 index 000000000000..988959fd0603 --- /dev/null +++ b/users/grfn/bbbg/src/bbbg/util/sql.clj @@ -0,0 +1,5 @@ +(ns bbbg.util.sql + (:require [honeysql.core :as hsql])) + +(defn count-where [cond] + (hsql/call :count (hsql/call :case cond #sql/raw "1" :else nil))) diff --git a/users/grfn/bbbg/src/bbbg/util/time.clj b/users/grfn/bbbg/src/bbbg/util/time.clj new file mode 100644 index 000000000000..0278f89f5edd --- /dev/null +++ b/users/grfn/bbbg/src/bbbg/util/time.clj @@ -0,0 +1,152 @@ +(ns bbbg.util.time + "Utilities for dealing with date/time" + (:require [clojure.spec.alpha :as s] + [clojure.test.check.generators :as gen] + [java-time :as jt]) + (:import [java.time + LocalDateTime LocalTime OffsetDateTime ZoneId ZoneOffset + LocalDate Year] + [java.time.format DateTimeFormatter DateTimeParseException] + java.util.Calendar + org.apache.commons.lang3.time.DurationFormatUtils)) + +(set! *warn-on-reflection* true) + +(defprotocol ToOffsetDateTime + (->OffsetDateTime [this] + "Coerces its argument to a `java.time.OffsetDateTime`")) + +(extend-protocol ToOffsetDateTime + OffsetDateTime + (->OffsetDateTime [odt] odt) + + java.util.Date + (->OffsetDateTime [d] + (-> d + .toInstant + (OffsetDateTime/ofInstant (ZoneId/of "UTC"))))) + +(defprotocol ToLocalTime (->LocalTime [this])) +(extend-protocol ToLocalTime + LocalTime + (->LocalTime [lt] lt) + + java.sql.Time + (->LocalTime [t] + (let [^Calendar cal (doto (Calendar/getInstance) + (.setTime t))] + (LocalTime/of + (.get cal Calendar/HOUR_OF_DAY) + (.get cal Calendar/MINUTE) + (.get cal Calendar/SECOND)))) + + java.util.Date + (->LocalTime [d] + (-> d .toInstant (LocalTime/ofInstant (ZoneId/of "UTC"))))) + +(defn local-time? [x] (satisfies? ToLocalTime x)) +(s/def ::local-time + (s/with-gen local-time? + #(gen/let [hour (gen/choose 0 23) + minute (gen/choose 0 59) + second (gen/choose 0 59) + nanos gen/nat] + (LocalTime/of hour minute second nanos)))) + +(defprotocol ToLocalDate (->LocalDate [this])) +(extend-protocol ToLocalDate + LocalDate + (->LocalDate [ld] ld) + + java.sql.Date + (->LocalDate [sd] (.toLocalDate sd)) + + java.util.Date + (->LocalDate [d] + (-> d .toInstant (LocalDate/ofInstant (ZoneId/of "UTC"))))) + +(defn local-date? [x] (satisfies? ToLocalDate x)) +(s/def ::local-date + (s/with-gen local-date? + #(gen/let [year (gen/choose Year/MIN_VALUE Year/MAX_VALUE) + day (gen/choose 1 (if (.isLeap (Year/of year)) + 366 + 365))] + (LocalDate/ofYearDay year day)))) + +(extend-protocol Inst + OffsetDateTime + (inst-ms* [zdt] + (inst-ms* (.toInstant zdt))) + + LocalDateTime + (inst-ms* [^LocalDateTime ldt] + (inst-ms* (.toInstant ldt ZoneOffset/UTC)))) + +(let [formatter DateTimeFormatter/ISO_OFFSET_DATE_TIME] + (defn ^OffsetDateTime parse-iso-8601 + "Parse s as an iso-8601 datetime, returning nil if invalid" + [^String s] + (try + (OffsetDateTime/parse s formatter) + (catch DateTimeParseException _ nil))) + + (defn format-iso-8601 + "Format dt, which can be an OffsetDateTime or java.util.Date, as iso-8601" + [dt] + (some->> dt ->OffsetDateTime (.format formatter)))) + +(let [formatter DateTimeFormatter/ISO_TIME] + (defn parse-iso-8601-time + "Parse s as an iso-8601 timestamp, returning nil if invalid" + [^String s] + (try + (LocalTime/parse s formatter) + (catch DateTimeParseException _ nil))) + + (defn format-iso-8601-time + "Format lt, which can be a LocalTime or java.sql.Time, as an iso-8601 + formatted timestamp without a date." + [lt] + (some->> lt ->LocalTime (.format formatter)))) + +(defmethod print-dup LocalTime [t w] + (binding [*out* w] + (print "#local-time ") + (print (str "\"" (format-iso-8601-time t) "\"")))) + +(defmethod print-method LocalTime [t w] + (print-dup t w)) + +(let [formatter DateTimeFormatter/ISO_LOCAL_DATE] + (defn parse-iso-8601-date + "Parse s as an iso-8601 date, returning nil if invalid" + [^String s] + (try + (LocalDate/parse s formatter) + (catch DateTimeParseException _ nil))) + + (defn format-iso-8601-date + "Format lt, which can be a LocalDate, as an iso-8601 formatted date without + a timestamp." + [lt] + (some->> lt ->LocalDate (.format formatter)))) + +(defmethod print-dup LocalDate [t w] + (binding [*out* w] + (print "#local-date ") + (print (str "\"" (format-iso-8601-date t) "\"")))) + +(defmethod print-method LocalDate [t w] + (print-dup t w)) + + +(defn ^String human-format-duration + "Human-format the given duration" + [^java.time.Duration dur] + (DurationFormatUtils/formatDurationWords (Math/abs (.toMillis dur)) true true)) + +(comment + (human-format-duration (jt/hours 5)) + (human-format-duration (jt/plus (jt/hours 5) (jt/minutes 7))) + ) |