Skip to content

Instantly share code, notes, and snippets.

@NPException
Last active May 9, 2022 05:56
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save NPException/1b9fc44077a0fbc32fa795bcf535352c to your computer and use it in GitHub Desktop.
Save NPException/1b9fc44077a0fbc32fa795bcf535352c to your computer and use it in GitHub Desktop.
Clojure snippets
(ns caffeine-wrapper.core
(:require [com.stuartsierra.component :as component])
(:import [com.github.benmanes.caffeine.cache Cache Caffeine]
[java.util.concurrent TimeUnit]
[clojure.lang ITransientMap]
[com.codahale.metrics MetricSet Gauge]))
(defn store
"Stores an element for the given key in the Caffeine cache.
If the cache already contains an element for the given key, it is replaced with the new one.
Does not store nil keys or values."
[^Cache cache key value]
(when (and (some? key) (some? value))
(.put cache key value)))
(defn- check-entry-validity!
[^ITransientMap m key value]
(if (and (some? key) (some? value))
m
(dissoc! m key)))
(defn- remove-invalid-entries
"Removes map entries that have a key or value of nil."
[m]
;; use of transient to minimise the cost of this operation.
(->> m
(reduce-kv check-entry-validity! (transient m))
persistent!))
(defn store-all
"Stores all elements of the given map in the Caffeine cache.
If the cache already contains an element for any of the keys, it is replaced with the new one.
Entries with nil keys or values will not be stored."
[^Cache cache key-value-map]
(.putAll cache (remove-invalid-entries key-value-map)))
(defn fetch
"Retrieves an element for the given key from the Caffeine cache.
If there is no element associated with the key and a load-function is supplied, the load-function will be called
with the key as the argument and the return value will be put into the cache.
The load-function will at most be called once. Nil return values will not be cached.
Optionally a sequence of cache key generating functions can be supplied via store-key-fns. The value returned by
load-function will also be stored under keys generated by applying each store-key function to the value.
Returns nil when the key is nil."
[^Cache cache key
& {:keys [load-function store-key-fns]}]
(when (some? key)
(if-some [result (.getIfPresent cache key)]
result
(when load-function
(when-some [value (load-function key)]
;; store via main key
(store cache key value)
;; store via provided additional keys
(when (seq store-key-fns)
(doseq [additional-key ((apply juxt store-key-fns) value)
:when (not= key additional-key)]
(store cache additional-key value)))
value)))))
(defn fetch-all
"Retrieves multiple elements from the Caffeine cache at once.
A map will be returned consisting of key-value mappings for all entries that have been found.
If a load-function is supplied, and not all keys are present in the cache,
the load-function will be called with a sequence of all the keys that are not yet present in the cache.
The load-function is expected to return a map which maps each of the given keys to the loaded
value. Nil values will not be cached. Nil keys and duplicate keys will be ignored.
Optionally a sequence of cache key generating functions can be supplied via store-key-fns. The value returned by
load-function will also be stored under keys generated by applying each store-key function to the value."
[^Cache cache keys
& {:keys [load-function store-key-fns]}]
(let [keys (remove nil? (set keys))
found (into {} (.getAllPresent cache keys))
missing-keys (filter #(not (contains? found %)) keys)]
(if (or (nil? load-function) (empty? missing-keys))
found
(let [loaded (load-function missing-keys)]
;; store via main key
(store-all cache loaded)
;; store via provided additional keys
(when-let [generate-additional-keys (some->> store-key-fns seq (apply juxt))]
(doseq [[key value] loaded]
(store-all cache (into {}
(comp
(remove #{key})
(map #(vector % value)))
(generate-additional-keys value)))))
(merge found loaded)))))
(defn- period-millis
[[n unit]]
(case unit
:millis (* n 1)
:seconds (* n 1000)
:minutes (* n 60000)
:hours (* n 3600000)
(throw
(IllegalArgumentException. (str "Invalid unit: " unit)))))
(defn new-cache
"Creates a new Caffeine cache with the provided options."
^Cache
[{:keys [max-size
expire-after-write
expire-after-access
record-stats?]
:as options}]
(let [caffeine (Caffeine/newBuilder)]
(when max-size
(.maximumSize caffeine max-size))
(when expire-after-write
(.expireAfterWrite caffeine (period-millis expire-after-write) TimeUnit/MILLISECONDS))
(when expire-after-access
(.expireAfterAccess caffeine (period-millis expire-after-access) TimeUnit/MILLISECONDS))
(when record-stats?
(.recordStats caffeine))
(.build caffeine)))
(defn build-caches
[cache-configs]
(reduce-kv
(fn [caches name config]
(assoc caches name (new-cache config)))
{} cache-configs))
(def ^:private metrics-prefix "caches")
(defn create-metric-set
[cache-name ^Cache cache]
(let [prefix (str metrics-prefix "." (name cache-name) ".")]
{(str prefix "size")
(reify Gauge (getValue [_] (-> cache .estimatedSize)))
(str prefix "hits")
(reify Gauge (getValue [_] (-> cache .stats .hitCount)))
(str prefix "misses")
(reify Gauge (getValue [_] (-> cache .stats .missCount)))
(str prefix "evictions")
(reify Gauge (getValue [_] (-> cache .stats .evictionCount)))}))
(defrecord CacheComponent [cache-configs]
component/Lifecycle
(start [this]
(let [caches (build-caches cache-configs)
caches-with-stats (->> caches
(filter #(-> (key %) cache-configs :record-stats?))
(into {}))]
(assoc this
:caches caches
:metrics (reify MetricSet
(getMetrics [_]
(->> caches-with-stats
(map #(apply create-metric-set %))
(apply merge)))))))
(stop [this]
(dissoc this :metrics)))
;; TEST NAMESPACE ;;
(ns caffeine-wrapper.core-test
(:require [clojure.test :refer :all]
[caffeine-wrapper.core :refer :all]
[clojure.string :refer [upper-case]])
(:import [clojure.lang ArityException]))
(deftest basics
(let [cache (new-cache {:max-size 10})]
(testing "store and fetch"
(store cache :a 123)
(is (= 123 (fetch cache :a))))
(testing "load-function"
(let [loaded (fetch cache "Space Unicorn"
:load-function count)]
(is (= 13 loaded))
(is (= 13 (fetch cache "Space Unicorn"))))
(is (thrown?
ArityException
(fetch cache :load-0
:load-function (fn [] "nothing here")))
"load function needs to support arity 1")
(is (thrown?
ArityException
(fetch cache :load-2
:load-function (fn [a b] "too much.")))
"load function needs to support arity 1"))
(testing "ignore nil keys"
(is (nil? (store cache nil :value)))
(is (nil? (fetch cache nil)))
(is (nil? (store-all cache {:some :value nil :NIL})))
(is (= {:some :value} (fetch-all cache [:some nil]))))
(testing "ignore nil values"
(store cache :key nil)
(is (= {} (fetch-all cache [:keys])))
(store-all cache {:ignore nil, :keep :value, :keep-2 "test"})
(is (= {:keep :value, :keep-2 "test"}
(fetch-all cache [:ignore :keep :keep-2])))
(let [load-calls (atom 0)
load-fn (fn [_]
(swap! load-calls inc)
nil)]
(fetch cache :load-nil :load-function load-fn)
(is (= 1 @load-calls))
(fetch cache :load-nil :load-function load-fn)
(is (= 2 @load-calls))
(fetch cache :load-nil :load-function load-fn)
(is (= 3 @load-calls))))
(testing "only accept specific time units"
(let [period-millis @#'caffeine-wrapper.core/period-millis]
(is (= 12 (period-millis [12 :millis])))
(is (= 3000 (period-millis [3 :seconds])))
(is (= 60000 (period-millis [1 :minutes])))
(is (= 7200000 (period-millis [2 :hours])))
(is (thrown?
IllegalArgumentException
(period-millis [12 :weeks])))
(is (thrown?
NullPointerException
(period-millis [nil :minutes])))
(is (thrown?
ClassCastException
(period-millis ["5" :minutes])))
(is (thrown?
ClassCastException
(period-millis ["3" :millis])))))))
(deftest eviction
(testing "size based eviction"
(let [cache (new-cache {:max-size 3})]
(dotimes [n 10]
(store cache n :value))
;; sleep because Caffeine caches may temporarily exceed the maximum size before eviction
(Thread/sleep 10)
(let [cached (->> (range 10)
(map #(fetch cache %))
(filter some?)
count)]
(is (= 3 cached) "Cache with max size of 3 should only keep 3 elements."))))
(testing "expire-based eviction"
(let [write-expire-cache (new-cache {:expire-after-write [20 :millis]})
access-expire-cache (new-cache {:expire-after-access [20 :millis]})]
(store write-expire-cache :key :value)
(store access-expire-cache :key :value)
(is (some? (fetch write-expire-cache :key)))
(is (some? (fetch access-expire-cache :key)))
(Thread/sleep 10)
(is (some? (fetch write-expire-cache :key)))
(is (some? (fetch access-expire-cache :key)))
(Thread/sleep 15)
(is (nil? (fetch write-expire-cache :key)) "entry should have expired 20 millis after write")
(is (some? (fetch access-expire-cache :key)) "entry should still exist 15 millis after last access")
(Thread/sleep 25)
(is (nil? (fetch access-expire-cache :key)) "entry should have expired 20 millis after last access"))))
(deftest fetch-all-test
(let [cache (new-cache {:max-size 10})
keys [:a :b :c :d :e]]
(testing "ignore nil keys"
(is (= {} (fetch-all cache [1 nil 2]))))
(testing "multi-fetch without load-function"
(store-all cache {:a 1, :b 2})
(is (= {:a 1, :b 2}
(fetch-all cache keys))))
(testing "multi-fetch with load-function"
(is (= {:a 1, :b 2, :c "C", :d "D" :e "E"}
(fetch-all cache keys
:load-function (fn [ks]
(zipmap ks (map (comp upper-case name) ks))))))
(is (= {:a 1, :b 2, :c "C", :d "D" :e "E"}
(fetch-all cache keys))))))
(deftest multi-key-storage-on-fetch
(let [cache (new-cache {})
key-generators [:id #(-> % :user :email)]
carl {:id 0
:user {:name "Carl Sagan"
:email "carl.sagan@test.com"}}
bobba {:id 1
:user {:name "Bobba Fett"
:email "jedisarebad@empire.net"}}
gaben {:id 2
:user {:name "Gabe Newell"
:email "gaben@valve.com"}}
entries [carl bobba gaben]
load-fn #(nth entries %)]
(is (empty? (fetch-all cache [0 "carl.sagan@test.com"
1 "jedisarebad@empire.net"
2 "gaben@valve.com"])))
(testing "fetch"
(is (= (fetch cache 0
:load-function load-fn
:store-key-fns key-generators)
carl))
(is (= (fetch cache "carl.sagan@test.com")
carl)))
(testing "fetch-all"
(is (= (fetch-all cache [1 2]
:load-function (fn [keys]
(into {} (map (juxt identity load-fn)) keys))
:store-key-fns key-generators)
{1 bobba
2 gaben}))
(is (= (fetch-all cache ["jedisarebad@empire.net" "gaben@valve.com"])
{"jedisarebad@empire.net" bobba
"gaben@valve.com" gaben})))))
(ns lambda
(:import [java.lang.reflect Method Modifier]))
(set! *warn-on-reflection* true)
(defn ^:private valid-method?
[^Method m]
(let [modifiers (.getModifiers m)]
(and (not (.isDefault m))
(Modifier/isPublic modifiers)
(not (Modifier/isStatic modifiers)))))
(defn ^:private extract-method-details
[fi-sym target-param-count]
(let [fi-class (resolve fi-sym)
method-candidates (when (class? fi-class)
(filter valid-method? (.getMethods ^Class fi-class)))
method (when (= 1 (count method-candidates))
^Method (first method-candidates))
_ (when-not method
(throw (IllegalArgumentException. (str fi-sym " is not a functional interface!"))))
param-count (.getParameterCount method)
_ (when-not (or (nil? target-param-count)
(= param-count target-param-count))
(throw (IllegalArgumentException. "Number of arguments doesn't match number of interface parameters")))]
{:name (.getName method)
:pcount param-count
:rtype (.getReturnType method)}))
(defn ^:private lambda-from-fn-form
[fi-sym [_fn-sym args & body :as _fn-form]]
(when-not (vector? args)
(throw (IllegalArgumentException. (str "Second parameter must be an fn form or a something that resolves to a function"))))
(let [body (if (> (count body) 1)
`(do ~@body)
(first body))]
`(lambda ~fi-sym ~args ~body)))
(defn ^:private boolean-type? [^Class class]
(#{"boolean" "java.lang.Boolean"} (.getCanonicalName class)))
(defmacro lambda
"Similar to reify, but designed exclusively for functional interfaces.
Functional interfaces with boolean return types don't require their body
to be wrapped in `(boolean ...)` explicitly.
Method name and 'this' argument can be omitted
-> (lambda BinaryOperator [a b] (+ a b))
fn forms can be used if they have matching parameter counts
-> (lambda BinaryOperator #(+ %1 %2))
Anything that resolves to a function that takes matching parameters can be used
-> (lambda BinaryOperator +)"
([fi-sym action]
(if (and (list? action)
('#{fn fn*} (first action)))
(lambda-from-fn-form fi-sym action)
(let [{param-count :pcount} (extract-method-details fi-sym nil)
param-syms (repeatedly param-count #(gensym "lambda_arg__"))]
`(lambda ~fi-sym ~(vec param-syms) (~action ~@param-syms)))))
([fi-sym args body]
(let [{method-name :name
return-type :rtype} (extract-method-details fi-sym (count args))
body (if (boolean-type? return-type)
;; convert literals to their boolean representation immediately
(if (seq? body) ;; FIXME: should probably check for list, not seq
`(boolean ~body)
(boolean body))
body)]
`(reify ~fi-sym
(~(symbol method-name) [~(gensym "lambda_this__") ~@args]
~body)))))
;; functions to combine predicates/rules
(defn rule-and
([] (constantly true))
([rule] rule)
([rule1 rule2]
#(and (apply rule1 %&) (apply rule2 %&)))
([rule1 rule2 & rules]
(apply rule-and (rule-and rule1 rule2) rules)))
(defn rule-or
([] (constantly false))
([rule] rule)
([rule1 rule2]
#(or (apply rule1 %&) (apply rule2 %&)))
([rule1 rule2 & rules]
(apply rule-or (rule-or rule1 rule2) rules)))
(defn rule-not [rule]
#(not (apply rule %&)))
;; logical IMPLY (single arrow): rule is true unless p is true and q is false. ("We care about q only if p is true.")
(defn rule-if [rule-p rule-q]
(rule-or (rule-not rule-p) rule-q))
;; logical XNOR (double arrow): returns true only if the p and q have the same result.
(defn rule-iff [rule-p rule-q]
#_(comment
;; this would be the implementation using just the established rule system instead of `=`
(rule-and (rule-if rule-p rule-q)
(rule-if rule-q rule-p)))
#(= (apply rule-p %&)
(apply rule-q %&)))
(defn re-matches-named-groups
"Returns a map-like object to query for named groups"
[^java.util.regex.Pattern re s]
(let [m (re-matcher re s)]
(when (. m (matches))
(reify
clojure.lang.ILookup
(valAt [_ key]
(when (string? key)
(.group m ^String key)))
(valAt [this key not-found]
(or
(.valAt this key)
not-found))
clojure.lang.IFn
(invoke [this key]
(.valAt this key))
(invoke [this key not-found]
(.valAt this key not-found))))))
(defmacro measure [x]
`(let [name# (with-out-str (pr (quote ~x)))
start# (System/nanoTime)
ret# ~x]
(println "Measured: " name# " - Took: " (long (/ (- (System/nanoTime) start#) 1000000)) " msec")
ret#))
(defn fast-merge
([])
([a] a)
([a b]
(when (or a b)
(persistent! (reduce-kv assoc! (transient (or a {})) b))))
([a b & maps]
(let [r (persistent!
(reduce
#(reduce-kv assoc! %1 %2)
(reduce-kv assoc! (transient (or a {})) b)
maps))]
(when (or a b (< 0 (count r)) (some identity maps))
r))))
(defn cached
"Returns an IDeref that holds a value for the given amount of time before
recreating it by calling load-fn"
[load-fn ttl-millis]
(let [write-time (atom (Long/MIN_VALUE)) ;; MIN_VALUE to force load on first deref
cache (atom nil)]
(reify IDeref
(deref [_]
(let [prev @write-time
now (System/currentTimeMillis)]
(if (and (> now (+ prev ttl-millis))
(compare-and-set! write-time prev now))
(reset! cache (load-fn))
@cache))))))
(defn lazy-concat
"Like `(apply concat colls)`, but wont fully realize `colls` if it is lazy"
[colls]
(lazy-seq
(if (seq colls)
(concat (first colls) (lazy-concat (rest colls))))))
(defn xf-flatten
"Transducer variant of `flatten`"
[rf]
(fn rf-flatten
([] (rf))
([result] (rf result))
([result input]
(if (sequential? input)
(loop [result result
inputs (seq input)]
(if inputs
(let [new-result (rf-flatten result (first inputs))]
(if (reduced? new-result)
new-result
(recur new-result (next inputs))))
result))
(rf result input)))))
(def ^:private hex-lookup
(let [hex-chars [\0 \1 \2 \3 \4 \5 \6 \7 \8 \9 \a \b \c \d \e \f]]
(->> hex-chars
(mapcat #(interleave (repeat %) hex-chars))
(partition 2)
(mapv #(apply str %)))))
(defn byte->hex
^String [b]
(hex-lookup (Byte/toUnsignedInt b)))
(defn bytes->hex
^String [^bytes bs]
(let [sb (StringBuilder. (int (* 2 (alength bs))))]
(dotimes [i (alength bs)]
(.append sb (byte->hex (aget bs i))))
(.toString sb)))
(defn cpmap
"A chunked variant of pmap. Instead of using one thread for application of f,
uses one thread for n applications of f."
[n f col]
(->> (partition-all n col)
(pmap #(mapv f %))
(apply concat)))
(defn url-from-clipboard
[]
(let [url (-> (java.awt.Toolkit/getDefaultToolkit)
(.getSystemClipboard)
(.getData java.awt.datatransfer.DataFlavor/stringFlavor))]
;; sanity check
(java.net.URL. url)
url))
(defmacro deftemplate
"The poor man's mustache"
[name-sym text]
(let [resolve-fn-sym (gensym "resolve-fn")
regex #"\{\{([^}]+)\}\}"
variable-parts (->> (re-seq regex text)
(map second)
(map (fn [key]
`(~resolve-fn-sym ~(keyword key)))))
parts (->> (concat variable-parts (repeat nil)) ;; lengthen to make interleave not stop too early
(interleave (str/split text regex -1))
(filter seq))]
`(defn ~name-sym [~resolve-fn-sym]
(str ~@parts))))
;; usage
;; (deftemplate hello-template "Hey, {{name}}! I hope you had a {{nice-fun}} day!")
;; result
;; (defn hello-template
;; [resolve-fn60262]
;; (str "Hey, " (resolve-fn60262 :name) "! I hope you had a " (resolve-fn60262 :nice-fun) " day!"))
(defn vpartition
"Returns a lazy sequence of vectors of n items each, at offsets step
apart. If step is not supplied, defaults to n, i.e. the partitions
do not overlap."
;; TODO: implement 4-arity variant with pad collection
([n ^IPersistentVector v]
(vpartition n n v))
([n step ^IPersistentVector v]
(lazy-seq
(let [num (count v)]
(when (>= num n)
(cons (subvec v 0 n)
(vpartition n step (subvec v step num))))))))
(defn partitioning
"A transducer variation of clojure.core/partition."
([^long n] (partitioning n n))
([^long n ^long step]
(fn [rf]
(let [a (java.util.ArrayDeque. n)]
(fn
([] (rf))
([result] (rf result))
([result input]
;; the commentet out alternatives would allow for nil values
;(.addLast a (if (nil? input) ::nil input))
(.addLast a input)
(if (= n (.size a))
;(let [v (mapv #(when-not (identical? % ::nil) %) a)]
(let [v (vec (.toArray a))]
(dotimes [_ step]
(.pollFirst a))
(rf result v))
result)))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment