medley.core.cwj

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

Try recursion-primary syntax

Use ⎵ for placeholder slots, ⦃ for map forms, and ⟦ for vec forms