pax_global_header00006660000000000000000000000064134023031450014505gustar00rootroot0000000000000052 comment=16011d0a026373a6554110b713222c78fbd7d82a useful-0.11.6/000077500000000000000000000000001340230314500130755ustar00rootroot00000000000000useful-0.11.6/.github/000077500000000000000000000000001340230314500144355ustar00rootroot00000000000000useful-0.11.6/.github/CODEOWNERS000066400000000000000000000000211340230314500160210ustar00rootroot00000000000000* @danielcompton useful-0.11.6/.gitignore000066400000000000000000000001751340230314500150700ustar00rootroot00000000000000.cake pom.xml *.jar *~ lib/ classes/ build/ docs .lein* bin/ target/ .settings/ .ritz* .project .classpath doc/ /.nrepl-port useful-0.11.6/.travis.yml000066400000000000000000000001241340230314500152030ustar00rootroot00000000000000language: clojure script: lein testall jdk: - oraclejdk8 - oraclejdk11 - openjdk-ea useful-0.11.6/CHANGELOG.md000066400000000000000000000005431340230314500147100ustar00rootroot00000000000000# Changelog All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). ## Unreleased ## 0.11.6 - 2018-12-07 ### Fixed - Fix lazy-loop's support for destructured bindings useful-0.11.6/LICENSE000066400000000000000000000257641340230314500141200ustar00rootroot00000000000000Eclipse Public License - v 1.0 THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 1. DEFINITIONS "Contribution" means: a) in the case of the initial Contributor, the initial code and documentation distributed under this Agreement, and b) in the case of each subsequent Contributor: i) changes to the Program, and ii) additions to the Program; where such changes and/or additions to the Program originate from and are distributed by that particular Contributor. A Contribution 'originates' from a Contributor if it was added to the Program by such Contributor itself or anyone acting on such Contributor's behalf. Contributions do not include additions to the Program which: (i) are separate modules of software distributed in conjunction with the Program under their own license agreement, and (ii) are not derivative works of the Program. "Contributor" means any person or entity that distributes the Program. "Licensed Patents" mean patent claims licensable by a Contributor which are necessarily infringed by the use or sale of its Contribution alone or when combined with the Program. "Program" means the Contributions distributed in accordance with this Agreement. "Recipient" means anyone who receives the Program under this Agreement, including all Contributors. 2. GRANT OF RIGHTS a) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free copyright license to reproduce, prepare derivative works of, publicly display, publicly perform, distribute and sublicense the Contribution of such Contributor, if any, and such derivative works, in source code and object code form. b) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free patent license under Licensed Patents to make, use, sell, offer to sell, import and otherwise transfer the Contribution of such Contributor, if any, in source code and object code form. This patent license shall apply to the combination of the Contribution and the Program if, at the time the Contribution is added by the Contributor, such addition of the Contribution causes such combination to be covered by the Licensed Patents. The patent license shall not apply to any other combinations which include the Contribution. No hardware per se is licensed hereunder. c) Recipient understands that although each Contributor grants the licenses to its Contributions set forth herein, no assurances are provided by any Contributor that the Program does not infringe the patent or other intellectual property rights of any other entity. Each Contributor disclaims any liability to Recipient for claims brought by any other entity based on infringement of intellectual property rights or otherwise. As a condition to exercising the rights and licenses granted hereunder, each Recipient hereby assumes sole responsibility to secure any other intellectual property rights needed, if any. For example, if a third party patent license is required to allow Recipient to distribute the Program, it is Recipient's responsibility to acquire that license before distributing the Program. d) Each Contributor represents that to its knowledge it has sufficient copyright rights in its Contribution, if any, to grant the copyright license set forth in this Agreement. 3. REQUIREMENTS A Contributor may choose to distribute the Program in object code form under its own license agreement, provided that: a) it complies with the terms and conditions of this Agreement; and b) its license agreement: i) effectively disclaims on behalf of all Contributors all warranties and conditions, express and implied, including warranties or conditions of title and non-infringement, and implied warranties or conditions of merchantability and fitness for a particular purpose; ii) effectively excludes on behalf of all Contributors all liability for damages, including direct, indirect, special, incidental and consequential damages, such as lost profits; iii) states that any provisions which differ from this Agreement are offered by that Contributor alone and not by any other party; and iv) states that source code for the Program is available from such Contributor, and informs licensees how to obtain it in a reasonable manner on or through a medium customarily used for software exchange. When the Program is made available in source code form: a) it must be made available under this Agreement; and b) a copy of this Agreement must be included with each copy of the Program. Contributors may not remove or alter any copyright notices contained within the Program. Each Contributor must identify itself as the originator of its Contribution, if any, in a manner that reasonably allows subsequent Recipients to identify the originator of the Contribution. 4. COMMERCIAL DISTRIBUTION Commercial distributors of software may accept certain responsibilities with respect to end users, business partners and the like. While this license is intended to facilitate the commercial use of the Program, the Contributor who includes the Program in a commercial product offering should do so in a manner which does not create potential liability for other Contributors. Therefore, if a Contributor includes the Program in a commercial product offering, such Contributor ("Commercial Contributor") hereby agrees to defend and indemnify every other Contributor ("Indemnified Contributor") against any losses, damages and costs (collectively "Losses") arising from claims, lawsuits and other legal actions brought by a third party against the Indemnified Contributor to the extent caused by the acts or omissions of such Commercial Contributor in connection with its distribution of the Program in a commercial product offering. The obligations in this section do not apply to any claims or Losses relating to any actual or alleged intellectual property infringement. In order to qualify, an Indemnified Contributor must: a) promptly notify the Commercial Contributor in writing of such claim, and b) allow the Commercial Contributor tocontrol, and cooperate with the Commercial Contributor in, the defense and any related settlement negotiations. The Indemnified Contributor may participate in any such claim at its own expense. For example, a Contributor might include the Program in a commercial product offering, Product X. That Contributor is then a Commercial Contributor. If that Commercial Contributor then makes performance claims, or offers warranties related to Product X, those performance claims and warranties are such Commercial Contributor's responsibility alone. Under this section, the Commercial Contributor would have to defend claims against the other Contributors related to those performance claims and warranties, and if a court requires any other Contributor to pay any damages as a result, the Commercial Contributor must pay those damages. 5. NO WARRANTY EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the appropriateness of using and distributing the Program and assumes all risks associated with its exercise of rights under this Agreement , including but not limited to the risks and costs of program errors, compliance with applicable laws, damage to or loss of data, programs or equipment, and unavailability or interruption of operations. 6. DISCLAIMER OF LIABILITY EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 7. GENERAL If any provision of this Agreement is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this Agreement, and without further action by the parties hereto, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable. If Recipient institutes patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Program itself (excluding combinations of the Program with other software or hardware) infringes such Recipient's patent(s), then such Recipient's rights granted under Section 2(b) shall terminate as of the date such litigation is filed. All Recipient's rights under this Agreement shall terminate if it fails to comply with any of the material terms or conditions of this Agreement and does not cure such failure in a reasonable period of time after becoming aware of such noncompliance. If all Recipient's rights under this Agreement terminate, Recipient agrees to cease use and distribution of the Program as soon as reasonably practicable. However, Recipient's obligations under this Agreement and any licenses granted by Recipient relating to the Program shall continue and survive. Everyone is permitted to copy and distribute copies of this Agreement, but in order to avoid inconsistency the Agreement is copyrighted and may only be modified in the following manner. The Agreement Steward reserves the right to publish new versions (including revisions) of this Agreement from time to time. No one other than the Agreement Steward has the right to modify this Agreement. The Eclipse Foundation is the initial Agreement Steward. The Eclipse Foundation may assign the responsibility to serve as the Agreement Steward to a suitable separate entity. Each new version of the Agreement will be given a distinguishing version number. The Program (including Contributions) may always be distributed subject to the version of the Agreement under which it was received. In addition, after a new version of the Agreement is published, Contributor may elect to distribute the Program (including its Contributions) under the new version. Except as expressly stated in Sections 2(a) and 2(b) above, Recipient receives no rights or licenses to the intellectual property of any Contributor under this Agreement, whether expressly, by implication, estoppel or otherwise. All rights in the Program not expressly granted under this Agreement are reserved. This Agreement is governed by the laws of the State of Washington and the intellectual property laws of the United States of America. No party to this Agreement will bring a legal action under this Agreement more than one year after the cause of action arose. Each party waives its rights to a jury trial in any resulting litigation. useful-0.11.6/README.md000066400000000000000000000015231340230314500143550ustar00rootroot00000000000000# Useful A collection of generally-useful Clojure utility functions. [![Build Status](https://www.travis-ci.org/clj-commons/useful.svg)](https://www.travis-ci.org/clj-commons/useful) ![lein dependency](https://clojars.org/org.flatland/useful/latest-version.svg) [![cljdoc badge](https://cljdoc.org/badge/org.flatland/useful)](https://cljdoc.org/d/org.flatland/useful/CURRENT) ## History useful was originally created by [Alan Malloy](https://github.com/amalloy) and was part of the [flatland](https://github.com/flatland) organisation. In December 2018 it was moved to CLJ Commons for continued maintenance. It could previously be found at [amalloy/useful](https://github.com/amalloy/useful) and [flatland/useful](https://github.com/flatland/useful). [clj-commons/useful](https://github.com/clj-commons/useful) is the canonical repository now. useful-0.11.6/build-docs.sh000077500000000000000000000005511340230314500154620ustar00rootroot00000000000000#!/bin/sh set -e lein doc echo "*** Docs built ***" tmpdir=`mktemp -d /tmp/flatland-useful.XXXXXX` mv doc/** $tmpdir rmdir doc git checkout gh-pages git rm -rf . mv $tmpdir/** . git add -Av . git commit -m "Updated docs" echo "*** gh-pages branch updated ***" rmdir $tmpdir git checkout - echo "Run this to complete:" echo "git push origin gh-pages:gh-pages" useful-0.11.6/project.clj000066400000000000000000000020451340230314500152360ustar00rootroot00000000000000(defproject org.flatland/useful "0.11.6" :description "A collection of generally-useful Clojure utility functions" :license {:name "Eclipse Public License - v 1.0" :url "http://www.eclipse.org/legal/epl-v10.html" :distribution :repo} :url "https://github.com/amalloy/useful" :dependencies [[org.clojure/clojure "1.9.0"] [org.clojure/tools.macro "0.1.1"] [org.clojure/tools.reader "0.7.2"]] :aliases {"testall" ["with-profile" "1.6:1.7:1.8:1.9:1.10" "test"]} :profiles {:1.10 {:dependencies [[org.clojure/clojure "1.10.0-RC3"]]} :1.9 {} :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]} :1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]}} :deploy-repositories [["releases" :clojars] ["snapshots" :clojars]] :plugins [[codox "0.8.0"]] :codox {:src-dir-uri "http://github.com/flatland/useful/blob/develop/" :src-linenum-anchor-prefix "L"}) useful-0.11.6/src/000077500000000000000000000000001340230314500136645ustar00rootroot00000000000000useful-0.11.6/src/flatland/000077500000000000000000000000001340230314500154515ustar00rootroot00000000000000useful-0.11.6/src/flatland/useful/000077500000000000000000000000001340230314500167545ustar00rootroot00000000000000useful-0.11.6/src/flatland/useful/bean.clj000066400000000000000000000025561340230314500203630ustar00rootroot00000000000000(ns flatland.useful.bean "Modify bean attributes in clojure." (:require [clojure.string :as s]) (:import (java.beans Introspector PropertyDescriptor) (java.lang.reflect Method))) (defn- property-key [^PropertyDescriptor property] (keyword (-> property .getName (s/replace #"\B([A-Z])" "-$1") .toLowerCase))) (defn property-setters "Returns a map of keywords to property setter methods for a given class." [class] (reduce (fn [map ^PropertyDescriptor property] (assoc map (property-key property) (.getWriteMethod property))) {} (.getPropertyDescriptors (Introspector/getBeanInfo class)))) (defmulti coerce (fn [bean-class type val] [type (class val)])) (defmethod coerce :default [_ type val] (when-not (nil? val) (try (cast type val) (catch ClassCastException e val)))) (defn update-bean "Update the given bean instance with attrs by calling the appropriate setter methods on it." [instance attrs] (let [bean-class (class instance) setters (property-setters bean-class)] (doseq [[key val] attrs] (if-let [^Method setter (setters key)] (let [type (first (.getParameterTypes setter))] (.invoke setter instance (to-array [(coerce bean-class type val)]))) (throw (Exception. (str "property not found for " key))))) instance)) useful-0.11.6/src/flatland/useful/cli.clj000066400000000000000000000031631340230314500202200ustar00rootroot00000000000000(ns flatland.useful.cli (:refer-clojure :exclude [update]) (:use [flatland.useful.experimental :only [cond-let]] [flatland.useful.map :only [update]])) (defn- parse-opt [default opts arg] (let [m re-matches key (comp keyword str) into-vec (fnil into []) conj-vec (fnil conj [])] (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)))useful-0.11.6/src/flatland/useful/compress.clj000066400000000000000000000011351340230314500213010ustar00rootroot00000000000000(ns flatland.useful.compress (:import [java.util.zip DeflaterOutputStream InflaterInputStream] [java.io ByteArrayOutputStream ByteArrayInputStream] [sun.misc BASE64Decoder BASE64Encoder])) (defn smash [^String str] (let [out (ByteArrayOutputStream.)] (doto (DeflaterOutputStream. out) (.write (.getBytes str)) (.finish)) (-> (BASE64Encoder.) (.encodeBuffer (.toByteArray out))))) (defn unsmash [^String str] (let [bytes (-> (BASE64Decoder.) (.decodeBuffer str)) in (ByteArrayInputStream. bytes)] (slurp (InflaterInputStream. in)))) useful-0.11.6/src/flatland/useful/config.clj000066400000000000000000000016301340230314500207130ustar00rootroot00000000000000(ns flatland.useful.config (:require [clojure.java.io :as io])) (defn read-config [filename & {:keys [optional]}] (let [resource (io/resource filename)] (if resource (with-open [in (java.io.PushbackReader. (io/reader resource))] (let [eof (Object.) forms (take-while (complement #{eof}) (repeatedly #(binding [*read-eval* false] (read in false eof))))] (if-let [error (cond (empty? forms) "No config data in %s" (next forms) "Too many forms in %s")] (throw (IllegalArgumentException. (format error filename))) (first forms)))) (when-not optional (throw (java.io.FileNotFoundException. (format "Cannot find config resource %s" filename))))))) (defn load-config [filename & args] (eval (apply read-config filename args))) useful-0.11.6/src/flatland/useful/datatypes.clj000066400000000000000000000115561340230314500214540ustar00rootroot00000000000000(ns flatland.useful.datatypes (:refer-clojure :exclude [update]) (:use [flatland.useful.map :only [position into-map update]] [flatland.useful.utils :only [invoke]] [flatland.useful.fn :only [fix]]) (:require [clojure.string :as s]) (:import (java.lang.reflect Field) (clojure.lang Compiler$LocalBinding))) (defn as-int [x] (condp invoke x integer? x string? (Integer/parseInt x) float? (int x) nil)) (let [munge-ops [["?" "_QMARK_"] ["!" "_BANG_"] ["-" "_"]] munger (fn [f] (fn [field] (symbol (reduce (fn [^String s op] (let [[from to] (f op)] (.replaceAll s (java.util.regex.Pattern/quote from) to))) (name field) munge-ops))))] (def clj->java (munger seq)) (def java->clj (munger rseq))) (defn- ^Class coerce-class "Get a Class object from either a Symbol (by resolving it) or a Class." [type] (fix type symbol? resolve)) (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] (record-fields type clj->java)) ([type lang] (->> (.getDeclaredFields (coerce-class type)) (remove #(java.lang.reflect.Modifier/isStatic (.getModifiers ^Field %))) (remove #(let [name (.getName ^Field %)] (and (not (#{"__extmap" "__meta"} name)) (.startsWith name "__")))) (map #(lang (.getName ^Field %)))))) (defmacro make-record "Construct a record given a pairs of lists and values. Mapping fields into constuctor arguments is done at compile time, so this is more efficient than creating an empty record and calling merge." [type & attrs] (let [fields (record-fields type clj->java) index (position fields) vals (reduce (fn [vals [field val]] (if-let [i (index (clj->java field))] (assoc vals i val) (assoc-in vals [(index '__extmap) (keyword field)] val))) (vec (repeat (count fields) nil)) (into-map attrs))] `(new ~type ~@vals))) (defn- type-hint [form &env fn-name] (or (:tag (meta form)) (let [^Compiler$LocalBinding binding (get &env form)] (and binding (.hasJavaClass binding) (.getJavaClass binding))) (throw (Exception. (str "type hint required on record to use " fn-name))))) (defmacro assoc-record "Assoc attrs into a record. Mapping fields into constuctor arguments is done at compile time, so this is more efficient than calling assoc on an existing record." [record & attrs] (let [r (gensym 'record) type (type-hint record &env 'assoc-record) fields (record-fields type clj->java) index (position fields) vals (reduce (fn [vals [field val]] (if-let [i (index (clj->java field))] (assoc vals i val) (assoc-in vals [(index '__extmap) (keyword field)] val))) (vec (map #(list '. r %) fields)) (into-map attrs))] `(let [~r ~record] (new ~type ~@vals)))) (defmacro update-record "Construct a record given a list of forms like (update-fn record-field & args). Mapping fields into constuctor arguments is done at compile time, so this is more efficient than calling assoc on an existing record." [record & forms] (let [r (gensym 'record) type (type-hint record &env 'update-record) fields (record-fields type clj->java) index (position fields) vals (reduce (fn [vals [f field & args]] (if-let [i (index (clj->java field))] (assoc vals i `(~f ~(get vals i) ~@args)) (let [i (index '__extmap)] (assoc vals i `(update ~(get vals i) ~(keyword field) ~@args))))) (vec (map #(list '. r %) fields)) forms)] `(let [~r ~record] (new ~type ~@vals)))) (defmacro record-accessors "Defines optimized macro accessors using interop and typehints for all fields in the given records." [& types] `(do ~@(for [type types :let [tag (symbol (.getName (coerce-class type)))] field (record-fields type clj->java) :when (not (.startsWith (name field) "__"))] `(defmacro ~(java->clj field) [~'record] (with-meta (list '. (with-meta ~'record {:tag '~tag}) '~field) (meta ~'&form)))))) useful-0.11.6/src/flatland/useful/debug.clj000066400000000000000000000033331340230314500205360ustar00rootroot00000000000000(ns flatland.useful.debug) ;; leave out of ns decl so we can load with classlojure.io/resource-forms (require '[clojure.pprint :as p]) (require '[clojure.stacktrace :as s]) (letfn [(interrogate-form [list-head form] `(let [display# (fn [val#] (let [form# (with-out-str (clojure.pprint/with-pprint-dispatch clojure.pprint/code-dispatch (clojure.pprint/pprint '~form))) val# (with-out-str (clojure.pprint/pprint val#))] (~@list-head (if (every? (partial > clojure.pprint/*print-miser-width*) [(count form#) (count val#)]) (str (subs form# 0 (dec (count form#))) " is " val#) (str form# "--------- is ---------\n" val#)))))] (try (doto ~form display#) (catch Throwable t# (display# {:thrown t# :trace (with-out-str (clojure.stacktrace/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 `(#(do (print %) (flush))) val)) (defmacro ^{:dont-test "Complicated to test, and should work if ? does"} ?! ([val] `(?! "/tmp/spit" ~val)) ([file val] (interrogate-form `(#(spit ~file % :append true)) val)))) useful-0.11.6/src/flatland/useful/deftype.clj000066400000000000000000000123621340230314500211120ustar00rootroot00000000000000(ns flatland.useful.deftype (:use [flatland.useful.experimental.delegate :only [parse-deftype-specs emit-deftype-specs]] [flatland.useful.map :only [merge-in]]) (:require [clojure.string :as s]) (:import (clojure.lang IObj MapEntry IPersistentVector IPersistentMap APersistentMap MapEquivalence) (java.util Map Map$Entry))) ;; to define a new map type, you still must provide: ;; - IPersistentMap: ;; - (.count this) ;; - (.valAt this k not-found) ;; - (.empty this) ;; - (.assoc this k v) ;; - (.without this k) ;; - (.seq this) ;; - recommended but not required: (.entryAt this k) ;; - IObj ;; - (.meta this) ;; - (.withMeta this m) (defmacro defmap [name fields & specs] `(deftype ~name ~fields ~@(emit-deftype-specs (->> (parse-deftype-specs specs) (merge-in (parse-deftype-specs `(java.util.Map (size [this#] (count this#)) (containsKey [this# k#] (contains? this# k#)) (isEmpty [this#] (empty? this#)) (keySet [this#] (set (keys this#))) (values [this#] (vals this#)) (get [this# k#] (get this# k#)) (containsValue [this# v#] (boolean (seq (filter #(= % v#) (vals this#))))) Object (toString [this#] (str "{" (s/join ", " (for [[k# v#] this#] (str k# " " v#))) "}")) (equals [this# other#] (= this# other#)) (hashCode [this#] (APersistentMap/mapHash this#)) clojure.lang.IFn (invoke [this# k#] (get this# k#)) (invoke [this# k# not-found#] (get this# k# not-found#)) MapEquivalence IPersistentMap (equiv [this# other#] (and (instance? Map other#) (or (instance? MapEquivalence other#) (not (instance? IPersistentMap other#))) (= (count this#) (count other#)) (every? (fn [e#] (let [k# (key e#) o# ^Map other#] (and (.containsKey o# k#) (= (.get o# k#) (val e#))))) (seq this#)))) (entryAt [this# k#] (let [not-found# (Object.) v# (get this# k# not-found#)] (when (not= v# not-found#) (MapEntry. k# v#)))) (valAt [this# k#] (get this# k# nil)) (cons [this# obj#] (condp instance? obj# Map$Entry (assoc this# (key obj#) (val obj#)) IPersistentVector (if (= 2 (count obj#)) (assoc this# (nth obj# 0) (nth obj# 1)) (throw (IllegalArgumentException. "Vector arg to map conj must be a pair"))) (reduce (fn [m# e#] (assoc m# (key e#) (val e#))) this# obj#))) (iterator [this#] (clojure.lang.SeqIterator. (seq this#)))))))))) (defmap AList [entries meta] IPersistentMap (count [this] (count entries)) (valAt [this k not-found] (if-let [e (find this k)] (val e) not-found)) (entryAt [this k] (first (filter #(= k (key %)) entries))) (empty [this] (AList. () meta)) (seq [this] (seq entries)) (assoc [this k v] (AList. (conj entries (MapEntry. k v)) meta)) (without [this k] (AList. (->> entries (remove #(= k (key %))) (apply list)) meta)) IObj (meta [this] meta) (withMeta [this meta] (AList. entries meta))) (defn alist "A map stored like a common-lisp alist, ie a seq of [key, value] pairs. A new entry can simply be consed onto the front, without having to do any additional work to update the rest of the entries." [& kvs] (AList. (apply list (map vec (partition 2 kvs))) nil)) useful-0.11.6/src/flatland/useful/dispatch.clj000066400000000000000000000036731340230314500212560ustar00rootroot00000000000000(ns flatland.useful.dispatch (:use [flatland.useful.map :only [into-map]] [flatland.useful.fn :only [any]] [flatland.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) publics (memoize (fn [ns] (try (require ns) (ns-publics (find-ns ns)) (catch java.io.FileNotFoundException e))))] (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 (get (publics ns) method) 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#)))))useful-0.11.6/src/flatland/useful/exception.clj000066400000000000000000000013021340230314500214400ustar00rootroot00000000000000(ns flatland.useful.exception (:use [clojure.stacktrace :only [print-cause-trace]] [clojure.string :only [split-lines trim]])) (defmacro rescue "Evaluate form, returning error-form on any Exception." [form error-form] `(try ~form (catch Exception e# ~error-form))) (defn cause-trace "Return an Exception's cause trace as an array of lines" [exception] (map trim (split-lines (with-out-str (print-cause-trace exception))))) (defn exception-map "Return a map with the keys: :name, :message, and :trace. :trace is the cause trace as an array of lines " [exception] {:name (.getName (class exception)) :message (.getMessage exception) :trace (cause-trace exception)}) useful-0.11.6/src/flatland/useful/experimental.clj000066400000000000000000000243141340230314500221470ustar00rootroot00000000000000(ns flatland.useful.experimental (:use [flatland.useful.utils :only [split-vec]] [flatland.useful.seq :only [alternates find-first]] [flatland.useful.map :only [keyed]] [clojure.tools.macro :only [name-with-attributes]] [flatland.useful.fn :only [any as-fn knit]])) (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)))) (defmacro order-let-if "If predicate is true, bind the names provided, otherwise reverse those bindings. Example: (order-let-if false [a \"foo\" b \"bar\"] [a b]) = [\"bar\" \"foo\"]" [pred bindings & body] `(if ~pred (let ~bindings ~@body) (let ~(vec (let [parts (partition 2 bindings)] (mapcat #(vector % (second %2)) (reverse (map first parts)) parts))) ~@body))) (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)))))) (defn wrap-with ^{:dont-test "Tested by make-wrappable!, wrap-multiple"} [f wrapper-var & [name]] (with-meta (fn [& args] (let [wrappers (not-empty @wrapper-var)] (if-not wrappers (apply f args) (with-bindings {wrapper-var (vary-meta wrappers assoc ::call-data {:fn-name name})} (apply (reduce (fn [f wrapper] (wrapper f)) f wrappers) args))))) (meta f))) (defn make-wrappable! [fn-var wrappers-var & [name]] (alter-var-root fn-var wrap-with wrappers-var name)) (defmacro wrap-multiple [wrappers-var & fn-syms] (cons `do (for [f fn-syms] `(make-wrappable! #'~f ~wrappers-var '~f)))) (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)] `(doto (defn ~name ~@macro-args) (make-wrappable! ~wrappers-var '~name)))) (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)) (defn fixes "Like fix, but each clause is tested whether or not the previous clauses matched, so multiple transformations may be applied. Unlike fix, fixes does not support a final one-element \"pair\"." [x & clauses] (if (odd? (count clauses)) (throw (IllegalArgumentException. "Fixes does not support a fallback clause.")) (reduce (fn [acc [pred transform]] (if ((as-fn pred) acc) ((as-fn transform) acc) acc)) x (partition 2 clauses)))) (defn lift-meta "Move some of the keys from m into its metadata, overriding existing values. (lift-meta {:a 1 :b 2} [:a]) -> ^{:a 1} {:b 2}" [m & ks] (-> (apply dissoc m ks) (vary-meta merge (select-keys m ks)))) (defn prefix-lookup "Takes a map whose keys are names, and returns a function that does fast prefix matching on its input against the names in the original map, returning the first value whose key is a prefix. If order is important (eg because your prefixes overlap, or you want to test common prefixes first for performance), you can pass a sequence of pairs instead of a map." [prefix-map] (let [name-pairs (map (knit name identity) prefix-map)] (fn [^String s] (when-let [pair (find-first #(.startsWith s (first %)) name-pairs)] (second pair))))) useful-0.11.6/src/flatland/useful/experimental/000077500000000000000000000000001340230314500214515ustar00rootroot00000000000000useful-0.11.6/src/flatland/useful/experimental/delegate.clj000066400000000000000000000107771340230314500237310ustar00rootroot00000000000000(ns flatland.useful.experimental.delegate (:use flatland.useful.debug) (:require [flatland.useful.ns :as ns])) (defn canonical-name "Resolve a symbol in the current namespace; but intead of returning its value, return a canonical name that can be used to name the same thing in any namespace." [sym] (if-let [val (resolve sym)] (condp instance? val java.lang.Class (symbol (pr-str val)) clojure.lang.Var (ns/var-name val) (throw (IllegalArgumentException. (format "%s names %s, an instance of %s, which has no canonical name." sym val (class val))))) sym)) (defn parse-deftype-specs "Given a mess of deftype specs, possibly with classes/interfaces specified multiple times, collapse it into a map like {interface => (method1 method2...)}. Needed because core.deftype only allows specifying a class ONCE, so our delegating versions would clash with client's custom methods." [decls] (loop [ret {}, curr-key nil, decls decls] (if-let [[x & xs] (seq decls)] (if (seq? x) (let [mname (symbol (name (first x))) nargs (count (second x))] (recur (assoc-in ret [curr-key [mname nargs]] x), curr-key, xs)) (let [interface-name (canonical-name x)] (recur (update-in ret [interface-name] #(or % {})), interface-name, xs))) ret))) (defn emit-deftype-specs "Given a map returned by aggregate, spit out a flattened deftype body." [specs] (apply concat (for [[interface methods] specs] (cons interface (for [[[method-name num-args] method] methods] method))))) (letfn [;; Output the method body for a delegating implementation (delegating-method [method-name args delegate] `(~method-name [~'_ ~@args] (. ~delegate (~method-name ~@args)))) ;; Create a series of Interface (method...) (method...) expressions, ;; suitable for creating the entire body of a deftype or reify. (type-body [delegate-map other-args] (let [our-stuff (for [[send-to interfaces] delegate-map [interface which] interfaces :let [send-to (vary-meta send-to assoc :tag interface)] [name args] which] [interface (delegating-method name args send-to)])] (emit-deftype-specs (parse-deftype-specs (apply concat other-args our-stuff)))))] (defmacro delegating-deftype "Shorthand for defining a new type with deftype, which delegates the methods you name to some other object or objects. Delegates are usually a member field, but can be any expression: the expression will be evaluated every time a method is delegated. The delegate object (or expression) will be type-hinted with the type of the interface being delegated. The delegate-map argument should be structured like: {object-to-delegate-to {Interface1 [(method1 []) (method2 [foo bar baz])] Interface2 [(otherMethod [other])]}, another-object {Interface1 [(method3 [whatever])]}}. This will cause your deftype to include an implementation of Interface1.method1 which does its work by forwarding to (.method1 object-to-delegate-to), and likewise for the other methods. Arguments will be forwarded on untouched, and you should not include a `this` parameter. Note especially that you can have methods from Interface1 implemented by delegating to multiple objects if you choose, and can also include custom implementations for the remaining methods of Interface1 if you have no suitable delegate. Arguments after `delegate-map` are as with deftype, although if deftype ever has options defined for it, delegating-deftype may break with them." [cname [& fields] delegate-map & deftype-args] `(deftype ~cname [~@fields] ~@(type-body delegate-map deftype-args))) (defmacro delegating-defrecord "Like delegating-deftype, but creates a defrecod body instead of a deftype." [cname [& fields] delegate-map & deftype-args] `(defrecord ~cname [~@fields] ~@(type-body delegate-map deftype-args))) (defmacro delegating-reify "Like delegating-deftype, but creates a reify body instead of a deftype." [delegate-map & reify-args] `(reify ~@(type-body delegate-map reify-args))))useful-0.11.6/src/flatland/useful/experimental/unicode.clj000066400000000000000000000005351340230314500235740ustar00rootroot00000000000000(ns ^{:dont-test "Just aliases for other functions/macros"} flatland.useful.experimental.unicode (:use [flatland.useful.utils :only [map-entry]] [flatland.useful.macro :only [macro-do]] [flatland.useful.ns :only [defalias]])) (macro-do [dest src] `(defalias ~dest ~src) ∮ map-entry ! complement ∘ comp φ partial) useful-0.11.6/src/flatland/useful/fn.clj000066400000000000000000000155521340230314500200610ustar00rootroot00000000000000(ns flatland.useful.fn) (def ! complement) (defn validator "Create a version of a predicate that only tests its output for truthiness, returning the original input value if the predicate evaluates to anything truthy, and nil otherwise. ((validator even?) 10) => 10, even though (even? 10) is true." [pred] (fn [x] (when (pred x) x))) (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 as-fn "Turn an object into a fn if it is not already, by wrapping it in constantly." [x] (if (ifn? x) x, (constantly 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 #((as-fn %) 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))) (defn fixing "A version of fix that fits better with the unified update model: instead of multiple clauses, additional args to the transform function are permitted. For example, (swap! my-atom fixing map? update-in [k] inc)" [x pred transform & args] (if ((as-fn pred) x) (apply (as-fn transform) x args) x)) (defmacro given "A macro combining the features of fix and fixing, by using parentheses to group the additional arguments to each clause: (-> x (given string? read-string map? (dissoc :x :y :z) even? (/ 2)))" [x & clauses] (let [[clauses default] (if (even? (count clauses)) [clauses `identity] [(butlast clauses) (last clauses)])] `(fix ~x ~@(for [[pred transform] (partition 2 clauses) arg [pred `#(-> % ~transform)]] arg) ~default))) (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 knit "Takes a list of functions (f1 f2 ... fn) and returns a new function F. F takes a collection of size n (x1 x2 ... xn) and returns a vector [(f1 x1) (f2 x2) ... (fn xn)]. Similar to Haskell's ***, and a nice complement to juxt (which is Haskell's &&&)." [& fs] (fn [arg-coll] (vec (map #(% %2) fs arg-coll)))) (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 ([] (f)) ([a] (if (nil? a) (f) (f a))) ([a b] (if (nil? a) (if (nil? b) (f) (f b)) (if (nil? b) (f a) (f a b)))) ([a b & more] (when-let [items (seq (remove nil? (list* a b more)))] (apply f items))))) (defn key-comparator "Given a transformation function (and optionally a direction), return a comparator which does its work by comparing the values of (transform x) and (transform y)." ([modifier] (fn [a b] (compare (modifier a) (modifier b)))) ([direction modifier] (let [f (key-comparator modifier)] (condp #(% %2) direction #{:desc :descending -} (comp - f) #{:asc :ascending +} f)))) (defn rate-limited "Create a version of a function which 'refuses' to be called too frequently. If it has successfully been called in the last N milliseconds, calls to it will return nil; if no calls have succeeded in that period, args will be passed along to the base function." [f ms-period] (let [tracker (atom {:last-sent 0})] (fn [& args] (when (:accepted (swap! tracker (fn [{:keys [last-sent]}] (let [now (System/currentTimeMillis) ok (< ms-period (- now last-sent))] {:accepted ok :last-sent (if ok now last-sent)})))) (apply f args))))) (defn memoize-last "A version of memoize that only remembers the result for a single input argument at a time. eg, if you call (f 1) (f 1) (f 2) (f 1), only the second call is memoized, because it is the same argument you just gave. The third and fourth calls see a new argument, and therefore refresh the cached value." [f] (let [cache (atom nil)] (fn [& args] (:value (swap! cache (fn [cache] (if (= args (get cache :args ::not-found)) cache {:args args, :value (apply f args)}))))))) (defn applied "A version of f that uses apply on its args." [f] (partial apply f)) (def ap "A shorthand version of applied" applied) (let [impl (delay (try (eval `(fn [x#] (if (keyword? x) ;; a case myssteriously not covered in equivPred (fn [y#] (identical? x# y#)) (let [p# (clojure.lang.Util/equivPred x#)] (fn [y#] (.equiv p# x# y#)))))) (catch Exception e ;; running some version prior to equivPred (fn [x] (fn [y] (= x y))))))] (defn =to "Produces an equality predicate from a single object. ((=to x) y) is the same as (= x y), but if the returned function will be called many times it may be more efficient than repeated calls to =, because =to can short-circuit many irrelevant code paths based on knowing the type of x. Just a wrapper for clojure.lang.Util/equivPred." [x] (@impl x))) useful-0.11.6/src/flatland/useful/io.clj000066400000000000000000000050211340230314500200530ustar00rootroot00000000000000(ns flatland.useful.io (:use [clojure.java.io :only [reader]] [flatland.useful.ns :only [defalias]] [flatland.useful.map :only [keyed]]) (:require [clojure.tools.reader.edn :as edn]) (:import (java.io Reader PushbackReader ByteArrayInputStream ByteArrayOutputStream DataOutputStream DataInputStream RandomAccessFile) (java.nio.channels FileChannel$MapMode))) (defprotocol PushbackFactory (^{:added "1.4"} pushback-reader [x] "Creates a PushbackReader from an object.")) (extend-protocol PushbackFactory PushbackReader (pushback-reader [this] this) Reader (pushback-reader [this] (PushbackReader. this)) Object (pushback-reader [this] (pushback-reader (reader this)))) (defalias pbr pushback-reader) (let [sentinel (Object.) valid? #(not (identical? % sentinel))] (defn read-seq "Read a lazy sequence of Clojure forms from an input reader." [in] (let [in (pushback-reader in)] (take-while valid? (repeatedly #(edn/read {:eof sentinel} in)))))) (defn bytes->long "Read the first eight bytes of a byte-array and convert them to a Long using the standard network order (by delegating to DataInputStream)." [bytes] (-> bytes (ByteArrayInputStream.) (DataInputStream.) (.readLong))) (defn long->bytes "Create an eight-byte array from a Long, using the standard network order (by delegating to DataOutputStream)." [long] (-> (ByteArrayOutputStream. 8) (doto (-> (DataOutputStream.) (.writeLong long))) (.toByteArray))) (defn compare-bytes [^"[B" a ^"[B" b] (let [alen (alength a) blen (alength b) len (int (min alen blen))] (loop [idx (int 0)] (if (= idx len) (compare alen blen) (let [ai (long (aget a idx)) bi (long (aget b idx)) neg-ai? (neg? ai) diff (if (= neg-ai? (neg? bi)) (unchecked-subtract ai bi) (if neg-ai? 1 -1))] ;; cannot subtract if signs are different (if (zero? diff) (recur (unchecked-inc-int idx)) diff)))))) (defn mmap-file "Memory map a file. Returns a map containing a :buffer key which holds the mapped buffer and a :close key containing a function that, when called, closes the file." [^RandomAccessFile file] (let [channel (.getChannel file) buffer (.map channel FileChannel$MapMode/READ_WRITE 0 (.size channel)) close #(.close file)] (keyed [buffer close]))) useful-0.11.6/src/flatland/useful/java.clj000066400000000000000000000042151340230314500203710ustar00rootroot00000000000000(ns flatland.useful.java (:import (java.lang.reflect Method))) (defn ^{:dont-test "Can't test killing the JVM"} abort "Print message then exit." [& message] (apply println message) (System/exit 1)) (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 (class instance)] (when-let [^Method method (some #(try (.getDeclaredMethod ^Class % 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." [^Runnable f] (.addShutdownHook (Runtime/getRuntime) (Thread. f))) (defmacro multi-hinted-let "Test expr for instance-of each class in classes. When a match is found, evaluate body with name bound to expr and type-hinted as the matching class. For example, (multi-hinted-let [x {:foo 1} [Collection Map]] (.size x))." [[name expr classes] & body] (let [x (gensym)] `(let [~x ~expr] (condp instance? ~x ~@(interleave classes (for [class classes] `(let [~(vary-meta name assoc :tag class) ~x] ~@body))) (throw (IllegalArgumentException. (str "No matching class for " ~x " in " '~classes))))))) useful-0.11.6/src/flatland/useful/macro.clj000066400000000000000000000031301340230314500205440ustar00rootroot00000000000000(ns flatland.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))))) useful-0.11.6/src/flatland/useful/map.clj000066400000000000000000000216601340230314500202300ustar00rootroot00000000000000(ns flatland.useful.map (:refer-clojure :exclude [update]) (:use [flatland.useful.utils :only [map-entry pop-if]] [flatland.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." ([m key val] (if (nil? (m key)) (assoc m key val) m)) ([m key val & kvs] (let [m (assoc-or m key val)] (if kvs (recur m (first kvs) (second kvs) (nnext kvs)) m)))) (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. If the first arg is a function, it will be used for merging duplicate 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." [m f & args] (when m (into {} (for [[k v] m] (map-entry k (apply f v args)))))) (defn map-keys "Create a new map from m by calling function f on each key to get a new key." [m f & args] (when m (into {} (for [[k v] m] (map-entry (apply f k args) 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." [m f & args] (when m (into {} (for [[k v] m] (map-entry k (apply f k v args)))))) (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" [m f & args] (when m (into {} (for [[k v] m] (map-entry (apply f k args) (apply f v args)))))) (defn dissoc-in* "Dissociates a value in a nested associative structure, where ks is a sequence of keys and returns a new nested structure. If any resulting maps are empty, they will be removed from the new structure. This implementation was adapted from clojure.core.contrib, but the behavior is more correct if keys is empty." [m keys] (if-let [[k & ks] (seq keys)] (let [old (get m k ::sentinel)] (if-not (= old ::sentinel) (let [new (dissoc-in* old ks)] (if (seq new) (assoc m k new) (dissoc m k))) m)) {})) (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. If any levels do not exist, hash-maps will be created. This implementation was adapted from clojure.core, but the behavior is more correct if keys is empty." [m keys v] (if-let [[k & ks] (seq keys)] (assoc m k (assoc-in* (get m k) ks v)) v)) (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. If any levels do not exist, hash-maps will be created. This implementation was adapted from clojure.core, but the behavior is more correct if keys is empty and unchanged values are not re-assoc'd." [m keys f & args] (if-let [[k & ks] (seq keys)] (let [old (get m k) new (apply update-in* old ks f args)] (if (identical? old new) m (assoc m k new))) (apply f m args))) (defn update "Update a value for the given key in a map where f is a function that takes the previous value and the supplied args and returns the new value. Like update-in*, unchanged values are not re-assoc'd." [m key f & args] (apply update-in* m [key] f args)) (defn update-each "Update the values for each of the given keys in a map where f is a function that takes each previous value and the supplied args and returns a new value. Like update-in*, unchanged values are not re-assoc'd." [m keys f & args] (reduce (fn [m key] (apply update-in* m [key] f args)) m keys)) (defn update-within "Like update-in*, but don't call f at all unless the map contains something at the given keyseq." [m keyseq f & args] (if (seq keyseq) (update-in* m (butlast keyseq) (fn [m*] (let [k (last keyseq)] (if (contains? m* k) (apply update m* k f args) m*)))) (apply f m args))) (letfn [(merge-in* [a b] (if (map? a) (merge-with merge-in* a b) b))] (defn merge-in "Merge multiple nested maps." [& args] (reduce merge-in* nil args))) (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 (distinct 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 m] (when m (for [[key val] m :when (pred val)] key))) (defn remove-keys-by-val "Returns all keys of map for which (pred value) returns false." [pred m] (filter-keys-by-val (complement pred) m)) (defn filter-vals [m pred] (when m (persistent! (reduce (fn [m [k v]] (if (pred v) m (dissoc! m k))) (transient m) m)))) (defn remove-vals "Returns a map that only contains values where (pred value) returns false." [m pred] (filter-vals m (complement pred))) (defn filter-keys "Returns a map that only contains keys where (pred key) returns true." [m pred] (when m (select-keys m (filter pred (keys m))))) (defn remove-keys "Returns a map that only contains keys where (pred key) returns false." [m pred] (filter-keys m (complement pred))) (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}))) (defn ordering-map "Create an empty map with a custom comparator that puts the given keys first, in the order specified. Other keys will be placed after the special keys, sorted by the default-comparator." ([key-order] (ordering-map key-order compare)) ([key-order default-comparator] (let [indices (into {} (map-indexed (fn [i x] [x i]) key-order))] (sorted-map-by (fn [a b] (if-let [a-idx (indices a)] (if-let [b-idx (indices b)] (compare a-idx b-idx) -1) (if-let [b-idx (indices b)] 1 (default-comparator a b)))))))) useful-0.11.6/src/flatland/useful/ns.clj000066400000000000000000000022131340230314500200640ustar00rootroot00000000000000(ns flatland.useful.ns) (defn var-name "Get the namespace-qualified name of a var." [v] (apply symbol (map str ((juxt (comp ns-name :ns) :name) (meta v))))) (defn alias-var "Create a var with the supplied name in the current namespace, having the same metadata and root-binding as the supplied var." [name ^clojure.lang.Var var] (apply intern *ns* (with-meta name (merge {:dont-test (str "Alias of " (var-name var))} (meta var) (meta name))) (when (.hasRoot var) [@var]))) (defmacro 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." [dst src] `(alias-var (quote ~dst) (var ~src))) (defn alias-ns "Create vars in the current namespace to alias each of the public vars in the supplied namespace." [ns-name] (require ns-name) (doseq [[name var] (ns-publics (the-ns ns-name))] (alias-var name var))) useful-0.11.6/src/flatland/useful/parallel.clj000066400000000000000000000034361340230314500212500ustar00rootroot00000000000000(ns flatland.useful.parallel (:use [flatland.useful.seq :only [slice]])) (def ^{:dynamic true} *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- assoc-noclobber "An assoc wrapper which ensures that existing keys will not be clobbered by subsequent assoc invocations. Used as a helper for locking-memoize to ensure that (delay) refs cannot be lost by swap! retry behavior." [m k v] (if (contains? m k) m (assoc m k v))) (defn pmemoize "Memoizes the function f, using the same approach as clojure.core/memoize. The practical difference is that this function provides the gurantee that in spite of parallel invocations of the memoized function each input to f will only ever be memoized once. This resolves an implementation detail in clojure.core/memoize which allows f to be applied to args without locking the cache to prevent other threads duplicating the work." [f] (let [mem (atom {})] (fn [ & args ] (if-let [e (find @mem args)] (deref (val e)) (-> (swap! mem assoc-noclobber args (delay (apply f args))) (get args) (deref)))))) useful-0.11.6/src/flatland/useful/seq.clj000066400000000000000000000427601340230314500202470ustar00rootroot00000000000000(ns flatland.useful.seq (:use [flatland.useful.fn :only [decorate]] [flatland.useful.utils :only [pair]]) (:import (java.util.concurrent LinkedBlockingQueue BlockingQueue))) (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] (lazy-seq (when (seq 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. Regular recurs are also supported, if they are in tail position and don't need any laziness." [bindings & body] (let [f 'lazy-recur [names values] (alternates bindings) blob-names (repeatedly (count names) gensym)] `(letfn [(~f [~@blob-names] (lazy-seq (iter# ~@blob-names))) (iter# [~@names] ~@body)] (~f ~@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 is a function that operates on a seed: it 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 next. If nil is returned instead of a pair, the resulting sequence will terminate. (defn fibs [] (unfold (fn [[a b]] [a [b (+ a b)]]) [0 1]))" [next seed] (lazy-loop [seed seed] (when-let [[val seed] (next seed)] (cons val (lazy-recur 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 "http://www.haskell.org/haskellwiki/Fold" [f start coll] (reduce #(f %2 %1) start (reverse coll))) (defn unchunk "Create a one-at-a-time sequence out of a chunked sequence." [s] (lazy-seq (when-let [s (seq s)] (cons (first s) (unchunk (rest s)))))) (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))))) (defn glue "Walk over an input sequence, \"gluing\" together elements to create batches. Batches may be of any type you like, and are computed as follows: - Each batch is initialized by combining init (default false) with next-item. - For each additional item in coll, functions glue? and unglue? are consulted to decide whether the next item should be included into the current batch. - If (glue? current-batch next-item) returns truthy, then a prospective updated-batch is computed, as (combine current-batch next-item). If (unglue? updated-batch) returns falsey, then updated-batch is accepted and may be used as the target for further gluing. - If glue? returned falsey, or unglue? returned truthy, then the current batch is inserted into the output sequence, and a new batch is started as (combine init next-item)." ([combine glue? coll] (glue combine nil glue? coll)) ([combine init glue? coll] (glue combine init glue? (constantly false) coll)) ([combine init glue? unglue? coll] (lazy-seq (when-let [coll (seq coll)] (lazy-loop [glob (combine init (first coll)), coll (rest coll)] (if-let [coll (seq coll)] (let [x (first coll) more (rest coll) glued (delay (combine glob x))] (if (and (glue? glob x) (not (unglue? @glued))) (recur @glued more) (cons glob (lazy-recur (combine init x) more)))) (list glob))))))) (defn partition-between "Partition an input seq into multiple sequences, as with partition-by. Walks the collection two at a time, calling (split? [a b]) for each pair. Any time split? returns truthy, the partition containing a ends, and a new one containing b begins. Note that the split? predicate should not take two arguments, but instead a single argument, a pair. Like partition-by, a lazy sequence of partitions is returned, but the partitions themselves are eager. For example, to cause each nil to be folded into the next partition: (partition-between (fn [[a b]] (not (nil? a))) '[1 nil nil 2 nil 3]) => ([1] [nil nil 2] [nil 3])" [split? coll] (glue conj [] (fn [v x] (not (split? [(peek v) x]))) (constantly false) coll)) (defn remove-prefix "Remove prefix from coll, returning the remaining suffix. Returns nil if prefix does not match coll." [prefix coll] (if (seq prefix) (and (seq coll) (= (first prefix) (first coll)) (recur (rest prefix) (rest coll))) coll)) (defn prefix-of? "Given prefix is N elements long, are the first N elements of coll equal to prefix?" [coll prefix] (boolean (remove-prefix prefix coll))) (defn merge-sorted "Merge N sorted sequences together, as in the merge phase of a merge-sort. Comparator should be a two-argument predicate like `<`, which returns true if its first argument belongs before its second element in the merged sequence. The collections themselves should already be sorted in the order your comparator would put them; otherwise ordering is undefined." ([comparator] nil) ([comparator xs] xs) ([comparator xs ys] (lazy-loop [xs xs, ys ys] (if-let [xs (seq xs)] (if-let [ys (seq ys)] (let [x (first xs), y (first ys)] (if (comparator x y) (cons x (lazy-recur (rest xs) ys)) (cons y (lazy-recur xs (rest ys))))) xs) ys))) ([comparator xs ys & more] (apply merge-sorted comparator (merge-sorted comparator xs ys) more))) (defn indexed "Returns a lazy sequence of pairs of index and item." [coll] (map-indexed pair coll)) (defn sequeue "A version of seque from clojure.core that uses a future instead of an agent. The agent version was causing problems because you can't depend on an agent from within another agent's action, which means you can't use seque inside an agent. This version is probably less performant, because it keeps a thread running until the sequence is entirely consumed, and it attempts to refill the queue as soon as there is space, rather than when the queue is emptied. More importantly, though, this version may be *DANGEROUS* if you are not careful: if you do not consume the entire output sequence, the future-thread will remain active indefinitely, blocking on the queue and holding the lazy sequence open, ineligible for garbage collection." ([s] (sequeue 100 s)) ([n-or-q s] (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q) n-or-q (LinkedBlockingQueue. (int n-or-q))) NIL (Object.) ;nil sentinel since LBQ doesn't support nils worker (future (try (loop [[x & xs :as s] (seq s)] (if s (do (.put q (if (nil? x) NIL x)) (recur xs)) (.put q q))) ; q itself is eos sentinel (catch Exception e (.put q q) (throw e))))] (lazy-loop [] (let [x (.take q)] (if (identical? x q) ;q itself is eos sentinel (do @worker nil) ;just to propagate errors (cons (if (identical? x NIL) nil x) (lazy-recur)))))))) (defn seque* "A version of clojure.core/seque that fixes a memory/thread-handle leak." {:added "1.0" :static true} ([s] (seque 100 s)) ([n-or-q s] (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q) n-or-q (LinkedBlockingQueue. (int n-or-q))) NIL (Object.) ;nil sentinel since LBQ doesn't support nils agt (agent (sequence s)) ; never start with nil; that signifies we've already put eos log-error (fn [q e] (if (.offer q q) (throw e) e)) fill (fn [s] (when s (if (instance? Exception s) ; we failed to .offer an error earlier (log-error q s) (try (loop [[x & xs :as s] (seq s)] (if s (if (.offer q (if (nil? x) NIL x)) (recur xs) s) (when-not (.offer q q) ; q itself is eos sentinel ()))) ; empty seq, not nil, so we know to put eos next time (catch Exception e (log-error q e)))))) drain (fn drain [] (lazy-seq (let [x (.take q)] (if (identical? x q) ;q itself is eos sentinel (do @agt nil) ;touch agent just to propagate errors (do (send-off agt fill) (cons (if (identical? x NIL) nil x) (drain)))))))] (send-off agt fill) (drain)))) (defn take-until "Take from coll up to and including the first item that satisfies pred." [pred coll] (lazy-seq (when-let [coll (seq coll)] (let [x (first coll)] (cons x (when-not (pred x) (take-until pred (rest coll)))))))) (defn map-nth "Calls f on every nth element of coll. If start is passed, starts at that element (counting from zero), otherwise starts with zero." ([f nth coll] (map-nth f 0 nth coll)) ([f start nth coll] (map #(% %2) (concat (repeat start identity) (cycle (cons f (repeat (dec nth) identity)))) coll))) (defn update-first "Returns a lazy-seq that is a version of coll with the first item matching pred updated by calling f on it with the supplied args." ([coll pred f] (lazy-seq (if-let [coll (seq coll)] (let [x (first coll) xs (rest coll)] (if (pred x) (cons (f x) xs) (cons x (update-first xs pred f)))) (list (f nil))))) ([coll pred f & args] (update-first coll pred #(apply f % args)))) (defn single? "Does coll have only one element?" [coll] (and (seq coll) (not (next coll)))) (defn assert-length "Assert, as a side effect, that coll has exactly len elements, and then return coll." [len coll] (if (zero? len) (assert (empty? coll) "Too many elements") (let [last-expected (nthnext coll (dec len))] (assert last-expected "Too few elements") (assert (not (next last-expected)) "Too many elements"))) coll) (defn flatten-all "Takes a nested collection and flattens it into one flat collection. Like clojure.core/flatten, but also works with maps and collections containing nested maps." [form] (remove coll? (tree-seq coll? seq form))) (defn groupings "Similar to clojure.core/group-by, but allowing you to specify how to add items to each group. For example, if you are grouping by :name, you may want to remove the :name key from each map before adding it to the list. So, you can specify #(dissoc % :name) as your transform. If you need finer-grained control, you can specify a reduce function for accumulating each group, rather than mapping over the items in it. For example, (groupings even? + 0 coll) finds you the sum of all odd numbers in coll and the sum of all even numbers in coll." ([group transform coll] (groupings group #(conj %1 (transform %2)) [] coll)) ([group reductor init coll] (loop [ret {}, coll (seq coll)] (if-not coll ret (let [x (first coll) category (group x)] (recur (assoc ret category (reductor (get ret category init) x)) (next coll))))))) (defn increasing* "Scans through a collection, comparing items via (comp (keyfn x) (keyfn y)), and finding those which are in increasing order. Each input item x is output once, as part of a pair, [included? x]. Those items which are part of an increasing sequence will have included? true, while any that go \"backwards\" from the current max will have included? false." [keyfn comp coll] (lazy-seq (when-first [x coll] (let [max (keyfn x)] (cons [true x] (lazy-loop [max max, coll (rest coll)] (when-first [x coll] (let [key (keyfn x)] (if (neg? (comp key max)) (cons [false x] (lazy-recur max (rest coll))) (cons [true x] (lazy-recur key (rest coll)))))))))))) (defn increasing "Throw away any elements from coll which are not in increasing order, according to keyfn and comp (used similarly to the arguments to sort-by)." ([coll] (increasing identity compare coll)) ([keyfn coll] (increasing keyfn compare coll)) ([keyfn comp coll] (map second (filter first (increasing* keyfn comp coll))))) useful-0.11.6/src/flatland/useful/state.clj000066400000000000000000000132701340230314500205710ustar00rootroot00000000000000(ns flatland.useful.state (:require [flatland.useful.time :as time]) (:use [flatland.useful.utils :only [returning]]) (:import [clojure.lang IDeref IObj] [java.util.concurrent ScheduledThreadPoolExecutor ThreadFactory])) (defprotocol Mutable (put! [self v])) (deftype Volatile [^{:volatile-mutable true} val validator meta] IDeref (deref [self] val) Mutable (put! [self v] (if (and validator (not (validator v))) (throw (IllegalStateException. "Invalid reference state")) (set! val v))) IObj (meta [self] meta) (withMeta [self meta] (Volatile. val validator meta))) (defn volatile "Creates and returns a Volatile with an initial value of x and zero or more options (in any order): :meta metadata-map :validator validate-fn If metadata-map is supplied, it will become the metadata on the Volatile. validate-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validate-fn should return false or throw an exception." ([x] (Volatile. x nil {})) ([x & options] (let [opts (apply hash-map options)] (Volatile. x (:validator opts) (:meta opts))))) (defn trade! "Like swap!, except it returns the old value of the atom." [atom f & args] (let [m (volatile nil)] (apply swap! atom (fn [val & args] (put! m val) (apply f val args)) args) @m)) (defn wait-until [reference pred] (let [curr @reference] ;; try to get out fast - not needed for correctness, just performance (if (pred curr) curr (let [result (promise)] (add-watch reference result (fn this [_ _ old new] (when (pred new) (try ;; multiple delivers throw an exception in clojure 1.2 (when (deliver result new) (remove-watch reference result)) (catch Exception e nil))))) (let [curr @reference] ; needed for correctness, in case it's become acceptable since adding ; watcher and will never change again (if (pred curr) (do (remove-watch reference result) curr) @result)))))) (let [executor (ScheduledThreadPoolExecutor. 1 (reify ThreadFactory (newThread [this r] (doto (Thread. r) (.setDaemon true)))))] (defn periodic-recompute "Takes a thunk and a duration (from flatland.useful.time), and yields a function that attempts to pre-cache calls to that thunk. The first time you call the returned function, it starts a background thread that re-computes the thunk's result according to the requested duration. If you call the returned function with no arguments, it blocks until some cached value is available; with one not-found argument, it returns the not-found value if no cached value has yet been computed. Take care: if the duration you specify causes your task to be scheduled again while it is still running, the task will wait in a queue. That queue will continue to grow unless your task is able to complete more quickly than the duration you specified." [f duration] (let [{:keys [unit num]} duration cache (agent {:ready false}) task (delay (.scheduleAtFixedRate executor (fn [] (send cache (fn [_] {:ready true :value (f)}))) 0, num unit)) get-ready (fn [] (do @task nil))] (fn ([] (do (get-ready) (:value (wait-until cache :ready)))) ([not-found] (do (get-ready) (let [{:keys [ready value]} @cache] (if ready value not-found)))))))) (defmacro with-altered-vars "Binds each var-name to the result of (apply f current-value args) for the dynamic scope of body. Basically like swap! or alter, but for vars. bindings should be a vector, each element of which should look like a function call: (with-altered-vars [(+ x 10)] body) ;; binds x to (+ x 10)" [bindings & body] `(binding [~@(for [[f var-name & args] bindings binding `[~var-name (~f ~var-name ~@args)]] binding)] ~@body)) (defmacro with-altered-roots "Use alter-var-root to temporarily modify the root bindings of some vars. For each var, the temporary value will be (apply f current-value args). bindings should be a vector, each element of which should look like a function call: (with-altered-roots [(+ x 10)] body) ;; sets x to (+ x 10) Use with caution: this is not thread-safe, and multiple concurrent calls can leave vars' root values in an unpredictable state." [bindings & body] (let [inits (gensym 'init-vals)] `(let [~inits (atom {})] ~@(for [[f var-name & args] bindings] (let [v (gensym var-name)] `(alter-var-root (var ~var-name) (fn [~v] (swap! ~inits assoc '~var-name ~v) (~f ~v ~@args))))) (returning (do ~@body) ~@(for [[f var-name & args] (reverse bindings)] `(alter-var-root (var ~var-name) (constantly ('~var-name @~inits)))))))) useful-0.11.6/src/flatland/useful/string.clj000066400000000000000000000031221340230314500207520ustar00rootroot00000000000000(ns flatland.useful.string (:require [clojure.string :as s])) (defn camelize [string] (s/replace string #"[-_](\w)" (comp s/upper-case second))) (defn classify [string] (apply str (map s/capitalize (s/split string #"[-_]")))) (letfn [(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: (pluralize 5 \"month\") => \"5 months\" (pluralize 1 \"month\") => \"1 month\" (pluralize 1 \"radius\" \"radii\") => \"1 radius\" (pluralize 9 \"radius\" \"radii\") => \"9 radii\"" [num singular & [plural]] (str num " " (if (= 1 num) singular (or plural (str singular "s"))))) (defn substring-after "Find the part of the string s which comes after the last instance of delim." [^String delim] (fn [^String s] (let [idx (.lastIndexOf s delim)] (if (neg? idx) s ;; no match (subs s (+ (.length delim) idx)))))) (defn substring-before "Find the part of the string s which comes before the first instance of delim." [^String delim] (fn [^String s] (let [idx (.indexOf s delim)] (if (= -1 idx) s (subs s 0 idx))))) useful-0.11.6/src/flatland/useful/test.clj000066400000000000000000000013041340230314500204230ustar00rootroot00000000000000(ns flatland.useful.test (:use [clojure.tools.macro :only [macrolet]])) (defmacro with-test-tags [tags & body] (let [tags (set (map keyword tags)) deftest-decl (list 'deftest '[name & body] (list 'let ['n `(vary-meta ~'name update-in [:tags] (fnil into #{}) ~tags) 'form `(list* '~'clojure.test/deftest ~'n ~'body)] 'form)) with-test-tags-decl (list 'with-test-tags '[tags & body] `(list* 'with-test-tags (into ~tags (map keyword ~'tags)) ~'body))] `(macrolet [~deftest-decl ~with-test-tags-decl] ~@body))) useful-0.11.6/src/flatland/useful/time.clj000066400000000000000000000015201340230314500204020ustar00rootroot00000000000000(ns flatland.useful.time (:import [java.util.concurrent TimeUnit])) (def ^{:doc "Convert a Clojure keyword into a java.util.concurrent.TimeUnit" :attribution "I stole this from my Clojail implementation"} unit (into {} (for [[enum aliases] {TimeUnit/NANOSECONDS [:ns :nanoseconds] TimeUnit/MICROSECONDS [:us :microseconds] TimeUnit/MILLISECONDS [:ms :milliseconds] TimeUnit/SECONDS [:s :sec :seconds] TimeUnit/MINUTES [:m :min :minutes] TimeUnit/HOURS [:h :hr :hours] TimeUnit/DAYS [:d :day :days]} alias aliases] {alias enum}))) (defn duration [num unit-keyword] {:num num, :unit (unit unit-keyword)}) useful-0.11.6/src/flatland/useful/utils.clj000066400000000000000000000233301340230314500206070ustar00rootroot00000000000000(ns flatland.useful.utils (:use [clojure.walk :only [walk]] [flatland.useful.fn :only [decorate ignoring-nils fix]] [clojure.tools.macro :only [symbol-macrolet]]) (:import (clojure.lang IDeref ISeq IPersistentMap IPersistentSet IPersistentCollection))) (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))) (defn fail "Raise an exception. Takes an exception or a string with format args." ([exception] (throw (fix exception string? #(Exception. ^String %)))) ([string & args] (fail (apply format string args)))) (defmacro verify "Raise exception unless test returns true." [test & args] `(when-not ~test (fail ~@args))) (defmacro returning "Compute a return value, then execute other forms for side effects. Like prog1 in common lisp, or a (do) that returns the first form." [value & forms] `(let [value# ~value] ~@forms value#)) (letfn [(no-arg-nil [f] (fn ([] nil) ([& args] (apply f args))))] (def ^{:doc "The minimium value of vals, ignoring nils." :arglists '([& args])} or-min (ignoring-nils (no-arg-nil min))) (def ^{:doc "The maximium value of vals, ignoring nils." :arglists '([& args])} or-max (ignoring-nils (no-arg-nil max)))) (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 into-set "Update the given set using an existence map." [set map] (if (map? map) (reduce (fn [set [k v]] ((if v conj disj) set k)) set map) (into set map))) (defprotocol Adjoin (adjoin-onto [left right] "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.")) (extend-protocol Adjoin IPersistentMap (adjoin-onto [this other] (merge-with adjoin-onto this other)) IPersistentSet (adjoin-onto [this other] (into-set this other)) ISeq (adjoin-onto [this other] (concat this other)) IPersistentCollection (adjoin-onto [this other] (into this other)) Object (adjoin-onto [this other] other) nil (adjoin-onto [this other] other)) (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." [a b] (adjoin-onto a b)) (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]))) (defn update-peek "Update the element in stack that would be returned by peek, returning a new stack." [stack f & args] (conj (pop stack) (apply f (peek stack) args))) (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. flatland.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 ^{:dont-test "Used in impl of thread-local"} thread-local* "Non-macro version of thread-local - see documentation for same." [init] (let [generator (proxy [ThreadLocal] [] (initialValue [] (init)))] (reify IDeref (deref [this] (.get generator))))) (defmacro thread-local "Takes a body of expressions, and returns a java.lang.ThreadLocal object. (see http://download.oracle.com/javase/6/docs/api/java/lang/ThreadLocal.html). To get the current value of the thread-local binding, you must deref (@) the thread-local object. The body of expressions will be executed once per thread and future derefs will be cached. Note that while nothing is preventing you from passing these objects around to other threads (once you deref the thread-local, the resulting object knows nothing about threads), you will of course lose some of the benefit of having thread-local objects." [& body] `(thread-local* (fn [] ~@body))) (defn read-seq "Read all forms from *in* until an EOF is reached. Throws an exception on incomplete forms." [] (lazy-seq (let [form (read *in* false ::EOF)] (when-not (= ::EOF form) (cons form (read-seq)))))) (defmacro let-later "Behaves like let, but bindings which have :delay metadata on them are evaluated lazily, by placing their values in a delay and forcing the delay whenever the body of the let-later needs the value. For example, (let-later [^:delay a (do-stuff)] (when (whatever) a)) will only evaluate (do-stuff) if (whatever) is true." [bindings & body] (letfn [(let-delayed [body name val] (let [delay-sym (gensym (str "delay-" name))] `(let [~delay-sym (delay ~val)] (symbol-macrolet [~name (force ~delay-sym)] ~body)))) (destructure-delayed [body name val] `(let-later [~@(apply concat (for [[k v] (partition 2 (destructure [name val]))] [(vary-meta k assoc :delay true) v]))] ~body))] (reduce (fn [body [name val]] (if (:delay (meta name)) (if (symbol? name) (let-delayed body name val) (destructure-delayed body name val)) `(let [~name ~val] ~body))) `(do ~@body) (reverse (partition 2 bindings))))) (defn copy-meta "Copy all the metadata from src to dest." [dest src] (with-meta dest (meta src))) (defn empty-coll? "Is x a collection and also empty?" [x] (or (nil? x) (and (coll? x) (empty? x)))) (defmacro switch "Like case, but uses object equality instead of the compile-time hash. Also, switch does not require a default clause. Of course, switch is not as efficient as case, but it works for things like functions, which case cannot support." [expr & clauses] (let [[clauses default] (if (even? (count clauses)) [clauses nil] [(butlast clauses) (last clauses)])] `(condp contains? ~expr ~@(mapcat (fn [[val form]] [(fix val, list? set, hash-set) form]) (partition 2 clauses)) ~default))) (defmacro with-timing "Same as clojure.core/time but returns a vector of the result of the code and the milliseconds rather than printing a string. Runs the code in an implicit do." [& body] `(let [start# (System/nanoTime) ret# ~(cons 'do body)] [ret# (/ (double (- (System/nanoTime) start#)) 1000000.0)])) useful-0.11.6/test/000077500000000000000000000000001340230314500140545ustar00rootroot00000000000000useful-0.11.6/test/config1.clj000066400000000000000000000000111340230314500160640ustar00rootroot00000000000000{size 1} useful-0.11.6/test/config2.clj000066400000000000000000000000531340230314500160730ustar00rootroot00000000000000(let [point [1 1]] {:x point, :y point}) useful-0.11.6/test/flatland/000077500000000000000000000000001340230314500156415ustar00rootroot00000000000000useful-0.11.6/test/flatland/useful/000077500000000000000000000000001340230314500171445ustar00rootroot00000000000000useful-0.11.6/test/flatland/useful/bean_test.clj000066400000000000000000000012231340230314500216000ustar00rootroot00000000000000(ns flatland.useful.bean-test (:use clojure.test flatland.useful.bean) (:import (java.beans PropertyDescriptor))) (defmethod coerce [Boolean/TYPE nil] [_ _ val] false) (defmethod coerce [Boolean/TYPE Object] [_ _ val] (boolean val)) (deftest beans (let [b (PropertyDescriptor. "bound" PropertyDescriptor)] (is (= false (.isBound b))) (is (= false (.isConstrained b))) (update-bean b {:bound true :constrained true}) (is (= true (.isBound b))) (is (= true (.isConstrained b))) (testing "coercion" (update-bean b {:bound nil :constrained nil}) (is (= false (.isBound b))) (is (= false (.isConstrained b))))))useful-0.11.6/test/flatland/useful/cli_test.clj000066400000000000000000000002461340230314500214460ustar00rootroot00000000000000(ns flatland.useful.cli-test (:use clojure.test flatland.useful.cli)) (deftest test-parse-opts (is (= {:foo ["a"] :bar [""]} (parse-opts ["--foo=a" "--bar"])))) useful-0.11.6/test/flatland/useful/compress_test.clj000066400000000000000000000003721340230314500225320ustar00rootroot00000000000000(ns flatland.useful.compress-test (:use clojure.test flatland.useful.compress)) (deftest round-trip (let [s "f3509ruwqerfwoa reo1u30`1 ewf dfgjdsf sfc saf65sad+ f5df3 g2 sd35g4szdf sdf4 as89faw76fwfwf210 "] (is (= s (unsmash (smash s)))))) useful-0.11.6/test/flatland/useful/config_test.clj000066400000000000000000000011711340230314500221420ustar00rootroot00000000000000(ns flatland.useful.config-test (:use clojure.test flatland.useful.config)) (deftest reading (is (= '{size 1} (read-config "config1.clj"))) (is (thrown-with-msg? java.io.FileNotFoundException #"Cannot find config resource config3.clj" (read-config "config3.clj"))) (is (= nil (read-config "config3.clj" :optional true)))) (deftest loading (is (= {:x [1 1] :y [1 1]} (load-config "config2.clj"))) (is (thrown-with-msg? java.io.FileNotFoundException #"Cannot find config resource config3.clj" (load-config "config3.clj"))) (is (= nil (load-config "config3.clj" :optional true)))) useful-0.11.6/test/flatland/useful/datatypes_test.clj000066400000000000000000000035651340230314500227040ustar00rootroot00000000000000(ns flatland.useful.datatypes-test (:use clojure.test flatland.useful.datatypes)) (deftest test-as-int (are [in out] (= (as-int in) out) "1" 1 2 2 4.5 4 nil nil)) (defrecord Test [a b c]) (defrecord Other [dash-thing question? bang!]) (record-accessors Test Other) (deftest test-munged-names (let [x (Other. 1 2 3)] (testing "Accessor functions" (is (= 1 (dash-thing x))) (is (= 2 (question? x))) (is (= 3 (bang! x)))) (testing "assoc-record" (is (= x (assoc-record x :dash-thing 1))) (is (= x (assoc-record x :question? 2))) (is (= x (assoc-record x :bang! 3)))) (testing "update-record" (is (= x (update-record x (identity dash-thing) (identity question?) (identity bang!))))))) (defprotocol Inline (foo [this])) (defprotocol Dynamic (bar [this])) (defrecord Implementor [x] Inline (foo [this] (bar this))) (extend-type Implementor Dynamic (bar [this] "y")) (deftest test-record (let [init (Test. 1 2 3) second (Test. 1 5 4)] (is (= init (make-record Test :b 2 :a 1 :c 3))) (is (= second (assoc-record init :b 5 :c 4))) (is (= second (update-record init (+ b 3) (inc c)))) (is (= (:a init) (a init))) (testing "Preserves metadata" (let [m {:test 1} r (Test. 1 2 3 m {})] (is (= m (meta (assoc-record r :b 10)))))) (testing "Inline typehinting" (is (= second (assoc-record ^Test (assoc init :b 5) :c 4)))) (testing "Don't eval more than once" (let [times-evaled (atom 0) r (Test. 1 2 3)] (assoc-record ^Test (do (swap! times-evaled inc) r) :a :x :b :y :c :z) (is (= 1 @times-evaled)))) (testing "Works calling implemented protocols" (let [r (Implementor. 1)] (assoc-record r :x 5))))) useful-0.11.6/test/flatland/useful/debug_test.clj000066400000000000000000000007721340230314500217710ustar00rootroot00000000000000(ns flatland.useful.debug-test (:use flatland.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"))) useful-0.11.6/test/flatland/useful/deftype_test.clj000066400000000000000000000030731340230314500223400ustar00rootroot00000000000000(ns flatland.useful.deftype-test (:use clojure.test flatland.useful.deftype)) (defn is-valid-map [inst] (let [m (into (empty inst) [[1 :a] [:foo [1 2 3]] ["bar" 42] [:none nil]])] (testing "find" (is (= [1 :a] (find m 1))) (is (= [:foo [1 2 3]] (find m :foo))) (is (= ["bar" 42] (find m "bar"))) (is (= [:none nil] (find m :none))) (is (= nil (find m 3)))) (testing "get" (is (= :a (get m 1))) (is (= [1 2 3] (get m :foo))) (is (= 42 (get m "bar"))) (is (= nil (get m 3))) (is (= :nope (get m 3 :nope))) (is (= :a (get m 1 :yep))) (is (= nil (get m :none 42)))) (testing "keys" (is (= #{1 :foo "bar" :none} (set (keys m))))) (testing "vals" (is (= #{:a [1 2 3] 42 nil} (set (vals m))))) (testing "assoc" (let [m2 (assoc m 1 :one :b 4 :c 8)] (is (= :one (get m2 1))) (is (= 4 (get m2 :b))) (is (= 8 (get m2 :c))) (is (= #{1 :foo "bar" :none :b :c} (set (keys m2)))) (let [m3 (assoc m2 1 nil :b 5)] (is (= nil (get m3 1))) (is (= 5 (get m3 :b))) (is (= #{1 :foo "bar" :none :b :c} (set (keys m3))))))) (testing "dissoc" (let [m2 (dissoc m 1 :foo :bar)] (is (= nil (find m2 1))) (is (= nil (find m2 :foo))) (is (= ["bar" 42] (find m2 "bar"))) (is (= #{"bar" :none} (set (keys m2)))) (is (= #{42 nil} (set (vals m2)))))))) (deftest test-alist (is-valid-map (alist))) useful-0.11.6/test/flatland/useful/dispatch_test.clj000066400000000000000000000065441340230314500225050ustar00rootroot00000000000000(ns flatland.useful.dispatch-test (:use clojure.test flatland.useful.dispatch [clojure.walk :only [stringify-keys]]) ;; not used directly, but added to verify that imported functions aren't exposed via dispatcher (:require [clojure.set :refer [rename-keys]])) (deftest test-dispatcher-fn (let [dispatch (dispatcher (fn [f & args] (symbol "clojure.core" f)))] (is (= "str5" (dispatch "str" 5))))) (deftest test-imported-functions (let [fn-name 'flatland.useful.dispatch-test/rename-keys dispatch (dispatcher (constantly fn-name))] (is (thrown? Exception (dispatch {:a 1} {:a :b}))))) (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})))))useful-0.11.6/test/flatland/useful/exception_test.clj000066400000000000000000000002631340230314500226740ustar00rootroot00000000000000(ns flatland.useful.exception-test (:use clojure.test flatland.useful.exception)) (deftest test-rescue (is (= nil (rescue (/ 9 0) nil))) (is (= 3 (rescue (/ 9 3) nil)))) useful-0.11.6/test/flatland/useful/experimental_test.clj000066400000000000000000000151721340230314500234000ustar00rootroot00000000000000(ns flatland.useful.experimental-test (:refer-clojure :exclude [update]) (:use clojure.test flatland.useful.map flatland.useful.experimental flatland.useful.experimental.delegate) (:require [flatland.useful.utils :as utils])) (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)))))) (deftest test-order-let-if (order-let-if true [a 1, b 2] (is (and (= a 1) (= b 2)))) (order-let-if false [a 1, b 2] (is (and (= a 2) (= b 1))))) ;;; 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 (with-local-vars [dummy-wrapper ()] (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 :flatland.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 dummy-wrapper "re-implement clojure.core/first." [[x]] x) (let [meta (meta #'myfn)] (is (= '([[x]]) (:arglists meta))) (is (= "re-implement clojure.core/first." (:doc meta)))) (testing "Docstring is optional" (defn-wrapping testfn dummy-wrapper [x] (inc x)) (is (= 1 (testfn 0))))) (let [inc-fn (fn [f] (comp inc f))] (testing "Wrapper can be added after function is defined" (defn frizzle [x] (inc x)) (make-wrappable! #'frizzle dummy-wrapper) (is (= 3 (with-wrapper dummy-wrapper inc-fn (frizzle 1))))) (testing "wrap-multiple" (defn frazzle [x] (inc x)) (defn zazzle [x] (inc x)) (wrap-multiple dummy-wrapper frazzle zazzle) (are [f] (= 3 (with-wrapper dummy-wrapper inc-fn (f 1))) frazzle zazzle))))) (deftest fixes-test (is (= 4 (fixes {:value 9} map? :value string? read-string odd? dec even? #(/ % 2)))) (let [a (atom 0)] (is (thrown? Exception (fixes a identity #(swap! % inc) identity))) (is (= 0 @a) "Should throw an exception before trying any clauses"))) (deftest lift-meta-test (let [m (lift-meta {:a 1 :b 2} :a)] (is (= {:b 2} m)) (is (= {:a 1} (meta m))))) (deftest prefix-lookup-test (let [lookup (prefix-lookup [["a" :apple] ["person" :person] [:p :pineapple] ["abbrev" :abbreviation]])] (are [in out] (= out (lookup in)) "apropos" :apple "persona" :person "pursues" :pineapple ;; keywords should work "abbrev." :apple ;; should test in order, and short-circuit ))) (deftest canonical-name-test (is (= 'clojure.core/inc (canonical-name 'inc))) (is (= 'java.lang.Object (canonical-name 'Object))) (is (= 'flatland.useful.utils/adjoin (canonical-name `utils/adjoin)))) useful-0.11.6/test/flatland/useful/fn_test.clj000066400000000000000000000056041340230314500213050ustar00rootroot00000000000000(ns flatland.useful.fn-test (:use clojure.test flatland.useful.fn)) (deftest test-validator (is (= [0 2 4 6 8] (keep (validator even?) (range 10))))) (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-as-fn (is (= 3 ((as-fn 3) :foo))) (is (= :foo ((as-fn #{:foo}) :foo))) (is (= 9 ((as-fn inc) 8)))) (deftest test-fixing (let [m (atom {:x 1})] (is (= {:x 3} (swap! m update-in [:x] fixing odd? + 2))) (is (= {:x 1} (fixing {:x 1} seq? conj 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)))) (is (= {:value 1} (-> {:value 0} (given map? (update-in [:value] inc) ; matches sequential? reverse ; these next two are never tested :value :value)))) (is (= 4 (-> 3 (given map? (update-in [:value] inc) ; matches sequential? reverse ; these next two are never tested inc))))) (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-knit (is (= [5 \t 9] ((knit inc last #(* 3 %)) [4 "last" 3]))) (is (= {"A" 10 "B" 1} (into {} (map (knit #(.toUpperCase %) inc) {"a" 9 "b" 0}))))) (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)))) (deftest test-key-comparator (let [subtract-comparator-fn-breaks-on-this [2147483650 2147483651 2147483652 4 2 3 1] normal-cmp (key-comparator identity)] (is (= (sort subtract-comparator-fn-breaks-on-this) (sort normal-cmp subtract-comparator-fn-breaks-on-this)))) (let [square (fn [x] (* x x)) by-square (key-comparator :ascending square)] (is (= (sort-by square [-9 -5 1 -2]) (sort by-square [-9 -5 1 -2]))))) (deftest test-=to (let [objs [1 :x "x" [5] nil (Object.) {:x 1} '((a b c) d)]] (doseq [x objs y objs] (is (= (= x y) ((=to x) y)))))) useful-0.11.6/test/flatland/useful/io_test.clj000066400000000000000000000034761340230314500213160ustar00rootroot00000000000000(ns flatland.useful.io-test (:use flatland.useful.io clojure.test) (:import (java.io StringReader RandomAccessFile))) (deftest test-read-seq (let [forms '(this (is) #(100 %) ~of a [long, [complicated, [nested]]] {:quoted #{form}}) form-str (with-out-str (doseq [form forms] (prn form)))] (is (= forms (read-seq (StringReader. form-str)))))) (deftest test-bytes-and-longs (are [x bs] (and (= x (bytes->long (into-array Byte/TYPE (map byte bs)))) (= bs (seq (long->bytes x)))) 10 [0 0 0 0 0 0 0 10] 255 [0 0 0 0 0 0 0 -1] 256 [0 0 0 0 0 0 1 0] 65540 [0 0 0 0 0 1 0 4])) (deftest test-mmap-file (let [{:keys [buffer close]} (mmap-file (RandomAccessFile. "project.clj" "rw")) a (byte-array (.capacity buffer))] (is (= (slurp "project.clj") (do (.get buffer a 0 (alength a)) (apply str (map char a))))) (close))) (deftest test-compare-bytes (letfn [(bytes [& xs] (byte-array (map unchecked-byte xs)))] (is (neg? (compare-bytes (bytes 1 2 3) (bytes 3)))) (is (neg? (compare-bytes (bytes 1 2 3) (bytes 1 2 3 4)))) (is (zero? (compare-bytes (bytes 1 2 3) (bytes 1 2 3)))) (is (pos? (compare-bytes (bytes 1 2 -3) (bytes 1 2 3)))) (is (pos? (compare-bytes (bytes 1 2 -3) (bytes 1 2 -4)))) (is (neg? (compare-bytes (bytes 100) (bytes -100)))) (is (pos? (compare-bytes (bytes -100) (bytes 100)))) (is (pos? (compare-bytes (bytes -1) (bytes 0)))) (is (neg? (compare-bytes (bytes 0) (bytes -128)))))) useful-0.11.6/test/flatland/useful/java_test.clj000066400000000000000000000015051340230314500216170ustar00rootroot00000000000000(ns flatland.useful.java-test (:use clojure.test flatland.useful.java) (:import (java.util Collection Map))) (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))))) (deftest test-hinted-let (let [item {:foo 10}] (is (= 1 (multi-hinted-let [x item [Collection Map]] (.size x))) "Should work when actual class matches.") (is (thrown? Throwable (multi-hinted-let [x item [Collection]] (.size x)) "Should fail when no class matches.")) ;; TODO find a way to assert no reflection happens? )) useful-0.11.6/test/flatland/useful/macro_test.clj000066400000000000000000000014671340230314500220060ustar00rootroot00000000000000(ns flatland.useful.macro-test (:use clojure.test flatland.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)))))) useful-0.11.6/test/flatland/useful/map_test.clj000066400000000000000000000113641340230314500214570ustar00rootroot00000000000000(ns flatland.useful.map-test (:refer-clojure :exclude [update]) (:use clojure.test flatland.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 {:foo 0 :bar 8 :baz 3} inc)))) (deftest test-map-keys (is (= {"foo" 1 "bar" 2 "baz" 3} (map-keys {:foo 1 :bar 2 :baz 3} name)))) (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 {:a :b :c :d} name)))) (deftest test-update (is (= {:a 3 :b 3 :c nil} (-> {:a 2 :b 4 :c ()} (update :a inc) (update :b dec) (update :c seq))))) (deftest test-update-each (is (= {:a 6 :b 8} (-> {:a 3 :b 4} (update-each [:a :b] * 2)))) (let [m {:a 1 :b 2}] (is (identical? m (update-each m [:a :b] identity))))) (deftest test-update-within (is (= {:foo 1} (update-within {:foo 0} [] update :foo inc) (update-within {:foo 0} [:foo] inc) (update-within {:foo 1} [:bar] inc)))) (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}))) (is (= {:a {:b {:c 1 :d 2} :e 2}} (merge-in {:a {:b {:c 1}}} {:a {:b {:d 2}}} {:a {:b {} :e 2}}))) (is (= {:a 1 :b 2} (merge-in nil {:a 1} {:b 2}))) (is (= nil (merge-in))) (is (= nil (merge-in nil))) (is (= {} (merge-in {})))) (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 m zero?))) (is (= '{b 1, c 11, d 92} (remove-vals m zero?))) (is (= '{a 0} (filter-keys m '#{a}))) (is (= '{b 1, c 11, d 92} (remove-keys m '#{a}))))) (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-dissoc-in* (is (= {} (dissoc-in* {:foo {:bar 3}} [:foo :bar]))) (is (= {:foo {:baz 8}} (dissoc-in* {:foo {:bar 3 :baz 8}} [:foo :bar]))) (is (= {:bam 3} (dissoc-in* {:foo {:bar 3 :baz 8} :bam 3} [:foo]))) (is (= {} (dissoc-in* {:foo {:bar 3 :baz 8}} []))) (is (= {} (dissoc-in* {:foo {:bar false}} [:foo :bar]))) (is (= {} (dissoc-in* {:foo {:bar nil}} [:foo :bar])))) (deftest test-assoc-in* (is (= {:foo {:bar 1}} (assoc-in* {} [:foo :bar] 1))) (is (= {:foo {}} (assoc-in* {:foo {:bar 3 :baz 8}} [:foo] {}))) (is (= {:foo {:bar 3 :baz 8} :bam 3} (assoc-in* {:foo {:bar 3} :bam 3} [:foo :baz] 8))) (is (= {:bar 1} (assoc-in* {:foo 1} [] {:bar 1})))) (deftest test-update-in* (is (= {:foo {:bar 1}} (update-in* {} [:foo :bar] (constantly 1)))) (is (= {:foo 2} (update-in* {:foo {:bar 3 :baz 8}} [:foo] count))) (is (= {:foo {:bar 4} :bam 3} (update-in* {:foo {:bar 3} :bam 3} [:foo :bar] inc))) (is (= 2 (update-in* {:foo 1 :bar 2} [] count))) (is (= {} (update-in* {} [:foo :bar :baz] identity)))) (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}})))) (deftest test-ordering-map (let [template (ordering-map [:b :c :a])] (is (= {} template)) (is (= [[:b 2] [:c 3] [:a 1]] (seq (into template {:a 1 :b 2 :c 3})))) (is (= [[:c 3] [:a 1] [1 :a] [5 :e]] (seq (into template {:a 1, 5 :e, :c 3, 1 :a})))))) useful-0.11.6/test/flatland/useful/ns_test.clj000066400000000000000000000010251340230314500213130ustar00rootroot00000000000000(ns flatland.useful.ns-test (:use clojure.test flatland.useful.ns) (:require [flatland.useful.fn :as fn] [flatland.useful.macro :as macro])) (defalias fixit fn/fix) (alias-var 'as-macro #'macro/anon-macro) (alias-ns 'flatland.useful.string) (deftest test-var-name (is (= 'clojure.core/inc (var-name #'inc)))) (deftest test-defalias (is (= 1 (fixit 0 even? inc)))) (deftest test-alias-var (is (= 3 (as-macro [x y] `(+ ~x ~y) 1 2)))) (deftest test-alias-ns (is (bound? #'flatland.useful.ns-test/camelize)))useful-0.11.6/test/flatland/useful/parallel_test.clj000066400000000000000000000010021340230314500224620ustar00rootroot00000000000000(ns flatland.useful.parallel-test (:use clojure.test flatland.useful.parallel)) (def ^{:dynamic true} *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])))))) useful-0.11.6/test/flatland/useful/seq_test.clj000066400000000000000000000200151340230314500214630ustar00rootroot00000000000000(ns flatland.useful.seq-test (:use clojure.test flatland.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])))) ;; TODO test unglue? option to glue (deftest test-glue ;; Make sure all items of the same type wind up in the same batch, ;; and each batch is as close to size 6 as possible without going over. ;; The D batch is too large, and glue promises to return a too-large batch ;; in preference to splitting up a batch. (is (= '((a1 a2 a3 a4 b1) (c1 c2) (d1 d2 d3 d4 d5 d6 d7) (e8)) (glue into [] (fn [batch more] (>= 6 (+ (count batch) (count more)))) '((a1 a2 a3 a4) (b1) (c1 c2) (d1 d2 d3 d4 d5 d6 d7) (e8)))))) (deftest test-partition-between (testing "returns a totally lazy sequence" (is (= (lazy-seq nil) (partition-between (fn [& _] (throw (Exception. "Never call me"))) nil)))) (testing "doesn't force input sequence more than necessary" ;; partition-between should be forcing elements 1 and 2 of this sequence ;; to compute the first partition. (let [input (list* 1 2 (lazy-seq (throw (Exception. "broken")))) partitioned (partition-between (constantly true) input)] (is (= [1] (first partitioned))) (is (thrown? Exception (second partitioned))))) (let [input [1 nil nil 2 3 nil 4]] (are [f output] (= output (partition-between f input)) (fn [[a b]] (not (nil? a))) [[1] [nil nil 2] [3] [nil 4]], (fn [[a b]] (not (nil? b))) [[1 nil nil] [2] [3 nil] [4]], (partial some nil?) [[1] [nil] [nil] [2 3] [nil] [4]], (fn [[a b]] (not= (nil? a) (nil? b))) [[1] [nil nil] [2 3] [nil] [4]]))) (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))))))) (testing "0-arg lazy-loop" (is (= [1 1 1] (take 3 (lazy-loop [] (cons 1 (lazy-recur))))))) (testing "destructuring support" (is (= (range 1 6) ((fn my-map [f xs] (lazy-loop [[x & xs :as coll] xs] (when (seq coll) (cons (f x) (lazy-recur xs))))) inc (range 5)))))) (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)))) (testing "Doesn't blow up for empty seqs" (let [a (alternates [])] (testing "Lazy if nothing forced." (is a)) (is (not (seq a)))))) (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-unchunk (let [a (atom 0) f (fn [_] (swap! a inc)) coll (range 100)] (is (= 1 (first (map f coll)))) (is (< 1 @a)) ;; multiple elements realized (reset! a 0) (is (= 1 (first (map f (unchunk coll))))) (is (= 1 @a)))) ;; only one element realized (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)))) (deftest test-remove-prefix (let [a [1 2 3], b [1 2], c [2 3], d []] (is (= [3] (remove-prefix [1 2] [1 2 3]))) (is (= [] (remove-prefix [1 2] [1 2]))) (is (= [1 2] (remove-prefix [] [1 2]))) (is (= false (remove-prefix [1 2] [3 2]))) (is (= nil (remove-prefix [1 2 3] [1 2]))))) (deftest test-prefix-of? (is (prefix-of? [1 2 3] [1 2])) (is (prefix-of? [1 2] [1 2])) (is (not (prefix-of? [1 2] [1 2 3]))) (is (not (prefix-of? [1 2 3] [2 3]))) (is (prefix-of? [1 2 3] [])) (is (prefix-of? [1 2] []))) (deftest test-sequeue (testing "lookahead" (let [a (atom 0) xs (list* 1 2 3 4 5 6 7 8 9 [10]) ;; avoid chunking coll (for [x xs] (do (swap! a inc) x))] (is (zero? @a)) (let [s (sequeue 5 coll)] (Thread/sleep 100) (is (< 0 @a 10)) ;; should have some queued, but not all (is (= coll (doall s))) (is (= 10 @a))))) (testing "error propagation" (let [coll (lazy-seq (list* 1 2 3 4 5 6 7 8 9 (lazy-seq (cons 10 (lazy-seq (throw (IllegalStateException. "Broken"))))))) s (sequeue 2 coll)] (is (= 1 (first s))) (is (thrown? Throwable (dorun s)))))) (deftest test-map-nth (is (= [2 2 4 4 6 6 8 8 10 10] (map-nth inc 2 [1 2 3 4 5 6 7 8 9 10]))) (is (= ["" "x" "" "x"] (map-nth #(str % "x") 1 2 ["" "" "" ""])))) (deftest test-update-first (is (= [1 3 3 4 5] (update-first [1 2 3 4 5] even? inc))) (is (= [1 2 3 4 5 15] (update-first [1 2 3 4 5] zero? (fnil + 0) 1 2 3 4 5)))) (deftest test-assert-length (is (= [1 2 3] (assert-length 3 [1 2 3]))) (is (thrown? Throwable (assert-length 3 [1])))) (deftest test-flatten-all (is (= [:a 1 2 :e 1 2] (flatten-all {:a [1 2 {:e '(1 2)}]})))) (deftest test-groupings (is (= {true ["0" "2" "4" "6" "8"] false ["1" "3" "5" "7" "9"]} (groupings even? str (range 10)))) (is (= {true 20, false 25} (groupings even? + 0 (range 10))))) (deftest test-increasing (let [input [3 4 2 3 5 9 1]] (are [args output] (= output (apply increasing (conj args input))) [] [3 4 5 9] [-] [3 2 1] [identity #(if (< %2 %) -1 1)] [3 2 1] [- ;; descending, but even numbers sort before odds (fn [a b] (cond (and (even? a) (odd? b)) -1 (and (even? b) (odd? a)) 1 :else (compare a b)))] [3 3 1]))) useful-0.11.6/test/flatland/useful/state_test.clj000066400000000000000000000025131340230314500220160ustar00rootroot00000000000000(ns flatland.useful.state-test (:use clojure.test flatland.useful.state)) (deftest test-volatile (testing "volatile returns a mutable ref" (let [a (volatile 1)] (is (= 1 @a)) (is (= 2 (put! a 2))) (is (= 2 @a))) (let [a (volatile 1 :meta {:foo 1} :validator pos?)] (is (= 1 (:foo (meta a)))) (is (= 1 @a)) (is (= 2 (put! a 2))) (is (= 1 (:foo (meta a)))) (is (= 2 @a)) (is (thrown-with-msg? java.lang.IllegalStateException #"Invalid reference state" (put! a 0)))))) (deftest test-trade (testing "trade! returns the old atom value" (let [a (atom 1)] (is (= 1 (trade! a inc))) (is (= 2 @a)) (is (= 2 (trade! a + 100))) (is (= 102 @a))))) (deftest test-wait-until (let [a (atom 0)] (is (zero? (wait-until a even?))) (let [f (future (Thread/sleep 250) (swap! a inc))] (is (odd? (wait-until a odd?)))))) (def ^{:dynamic true} *value* 1) (deftest test-alter-var (let [get-value (fn [] *value*)] (is (= 1 *value*)) (is (= 4 (with-altered-vars [(+ *value* 3)] (get-value)))))) (def const 20) (deftest test-alter-root (let [get-value (fn [] const)] (is (= 20 (get-value))) (is (= 10 (with-altered-roots [(- const 10)] (get-value)))) (is (= 20 (get-value))))) useful-0.11.6/test/flatland/useful/string_test.clj000066400000000000000000000026531340230314500222110ustar00rootroot00000000000000(ns flatland.useful.string-test (:use flatland.useful.string clojure.test)) (deftest to-camel (are [in out] (= out (camelize in)) "the-string" "theString" "this-is-real" "thisIsReal" "untouched" "untouched")) (deftest to-class (are [in out] (= out (classify in)) "the-string" "TheString" "this-is-real" "ThisIsReal" "touched" "Touched")) (deftest from-camel (are [in dashed underscored] (= [dashed underscored] ((juxt dasherize underscore) in)) "setSize" "set-size" "set_size" "theURL" "the-url" "the_url" "ClassName" "class-name" "class_name" "LOUD_CONSTANT" "loud-constant" "loud_constant" "the_CRAZY_train" "the-crazy-train" "the_crazy_train" "with-dashes" "with-dashes" "with_dashes" "with_underscores" "with-underscores" "with_underscores")) (deftest pluralize-test (is (= "10 dogs" (pluralize 10 "dog"))) (is (= "1 cat" (pluralize 1 "cat"))) (is (= "0 octopodes" (pluralize 0 "octopus" "octopodes"))) (is (= "1 fish" (pluralize 1 "fish" "fishes")))) (deftest substring-after-test (let [s "foo:bar:baz-10"] (is (= "baz-10" ((substring-after ":") s))) (is (= "10" ((substring-after "-") s))) (is (= s ((substring-after "Q") s))) (is (= "z-10" ((substring-after "ba") s))) (is (= "" ((substring-after "0") s))))) useful-0.11.6/test/flatland/useful/test_test.clj000066400000000000000000000016771340230314500216670ustar00rootroot00000000000000(ns flatland.useful.test-test (:use flatland.useful.test clojure.test)) (defmacro tags? [test expected] `(is (= ~(set (map keyword expected)) (-> ~test var meta :tags)))) (with-test-tags [unit] (deftest test-unit (tags? test-unit [unit])) (with-test-tags [debug] (deftest test-debug (tags? test-debug [unit debug]))) (deftest more-unit-tests (tags? more-unit-tests [unit]))) ;; defines a test with no tags attached: (deftest plain-deftest (is (not (contains? (meta #'plain-deftest) :tags)))) (with-test-tags [foo] ;; this test will be tagged #{:foo}: (deftest foo (tags? foo [foo])) (with-test-tags [bar] ;; this test will be tagged #{:foo :bar}: (deftest foo-bar (tags? foo-bar [foo bar])))) ;; tests inside with-test-args can be closures: (with-test-tags [foo] (let [x #{:foo}] (deftest lexical-bindings-with-tags (is (= x (:tags (meta #'lexical-bindings-with-tags))))))) useful-0.11.6/test/flatland/useful/utils_test.clj000066400000000000000000000145661340230314500220510ustar00rootroot00000000000000(ns flatland.useful.utils-test (:use clojure.test flatland.useful.utils)) (deftest test-invoke (is (= 1 (invoke inc 0))) (is (= (range 5) (map invoke (map constantly (range 5)))))) (deftest test-or-min (is (= 3 (or-min nil 4 3 nil 9))) (is (= 1 (or-min 1 2 3 4))) (is (= 1 (or-min 1 nil))) (is (= nil (or-min nil nil nil)))) (deftest test-or-max (is (= 9 (or-max nil 4 3 nil 9))) (is (= 4 (or-max 1 2 3 4))) (is (= 1 (or-max 1 nil))) (is (= nil (or-max nil nil nil)))) (deftest test-split-vec (is (= [[1 2] [3 4]] (split-vec [1 2 3 4] 2))) (is (= [[1 2] [3 4] [5 6]] (split-vec [1 2 3 4 5 6] 2 4))) (is (= [[1] [2 3 4 5] [6]] (split-vec [1 2 3 4 5 6] 1 5))) (is (= [[1] [2 3 4] [5 6]] (split-vec [1 2 3 4 5 6] 1 -2)))) (deftest test-if-ns (if-ns (:use this-namespace.should-not-exist) (is false) (is true)) (if-ns (:require clojure.string) (is true) (is false))) (deftest test-returning (let [side-effects (atom 0)] (is (= "TEST" (returning "TEST" (swap! side-effects inc)))) (is (= 1 @side-effects)))) (deftest test-into-set (is (= #{1 2 3 4} (into-set #{3 1 5} {5 false 4 true 2 true})))) (deftest test-adjoin (is (= {:a [1 2 3] :b {"foo" [2 3 5] "bar" 7 "bap" 9 "baz" 2} :c #{2 4 6 8}} (adjoin {:a [1] :b {"foo" [2 3] "bar" 8 "bap" 9} :c #{2 3 4 6}} {:a [2 3] :b {"foo" [5] "bar" 7 "baz" 2} :c {3 false 8 true}})))) (deftest test-pop-if (is (= [[1 2 3] 4] (pop-if [1 2 3 4] even?))) (is (= [[1 2 3 4] 1] (pop-if [1 2 3 4] odd? 1))) (is (= ['(2 3) 1] (pop-if '(1 2 3) odd?))) (is (= ['(1 2 3) nil] (pop-if '(1 2 3) even?))) (is (= ['(2) 1] (pop-if (cons 1 [2]) odd?))) (is (= ['(1 2) nil] (pop-if (cons 1 [2]) neg?)))) (deftest test-update-peek (is (= [1 2 4] (update-peek [1 2 3] inc))) (is (= [1 2 6] (update-peek [1 2 3] + 1 2))) (is (= '(2 2 3) (update-peek '(1 2 3) inc))) (is (= [{:foo 1}] (update-peek [{}] assoc :foo 1)))) (deftest test-queue (let [q (queue)] (is (instance? clojure.lang.PersistentQueue q)) (is (empty? q))) (let [q (queue [1 2 3 4])] (is (= 1 (first q))) (is (= 2 (-> q pop first))) (is (= 3 (-> q pop pop first))) (is (= 4 (-> q pop pop pop first))) (is (= 4 (count q))))) (def ^{:dynamic true} *i* 1) (deftest test-memoize-deref (let [count (atom 0) incr (memoize-deref [#'*i*] (fn [i] (swap! count inc) (+ i *i*)))] (dotimes [n 5] (binding [*i* 4] (is (= 9 (incr 5))) (is (= 1 (incr -3)))) (binding [*i* 1] (is (= 6 (incr 5))) (is (= -2 (incr -3))))) (is (= 4 @count)))) (deftest test-fail (is (thrown? Throwable (fail "Test"))) (is (thrown-with-msg? Throwable #"foo bar 2" (fail "%s bar %d" "foo" 2)))) (deftest test-verify (is (thrown? Throwable (verify false "Test"))) (is (thrown-with-msg? Throwable #"error 10" (verify nil "error %d" 10))) (testing "exception clause is not evaluated when verify succeeds" (is (= nil (verify true (throw (Exception.))))))) (def memo-called (atom 0)) (defm sample-memoized [x] (swap! memo-called inc) (inc x)) (deftest test-defm (let [i @memo-called j (inc i)] (is (= j (sample-memoized i))) (is (= j @memo-called)) (is (= j (sample-memoized i))) (is (= j @memo-called)))) (deftest test-with-adjustments (is (= 1 (with-adjustments #(fnil % 0) [+ inc] (+ nil (inc nil)))))) (deftest test-syntax-quote (is (= '((quote foo) (quote (bar [baz] "hi"))) (syntax-quote '(foo (bar [baz] "hi")))))) (deftest test-pair (testing "map-entry is a macro (for performance)" (let [form `(map-entry 1 2)] (is (not= form (macroexpand form))))) (testing "map-entry works, and is a MapEntry" (let [p (map-entry 1 2) [x y] p] (is (= x 1)) (is (= y 2)) (is (= p [1 2])) (are [c] (instance? c p) clojure.lang.IMapEntry clojure.lang.IPersistentVector))) (testing "pair is a non-macro version of map-entry" (is (= [(map-entry 1 2) (map-entry 3 4)] (map pair [1 3] [2 4]))))) (deftest thread-locals (let [times-called (atom 0) inst (thread-local (swap! times-called inc) (gensym))] (testing "thread-local caches return values" (is (= 0 @times-called)) (is (symbol? @inst)) (is (= 1 @times-called)) (is (symbol? @inst)) (is (= 1 @times-called))) (testing "thread has only one thread-local" (is (= @inst @inst))) (testing "new thread gets new value" (is (not= @inst @(future @inst)))))) (deftest test-let-later (let-later [a (atom 0) b (swap! a inc) ^{:delay true} c (swap! a inc) ^{:delay true} [x y] [@a (swap! a inc)]] (is (= 1 b)) (is (= 1 @a) "delay shouldn't have been forced yet") (is (= 2 c) "delay should fire when its value is needed") (is (= 2 @a) "and now the atom should have changed") (is (= 2 c) "shouldn't be eval'd again") (is (= 2 @a)) (is (= 2 x)) (is (= 3 y)))) (deftest test-copy-meta (let [x (-> [1 2 3] (with-meta {:foo 1})) y [4 5 6] z (copy-meta y x)] (is (= y z)) (is (= (meta z) (meta x))))) (deftest test-empty-coll (are [x] (empty-coll? x) nil, (), {}, []) (are [x] (not (empty-coll? x)) "", [1], [[]], '(()), 1, {1 2})) (deftest test-switch (testing "without default" (is (= :a (switch #{1}, #{1} :a, (2 3) :b, inc :c))) (is (= :b (switch 2, #{1} :a, (2 3) :b, inc :c))) (is (= :b (switch 3, #{1} :a, (2 3) :b, inc :c))) (is (= :c (switch inc, #{1} :a, (2 3) :b, inc :c))) (is (= nil (switch :foo, #{1} :a, (2 3) :b, inc :c)))) (testing "with default" (is (= :a (switch #{1}, #{1} :a, (2 3) :b, inc :c, :d))) (is (= :b (switch 2, #{1} :a, (2 3) :b, inc :c, :d))) (is (= :b (switch 3, #{1} :a, (2 3) :b, inc :c, :d))) (is (= :c (switch inc, #{1} :a, (2 3) :b, inc :c, :d))) (is (= :d (switch :foo, #{1} :a, (2 3) :b, inc :c, :d))))) (deftest test-with-timing (let [[ret ms] (with-timing (+ 2 2) (+ 3 3))] (is (= ret 6)) (is (float? ms))))