Browse files

Merge branch 'r/0.5.4'

  • Loading branch information...
2 parents 6845a1c + 193db78 commit 4ed475ba7435caf8d7fdfcf4adca489d3c9dd9bf @amalloy amalloy committed Aug 3, 2011
View
3 .gitignore
@@ -4,4 +4,5 @@ pom.xml
*~
lib/
classes/
-build/
+build/
+docs
View
9 project.clj
@@ -1,3 +1,6 @@
-(defproject useful "0.3.9"
- :description "useful clojure functions"
- :dependencies [[clojure "1.2.0"]])
+(defproject useful "0.5.4"
+ :description "A collection of generally-useful Clojure utility functions"
+ :dependencies [[clojure "1.2.0"]
+ [org.clojure/tools.macro "0.1.1"]]
+ :dev-dependencies [[org.clojars.flatland/cake-marginalia "0.6.2"]]
+ :tasks [cake-marginalia.tasks])
View
535 src/useful.clj
@@ -1,535 +0,0 @@
-(ns useful
- (:use [clojure.walk :only [walk]]))
-
-(defmacro assoc-if
- "Create mapping from keys to values in map if test returns true."
- [map test & kvs]
- `(if ~test
- (assoc ~map ~@kvs)
- ~map))
-
-(defn assoc-or
- "Create mapping from each key to val in map only if existing val is nil."
- ([map key val]
- (if (nil? (map key))
- (assoc map key val)
- map))
- ([map key val & kvs]
- (let [map (assoc-or map key val)]
- (if kvs
- (recur map (first kvs) (second kvs) (nnext kvs))
- map))))
-
-(defn or-min
- "The minimium value of vals, ignoring nils."
- [& vals]
- (when-let [vals (seq (remove nil? vals))]
- (apply min vals)))
-
-(defn or-max
- "The maximum value of vals, ignoring nils."
- [& vals]
- (when-let [vals (seq (remove nil? vals))]
- (apply max vals)))
-
-(defn conj-vec
- "Conj onto collection ensuring it is a vector."
- [coll item]
- (conj (vec coll) item))
-
-(defn conj-set
- "Conj onto collection ensuring it is a set."
- [coll item]
- (conj (set coll) item))
-
-(defn into-vec
- "Returns a new vector consisting of to-coll with all of the items of from-coll conjoined."
- [to-coll from-coll]
- (into (vec to-coll) from-coll))
-
-(defn into-map
- "Convert a list of heterogeneous args into a map. Args can be alternating keys and values,
- maps of keys to values or collections of alternating keys and values."
- [& args]
- (loop [args args map {}]
- (if (empty? args)
- map
- (let [arg (first args)
- args (rest args)]
- (condp #(%1 %2) arg
- nil? (recur args map)
- map? (recur args (merge map arg))
- coll? (recur (into args (reverse arg)) map)
- (recur (rest args) (assoc map arg (first args))))))))
-
-(defn map-vals
- "Create a new map from m by calling function f on each value to get a new value."
- [f m]
- (into {}
- (for [[k v] m]
- [k (f v)])))
-
-(defn map-vals-with-keys
- "Create a new map from m by calling function f on each key and value to get a new value."
- [f m]
- (into {}
- (for [[k v] m]
- [k (f k v)])))
-
-(defn map-reduce
- "Perform a map and a reduce over a collection in a single pass. Unlike map, this is not lazy.
- Returns the equivalent of [(vec (map map-fn coll)) (reduce reduce-fn val coll)]."
- ([map-fn reduce-fn reduce-val coll & [map-val]]
- (reduce
- (fn [results item]
- (let [item (map-fn item)]
- [(conj (first results) item)
- (reduce-fn (second results) item)]))
- [(into [] map-val) reduce-val]
- coll))
- ([map-fn reduce-fn coll]
- (let [val (map-fn (first coll))]
- (map-reduce map-fn reduce-fn val (rest coll) [val]))))
-
-(defn include?
- "Check if val exists in coll."
- [val coll]
- (some (partial = val) coll))
-
-(defn extract
- "Extracts the first item that matches pred from coll, returning a vector of that item
- followed by coll with the item removed."
- [pred coll]
- (let [[head [item & tail]] (split-with (complement pred) coll)]
- [item (concat head tail)]))
-
-(defn separate
- "Split coll into two sequences, one that matches pred and one that doesn't. Unlike the
- version in clojure.contrib.seq-utils, pred is only called once per item."
- [pred coll]
- (let [pcoll (map #(vector % (pred %)) coll)]
- (vec (map #(map first (% second pcoll)) [filter remove]))))
-
-(defn split-vec
- "Split the given vector at the provided offsets using subvec. Supports negative offsets."
- [v & ns]
- (let [ns (map #(if (neg? %) (+ % (count v)) %) ns)]
- (lazy-seq
- (if-let [n (first ns)]
- (cons (subvec v 0 n)
- (apply split-vec
- (subvec v n)
- (map #(- % n) (rest ns))))
- (list v)))))
-
-(defmacro if-ns
- "Try to load a namespace reference. If successful, evaluate then-form otherwise evaluate else-form."
- [ns-reference then-form & [else-form]]
- `(try (ns ~(ns-name *ns*) ~ns-reference)
- (eval '~then-form)
- (catch Exception e#
- (when-not (or (instance? java.io.FileNotFoundException e#)
- (instance? java.lang.ClassNotFoundException e#))
- (printf "%s: %s %s" (.getName (class e#)) (.getMessage e#) '~ns-reference))
- (eval '~else-form))))
-
-(defn tap
- "Call f on obj, presumably with side effects, then return obj. Useful for debugging when
- you want to print an object inline. e.g. (tap println foo)"
- [f obj]
- (f obj)
- obj)
-
-(defn update
- "Update value in map where f is a function that takes the old value and the supplied args and
- returns the new value. For efficiency, Do not change map if the old value is the same as the new
- value. If key is sequential, update all keys in the sequence with the same function."
- [map key f & args]
- (if (sequential? key)
- (reduce #(apply update %1 %2 f args) map key)
- (let [old (get map key)
- new (apply f old args)]
- (if (= old new) map (assoc map key new)))))
-
-(defn adjoin
- "Merge two data structures by combining the contents. For maps, merge recursively by
- adjoining values with the same key. For collections, combine the right and left using
- into or conj. If the left value is a set and the right value is a map, the right value
- is assumed to be an existence map where the value determines whether the key is in the
- merged set. This makes sets unique from other collections because items can be deleted
- from them."
- [left right]
- (cond (map? left)
- (merge-with adjoin left right)
-
- (and (set? left) (map? right))
- (reduce (fn [set [k v]] ((if v conj disj) set k))
- left right)
-
- (coll? left)
- ((if (coll? right) into conj) left right)
-
- :else right))
-
-(defn merge-in
- "Merge two nested maps."
- [left right]
- (if (map? left)
- (merge-with merge-in left right)
- right))
-
-(defmacro while-let
- "Repeatedly executes body, which presumably has side-effects, while let binding is not false."
- [bindings & body]
- (let [[form test] bindings]
- `(loop [~form ~test]
- (when ~form
- ~@body
- (recur ~test)))))
-
-(defn queue
- "Create an empty persistent queue or a persistent queue from a sequence."
- ([] clojure.lang.PersistentQueue/EMPTY)
- ([seq] (into (queue) seq)))
-
-(defmacro absorb
- "Thread val through form if val is not nil."
- [val form]
- `(let [v# ~val]
- (when-not (nil? v#)
- (-> v# ~form))))
-
-(defn abort
- "Print message then exit."
- [& message]
- (apply println message)
- (System/exit 1))
-
-(defmacro rescue
- "Evaluate form, returning error-form on any Exception."
- [form error-form]
- `(try ~form (catch Exception e# ~error-form)))
-
-(defmacro verify
- "Raise exception unless test returns true."
- [test exception]
- `(when-not ~test
- (throw (if (string? ~exception)
- (Exception. ~exception)
- ~exception))))
-
-(defn trap
- "Register signal handling function."
- [signal f]
- (sun.misc.Signal/handle
- (sun.misc.Signal. signal)
- (proxy [sun.misc.SignalHandler] []
- (handle [sig] (f sig)))))
-
-(defmacro defm [name & fdecl]
- "Define a function with memoization. Takes the same arguments as defn."
- `(doto (defn ~name ~@fdecl)
- (alter-var-root #(with-meta (memoize %) (meta %)))))
-
-(defmacro cond-let
- "An implementation of cond-let that is as similar as possible to if-let. Takes multiple
- test-binding/then-form pairs and evalutes the form if the binding is true. Also supports
- :else in the place of test-binding and always evaluates the form in that case.
-
- Example:
- (cond-let [b (bar 1 2 3)] (println :bar b)
- [f (foo 3 4 5)] (println :foo f)
- [b (baz 6 7 8)] (println :baz b)
- :else (println :no-luck))"
- [test-binding then-form & more]
- (let [test-binding (if (= :else test-binding) `[t# true] test-binding)
- else-form (when (seq more) `(cond-let ~@more))]
- `(if-let ~test-binding
- ~then-form
- ~else-form)))
-
-(defmacro let-if
- "Choose a set of bindings based on the result of a conditional test.
-
- Example:
- (let-if (even? a)
- [b (bar 1 2 3) (baz 1 2 3)
- c (foo 1) (foo 3)]
- (println (combine b c)))"
- [test bindings & forms]
- (let [then-bindings (vec (apply concat (partition 2 3 bindings)))
- else-bindings (vec (apply concat (take 1 bindings) (partition-all 2 3 (drop 2 bindings))))]
- `(if ~test
- (let ~then-bindings ~@forms)
- (let ~else-bindings ~@forms))))
-
-(defn zip
- "Returns a lazy sequence of vectors of corresponding items from each collection. If one collection
- is longer than the others, the missing items will be filled in with nils."
- [& colls]
- (lazy-seq
- (when (some seq colls)
- (cons (vec (map first colls))
- (apply zip (map rest colls))))))
-
-(defn find-first
- "Returns the first item of coll where (pred item) returns logical true."
- [pred coll]
- (first (filter pred coll)))
-
-(defn find-with
- "Returns the val corresponding to the first key where (pred key) returns true."
- [pred keys vals]
- (last (first (filter (comp pred first) (map vector keys vals)))))
-
-(defn filter-keys-by-val
- "Returns all keys in map for which (pred value) returns true."
- [pred map]
- (when map
- (for [[key val] map :when (pred val)] key)))
-
-(defn remove-keys-by-val
- "Returns all keys of map for which (pred value) returns false."
- [pred map]
- (filter-keys-by-val (complement pred) map))
-
-(defn filter-vals
- "Returns a map that only contains values where (pred value) returns true."
- [pred map]
- (when map
- (select-keys map (filter-keys-by-val pred map))))
-
-(defn remove-vals
- "Returns a map that only contains values where (pred value) returns false."
- [pred map]
- (filter-vals (complement pred) map))
-
-(defn filter-keys
- "Returns a map that only contains keys where (pred key) returns true."
- [pred map]
- (when map
- (select-keys map (filter pred (keys map)))))
-
-(defn remove-keys
- "Returns a map that only contains keys where (pred key) returns false."
- [pred map]
- (filter-keys (complement pred) map))
-
-(defn any
- "Takes a list of predicates and returns a new predicate that returns true if any do."
- [& preds]
- (fn [& args]
- (some #(apply % args) preds)))
-
-(defn all
- "Takes a list of predicates and returns a new predicate that returns true if all do."
- [& preds]
- (fn [& args]
- (every? #(apply % args) preds)))
-
-(defn slice
- "Divide coll into n approximately equal slices."
- [n coll]
- (loop [num n, slices [], items (vec coll)]
- (if (empty? items)
- slices
- (let [size (Math/ceil (/ (count items) num))]
- (recur (dec num) (conj slices (subvec items 0 size)) (subvec items size))))))
-
-(def *pcollect-thread-num* (.. Runtime getRuntime availableProcessors))
-
-(defn pcollect
- "Like pmap but not lazy and more efficient for less computationally intensive functions
- because there is less coordination overhead. The collection is sliced among the
- available processors and f is applied to each sub-collection in parallel using map."
- ([f coll]
- (pcollect identity f coll))
- ([wrap-fn f coll]
- (if (<= *pcollect-thread-num* 1)
- ((wrap-fn #(doall (map f coll))))
- (mapcat deref
- (map (fn [slice]
- (let [body (wrap-fn #(doall (map f slice)))]
- (future-call body)))
- (slice *pcollect-thread-num* coll))))))
-
-(defn wrap-bindings
- "Wrap f in a new fuction that re-establishes the current binding for the given vars."
- [vars f]
- (let [bindings (select-keys (get-thread-bindings) vars)]
- (fn [& args]
- (push-thread-bindings bindings)
- (try
- (apply f args)
- (finally
- (pop-thread-bindings))))))
-
-(defn update-in!
- "'Updates' a value in a nested associative structure, where ks is a sequence of keys and
- f is a function that will take the old value and any supplied args and return the new
- value, and returns a new nested structure. The associative structure can have transients
- in it, but if any levels do not exist, non-transient hash-maps will be created."
- [m [k & ks] f & args]
- (let [assoc (if (instance? clojure.lang.ITransientCollection m) assoc! assoc)
- val (get m k)]
- (assoc m k (if ks
- (apply update-in! val ks f args)
- (apply f val args)))))
-
-(defn assoc-in!
- "Associates a value in a nested associative structure, where ks is a sequence of keys
- and v is the new value and returns a new nested structure. The associative structure
- can have transients in it, but if any levels do not exist, non-transient hash-maps will
- be created."
- [m ks v]
- (update-in! m ks (constantly v)))
-
-(defn thrush
- "Takes the first argument and applies the remaining arguments to it as functions from left to right.
- This tiny implementation was written by Chris Houser. http://blog.fogus.me/2010/09/28/thrush-in-clojure-redux"
- [& args]
- (reduce #(%2 %1) args))
-
-(defn comp-partial
- "Like comp, except all args but the last are passed to every function with the last arg threaded through
- these partial functions. So, the rightmost fn is applied to all arguments. Each fn is then applied to the
- original args with the last arg replaced by the result of the previous fn."
- [& fns]
- (fn [& args]
- (let [f (apply comp (map #(apply partial % (butlast args)) fns))]
- (f (last args)))))
-
-(defn position
- "Returns a map from item to the position of its first occurence in coll."
- [coll]
- (into {} (reverse (map-indexed #(vector %2 %1) coll))))
-
-(defn map-to
- "Returns a map from each item in coll to f applied to that item."
- [f coll]
- (into {}
- (for [item coll]
- [item (f item)])))
-
-(defn index-by
- "Returns a map from the result of calling f on each item in coll to that item."
- [f coll]
- (into {}
- (for [item coll]
- [(f item) item])))
-
-(defn pluralize
- "Return a pluralized phrase, appending an s to the singular form if no plural is provided.
- For example:
- (plural 5 \"month\") => \"5 months\"
- (plural 1 \"month\") => \"1 month\"
- (plural 1 \"radius\" \"radii\") => \"1 radius\"
- (plural 9 \"radius\" \"radii\") => \"9 radii\""
- [num singular & [plural]]
- (let [plural (or plural (str singular "s"))]
- (str num " " (if (= 1 num) singular plural))))
-
-(defn syntax-quote ;; from leiningen.core/unquote-project
- "Syntax quote the given form, wrapping all seqs and symbols in quote."
- [form]
- (walk (fn [form]
- (cond (and (seq? form) (= `unquote (first form))) (second form)
- (or (seq? form) (symbol? form)) (list 'quote form)
- :else (syntax-quote form)))
- identity
- form))
-
-(defn construct
- "Construct a new instance of class using reflection."
- [class & args]
- (clojure.lang.Reflector/invokeConstructor class (into-array Object args)))
-
-(defn cross
- "Computes the cartesian-product of the provided seqs. In other words, compute the set of all
- possible combinations of ways you can choose one item from each seq."
- [& seqs]
- (if (seq (rest seqs))
- (for [x (first seqs)
- y (apply cross (rest seqs))]
- (cons x y))
- (map list (first seqs))))
-
-(defn lazy-cross
- "Compute a lazy cartesian-product of the provided seqs. The provided seqs can be lazy or even
- infinite, and lazy-cross will consume all sequences equally, only consuming more of any sequence
- when all possible combinations at the current level have been exhausted. This can be thought of
- intuitively as a breadth-first search of the cartesian product set."
- [& seqs]
- (letfn [(step [heads tails dim]
- (lazy-seq
- (when (< dim (count tails))
- (let [tail (get tails dim)]
- (concat (apply cross (assoc heads dim tail))
- (step (update-in heads [dim] concat tail)
- tails (inc dim)))))))
- (lazy-cross [seqs level]
- (lazy-seq
- (let [heads (vec (map #(take level %) seqs))
- tails (vec (map #(take 1 (drop level %)) seqs))]
- (when-not (every? empty? tails)
- (concat (step heads tails 0)
- (lazy-cross seqs (inc level)))))))]
- (lazy-cross seqs 0)))
-
-(defn memoize-deref
- "Returns a memoized version a non-referentially transparent function, calling deref on each
- provided var (or ref or atom) and using that in the cache key to prevent cross-contamination if
- any of the values change."
- [vars f]
- (let [mem (memoize
- (fn [args vals]
- (apply f args)))]
- (fn [& args]
- (mem args (doall (map deref vars))))))
-
-(defn invoke-private
- "Invoke a private or protected Java method. Be very careful when using this!
- I take no responsibility for the trouble you get yourself into."
- [instance method & params]
- (let [signature (into-array Class (map class params))
- c (.getClass instance)]
- (when-let [method (some #(try
- (.getDeclaredMethod % method signature)
- (catch NoSuchMethodException e))
- (conj (ancestors c) c))]
- (let [accessible (.isAccessible method)]
- (.setAccessible method true)
- (let [result (.invoke method instance (into-array params))]
- (.setAccessible method accessible)
- result)))))
-
-(defn on-shutdown
- "Execute the given function on jvm shutdown."
- [f]
- (.addShutdownHook
- (Runtime/getRuntime)
- (Thread. f)))
-
-(defn- parse-opt [default opts arg]
- (let [m re-matches, key (comp keyword str)]
- (cond-let
- [[_ ks] (m #"-(\w+)" arg)] (apply merge-with into-vec opts (for [k ks] {(key k) [""]}))
- [[_ k v] (m #"--?([-\w]+)=(.+)" arg)] (update opts (key k) into-vec (.split #"," v))
- [[_ k] (m #"--?([-\w]+)" arg)] (update opts (key k) conj-vec "")
- :else (update opts default conj-vec arg))))
-
-(defn parse-opts
- "Parse command line args or the provided argument list. Returns a map of keys to
- vectors of repeated values. Named args begin with --keyname and are mapped to
- :keyname. Unnamed arguments are mapped to nil or default. Repeated named values can be
- specified by repeating a key or by using commas in the value. Single and double dashes
- are both supported though a single dash followed by word characters without internal
- dashes or an equal sign is assumed to be single character argument flags and are split
- accordingly.
-
- Example:
- (parse-opts [\"foo\" \"-vD\" \"bar\" \"-no-wrap\" \"-color=blue,green\" \"--style=baroque\" \"-color=red\"])
- => {:style [\"baroque\"], :color [\"blue\" \"green\" \"red\"], :no-wrap [\"\"], :D [\"\"], :v [\"\"], nil [\"foo\" \"bar\"]}"
- ([] (parse-opts nil *command-line-args*))
- ([args] (parse-opts nil args))
- ([default args] (reduce (partial parse-opt default) {} args)))
View
28 src/useful/cli.clj
@@ -0,0 +1,28 @@
+(ns useful.cli
+ (:use [useful.utils :only [into-vec conj-vec]]
+ [useful.experimental :only [cond-let]]
+ [useful.map :only [update]]))
+
+(defn- parse-opt [default opts arg]
+ (let [m re-matches, key (comp keyword str)]
+ (cond-let
+ [[_ ks] (m #"-(\w+)" arg)] (apply merge-with into-vec opts (for [k ks] {(key k) [""]}))
+ [[_ k v] (m #"--?([-\w]+)=(.+)" arg)] (update opts (key k) into-vec (.split #"," v))
+ [[_ k] (m #"--?([-\w]+)" arg)] (update opts (key k) conj-vec "")
+ :else (update opts default conj-vec arg))))
+
+(defn parse-opts
+ "Parse command line args or the provided argument list. Returns a map of keys to
+ vectors of repeated values. Named args begin with --keyname and are mapped to
+ :keyname. Unnamed arguments are mapped to nil or default. Repeated named values can be
+ specified by repeating a key or by using commas in the value. Single and double dashes
+ are both supported though a single dash followed by word characters without internal
+ dashes or an equal sign is assumed to be single character argument flags and are split
+ accordingly.
+
+ Example:
+ (parse-opts [\"foo\" \"-vD\" \"bar\" \"-no-wrap\" \"-color=blue,green\" \"--style=baroque\" \"-color=red\"])
+ => {:style [\"baroque\"], :color [\"blue\" \"green\" \"red\"], :no-wrap [\"\"], :D [\"\"], :v [\"\"], nil [\"foo\" \"bar\"]}"
+ ([] (parse-opts nil *command-line-args*))
+ ([args] (parse-opts nil args))
+ ([default args] (reduce (partial parse-opt default) {} args)))
View
4 src/useful/datatypes.clj
@@ -1,5 +1,5 @@
(ns useful.datatypes
- (:use [useful :only [position into-map update]])
+ (:use [useful.map :only [position into-map update]])
(:require [clojure.string :as s]))
(defn- normalize-field-name [field]
@@ -8,7 +8,7 @@
(s/replace #"_" "-")
symbol))
-(defn record-fields
+(defn- record-fields
"Uses reflection to get the declared fields passed to the defrecord call for type. If called on a
non-record, the behavior is undefined."
[type]
View
25 src/useful/debug.clj
@@ -0,0 +1,25 @@
+(ns useful.debug
+ (:use clojure.stacktrace))
+
+(letfn [(interrogate-form [list-head form]
+ `(let [display# (fn [val#]
+ (~@list-head (prn-str '~form '~'is val#)))]
+ (try (doto ~form display#)
+ (catch Throwable t#
+ (display# {:thrown t#
+ :trace (with-out-str
+ (print-cause-trace t#))})
+ (throw t#)))))]
+
+ (defmacro ?
+ "A useful debugging tool when you can't figure out what's going on:
+ wrap a form with ?, and the form will be printed alongside
+ its result. The result will still be passed along."
+ [val]
+ (interrogate-form `(print) val))
+
+ (defmacro ^{:dont-test "Complicated to test, and should work if ? does"}
+ ?!
+ ([val] `(?! "/tmp/spit" ~val))
+ ([file val]
+ (interrogate-form `(spit ~file) val))))
View
43 src/useful/dispatch.clj
@@ -0,0 +1,43 @@
+(ns useful.dispatch
+ (:use [useful.map :only [into-map]]
+ [useful.fn :only [any]]
+ [useful.utils :only [verify]]))
+
+(defn get-sub-type [hierarchy ns]
+ (let [sub-type (get hierarchy ns)]
+ (verify (not= sub-type ns) "a node type cannot have itself as a sub-type")
+ sub-type))
+
+(defn dispatcher
+ "Returns a function that dispatches using the given dispatch function to determine the
+ namespace and function to call."
+ [dispatch-fn & options]
+ (let [{:keys [hierarchy wrap default]} (into-map options)
+ wrap (or wrap identity)]
+ (fn [& args]
+ (let [fname (apply dispatch-fn args)
+ default (or default
+ (with-meta (fn [& args]
+ (throw (IllegalArgumentException. (str "cannot resolve function: " fname))))
+ {:no-wrap true}))]
+ (loop [[ns method] (map symbol ((juxt namespace name) (symbol fname)))]
+ (if-let [f (if ns
+ (try (require ns)
+ (ns-resolve ns method)
+ (catch java.io.FileNotFoundException e))
+ default)]
+ (let [wrap (if (:no-wrap (meta f))
+ identity
+ wrap)]
+ (apply (wrap f) args))
+ (recur [(get-sub-type hierarchy ns) method])))))))
+
+(defmacro defdispatch
+ "Defines a function that dispatches using the given dispatch function to determine the
+ namespace and function to call."
+ {:arglists '([name docstring? attr-map? dispatch-fn & options])}
+ [name & options]
+ (let [[defn-options [dispatch-fn & options]] (split-with (any string? map?) options)]
+ `(let [dispatcher# (dispatcher ~dispatch-fn ~@options)]
+ (defn ~name ~@defn-options [& args#]
+ (apply dispatcher# args#)))))
View
190 src/useful/experimental.clj
@@ -0,0 +1,190 @@
+(ns useful.experimental
+ (:use [useful.utils :only [split-vec]]
+ [useful.seq :only [alternates]]
+ [useful.map :only [keyed]]
+ [useful.macro :only [name-with-attributes]]
+ [useful.fn :only [any]]))
+
+(defn comp-partial
+ "A version of comp that \"rescues\" the first N args, passing them to every composed function
+ instead of just the first one.
+
+ For example, ((comp-partial 2 * +) 3 4 5 6) is equivalent to (* 3 4 (+ 3 4 5 6))."
+ [n & fns]
+ (let [split (if (neg? n)
+ #(split-vec (vec %) n)
+ #(split-at n %))]
+ (fn [& args]
+ (let [[rescued more] (split n args)
+ fns (for [f fns] (apply partial f rescued))]
+ (apply (apply comp fns) more)))))
+
+(defmacro while-let
+ "Repeatedly executes body, which presumably has side-effects, while let binding is not false."
+ [bindings & body]
+ (let [[form test] bindings]
+ `(loop [~form ~test]
+ (when ~form
+ ~@body
+ (recur ~test)))))
+
+(defmacro cond-let
+ "An implementation of cond-let that is as similar as possible to if-let. Takes multiple
+ test-binding/then-form pairs and evalutes the form if the binding is true. Also supports
+ :else in the place of test-binding and always evaluates the form in that case.
+
+ Example:
+ (cond-let [b (bar 1 2 3)] (println :bar b)
+ [f (foo 3 4 5)] (println :foo f)
+ [b (baz 6 7 8)] (println :baz b)
+ :else (println :no-luck))"
+ [test-binding then-form & more]
+ (let [test-binding (if (= :else test-binding) `[t# true] test-binding)
+ else-form (when (seq more) `(cond-let ~@more))]
+ `(if-let ~test-binding
+ ~then-form
+ ~else-form)))
+
+(defmacro let-if
+ "Choose a set of bindings based on the result of a conditional test.
+
+ Example:
+ (let-if (even? a)
+ [b (bar 1 2 3) (baz 1 2 3)
+ c (foo 1) (foo 3)]
+ (println (combine b c)))"
+ [test bindings & forms]
+ (let [[names thens elses] (alternates 3 bindings)]
+ `(if ~test
+ (let [~@(interleave names thens)] ~@forms)
+ (let [~@(interleave names elses)] ~@forms))))
+
+(letfn [(mapify [coll] (into {} coll)) ;; just for less-deep indenting
+ (symbol ([ns sym] ;; annoying that (symbol 'x 'y) fails
+ (clojure.core/symbol (name ns) (name sym))))
+ (behavior ([name default exceptions]
+ (= :forward
+ (if (exceptions name)
+ ({:forward :stub, :stub :forward} default)
+ default))))
+ (analyze-var [v]
+ (let [{:keys [ns name]} (meta v)
+ ns (ns-name ns)
+ sigs (:sigs @v)]
+ (keyed [ns name sigs])))
+ (append-if [test item coll]
+ (if-not test
+ coll
+ (concat coll [item])))]
+
+ (defmacro protocol-stub
+ "Define a new type of record implementing the specified protocols. Its
+ constructor will take two arguments:
+ - An object which already satisfies the given protocols. This object will
+ be delegated to for functions which are not stubbed out.
+ - A \"log\" function to be called (for side effects) every time a protocol
+ function is called. For functions marked as :stub (see below), the
+ log function will be called with two arguments: the function name (an
+ unqualified symbol), and the arglist (including \"this\"). Functions
+ marked :forward will have a third argument, the function's return value.
+ Use this function to implement your logging (or whatever else).
+
+ The macro itself needs two arguments: the name of the record to define, and:
+ - A map of protocol stubbing specifications. Each key should be a protocol,
+ and the value another map. It may have zero or more of these keys:
+ - A :default key specifying either :stub or :forward, to control whether
+ the underlying implementation is called after logging. Defaults to :stub,
+ meaning that only the logging function will be called, completely
+ stubbing out the backing implementation.
+ - An :exceptions key, listing the functions of this protocol that should
+ behave the opposite of the :default."
+ [name proto-specs]
+ (let [[trace-field impl-field ret] (map gensym '(trace impl ret))
+ [impl-kw trace-kw] (map keyword [impl-field trace-field])
+ trace (fn [this] `(~trace-kw ~this))
+
+ proto-fns
+ (mapify
+ (for [[name opts] proto-specs
+ :let [default-behavior (:default opts :stub)
+ exceptions (set (:exceptions opts))
+ proto-var (resolve name)
+ {:keys [ns name sigs]} (analyze-var proto-var)]]
+ {(symbol ns name)
+ (mapify
+ (for [[fn-key {arglists :arglists, short-name :name}] sigs
+ :let [forward? (behavior short-name default-behavior exceptions)
+ fn-name (symbol ns short-name)]]
+ {fn-key
+ (cons `fn
+ (for [[this & args :as argvec] arglists
+ :let [proxy-args `((~impl-kw ~this) ~@args)]]
+ `([~@argvec]
+ (let [~ret ~(when forward?
+ `(~fn-name ~@proxy-args))]
+ ~(->> `(~(trace this) '~short-name (list ~@proxy-args))
+ (append-if forward? ret))
+ ~ret))))}))}))]
+ `(do
+ (defrecord ~name [~impl-field ~trace-field])
+ (extend ~name
+ ~@(apply concat proto-fns))))))
+
+(defmacro defn-wrapping
+ "Define a function as with defn, which checks the contents of wrappers-var
+ whenever it is called. If that var is empty, the underlying defn is called
+ without modification. Otherwise, it is treated as a list of wrapper functions,
+ which are wrapped around the underlying implementation before it is called.
+
+ The wrappers are applied left-to-right, which means that the rightmost
+ wrapper is outermost, and the leftmost wrapper is applied just before the base
+ function.
+
+ The wrappers are not called \"directly\" on the arguments, but are
+ instead called like Ring wrappers, to create a single function composed of
+ all of them; the resulting function is called with the actual arguments to
+ the defn-wrapping function.
+
+ For example, if the wrapped function is -, and the wrappers are
+ [(fn [f] (fn [x] (* 2 (f x)))), (fn [f] (fn [x] (f (+ 10 x))))],
+ then the eventual function will behave like (fn [x] (* 2 (- (+ 10 x)))).
+
+ Swapping the order of the wrappers would yield a function behaving like
+ (fn [x] (* 2 (+ 10 (- x)))).
+
+ Note the order of the wrapping: when called with 10 as an argument, the former
+ will return -40, and the latter 0."
+ [name wrappers-var & defn-args]
+ (let [[name macro-args] (name-with-attributes name defn-args)
+ fake-defn-name (gensym 'tmp)]
+ `(let [impl# (fn ~@macro-args)
+ fake-defn-var# (defn ~fake-defn-name ~@macro-args)
+ arglists# (-> fake-defn-var# meta :arglists)]
+ (ns-unmap *ns* '~fake-defn-name)
+ (defn ~name {:arglists arglists#} [& args#]
+ (let [wrappers# (not-empty @~wrappers-var)]
+ (if-not wrappers#
+ (apply impl# args#)
+ (with-bindings {~wrappers-var
+ (vary-meta wrappers# assoc
+ ::call-data {:fn-name '~name})}
+ (apply (reduce (fn [f# wrapper#]
+ (wrapper# f#))
+ impl#
+ wrappers#)
+ args#))))))))
+
+(defmacro with-wrappers
+ "Dynamically bind some additional wrappers to the specified wrapper-var
+ (see defn-wrapping). Each wrapper function will be conj-ed onto the current
+ set of wrappers."
+ [wrappers-var wrap-fns & body]
+ `(with-bindings {~wrappers-var (into @~wrappers-var ~wrap-fns)}
+ ~@body))
+
+(defmacro with-wrapper
+ "Dynamically bind an additional wrapper to the specified wrapper-var
+ (see defn-wrapping). The wrapper function will be conj-ed onto the current
+ set of wrappers."
+ [wrappers-var wrap-fn & body]
+ `(with-wrappers ~wrappers-var [~wrap-fn] ~@body))
View
11 src/useful/experimental/unicode.clj
@@ -0,0 +1,11 @@
+(ns ^{:dont-test "Just aliases for other functions/macros"}
+ useful.experimental.unicode
+ (:use [useful.utils :only [map-entry]]
+ [useful.macro :only [defalias macro-do]]))
+
+(macro-do [dest src]
+ `(defalias ~dest ~src)
+ ∮ map-entry
+ ! complement
+ ∘ comp
+ φ partial)
View
81 src/useful/fn.clj
@@ -0,0 +1,81 @@
+(ns useful.fn
+ (:use useful.debug))
+
+(def ! complement)
+
+(defn decorate
+ "Return a function f such that (f x) => [x (f1 x) (f2 x) ...]."
+ [& fs]
+ (apply juxt identity fs))
+
+(defn annotate
+ "A vector of [x (f1 x) (f2 x) ...]."
+ [x & fs]
+ ((apply decorate fs) x))
+
+(defn fix
+ "Walk through clauses, a series of predicate/transform pairs. The
+ first predicate that x satisfies has its transformation clause
+ called on x. Predicates or transforms may be values (eg true or nil)
+ rather than functions; these will be treated as functions that
+ return that value.
+
+ The last \"pair\" may be only a transform with no pred: in that case it
+ is unconditionally used to transform x, if nothing previously matched.
+
+ If no predicate matches, then x is returned unchanged."
+ [x & clauses]
+ (let [call #(if (ifn? %) (% x) %)]
+ (first (or (seq (for [[pred & [transform :as exists?]] (partition-all 2 clauses)
+ :let [[pred transform] ;; handle odd number of clauses
+ (if exists? [pred transform] [true pred])]
+ :when (call pred)]
+ (call transform)))
+ [x]))))
+
+(defn to-fix
+ "A \"curried\" version of fix, which sets the clauses once, yielding a
+ function that calls fix with the specified first argument."
+ [& clauses]
+ (fn [x]
+ (apply fix x clauses)))
+
+(defmacro given
+ "A macro version of fix: instead of taking multiple clauses, it treats any
+ further arguments as additional args to be passed to the transform function,
+ similarly to functions such as swap! and update-in."
+ [x pred transform & args]
+ `(fix ~x ~pred (fn [x#] (~transform x# ~@args))))
+
+(defn any
+ "Takes a list of predicates and returns a new predicate that returns true if any do."
+ [& preds]
+ (fn [& args]
+ (some #(apply % args) preds)))
+
+(defn all
+ "Takes a list of predicates and returns a new predicate that returns true if all do."
+ [& preds]
+ (fn [& args]
+ (every? #(apply % args) preds)))
+
+(defn thrush
+ "Takes the first argument and applies the remaining arguments to it as functions from left to right.
+ This tiny implementation was written by Chris Houser. http://blog.fogus.me/2010/09/28/thrush-in-clojure-redux"
+ [& args]
+ (reduce #(%2 %1) args))
+
+(defn ignoring-nils
+ "Create a new version of a function which ignores all nils in its arguments:
+((ignoring-nils +) 1 nil 2 3 nil) yields 6."
+ [f]
+ (fn
+ ([])
+ ([a] (f a))
+ ([a b]
+ (cond (nil? b) (f a)
+ (nil? a) (f b)
+ :else (f a b)))
+ ([a b & more]
+ (when-let [items (seq (remove nil? (list* a b more)))]
+ (apply f items)))))
View
28 src/useful/io.clj
@@ -1,37 +1,13 @@
(ns useful.io
(:use [clojure.java.io :only [copy]])
(:import [java.net URL URLConnection JarURLConnection]
- [java.io File FileInputStream PrintStream]
- [clojure.lang Atom]))
-
-(defmacro multi-outstream [var]
- (letfn [(outs [val] (if (instance? Atom val) (first @val) val))]
- `(PrintStream.
- (proxy [java.io.BufferedOutputStream] [nil]
- (write
- ([b#] (.write (~outs ~var) b#))
- ([b# off# len#] (.write (~outs ~var) b# off# len#)))
- (flush [] (.flush (~outs ~var)))))))
-
-(defmacro with-outstream [bindings & forms]
- `(do (doseq [[var# outs#] (partition 2 ~bindings)]
- (swap! var# conj outs#))
- (binding ~bindings ~@forms)
- (doseq [[var# outs#] (partition 2 ~bindings)]
- (doall (swap! var# (partial remove #(= outs# %)))))))
-
-(defn default-outstream-push [outs default]
- (swap! outs conj default))
-
-(defn default-outstream-pop [outs default]
- (doall (swap! outs (partial remove #(= default %)))))
+ [java.io File FileInputStream PrintStream]))
(defn resource-stream [name]
(if-let [url (.findResource (.getClassLoader clojure.lang.RT) name)]
(let [conn (.openConnection url)]
(if (instance? JarURLConnection conn)
- (let [jar (cast JarURLConnection conn)]
- (.getInputStream jar))
+ (.getInputStream ^JarURLConnection conn)
(FileInputStream. (File. (.getFile url)))))))
(defn extract-resource [name dest-dir]
View
48 src/useful/java.clj
@@ -0,0 +1,48 @@
+(ns useful.java)
+
+(defn ^{:dont-test "Can't test killing the JVM"} abort ;;
+ "Print message then exit."
+ [& message]
+ (apply println message)
+ (System/exit 1))
+
+(defmacro rescue
+ "Evaluate form, returning error-form on any Exception."
+ [form error-form]
+ `(try ~form (catch Exception e# ~error-form)))
+
+(defn ^{:dont-test "Can't send a signal in order to catch it!"} trap
+ "Register signal handling function."
+ [signal f]
+ (sun.misc.Signal/handle
+ (sun.misc.Signal. signal)
+ (proxy [sun.misc.SignalHandler] []
+ (handle [sig] (f sig)))))
+
+(defn construct
+ "Construct a new instance of class using reflection."
+ [class & args]
+ (clojure.lang.Reflector/invokeConstructor class (into-array Object args)))
+
+(defn invoke-private
+ "Invoke a private or protected Java method. Be very careful when using this!
+ I take no responsibility for the trouble you get yourself into."
+ [instance method & params]
+ (let [signature (into-array Class (map class params))
+ c (.getClass instance)]
+ (when-let [method (some #(try
+ (.getDeclaredMethod % method signature)
+ (catch NoSuchMethodException e))
+ (conj (ancestors c) c))]
+ (let [accessible (.isAccessible method)]
+ (.setAccessible method true)
+ (let [result (.invoke method instance (into-array params))]
+ (.setAccessible method accessible)
+ result)))))
+
+(defn ^{:dont-test "Can't test shutting down JVM"} on-shutdown
+ "Execute the given function on jvm shutdown."
+ [f]
+ (.addShutdownHook
+ (Runtime/getRuntime)
+ (Thread. f)))
View
87 src/useful/macro.clj
@@ -0,0 +1,87 @@
+(ns useful.macro
+ (:use [clojure.tools.macro :only [macrolet]]))
+
+(defmacro anon-macro
+ "Define, and then immediately use, an anonymous macro. For
+example, (anon-macro [x y] `(def ~x ~y) myconst 10) expands to (def
+myconst 10)."
+ ([args macro-body & body]
+ `(macrolet [(name# ~args ~macro-body)]
+ (name# ~@body))))
+
+(letfn [(partition-params [argvec actual-args]
+ (if (some #{'&} argvec)
+ [actual-args] ; one seq with all args
+ (vec (map vec (partition (count argvec) actual-args)))))]
+
+ (defmacro macro-do
+ "Wrap a list of forms with an anonymous macro, which partitions the
+ forms into chunks of the right size for the macro's arglists. The
+ macro's body will be called once for every N items in the args
+ list, where N is the number of arguments the macro accepts. The
+ result of all expansions will be glued together in a (do ...) form.
+
+ Really, the macro is only called once, and is adjusted to expand
+ into a (do ...) form, but this is probably an implementation detail
+ that I'm not sure how a client could detect.
+
+ For example,
+ (macro-do [[f & args]]
+ `(def ~(symbol (str \"basic-\" f))
+ (partial ~f ~@args))
+ [f 'test] [y 1 2 3])
+ expands into (do
+ (def basic-f (partial f 'test))
+ (def basic-y (partial y 1 2 3)))"
+ ([macro-args body & args]
+ `(anon-macro [arg#]
+ (cons 'do
+ (for [~macro-args arg#]
+ ~body))
+ ~(partition-params macro-args args)))))
+
+;; copied from clojure.contrib.def
+(defmacro ^{:dont-test "Exists in contrib, and has gross side effects anyway"}
+ defalias
+ "Defines an alias for a var: a new var with the same root binding (if
+ any) and similar metadata. The metadata of the alias is its initial
+ metadata (as provided by def) merged into the metadata of the original."
+ ([name orig]
+ `(do
+ (alter-meta!
+ (if (.hasRoot (var ~orig))
+ (def ~name (.getRoot (var ~orig)))
+ (def ~name))
+ ;; When copying metadata, disregard {:macro false}.
+ ;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273
+ #(conj (dissoc % :macro)
+ (apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %)))))
+ (var ~name)))
+ ([name orig doc]
+ (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig)))
+
+;; name-with-attributes by Konrad Hinsen, stolen from c.c.def:
+(defn ^{:dont-test "Stolen from contrib"} name-with-attributes
+ "To be used in macro definitions.
+ Handles optional docstrings and attribute maps for a name to be defined
+ in a list of macro arguments. If the first macro argument is a string,
+ it is added as a docstring to name and removed from the macro argument
+ list. If afterwards the first macro argument is a map, its entries are
+ added to the name's metadata map and the map is removed from the
+ macro argument list. The return value is a vector containing the name
+ with its extended metadata map and the list of unprocessed macro
+ arguments."
+ [name macro-args]
+ (let [[docstring macro-args] (if (string? (first macro-args))
+ [(first macro-args) (next macro-args)]
+ [nil macro-args])
+ [attr macro-args] (if (map? (first macro-args))
+ [(first macro-args) (next macro-args)]
+ [{} macro-args])
+ attr (if docstring
+ (assoc attr :doc docstring)
+ attr)
+ attr (if (meta name)
+ (conj (meta name) attr)
+ attr)]
+ [(with-meta name attr) macro-args]))
View
165 src/useful/map.clj
@@ -0,0 +1,165 @@
+(ns useful.map
+ (:use [useful.utils :only [map-entry pop-if]]
+ [useful.fn :only [to-fix !]]))
+
+(let [transforms {:keys keyword
+ :strs str
+ :syms identity}]
+ (defmacro keyed
+ "Create a map in which, for each symbol S in vars, (keyword S) is a
+ key mapping to the value of S in the current scope. If passed an optional
+ :strs or :syms first argument, use strings or symbols as the keys instead."
+ ([vars] `(keyed :keys ~vars))
+ ([key-type vars]
+ (let [transform (comp (partial list `quote)
+ (transforms key-type))]
+ (into {} (map (juxt transform identity) vars))))))
+
+(defn assoc-or
+ "Create mapping from each key to val in map only if existing val is nil."
+ ([map key val]
+ (if (nil? (map key))
+ (assoc map key val)
+ map))
+ ([map key val & kvs]
+ (let [map (assoc-or map key val)]
+ (if kvs
+ (recur map (first kvs) (second kvs) (nnext kvs))
+ map))))
+
+(defn into-map
+ "Convert a list of heterogeneous args into a map. Args can be alternating keys and values,
+ maps of keys to values or collections of alternating keys and values."
+ [& args]
+ (let [[args combine] (pop-if (apply list args) fn? (fn [_ x] x))]
+ (loop [args args m {}]
+ (if (empty? args)
+ m
+ (let [arg (first args)
+ args (rest args)]
+ (condp #(%1 %2) arg
+ nil? (recur args m)
+ map? (recur args (merge-with combine m arg))
+ coll? (recur (into args (reverse arg)) m)
+ (recur (conj (rest args) {arg (first args)}) m)))))))
+
+(defn map-vals
+ "Create a new map from m by calling function f on each value to get a new value."
+ [f m]
+ (into {}
+ (for [[k v] m]
+ (map-entry k (f v)))))
+
+(defn map-vals-with-keys
+ "Create a new map from m by calling function f, with two arguments (the key and value)
+ to get a new value."
+ [f m]
+ (into {}
+ (for [[k v] m]
+ (map-entry k (f k v)))))
+
+(defn map-keys-and-vals
+ "Create a new map from m by calling function f on each key & each value to get a new key & value"
+ [f m]
+ (into {}
+ (for [[k v] m]
+ (map-entry (f k) (f v)))))
+
+(defn update
+ "Update value in map where f is a function that takes the old value and the supplied args and
+ returns the new value. For efficiency, Do not change map if the old value is the same as the new
+ value. If key is sequential, update all keys in the sequence with the same function."
+ [map key f & args]
+ (if (sequential? key)
+ (reduce #(apply update %1 %2 f args) map key)
+ (let [old (get map key)
+ new (apply f old args)]
+ (if (= old new) map (assoc map key new)))))
+
+(defn merge-in
+ "Merge two nested maps."
+ [left right]
+ (if (map? left)
+ (merge-with merge-in left right)
+ right))
+
+(defn update-in!
+ "'Updates' a value in a nested associative structure, where ks is a sequence of keys and
+ f is a function that will take the old value and any supplied args and return the new
+ value, and returns a new nested structure. The associative structure can have transients
+ in it, but if any levels do not exist, non-transient hash-maps will be created."
+ [m [k & ks] f & args]
+ (let [assoc (if (instance? clojure.lang.ITransientCollection m) assoc! assoc)
+ val (get m k)]
+ (assoc m k (if ks
+ (apply update-in! val ks f args)
+ (apply f val args)))))
+
+(defn assoc-in!
+ "Associates a value in a nested associative structure, where ks is a sequence of keys
+ and v is the new value and returns a new nested structure. The associative structure
+ can have transients in it, but if any levels do not exist, non-transient hash-maps will
+ be created."
+ [m ks v]
+ (update-in! m ks (constantly v)))
+
+(defn map-to
+ "Returns a map from each item in coll to f applied to that item."
+ [f coll]
+ (into {}
+ (for [item coll]
+ (map-entry item (f item)))))
+
+(defn index-by
+ "Returns a map from the result of calling f on each item in coll to that item."
+ [f coll]
+ (into {}
+ (for [item coll]
+ (map-entry (f item) item))))
+
+(defn position
+ "Returns a map from item to the position of its first occurence in coll."
+ [coll]
+ (into {} (reverse (map-indexed (fn [idx val] (map-entry val idx)) coll))))
+
+(defn filter-keys-by-val
+ "Returns all keys in map for which (pred value) returns true."
+ [pred map]
+ (when map
+ (set (for [[key val] map :when (pred val)] key))))
+
+(defn remove-keys-by-val
+ "Returns all keys of map for which (pred value) returns false."
+ [pred map]
+ (filter-keys-by-val (complement pred) map))
+
+(defn filter-vals
+ "Returns a map that only contains values where (pred value) returns true."
+ [pred map]
+ (when map
+ (select-keys map (filter-keys-by-val pred map))))
+
+(defn remove-vals
+ "Returns a map that only contains values where (pred value) returns false."
+ [pred map]
+ (filter-vals (complement pred) map))
+
+(defn filter-keys
+ "Returns a map that only contains keys where (pred key) returns true."
+ [pred map]
+ (when map
+ (select-keys map (filter pred (keys map)))))
+
+(defn remove-keys
+ "Returns a map that only contains keys where (pred key) returns false."
+ [pred map]
+ (filter-keys (complement pred) map))
+
+(defn multi-map
+ "Takes a map with keys and values that can be sets or individual objects and returns a map from
+ objects to sets. Used to create associations between two sets of objects."
+ [m]
+ (apply merge-with into
+ (for [entry m, :let [[ks vs] (map (to-fix (! set?) hash-set) entry)]
+ k ks]
+ {k vs})))
View
19 src/useful/parallel.clj
@@ -0,0 +1,19 @@
+(ns useful.parallel
+ (:use [useful.seq :only [slice]]))
+
+(def *pcollect-thread-num* (.. Runtime getRuntime availableProcessors))
+
+(defn pcollect
+ "Like pmap but not lazy and more efficient for less computationally intensive functions
+ because there is less coordination overhead. The collection is sliced among the
+ available processors and f is applied to each sub-collection in parallel using map."
+ ([f coll]
+ (pcollect identity f coll))
+ ([wrap-fn f coll]
+ (if (<= *pcollect-thread-num* 1)
+ ((wrap-fn #(doall (map f coll))))
+ (mapcat deref
+ (map (fn [slice]
+ (let [body (wrap-fn #(doall (map f slice)))]
+ (future-call body)))
+ (slice *pcollect-thread-num* coll))))))
View
178 src/useful/seq.clj
@@ -0,0 +1,178 @@
+(ns useful.seq
+ (:use [useful.fn :only [decorate]]))
+
+(defn find-first
+ "Returns the first item of coll where (pred item) returns logical true."
+ [pred coll]
+ (first (filter pred coll)))
+
+(defn find-with
+ "Returns the val corresponding to the first key where (pred key) returns true."
+ [pred keys vals]
+ (->> (map vector keys vals)
+ (find-first (comp pred first))
+ last))
+
+(defn extract
+ "Extracts the first item that matches pred from coll, returning a vector of that item
+ followed by coll with the item removed."
+ [pred coll]
+ (let [[head [item & tail]] (split-with (complement pred) coll)]
+ [item (concat head tail)]))
+
+(defn separate
+ "Split coll into two sequences, one that matches pred and one that doesn't. Unlike the
+ version in clojure.contrib.seq-utils, pred is only called once per item."
+ [pred coll]
+ (let [pcoll (map (decorate pred) coll)]
+ (vec (for [f [filter remove]]
+ (map first (f second pcoll))))))
+
+(defn include?
+ "Check if val exists in coll."
+ [val coll]
+ (some (partial = val) coll))
+
+(defn zip
+ "Returns a lazy sequence of vectors of corresponding items from each collection. If one collection
+ is longer than the others, the missing items will be filled in with nils."
+ [& colls]
+ (lazy-seq
+ (when (some seq colls)
+ (cons (vec (map first colls))
+ (apply zip (map rest colls))))))
+
+(defn insert
+ "Inserts a seq of items into coll at position n."
+ [items n coll]
+ (let [[before after] (split-at n coll)]
+ (concat before items after)))
+
+(defn slice
+ "Divide coll into n approximately equal slices."
+ [n coll]
+ (loop [num n, slices [], items (vec coll)]
+ (if (empty? items)
+ slices
+ (let [size (Math/ceil (/ (count items) num))]
+ (recur (dec num) (conj slices (subvec items 0 size)) (subvec items size))))))
+
+(defn cross
+ "Computes the cartesian-product of the provided seqs. In other words, compute the set of all
+ possible combinations of ways you can choose one item from each seq."
+ [& seqs]
+ (if (seq (rest seqs))
+ (for [x (first seqs)
+ y (apply cross (rest seqs))]
+ (cons x y))
+ (map list (first seqs))))
+
+(defn lazy-cross
+ "Compute a lazy cartesian-product of the provided seqs. The provided seqs can be lazy or even
+ infinite, and lazy-cross will consume all sequences equally, only consuming more of any sequence
+ when all possible combinations at the current level have been exhausted. This can be thought of
+ intuitively as a breadth-first search of the cartesian product set."
+ [& seqs]
+ (letfn [(step [heads tails dim]
+ (lazy-seq
+ (when (< dim (count tails))
+ (let [tail (get tails dim)]
+ (concat (apply cross (assoc heads dim tail))
+ (step (update-in heads [dim] concat tail)
+ tails (inc dim)))))))
+ (lazy-cross [seqs level]
+ (lazy-seq
+ (let [heads (vec (map #(take level %) seqs))
+ tails (vec (map #(take 1 (drop level %)) seqs))]
+ (when-not (every? empty? tails)
+ (concat (step heads tails 0)
+ (lazy-cross seqs (inc level)))))))]
+ (lazy-cross seqs 0)))
+
+(defn alternates
+ "Split coll into 'threads' subsequences (defaults to 2), feeding
+each alternately from the input sequence. Effectively the inverse of
+interleave:
+
+ (alternates 3 (range 9))
+;=> ((0 3 6) (1 4 7) (2 5 8))"
+ ([coll] (alternates 2 coll))
+ ([threads coll]
+ (apply map list (partition threads coll))))
+
+(defmacro lazy-loop
+ "Provide a simplified version of lazy-seq to eliminate
+ boilerplate. Arguments are as to the built-in (loop...recur),
+ and (lazy-recur) will be defined for you. However, instead of doing
+ actual tail recursion, lazy-recur trampolines through lazy-seq. In
+ addition to enabling laziness, this means you can call lazy-recur
+ when not in the tail position."
+ [bindings & body]
+ (let [inner-fn 'lazy-recur
+ [names values] (alternates bindings)]
+ `((fn ~inner-fn
+ ~(vec names)
+ (lazy-seq
+ ~@body))
+ ~@values)))
+
+(defn unfold
+ "Traditionally unfold is the 'opposite of reduce': it turns a single
+ seed value into a (possibly infinite) lazy sequence of output
+ values.
+
+ Next and done? are functions that operate on a seed. next should
+ return a pair, [value new-seed]; the value half of the pair is
+ inserted into the resulting list, while the new-seed is used to
+ continue unfolding. Notably, the value is never passed as an
+ argument to either next or done?.
+
+ If done? is omitted, the sequence will be unfolded forever, for
+ example
+ (defn fibs []
+ (unfold (fn [[a b]]
+ [a [b (+ a b)]])
+ [0 1]))"
+ ([next seed]
+ (unfold next (constantly false) seed))
+ ([next done? seed]
+ (lazy-loop [seed seed]
+ (when-not (done? seed)
+ (let [[value new-seed] (next seed)]
+ (cons value
+ (lazy-recur new-seed)))))))
+
+(defn take-shuffled
+ "Lazily take (at most) n elements at random from coll, without
+ replacement. For n=1, this is equivalent to rand-nth; for n>=(count
+ coll) it is equivalent to shuffle.
+
+ Clarification of \"without replacement\": each index in the original
+ collection is chosen at most once. Thus if the original collection
+ contains no duplicates, neither will the result of this
+ function. But if the original collection contains duplicates, this
+ function may include them in its output: it does not do any
+ uniqueness checking aside from being careful not to use the same
+ index twice."
+ [n coll]
+ (let [coll (vec coll)
+ n (min n (count coll))]
+ (take n
+ (lazy-loop [coll coll]
+ (let [idx (rand-int (count coll))
+ val (coll idx)
+ coll (-> coll
+ (assoc idx (peek coll))
+ pop)]
+ (cons val (lazy-recur coll)))))))
+
+(defn foldr
+ [f start coll]
+ (reduce #(f %2 %1) start (reverse coll)))
+
+(defmacro lazy
+ "Return a lazy sequence of the passed-in expressions. Each will be evaluated
+ only if necessary."
+ [& exprs]
+ `(map force (list ~@(for [expr exprs]
+ `(delay ~expr)))))
View
45 src/useful/string.clj
@@ -1,19 +1,34 @@
(ns useful.string
- (:use [clojure.string :only [join split capitalize]]))
+ (:use [useful.debug :only [?]])
+ (:require [clojure.string :as s]))
-(defn camelize [s & [lower]]
- (let [parts (split (str s) #"-|_")]
- (apply str
- (if lower
- (cons (first parts) (map capitalize (rest parts)))
- (map capitalize parts)))))
+(defn camelize [string]
+ (s/replace string
+ #"[-_](\w)"
+ (comp s/upper-case second)))
-(defn dasherize [s]
- (.. (re-matcher #"\B([A-Z])" (str s))
- (replaceAll "-$1")
- toLowerCase))
+ (defn classify [string]
+ (apply str (map s/capitalize
+ (s/split string #"[-_]"))))
-(defn underscore [s]
- (.. (re-matcher #"\B([A-Z])" (str s))
- (replaceAll "_$1")
- toLowerCase))
+(defn- from-camel-fn [separator]
+ (fn [string]
+ (-> string
+ (s/replace #"^[A-Z]+" s/lower-case)
+ (s/replace #"_?([A-Z]+)"
+ (comp (partial str separator)
+ s/lower-case second))
+ (s/replace #"-|_" separator))))
+
+(def dasherize (from-camel-fn "-"))
+(def underscore (from-camel-fn "_"))
+
+(defn pluralize
+ "Return a pluralized phrase, appending an s to the singular form if no plural is provided.
+ For example:
+ (plural 5 \"month\") => \"5 months\"
+ (plural 1 \"month\") => \"1 month\"
+ (plural 1 \"radius\" \"radii\") => \"1 radius\"
+ (plural 9 \"radius\" \"radii\") => \"9 radii\""
+ [num singular & [plural]]
+ (str num " " (if (= 1 num) singular (or plural (str singular "s")))))
View
156 src/useful/utils.clj
@@ -0,0 +1,156 @@
+(ns useful.utils
+ (:use [clojure.walk :only [walk]]
+ [useful.fn :only [decorate ignoring-nils fix]]))
+
+(defn invoke
+ "Like clojure.core/apply, but doesn't expand/splice the last argument."
+ ([f] (f))
+ ([f x] (f x))
+ ([f x & more] (apply f x more)))
+
+(defmacro verify
+ "Raise exception unless test returns true."
+ [test exception]
+ `(when-not ~test
+ (throw (fix ~exception string? #(Exception. %)))))
+
+(def ^{:doc "The minimium value of vals, ignoring nils."
+ :arglists '([& args])}
+ or-min (ignoring-nils min))
+
+(def ^{:doc "The maximium value of vals, ignoring nils."
+ :arglists '([& args])}
+ or-max (ignoring-nils max))
+
+(defn conj-vec
+ "Conj onto collection ensuring it is a vector."
+ [coll item]
+ (conj (vec coll) item))
+
+(defn conj-set
+ "Conj onto collection ensuring it is a set."
+ [coll item]
+ (conj (set coll) item))
+
+(defn into-vec
+ "Returns a new vector consisting of to-coll with all of the items of from-coll conjoined."
+ [to-coll from-coll]
+ (into (vec to-coll) from-coll))
+
+(defn split-vec
+ "Split the given vector at the provided offsets using subvec. Supports negative offsets."
+ [v & ns]
+ (let [ns (map #(if (neg? %) (+ % (count v)) %) ns)]
+ (lazy-seq
+ (if-let [n (first ns)]
+ (cons (subvec v 0 n)
+ (apply split-vec
+ (subvec v n)
+ (map #(- % n) (rest ns))))
+ (list v)))))
+
+(defmacro if-ns
+ "Try to load a namespace reference. If successful, evaluate then-form otherwise evaluate else-form."
+ [ns-reference then-form & [else-form]]
+ `(try (ns ~(ns-name *ns*) ~ns-reference)
+ (eval '~then-form)
+ (catch Exception e#
+ (when-not (some #(instance? % e#) [java.io.FileNotFoundException
+ java.lang.ClassNotFoundException])
+ (printf "%s: %s %s" (.getName (class e#)) (.getMessage e#) '~ns-reference))
+ (eval '~else-form))))
+
+(defn adjoin
+ "Merge two data structures by combining the contents. For maps, merge recursively by
+ adjoining values with the same key. For collections, combine the right and left using
+ into or conj. If the left value is a set and the right value is a map, the right value
+ is assumed to be an existence map where the value determines whether the key is in the
+ merged set. This makes sets unique from other collections because items can be deleted
+ from them."
+ [left right]
+ (cond (map? left)
+ (merge-with adjoin left right)
+
+ (and (set? left) (map? right))
+ (reduce (fn [set [k v]] ((if v conj disj) set k))
+ left right)
+
+ (coll? left)
+ ((if (coll? right) into conj) left right)
+
+ :else right))
+
+(defn pop-if
+ "Pop item off the given stack if (pred? item) returns true, returning both the item and the
+ modified stack. If (pred? item) is false, return nil or the optional default value."
+ [stack pred? & [default]]
+ (let [[peek pop] (if (instance? clojure.lang.IPersistentStack stack)
+ [peek pop]
+ [first rest])
+ item (peek stack)]
+ (if (pred? item)
+ [(pop stack) item]
+ [stack default])))
+
+(defmacro with-adjustments
+ "Create new bindings for binding args, by applying adjustment
+ function to current values of bindings."
+ [adjustment bindings & body]
+ (let [bindings (vec bindings)]
+ `(let [~bindings (map ~adjustment ~bindings)]
+ ~@body)))
+
+(defn queue
+ "Create an empty persistent queue or a persistent queue from a sequence."
+ ([] clojure.lang.PersistentQueue/EMPTY)
+ ([seq] (into (queue) seq)))
+
+(defmacro defm
+ "Define a function with memoization. Takes the same arguments as defn."
+ [& defn-args]
+ `(doto (defn ~@defn-args)
+ (alter-var-root #(with-meta (memoize %) (meta %)))))
+
+(defn memoize-deref
+ "Returns a memoized version a non-referentially transparent function, calling deref on each
+ provided var (or ref or atom) and using that in the cache key to prevent cross-contamination if
+ any of the values change."
+ [vars f]
+ (let [mem (memoize
+ (fn [args vals]
+ (apply f args)))]
+ (fn [& args]
+ (mem args (doall (map deref vars))))))
+
+(defn syntax-quote ;; from leiningen.core/unquote-project
+ "Syntax quote the given form, wrapping all seqs and symbols in quote."
+ [form]
+ (walk (fn [form]
+ (cond (and (seq? form) (= `unquote (first form))) (second form)
+ (or (seq? form) (symbol? form)) (list 'quote form)
+ :else (syntax-quote form)))
+ identity
+ form))
+
+(defmacro map-entry
+ "Create a clojure.lang.MapEntry from a and b. Equivalent to a cons cell.
+ useful.experimental.unicode contains a shortcut to this, named ·."
+ [a b]
+ `(clojure.lang.MapEntry. ~a ~b))
+
+(defn pair
+ "Create a clojure.lang.MapEntry from a and b. Equivalent to a cons cell"
+ [a b]
+ (map-entry a b))
+
+(defn trade!
+ "Like swap!, except it returns the old value of the atom."
+ [atom f & args]
+ (with-local-vars [prev nil]
+ (apply swap! atom
+ (fn [val & args]
+ (var-set prev val)
+ (apply f val args))
+ args)
+ (var-get prev)))
+
View
4 test/useful/bean_test.clj
@@ -0,0 +1,4 @@
+(ns useful.bean-test
+ (:use clojure.test useful.bean))
+
+
View
5 test/useful/cli_test.clj
@@ -0,0 +1,5 @@
+(ns useful.cli-test
+ (:use clojure.test useful.cli))
+
+(deftest test-parse-opts
+ (is (= {:foo ["a"] :bar [""]} (parse-opts ["--foo=a" "--bar"]))))
View
9 test/useful/compress_test.clj
@@ -0,0 +1,9 @@
+(ns useful.compress-test
+ (:use clojure.test useful.compress))
+
+
+(deftest round-trip
+ (let [s "f3509ruwqerfwoa reo1u30`1 ewf dfgjdsf sfc saf65sad+ f5df3
+g2 sd35g4szdf sdf4 as89faw76fwfwf210
+"]
+ (is (= s (unsmash (smash s))))))
View
13 test/useful/datatypes_test.clj
@@ -0,0 +1,13 @@
+(ns useful.datatypes-test
+ (:use clojure.test useful.datatypes))
+
+(defrecord Test [a b])
+(record-accessors Test)
+
+(deftest test-record
+ (let [init (Test. 1 2)
+ second (Test. 1 5)]
+ (is (= init (make-record Test :b 2 :a 1)))
+ (is (= second (assoc-record init :b 5)))
+ (is (= second (update-record init (+ b 3))))
+ (is (= (:a init) (a init)))))
View
15 test/useful/debug_test.clj
@@ -0,0 +1,15 @@
+(ns useful.debug-test
+ (use useful.debug clojure.test))
+
+(defmacro test-? [form]
+ `(let [form# '~form
+ expected# ~form
+ collector# (java.io.StringWriter.)]
+ (binding [*out* collector#]
+ (is (= expected# (? ~form)))
+ (let [written# (str collector#)]
+ (are [val#] (.contains written# (pr-str val#))
+ form# expected#)))))
+
+(deftest ?-test ;; macro to avoid repeating expr with various levels of quoting
+ (test-? (str "test" "more")))
View
81 test/useful/dispatch_test.clj
@@ -0,0 +1,81 @@
+(ns useful.dispatch-test
+ (:use clojure.test useful.dispatch
+ [clojure.walk :only [stringify-keys]]))
+
+(deftest test-dispatcher-fn
+ (let [dispatch (dispatcher (fn [f & args] (symbol "clojure.core" f)))]
+ (is (= "str5" (dispatch "str" 5)))))
+
+(deftest test-dispatch
+ (testing "simple dispatch"
+ (defdispatch invert #(cond (map? %)
+ (symbol "clojure.set" "map-invert")
+
+ (vector? %)
+ (symbol "clojure.core" "reverse")))
+ (is (= {2 :b, 1 :a} (invert {:a 1 :b 2})))
+ (is (= [:bar :foo] (invert [:foo :bar]))))
+
+ (testing "flat hierarchy"
+ (defdispatch invert #(cond (map? %)
+ (symbol "clojure.core" "map-invert")
+
+ (vector? %)
+ (symbol "clojure.core" "reverse"))
+ :hierarchy '{clojure.core clojure.set})
+ (is (= {2 :b, 1 :a} (invert {:a 1 :b 2})))
+ (is (= [:bar :foo] (invert [:foo :bar]))))
+
+ (testing "deep hierarchy"
+ (defdispatch invert #(cond (map? %)
+ (symbol "clojure.core" "map-invert")
+
+ (vector? %)
+ (symbol "clojure.core" "reverse"))
+ :hierarchy '{clojure.core clojure.foo
+ clojure.foo clojure.bar
+ clojure.bar clojure.set})
+ (is (= {2 :b, 1 :a} (invert {:a 1 :b 2})))
+ (is (= [:bar :foo] (invert [:foo :bar]))))
+
+ (testing "dispatch to ns does not exist"
+ (defdispatch invert #(cond (map? %)
+ (symbol "clojure.foo" "map-invert")
+
+ (vector? %)
+ (symbol "clojure.core" "reverse")))
+ (is (thrown? java.lang.IllegalArgumentException
+ (invert {:a 1 :b 2}))))
+
+ (testing "dispatch to fn does not exist"
+ (defdispatch invert #(cond (map? %)
+ (symbol "clojure.set" "foo")
+
+ (vector? %)
+ (symbol "clojure.core" "reverse")))
+ (is (thrown? java.lang.IllegalArgumentException
+ (invert {:a 1 :b 2}))))
+
+ (testing "middleware"
+ (defdispatch invert #(cond (map? %)
+ (symbol "clojure.set" "map-invert")
+
+ (vector? %)
+ (symbol "clojure.core" "reverse"))
+ :wrap #(fn [arg]
+ (if (map? arg)
+ (% (stringify-keys arg))
+ (% arg))))
+ (is (= {2 "b" 1 "a"} (invert {:a 1 :b 2})))
+ (is (= [:bar :foo] (invert [:foo :bar]))))
+
+ (testing "self as sub-type"
+ (defdispatch invert #(cond (map? %)
+ (symbol "clojure.core" "map-invert")
+
+ (vector? %)
+ (symbol "clojure.core" "reverse"))
+ :hierarchy '{clojure.core clojure.foo
+ clojure.foo clojure.foo})
+ (is (thrown? java.lang.Exception
+ (invert {:a 1 :b 2})))))
View
115 test/useful/experimental_test.clj
@@ -0,0 +1,115 @@
+(ns useful.experimental-test
+ (:use clojure.test useful.map useful.experimental))
+
+(deftest test-while-let
+ (let [a (atom '(1 2 3 4 5))]
+ (while-let [val (seq @a)]
+ (is val)
+ (swap! a rest))
+ (is (empty? @a))))
+
+(deftest test-let-if
+ (doseq [a [1 2]]
+ (let-if (even? a)
+ [odd false true
+ even true false]
+ (is (= even (even? a)))
+ (is (= odd (odd? a))))))
+
+
+;;; protocols defined for testing protocol-stub
+(defprotocol Sample
+ (sample [this data]))
+
+(defprotocol Define
+ (define [this k v])
+ (lookup [this k]))
+
+(defrecord Implementor []
+ Sample
+ (sample [this data] 10)
+
+ Define
+ (define [this k v] false)
+ (lookup [this k] :not-found))
+
+(protocol-stub StubImpl
+ {Sample {:default :forward}
+ Define {:default :stub,
+ :exceptions [lookup]}})
+
+(deftest stub-test
+ (let [call-log (atom [])
+ real-impl (Implementor.)
+ stub-impl (StubImpl. real-impl
+ (fn
+ ([f [this & args]]
+ (reset! call-log (keyed [f args])))
+ ([f [this & args] ret]
+ (reset! call-log (keyed [f args ret])))))]
+ (testing "default action works without exceptions"
+ (is (= [] @call-log))
+ (is (= 10 (sample real-impl 'whatever)))
+ (is (= [] @call-log))
+ (is (= 10 (sample stub-impl 'whatever)))
+ (is (= {:f 'sample, :args ['whatever], :ret 10} @call-log)))
+
+ (testing "default action works with a different exception"
+ (is (false? (define real-impl 1 2)))
+ (is (nil? (define stub-impl 1 2)))
+ (is (= {:f 'define :args [1 2]} @call-log)))
+
+ (testing "exceptions are applied"
+ (is (= :not-found (lookup real-impl 1)))
+ (is (= :not-found (lookup stub-impl 1)))
+ (is (= {:f 'lookup :args [1] :ret :not-found} @call-log)))))
+
+(deftest wrapper-test
+ (testing "Wrapping respects manually-established bindings"
+ (with-local-vars [wrappers ()]
+ (defn-wrapping my-inc wrappers "add one" [x]
+ (+ 1 x))
+ (is (= 2 (my-inc 1)))
+ (let [start-num 1]
+ (is (= (* 2 (inc (+ 10 start-num)))
+ (with-bindings {wrappers (list (fn [f] ;; outermost wrapper
+ (fn [x]
+ (* 2 (f x))))
+ (fn [f] ;; innermost wrapper
+ (fn [x]
+ (f (+ 10 x)))))}
+ (my-inc start-num)))))
+ (let [call-log (atom nil)]
+ (is (= 2 (with-bindings {wrappers (list (fn [f]
+ (fn [x]
+ (let [ret (f x)]
+ (reset! call-log [(-> wrappers deref meta :useful.experimental/call-data :fn-name) x ret])
+ ret))))}
+ (my-inc 1))))
+ (testing "Wrapping-related metadata bound correctly"
+ (is (= ['my-inc 1 2] @call-log))))))
+
+ (testing "with-wrapper(s) works"
+ (let [prepend (fn [item] (fn [f] (fn [& args] (apply f item args))))
+ append (fn [item] (fn [f] (fn [& args] (apply f (concat args [item])))))]
+ (with-local-vars [vec-wrapper []
+ cons-wrapper ()]
+ (defn-wrapping vec-str vec-wrapper "Make stuff a string" [& args]
+ (apply str args))
+ (defn-wrapping cons-str cons-wrapper "Make stuff a string" [& args]
+ (apply str args))
+ (with-wrapper vec-wrapper (prepend 'foo)
+ (is (= "foo123" (vec-str 1 2 3)))
+ (with-wrapper vec-wrapper (append 'bar)
+ (is (= "foo123bar" (vec-str 1 2 3)))
+ (with-wrapper vec-wrapper (prepend 'baz)
+ (is (= "foobaz123bar" (vec-str 1 2 3))))))
+ (with-wrappers cons-wrapper [(prepend 'foo) (append 'bar) (prepend 'baz)]
+ (is (= "bazfoo123bar" (cons-str 1 2 3)))))))
+
+ (testing "Metadata is applied properly"
+ (defn-wrapping myfn nil "re-implement clojure.core/first." [[x]]
+ x)
+ (let [meta (meta #'myfn)]
+ (is (= '([[x]]) (:arglists meta)))
+ (is (= "re-implement clojure.core/first." (:doc meta))))))
View
45 test/useful/fn_test.clj
@@ -0,0 +1,45 @@
+(ns useful.fn-test
+ (:use clojure.test useful.fn))
+
+(deftest test-decorate
+ (is (= [[1 2] [2 3] [3 4]] (map (decorate inc) [1 2 3]))))
+
+(deftest test-annotate
+ (is (= [1 2] (annotate 1 inc))))
+
+(deftest test-fix
+ (let [repair (fn [val]
+ (-> (* val 2)
+ int
+ (fix zero? dec, even? (partial * 3), inc)))]
+ (is (= 12 (repair 2)))
+ (is (= 4 (repair 1.5)))
+ (is (= -1 (repair 0)))))
+
+(deftest test-to-fix
+ (is (= [1 -2 3 -4] (map (to-fix (! odd?) -) [1 2 3 4]))))
+
+(deftest test-given
+ (is (= 1
+ (-> {:value 0}
+ (given map? update-in [:value] inc) ; matches
+ (given sequential? reverse) ; doesn't match
+ (given :value :value)))))
+
+(deftest test-any
+ (is (= [0 2 3 4 6 8 9 10]
+ (filter (any #(zero? (rem % 2))
+ #(zero? (rem % 3)))
+ (range 11)))))
+
+(deftest test-all
+ (is (= [0 6]
+ (filter (all #(zero? (rem % 2))
+ #(zero? (rem % 3)))
+ (range 11)))))
+
+(deftest test-thrush
+ (is (= 5 (thrush 1 inc inc inc inc))))
+
+(deftest test-ignoring-nils
+ (is (= 6 ((ignoring-nils +) 1 nil 2 nil nil 3))))
View
4 test/useful/io_test.clj
@@ -0,0 +1,4 @@
+(ns useful.io-test
+ (:use clojure.test useful.io))
+
+
View
18 test/useful/java_test.clj
@@ -0,0 +1,18 @@
+(ns useful.java-test
+ (:use clojure.test useful.java))
+
+(deftest test-rescue
+ (is (= nil (rescue (/ 9 0) nil)))
+ (is (= 3 (rescue (/ 9 3) nil))))
+
+(deftest test-construct
+ (is (= "test" (construct String "test"))))
+
+(deftest test-invoke-private
+ (let [hash (doto (java.util.Hashtable.)
+ (.put 1 2)
+ (.put 3 4))]
+ (is (thrown? Throwable (.rehash hash)))
+ (is (= {1 2 3 4}
+ (doto hash (invoke-private "rehash"))))
+ (is (thrown? Throwable (.rehash hash)))))
View
22 test/useful/macro_test.clj
@@ -0,0 +1,22 @@
+(ns useful.macro-test
+ (:use clojure.test useful.macro))
+
+;; necessary because deftest does weird shit with namespaces, resolution, and
+;; macroexpansion, so this can't be inside there
+(let [strip-extraneous-do (fn [form]
+ (->> form
+ (iterate second)
+ (drop-while (comp #{`do} first))
+ first))
+ expansion (macroexpand '(anon-macro [name num]
+ `(inc ~(symbol (str name num)))
+ test 1))]
+
+ (deftest test-macro-toys
+ (is (= `(inc ~'test1)
+ (strip-extraneous-do expansion)))
+ (is (= "123abc"
+ (with-out-str
+ (macro-do [x] `(print '~x)
+ 123
+ abc))))))
View
81 test/useful/map_test.clj
@@ -0,0 +1,81 @@
+(ns useful.map-test
+ (:use clojure.test useful.map))
+
+(deftest test-assoc-or
+ (is (= {:a 1 :b 2 :c 3}
+ (-> {:a 1 :b nil}
+ (assoc-or :a 2)
+ (assoc-or :b 2)
+ (assoc-or :c 3)))))
+
+(deftest test-keyed
+ (let [a 1 b 2]
+ (is (= {:a 1 :b 2} (keyed [a b])))
+ (is (= '{a 1 b 2} (keyed :syms [a b])))))
+
+(deftest test-into-map
+ (is (= {:foo "1", :bar "2", :bang "3", :baz "4", :blah 5}
+ (into-map :foo 1 :bar 2 :bang 3 [:foo "1" :baz "4"] :bar "2" '(:bang "3") {:blah 5})))
+ (is (= {:foo {:bap 3, :baz 2, :bar 1}}
+ (into-map merge-in :foo {:bar 1} {:foo {:baz 2}} [:foo {:bap 3}]))))
+
+(deftest test-map-vals
+ (is (= {:foo 1 :bar 9 :baz 4}
+ (map-vals inc {:foo 0 :bar 8 :baz 3}))))
+
+(deftest test-map-vals-with-keys
+ (is (= {1 3, 7 8, 9 14}
+ (map-vals-with-keys + {1 2, 7 1, 9 5}))))
+
+(deftest test-map-keys-and-vals
+ (is (= {"a" "b" "c" "d"}
+ (map-keys-and-vals name {:a :b :c :d}))))
+
+(deftest test-update
+ (is (= {:a 3 :b 3}
+ (-> {:a 2 :b 4}
+ (update :a inc)
+ (update :b dec))))
+ (is (= {:a 6 :b 8}
+ (-> {:a 3 :b 4}
+ (update [:a :b] * 2)))))
+
+(deftest test-merge-in
+ (is (= {:a {:b {:c 4} :d 2 :e 3} :e 3 :f 2 :g 1}
+ (merge-in {:a {:b {:c 1} :d 2} :e 3 :f 4}
+ {:a {:b {:c 4} :e 3} :f 2 :g 1}))))
+
+(deftest test-map-to
+ (is (= {1 2 3 4 5 6} (map-to inc [1 3 5])))
+ (is (= {2 1} (map-to dec [2 2 2]))))
+
+(deftest test-index-by
+ (is (= {true 3 false 4} (index-by odd? [1 3 4])))
+ (is (= {1 2 3 4 5 6} (index-by dec [2 4 6]))))
+
+(deftest test-position
+ (is (= (position [1 3 5 3])
+ {1 0 3 1 5 2})))
+
+(deftest map-filtering-tests
+ (let [m '{a 0, b 1, c 11, d 92}]
+ (is (= '#{a d} (filter-keys-by-val even? m)))
+ (is (= '#{b c} (remove-keys-by-val even? m)))
+ (is (= '{a 0} (filter-vals zero? m)))
+ (is (= '{b 1, c 11, d 92} (remove-vals zero? m)))
+ (is (= '{a 0} (filter-keys '#{a} m)))
+ (is (= '{b 1, c 11, d 92} (remove-keys '#{a} m)))))
+
+(deftest test-update-in
+ (is (= [1] (-> (update-in! {:foo (transient {:bar []})} [:foo :bar] conj 1)
+ :foo :bar))))
+
+(deftest test-assoc-in
+ (is (= [1] (-> (assoc-in! {:foo {}} [:foo :bar] [1])
+ :foo :bar))))
+
+(deftest test-multi-map
+ (is (= {:foo #{1 2 3 4}, :bar #{2 3 4 5 6}, :baz #{5 6}}
+ (multi-map {:foo 1, #{:foo :bar} #{2 3 4}, #{:baz :bar} #{5 6}})))
+ (is (= {:foo #{1 2}, :bar #{2 3}}
+ (multi-map {:foo #{1 2}, :bar #{2 3}}))))
View
21 test/useful/parallel_test.clj
@@ -0,0 +1,21 @@
+(ns useful.parallel-test
+ (:use clojure.test useful.parallel))
+
+(def *i* 1)
+
+(defn mult [num]
+ (* num *i*))
+
+(defn wrap-i [f]
+ (fn []
+ (binding [*i* 2]
+ (f))))
+
+(deftest test-pcollect
+ (doseq [n [1 2 3 4]]
+ (binding [*pcollect-thread-num* n]
+ (is (= [1 2 3 4 5 6 7 8 9 10]
+ (pcollect inc [0 1 2 3 4 5 6 7 8 9])))
+ (is (= [2 4 6 8 10 12 14 16 18 20]
+ (pcollect wrap-i mult
+ [1 2 3 4 5 6 7 8 9 10]))))))
View
90 test/useful/seq_test.clj
@@ -0,0 +1,90 @@
+(ns useful.seq-test
+ (:use clojure.test useful.seq clojure.set))
+
+(deftest test-zip
+ (is (= [[1 4 8] [2 5 9] [3 6 nil] [nil 7 nil]] (zip [1 2 3] [4 5 6 7] [8 9]))))
+
+(deftest test-insert
+ (is (= [1 2 3 4 5] (insert [2 3] 1 [1 4 5]))))
+
+(deftest test-find-with
+ (is (= :foo (find-with odd? [2 4 5 7] [:bar :baz :foo :bap])))
+ (is (= nil (find-with even? [1 3 5 9] [:bar :baz :foo :bap]))))
+
+(deftest test-cross
+ (is (= '((0 0) (0 1) (1 0) (1 1)) (cross [0 1] [0 1])))
+ (is (= '((0 0 2) (0 1 2) (1 0 2) (1 1 2))) (cross [0 1] [0 1] [2])))
+
+(deftest test-lazy-cross
+ (is (= '((0 0) (1 0) (0 1) (1 1)) (lazy-cross [0 1] [0 1])))
+ (is (= '((0 0 2) (1 0 2) (0 1 2) (1 1 2)) (lazy-cross [0 1] [0 1] [2]))))
+
+(deftest test-extract
+ (is (= [5 '(2 4 6 1 2 7)] (extract odd? [2 4 6 5 1 2 7])))
+ (is (= [2 '(4 6 5 1 2 7)] (extract even? [2 4 6 5 1 2 7])))
+ (is (= [7 '(2 4 6 5 1 2)] (extract #(< 6 %) [2 4 6 5 1 2 7]))))
+
+(deftest test-separate
+ (is (= ['(5 1 7) '(2 4 6 2)] (separate odd? [2 4 6 5 1 2 7])))
+ (is (= ['(2 4 6 2) '(5 1 7)] (separate even? [2 4 6 5 1 2 7]))))
+
+(deftest test-include?
+ (is (include? 5 [1 2 3 4 5]))
+ (is (include? :bar '(1 4 :bar)))
+ (is (not (include? 2 '(1 3 4))))
+ (is (not (include? :foo [1 :bar :baz 3]))))
+
+(deftest test-unfold
+ (is (= [0 1 1 2 3 5 8 13 21 34]
+ (take 10 (unfold (fn [[a b]]
+ [a [b (+ a b)]])
+ [0 1])))))
+
+(deftest test-take-shuffled
+ (let [nums (set (range 10))]
+ (is (= nums (set (take-shuffled (count nums) nums))))
+ (is (= 5 (count (take-shuffled 5 nums))))
+ (is (subset? (set (take-shuffled 3 nums)) nums))))
+
+(deftest test-find-first
+ (is (= 5 (find-first odd? [2 5 9])))
+ (is (nil? (find-first (constantly false) (range 1000)))))
+
+(deftest test-lazy-loop
+ (is (= (range 10)
+ (lazy-loop [i 0]
+ (when-not (= i 10)
+ (cons i (lazy-recur (inc i))))))))
+
+(deftest test-alternates
+ (is (= '[[a b] [1 2]]
+ (alternates '[a 1 b 2])))
+ (is (= '[[0 3 6] [1 4 7] [2 5 8]]
+ (alternates 3 (range 9)))))
+
+(deftest test-slice
+ (let [size 900, slices 7, coll (range size),
+ sliced (slice slices coll), largest (apply max (map count sliced))]
+ (testing "We get all the items back in order"
+ (is (= coll (apply concat sliced))))
+ (testing "We get the right number of slices"
+ (is (= slices (count sliced))))
+ (testing "Slices are sized regularly"
+ (is (every? #(<= (Math/abs (- % largest)) 1)
+ (map count sliced))))))
+
+(deftest test-foldr
+ (is (= [1 2 3 4]
+ (foldr cons nil [1 2 3 4]))))
+
+(deftest test-lazy
+ (let [realized (atom 0)
+ realize (fn [x] (swap! realized inc) x)
+ the-list (lazy (realize 1) (realize 2))]
+ (is (= 0 @realized))
+ (is (= 1 (first the-list)))
+ (is (= 1 @realized))
+ (is (= 2 (second the-list)))
+ (is (= 2 @realized))
+ (is (nil? (next (next the-list))))
+ (is (= 2 @realized))))