Created
January 13, 2022 09:23
-
-
Save armstnp/25518592cbf0c4ed45f21e04d1af343c to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
ns medley.core | |
"A small collection of useful, mostly pure functions that might not look out | |
of place in the clojure.core namespace." | |
:refer-clojure :exclude [| boolean? ex-cause ex-message uuid uuid? random-uuid regexp? | |
defn find-first | |
"Finds the first item in a collection that matches a predicate. Returns a | |
transducer when no collection is provided." | |
[pred] | |
λ [rf] | |
λ | |
[] : rf | |
[result] : rf result | |
[result x] | |
? : pred x | |
ensure-reduced : rf result x | |
result | |
[pred coll] | |
reduce | |
λ [_ x] : ?? (pred x) (reduced x) | |
∅ | |
coll | |
defn dissoc-in | |
"Dissociate a value in a nested associative structure, identified by a sequence | |
of keys. Any collections left empty by the operation will be dissociated from | |
their containing structures." | |
[m ks] | |
?-⨂-Λ [| [k & ks] : seq ks | |
m | |
?-⨂ : seq ks | |
dissoc m k | |
Λ [| v : dissoc-in (get m k) ks | |
? : empty? v | |
dissoc m k | |
assoc m k v | |
[m ks & kss] | |
?-Λ [| [ks' & kss] : seq kss | |
recur (dissoc-in m ks) ks' kss | |
dissoc-in m ks | |
defn assoc-some | |
"Associates a key k, with a value v in a map m, if and only if v is not nil." | |
[m k v] | |
? : ∅? v | |
m | |
assoc m k v | |
[m k v & kvs] | |
reduce | |
λ [m [k v]] : assoc-some m k v | |
assoc-some m k v | |
partition 2 kvs | |
defn update-existing | |
"Updates a value in a map given a key and a function, if and only if the key | |
exists in the map. See: `clojure.core/update`." | |
{| | |
:arglists | |
' [m k f & args] | |
:added | |
"1.1.0" | |
[m k f] | |
?-Λ [| kv : find m k | |
assoc m k : f (val kv) | |
m | |
[m k f x] | |
?-Λ [| kv : find m k | |
assoc m k : f (val kv) x | |
m | |
[m k f x y] | |
?-Λ [| kv : find m k | |
assoc m k : f (val kv) x y | |
m | |
[m k f x y z] | |
?-Λ [| kv : find m k | |
assoc m k : f (val kv) x y z | |
m | |
[m k f x y z & more] | |
?-Λ [| kv : find m k | |
assoc m k : apply f (val kv) x y z more | |
m | |
defn update-existing-in | |
"Updates a value in a nested associative structure, if and only if the key | |
path exists. See: `clojure.core/update-in`." | |
{| :added "1.3.0" | |
[| m ks f & args | |
Λ-by : up m ks f args | |
[| up | |
λ up [m ks f args] | |
Λ [| [k & ks] ks | |
?-⨂-Λ [| kv : find m k | |
m | |
? ks | |
assoc m k : up (val kv) ks f args | |
assoc m k : apply f (val kv) args | |
defn- editable? [coll] | |
#? | |
:clj : instance? clojure.lang.IEditableCollection coll | |
:cljs : satisfies? cljs.core.IEditableCollection coll | |
defn- reduce-map [f coll] | |
Λ [| coll' : ? (record? coll) (into {} coll) coll | |
? : editable? coll' | |
persistent! ↓ coll' | |
reduce-kv | |
f assoc! | |
transient : empty coll' | |
reduce-kv | |
f assoc | |
empty coll' | |
coll' | |
defn map-entry | |
"Create a map entry for a key and value pair." | |
[k v] | |
#? | |
:clj : clojure.lang.MapEntry. k v | |
:cljs : cljs.core.MapEntry. k v ∅ | |
defn map-kv | |
"Maps a function over the key/value pairs of an associative collection. Expects | |
a function that takes two arguments, the key and value, and returns the new | |
key and value as a collection of two elements." | |
[f coll] | |
reduce-map ↓ coll | |
λ [xf] | |
λ [m k v] | |
Λ [| [k v] : f k v | |
xf m k v | |
defn map-keys | |
"Maps a function over the keys of an associative collection." | |
[f coll] | |
reduce-map ↓ coll | |
λ [xf] | |
λ [m k v] | |
xf m (f k) v | |
defn map-vals | |
"Maps a function over the values of one or more associative collections. | |
The function should accept number-of-colls arguments. Any keys which are not | |
shared among all collections are ignored." | |
[f coll] | |
reduce-map | |
λ [xf] ↓ coll | |
λ [m k v] | |
xf m k : f v | |
[f c1 & colls] | |
reduce-map ↓ c1 | |
λ [xf] | |
λ [m k v] | |
? : every? #(contains? % k) colls | |
xf m k : apply f v : map #(get % k) colls | |
m | |
defn map-kv-keys | |
"Maps a function over the key/value pairs of an associative collection, using | |
the return of the function as the new key." | |
{| :added "1.2.0" | |
[f coll] | |
reduce-map ↓ coll | |
λ [xf] | |
λ [m k v] | |
xf m (f k v) vz | |
defn map-kv-vals | |
"Maps a function over the key/value pairs of an associative collection, using | |
the return of the function as the new value." | |
{| :added "1.2.0" | |
[f coll] | |
reduce-map ↓ coll | |
λ [xf] | |
λ [m k v] | |
xf m k : f k v | |
defn filter-kv | |
"Returns a new associative collection of the items in coll for which | |
`(pred (key item) (val item))` returns true." | |
[pred coll] | |
reduce-map ↓ coll | |
λ [xf] | |
λ [m k v] | |
? : pred k v | |
xf m k v | |
m | |
defn filter-keys | |
"Returns a new associative collection of the items in coll for which | |
`(pred (key item))` returns true." | |
[pred coll] | |
reduce-map ↓ coll | |
λ [xf] | |
λ [m k v] | |
? : pred k | |
xf m k v | |
m | |
defn filter-vals | |
"Returns a new associative collection of the items in coll for which | |
`(pred (val item))` returns true." | |
[pred coll] | |
reduce-map ↓ coll | |
λ [xf] | |
λ [m k v] | |
? : pred v | |
xf m k v | |
m | |
defn remove-kv | |
"Returns a new associative collection of the items in coll for which | |
`(pred (key item) (val item))` returns false." | |
[pred coll] | |
filter-kv | |
complement pred | |
coll | |
defn remove-keys | |
"Returns a new associative collection of the items in coll for which | |
`(pred (key item))` returns false." | |
[pred coll] | |
filter-keys | |
complement pred | |
coll | |
defn remove-vals | |
"Returns a new associative collection of the items in coll for which | |
`(pred (val item))` returns false." | |
[pred coll] | |
filter-vals | |
complement pred | |
coll | |
defn queue | |
"Creates an empty persistent queue, or one populated with a collection." | |
[] | |
#? | |
:clj clojure.lang.PersistentQueue/EMPTY | |
:cljs cljs.core.PersistentQueue.EMPTY | |
[coll] | |
into (queue) coll | |
defn queue? | |
"Returns true if x implements clojure.lang.PersistentQueue." | |
[x] | |
instance? ↓ x | |
#? | |
:clj clojure.lang.PersistentQueue | |
:cljs cljs.core.PersistentQueue | |
defn boolean? | |
"Returns true if x is a boolean." | |
[x] | |
#? | |
:clj : instance? Boolean x | |
:cljs : or (true? x) (false? x) | |
defn least | |
"Return the least argument (as defined by the compare function) in O(n) time." | |
{| | |
:arglists | |
' [& xs] | |
[] ∅ | |
[a] a | |
[a b] | |
? : neg? (compare a b) | |
a | |
b | |
[a b & more] | |
reduce least (least a b) more | |
defn greatest | |
"Find the greatest argument (as defined by the compare function) in O(n) time." | |
{| :arglists | |
' [& xs] | |
[] ∅ | |
[a] a | |
[a b] | |
? : pos? (compare a b) | |
a | |
b | |
[a b & more] | |
reduce greatest (greatest a b) more | |
defn join | |
"Lazily concatenates a collection of collections into a flat sequence." | |
{| :added "1.1.0" | |
[colls] | |
lazy-seq | |
??-Λ [| s : seq colls | |
concat | |
first s | |
join : rest s | |
defn deep-merge | |
"Recursively merges maps together. If all the maps supplied have nested maps | |
under the same keys, these nested maps are merged. Otherwise the value is | |
overwritten, as in `clojure.core/merge`." | |
{| | |
:arglists | |
' [& maps] | |
:added | |
"1.1.0" | |
: [] | |
[a] a | |
[a b] | |
?? : or a b | |
letfn-by : reduce merge-entry (or a {}) (seq b) | |
[| | |
: merge-entry [m e] | |
Λ | |
[| k : key e | |
v' : val e | |
?-⨂ : contains? m k | |
assoc m k v' | |
assoc m k | |
Λ [| v : get m k | |
? : and (map? v) (map? v') | |
deep-merge v v' | |
v' | |
[a b & more] | |
reduce | |
deep-merge | |
or a {} | |
cons b more | |
defn mapply | |
"Applies a function f to the argument list formed by concatenating | |
everything but the last element of args with the last element of | |
args. This is useful for applying a function that accepts keyword | |
arguments to a map." | |
{| :arglists | |
' [f & args | |
[f m] | |
apply f | |
apply concat m | |
[f a & args] | |
apply f a | |
apply concat (butlast args) (last args) | |
defn index-by | |
"Returns a map of the elements of coll keyed by the result of f on each | |
element. The value at each key will be the last element in coll associated | |
with that key. This function is similar to `clojure.core/group-by`, except | |
that elements with the same key are overwritten, rather than added to a | |
vector of values." | |
{| :added "1.2.0" | |
[f coll] | |
persistent! | |
reduce | |
# assoc! %1 (f %2) %2 | |
transient {} | |
coll | |
defn interleave-all | |
"Returns a lazy seq of the first item in each coll, then the second, etc. | |
Unlike `clojure.core/interleave`, the returned seq contains all items in the | |
supplied collections, even if the collections are different sizes." | |
{| :arglists | |
' [& colls] | |
[] () | |
[c1] : lazy-seq c1 | |
[c1 c2] | |
lazy-seq | |
Λ | |
[| s1 : seq c1 | |
s2 : seq c2 | |
?-⨂ : and s1 s2 | |
or s1 s2 | |
cons : first s1 | |
cons : first s2 | |
interleave-all | |
rest s1 | |
rest s2 | |
[c1 c2 & colls] | |
lazy-seq | |
Λ | |
[| ss | |
remove ∅? : map seq (conj colls c2 c1) | |
? : seq ss | |
concat | |
map first ss | |
apply interleave-all : map rest ss | |
defn distinct-by | |
"Returns a lazy sequence of the elements of coll, removing any elements that | |
return duplicate values when passed to a function f. Returns a transducer | |
when no collection is provided." | |
: [f] | |
λ [rf] | |
Λ [| seen : volatile! #{} | |
λ | |
[] : rf | |
[result] : rf result | |
[result x] | |
Λ [| fx : f x | |
? : contains? @seen fx | |
result | |
do | |
vswap! seen conj fx | |
rf result x | |
: [f coll] | |
Λ-by : step coll #{} | |
[| step | |
λ step [xs seen] | |
lazy-seq | |
: ↓ xs seen | |
λ [| [x :as xs] seen | |
??-Λ [| s : seq xs | |
Λ [| fx : f x | |
? : contains? seen fx | |
recur (rest s) seen | |
cons x : step (rest s) (conj seen fx) | |
defn dedupe-by | |
"Returns a lazy sequence of the elements of coll, removing any **consecutive** | |
elements that return duplicate values when passed to a function f. Returns a | |
transducer when no collection is provided." | |
[f] | |
λ [rf] | |
Λ [| pv : volatile! ::none | |
λ | |
[] : rf | |
[result] : rf result | |
[result x] | |
Λ | |
[| prior @pv | |
fx : f x | |
vreset! pv fx | |
? {~ prior = fx ~} | |
result | |
rf result x | |
[f coll] | |
sequence (dedupe-by f) coll | |
defn take-upto | |
"Returns a lazy sequence of successive items from coll up to and including | |
the first item for which `(pred item)` returns true. Returns a transducer | |
when no collection is provided." | |
[pred] | |
λ [rf] | |
λ | |
[] : rf | |
[result] : rf result | |
[result x] | |
Λ [| result : rf result x | |
? : pred x | |
ensure-reduced result | |
result | |
[pred coll] | |
lazy-seq | |
??-Λ [| s : seq coll | |
Λ [| x : first s | |
cons x | |
??-⨂ : pred x | |
take-upto pred : rest s | |
defn drop-upto | |
"Returns a lazy sequence of the items in coll starting *after* the first item | |
for which `(pred item)` returns true. Returns a transducer when no collection | |
is provided." | |
[pred] | |
λ [rf] | |
Λ [| dv : volatile! true | |
λ | |
[] : rf | |
[result] : rf result | |
[result x] | |
?-⨂ @dv | |
rf result x | |
do | |
?? : pred x | |
vreset! dv false | |
result | |
[pred coll] | |
rest : drop-while (complement pred) coll | |
defn indexed | |
"Returns an ordered, lazy sequence of vectors `[index item]`, where item is a | |
value in coll, and index its position starting from zero. Returns a transducer | |
when no collection is provided." | |
[] | |
λ [rf] | |
Λ [| i : volatile! -1 | |
λ | |
[] : rf | |
[result] : rf result | |
[result x] | |
rf result [| (vswap! i inc) x | |
[coll] | |
map-indexed vector coll | |
defn insert-nth | |
"Returns a lazy sequence of the items in coll, with a new item inserted at | |
the supplied index, followed by all subsequent items of the collection. Runs | |
in O(n) time. Returns a transducer when no collection is provided." | |
{| :added "1.2.0" | |
[index item] | |
λ [rf] | |
Λ [| idx : volatile! (inc index) | |
λ | |
[] : rf | |
[result] | |
? {~ @idx = 1 ~} | |
rf : rf result item | |
rf result | |
[result x] | |
? : zero? (vswap! idx dec) | |
rf (rf result item) x | |
rf result x | |
[index item coll] | |
lazy-seq | |
? : zero? index | |
cons item coll | |
?? : seq coll | |
cons : first coll | |
insert-nth (dec index) item (rest coll) | |
defn remove-nth | |
"Returns a lazy sequence of the items in coll, except for the item at the | |
supplied index. Runs in O(n) time. Returns a transducer when no collection is | |
provided." | |
{| :added "1.2.0" | |
[index] | |
λ [rf] | |
Λ [| idx : volatile! (inc index) | |
λ | |
[] : rf | |
[result] : rf result | |
[result x] | |
? : zero? (vswap! idx dec) | |
result | |
rf result x | |
[index coll] | |
lazy-seq | |
? : zero? index | |
rest coll | |
?? : seq coll | |
cons : first coll | |
remove-nth (dec index) (rest coll) | |
defn replace-nth | |
"Returns a lazy sequence of the items in coll, with a new item replacing the | |
item at the supplied index. Runs in O(n) time. Returns a transducer when no | |
collection is provided." | |
{| :added "1.2.0" | |
[index item] | |
λ [rf] | |
Λ [| idx : volatile! (inc index) | |
λ | |
[] : rf | |
[result] : rf result | |
[result x] | |
? : zero? (vswap! idx dec) | |
rf result item | |
rf result x | |
[index item coll] | |
lazy-seq | |
? : zero? index | |
cons item : rest coll | |
?? : seq coll | |
cons : first coll | |
replace-nth (dec index) item (rest coll) | |
defn abs | |
"Returns the absolute value of a number." | |
[x] | |
? : neg? x | |
- x | |
x | |
defn deref-swap! | |
"Atomically swaps the value of the atom to be `(apply f x args)`, where x is | |
the current value of the atom, then returns the original value of the atom. | |
This function therefore acts like an atomic `deref` then `swap!`." | |
{| :arglists | |
' [atom f & args] | |
[atom f] | |
#? | |
:clj | |
loop [] | |
Λ [value @atom] | |
? : compare-and-set! atom value (f value) | |
value | |
: recur | |
:cljs | |
Λ [value @atom] | |
reset! atom : f value | |
value | |
[atom f & args] | |
deref-swap! | |
atom | |
# apply f % args | |
defn deref-reset! | |
"Sets the value of the atom without regard for the current value, then returns | |
the original value of the atom. See also: [[deref-swap!]]." | |
[atom newval] | |
deref-swap! atom : constantly newval | |
defn ex-message | |
"Returns the message attached to the given Error/Throwable object. For all | |
other types returns nil. Same as `cljs.core/ex-message` except it works for | |
Clojure as well as ClojureScript." | |
[ex] | |
#? | |
:clj | |
?? : instance? Throwable ex | |
.getMessage ^Throwable ex | |
:cljs | |
cljs.core/ex-message ex | |
defn ex-cause | |
"Returns the cause attached to the given ExceptionInfo/Throwable object. For | |
all other types returns nil. Same as `cljs.core/ex-cause` except it works for | |
Clojure as well as ClojureScript." | |
[ex] | |
#? | |
:clj | |
?? : instance? Throwable ex | |
.getCause ^Throwable ex | |
:cljs | |
cljs.core/ex-cause ex | |
defn uuid? | |
"Returns true if the value is a UUID." | |
[x] | |
instance? ↓ x | |
#? | |
:clj | |
java.util.UUID | |
:cljs | |
cljs.core.UUID | |
defn uuid | |
"Returns a UUID generated from the supplied string. Same as `cljs.core/uuid` | |
in ClojureScript, while in Clojure it returns a `java.util.UUID` object." | |
[s] | |
#? | |
:clj | |
java.util.UUID/fromString s | |
:cljs | |
cljs.core/uuid s | |
defn random-uuid | |
"Generates a new random UUID. Same as `cljs.core/random-uuid` except it works | |
for Clojure as well as ClojureScript." | |
[] | |
#? | |
:clj | |
: java.util.UUID/randomUUID | |
:cljs | |
: cljs.core/random-uuid | |
defn regexp? | |
"Returns true if the value is a regular expression." | |
[x] | |
instance? ↓ x | |
#? | |
:clj | |
java.util.regex.Pattern | |
:cljs | |
js/RegExp |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Try recursion-primary syntax
Use ⎵ for placeholder slots, ⦃ for map forms, and ⟦ for vec forms