diff options
| -rw-r--r-- | README.txt | 73 | ||||
| -rw-r--r-- | doc/datalog.markdown | 145 | ||||
| -rw-r--r-- | src/clojure/contrib/base64.clj | 99 | ||||
| -rw-r--r-- | src/clojure/contrib/datalog.clj | 3 | ||||
| -rw-r--r-- | src/clojure/contrib/http/agent.clj | 59 | ||||
| -rw-r--r-- | src/clojure/contrib/java_utils.clj | 28 | ||||
| -rw-r--r-- | src/clojure/contrib/macro_utils.clj | 5 | ||||
| -rw-r--r-- | src/clojure/contrib/monads.clj | 4 | ||||
| -rw-r--r-- | src/clojure/contrib/str_utils2.clj | 105 | ||||
| -rw-r--r-- | src/clojure/contrib/test_contrib.clj | 2 | ||||
| -rw-r--r-- | src/clojure/contrib/test_contrib/java_utils.clj | 10 | ||||
| -rw-r--r-- | src/clojure/contrib/test_contrib/str_utils2.clj | 83 |
12 files changed, 554 insertions, 62 deletions
@@ -1,6 +1,71 @@ -This library, clojure-contrib, has a dependency on Clojure: the clojure-lang JAR file. This is needed to compile the Clojure classes. -Normally, it is specified using -Dclojure.jar=<path>. +Clojure-contrib +--------------- -The nightly-build and stable-build targets are intended for use on the Tapestry360 continuous integration server -(http://tapestry.formos.com/bamboo). They require the presense of the Maven Ant Tasks in the Ant lib folder. +The user contributions library, clojure.contrib, is a collection of +namespaces each of which implements features that we believe may be +useful to a large part of the clojure community. +Clojure-contrib is open source under the Eclipse Public License and is +copyrighted by Rich Hickey and the various contributors. + +The official repository for clojure-contrib is +http://github.com/richhickey/clojure-contrib. + +For the latest documentation of the capabilities and APIs available +in clojure-contrib, please see http://richhickey.github.com/clojure-contrib/ + + +Building Clojure-contrib +------------------------ + +To build clojure-contrib, download the files or clone the git repository. + +This library, clojure-contrib, has a dependency on Clojure: the clojure-lang +JAR file. This is needed to compile the Clojure classes. Normally, it is specified +using -Dclojure.jar=<path>. + +The build works as follows: + +ant -Dclojure.jar=<path> + +This will produce a clojure-contrib.jar file that you can add to your classpath. + +The nightly-build and stable-build targets are intended for use on the +Tapestry360 continuous integration server (http://tapestry.formos.com/bamboo). +They require the presense of the Maven Ant Tasks in the Ant lib folder. + + +Clojure-contrib Versions +------------------------ + +There are currently two versions of clojure-contrib, stored in separate +branches on github. + +The master branch represents the latest and greatest contrib code and +is tied to the master branch of clojure (http://github.com/richhickey/clojure). +If you're using this branch, you'll want to be sure to keep your clojure +and clojure-contrib code in sync, though breaking changes between them +are pretty rare in practice. + +The clojure-1.0-compatible branch is designed to stay compatible with +clojure release 1.0. New contrib features may be added to this branch, at +the discretion of the contributors, but not necessarily. If you wish to +stay on a "standard release" of clojure, this is the branch for you. + + +Clojure-contrib Committers +-------------------------- + +The following people are committers to the official clojure-contrib +repositiory: + +Tom Faulhaber +Stephen Gilardi +Christophe Grand +Rich Hickey +Konrad Hinsen +Stuart Holloway +Chris Houser +David Miller +Stuart Sierra +Frantisek Sodomka diff --git a/doc/datalog.markdown b/doc/datalog.markdown new file mode 100644 index 00000000..709ec72b --- /dev/null +++ b/doc/datalog.markdown @@ -0,0 +1,145 @@ +# An Overview of Datalog +By Jeffrey Straszheim + +*What Datalog is, and what it can do for you.* + +*Work in Progress* + +## Introduction ## + +Datalog is a logical query language. It exists somewhere between relational algebra (the formal theory behind SQL) and Prolog, but is closer in motivation to the former than the later. It was invented to apply some of the principles of logic programming to database theory. Its primary addition to the semantics of databases is _recursive_ queries. Examples will be provided below. + +The implementation of Datalog that is provided (in this library) departs a bit from the original model insofar as it supports _in memory_ data structures only. It is intended to give developers tools to use relational modeling for their data. A good overview of why you would want to do this is Ben Mosely's _Functional Relational Programming_ material, found here: [http://web.mac.com/ben_moseley/frp/frp.html](http://web.mac.com/ben_moseley/frp/frp.html). + +## Details ## + +### The Database ### + +Clojure Datalog supports an in memory relational database format, implemented in clojure.contrib.datalog.database ([here](http://github.com/richhickey/clojure-contrib/blob/master/src/clojure/contrib/datalog/database.clj)). It supports relations (tables) with named columns and simple hash based indexes. At the present time it does not support any integrity constraints (perhaps later). + +Tables are built with `make-database`, like this: + + (make-database + (relation :employee [:id :name :position]) + (index :employee :name) + + (relation :boss [:employee-id :boss-id]) + (index :boss :employee-id) + + (relation :can-do-job [:position :job]) + (index :can-do-job :position) + + (relation :job-replacement [:job :can-be-done-by]) + + (relation :job-exceptions [:id :job])) + +The schema can be modified by `add-relation` and `add-index`. Under the hood, it is standard Clojure map from relation name to relation, and can be directly modified if needed. + +Data is added like this: + + (add-tuples db-base + [:employee :id 1 :name "Bob" :position :boss] + [:employee :id 2 :name "Mary" :position :chief-accountant] + [:employee :id 3 :name "John" :position :accountant] + [:employee :id 4 :name "Sameer" :position :chief-programmer] + [:employee :id 5 :name "Lilian" :position :programmer] + [:employee :id 6 :name "Li" :position :technician] + [:employee :id 7 :name "Fred" :position :sales] + [:employee :id 8 :name "Brenda" :position :sales] + [:employee :id 9 :name "Miki" :position :project-management] + [:employee :id 10 :name "Albert" :position :technician] + + [:boss :employee-id 2 :boss-id 1] + [:boss :employee-id 3 :boss-id 2] + [:boss :employee-id 4 :boss-id 1] + [:boss :employee-id 5 :boss-id 4] + [:boss :employee-id 6 :boss-id 4] + [:boss :employee-id 7 :boss-id 1] + [:boss :employee-id 8 :boss-id 7] + [:boss :employee-id 9 :boss-id 1] + [:boss :employee-id 10 :boss-id 6] + + [:can-do-job :position :boss :job :management] + [:can-do-job :position :accountant :job :accounting] + [:can-do-job :position :chief-accountant :job :accounting] + [:can-do-job :position :programmer :job :programming] + [:can-do-job :position :chief-programmer :job :programming] + [:can-do-job :position :technician :job :server-support] + [:can-do-job :position :sales :job :sales] + [:can-do-job :position :project-management :job :project-management] + + [:job-replacement :job :pc-support :can-be-done-by :server-support] + [:job-replacement :job :pc-support :can-be-done-by :programming] + [:job-replacement :job :payroll :can-be-done-by :accounting] + + [:job-exceptions :id 4 :job :pc-support]) + +The meaning is, I believe, obvious. + +Functions that add/remove individual tuples are also provided. Use the source. + + +### Rules ### + +In addition to the database itself, Datalog lets you define a series of _inference rules_ to apply to your data. Rules look like this: + + (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) + (:employee :id ?e-id :name ?x) + (:employee :id ?b-id :name ?y)) + +The `<-` operator represents implication. The first form is the head of the rule, the remainder the body. The meaning is that the head is true if each member of the body is true. We can read this above rule as: + + * An employee (?x) works for a boss (?y) if: in the :boss relation there is an employee id (?e-id) matched to a boss id (?b-id) *and* in the :employee relation that (?e-id) matches the name (?x) *and also* in the :employee relation the id (?b-id) matches the name (?y). + +Notice two things: Logic variables are prefixed by a '?', and the meaning of those variables in a rule can join together entities. + +That same rule might be expressed in SQL as: + + select e.name, b.name + from employee as e, employee as b, boss + where e.id = boss.employee-id and b.id = boss.boss-id + +However, unlike SQL, Datalog rules can be recursive. Like this: + + (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) + (:works-for :employee ?z :boss ?y)) + +If you combine these two rules, this builds a _transitive closure_ of the works-for relation. It will return not only ?x's direct boss, but the boss of his boss, and so on. This cannot be done in most forms of SQL. + +#### Negation and Conditionals #### + +_Todo_ + +### Queries ### + +A query is how you request information from a set of rules and a database. Queries look like this: + + (?- :works-for :employee ??name :boss ?y) + +Notice the double '?'! + +This asks for the name and boss columns from the works-for relation, which was defined by the two rules above. The double ?? allow you to parameterize your query. + +### Work Plans ### + +A set of work rules and a query can form a work plan. It is done like this: + + (build-work-plan rules (?- :works-for :employee '??name :boss ?x)) + +This takes a set of rules and a query, and performs some basic filtering an optimization. it is a fairly expensive operation, so try to build the plans you need once in your program, or perhaps cache them somehow. + +In SQL, a work plan is similar to a prepared statement. + +### Running your Work Plan ### + +You run a work plan like this: + + (run-work-plan wp db {'??name "Albert"}) + +Where wp is the result of (build-work-plan ...) and db is a database. The last argument is a map of bindings. It provides the specific values for any ??X forms in your query. Given the rules and query defined above, it should return a sequence of tuples of all the people that "Albert" works for. + +### Examples ### + +A completed example is provided at [http://github.com/richhickey/clojure-contrib/blob/master/src/clojure/contrib/datalog/example.clj](http://github.com/richhickey/clojure-contrib/blob/master/src/clojure/contrib/datalog/example.clj). + + diff --git a/src/clojure/contrib/base64.clj b/src/clojure/contrib/base64.clj new file mode 100644 index 00000000..5e1e3310 --- /dev/null +++ b/src/clojure/contrib/base64.clj @@ -0,0 +1,99 @@ +;;; base64.clj: Experimental Base-64 encoding and (later) decoding + +;; by Stuart Sierra, http://stuartsierra.com/ +;; August 19, 2009 + +;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use +;; and distribution terms for this software are covered by the Eclipse +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + +(ns #^{:doc "Base-64 encoding and (maybe later) decoding. + + This is mainly here as an example. It is much slower than the + Apache Commons Codec implementation or sun.misc.BASE64Encoder." + :author "Stuart Sierra"} + clojure.contrib.base64 + (:import (java.io InputStream Writer ByteArrayInputStream + StringWriter))) + +(def *base64-alphabet* + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=") + +(defn encode + "Encodes bytes of input, writing Base 64 text on output. alphabet + is a 65-character String containing the 64 characters to use in the + encoding; the 65th character is the pad character. line-length is + the maximum number of characters per line, nil for no line breaks." + [#^InputStream input #^Writer output #^String alphabet line-length] + (let [buffer (make-array Byte/TYPE 3)] + (loop [line 0] + (let [len (.read input buffer)] + (when (pos? len) + ;; Pre-boxing the bytes as Integers is more efficient for + ;; Clojure's bit operations. + (let [b0 (Integer/valueOf (int (aget buffer 0))) + b1 (Integer/valueOf (int (aget buffer 1))) + b2 (Integer/valueOf (int (aget buffer 2)))] + (cond (= len 3) + (let [s0 (bit-and 0x3F (bit-shift-right b0 2)) + s1 (bit-and 0x3F + (bit-or (bit-shift-left b0 4) + (bit-shift-right b1 4))) + s2 (bit-and 0x3F + (bit-or (bit-shift-left b1 2) + (bit-shift-right b2 6))) + s3 (bit-and 0x3F b2)] + (.append output (.charAt alphabet s0)) + (.append output (.charAt alphabet s1)) + (.append output (.charAt alphabet s2)) + (.append output (.charAt alphabet s3))) + + (= len 2) + (let [s0 (bit-and 0x3F (bit-shift-right b0 2)) + s1 (bit-and 0x3F + (bit-or (bit-shift-left b0 4) + (bit-shift-right b1 4))) + s2 (bit-and 0x3F (bit-shift-left b1 2))] + (.append output (.charAt alphabet s0)) + (.append output (.charAt alphabet s1)) + (.append output (.charAt alphabet s2)) + (.append output (.charAt alphabet 64))) + + (= len 1) + (let [s0 (bit-and 0x3F (bit-shift-right b0 2)) + s1 (bit-and 0x3F (bit-shift-left b0 4))] + (.append output (.charAt alphabet s0)) + (.append output (.charAt alphabet s1)) + (.append output (.charAt alphabet 64)) + (.append output (.charAt alphabet 64))))) + (if (and line-length (> (+ line 4) line-length)) + (do (.append output \newline) + (recur 0)) + (recur (+ line 4)))))))) + +(defn encode-str + "Encodes String in base 64; returns a String. If not specified, + encoding is UTF-8 and line-length is nil." + ([s] (encode-str s "UTF-8" nil)) + ([#^String s #^String encoding line-length] + (let [output (StringWriter.)] + (encode (ByteArrayInputStream. (.getBytes s encoding)) + output *base64-alphabet* line-length) + (.toString output)))) + + +;;; tests + +;; (deftest t-encode-str +;; (is (= (encode-str "") "")) +;; (is (= (encode-str "f") "Zg==")) +;; (is (= (encode-str "fo") "Zm8=")) +;; (is (= (encode-str "foo") "Zm9v")) +;; (is (= (encode-str "foob") "Zm9vYg==")) +;; (is (= (encode-str "fooba") "Zm9vYmE=")) +;; (is (= (encode-str "foobar") "Zm9vYmFy"))) diff --git a/src/clojure/contrib/datalog.clj b/src/clojure/contrib/datalog.clj index ebc52cf0..93e132de 100644 --- a/src/clojure/contrib/datalog.clj +++ b/src/clojure/contrib/datalog.clj @@ -19,8 +19,7 @@ (ns #^{:author "Jeffrey Straszheim", - :doc "A Clojure implementation of Datalog" - :see-also ["DatalogOverview"]} + :doc "A Clojure implementation of Datalog"} clojure.contrib.datalog (:use clojure.contrib.datalog.rules clojure.contrib.datalog.softstrat diff --git a/src/clojure/contrib/http/agent.clj b/src/clojure/contrib/http/agent.clj index d63cfd1e..806cb1af 100644 --- a/src/clojure/contrib/http/agent.clj +++ b/src/clojure/contrib/http/agent.clj @@ -63,7 +63,9 @@ clojure.contrib.http.agent (:require [clojure.contrib.http.connection :as c] [clojure.contrib.duck-streams :as duck]) - (:import (java.io ByteArrayOutputStream ByteArrayInputStream))) + (:import (java.io InputStream ByteArrayOutputStream + ByteArrayInputStream) + (java.net HttpURLConnection))) ;;; PRIVATE @@ -73,7 +75,7 @@ (defn- setup-http-connection "Sets the instance method, redirect behavior, and request headers of the HttpURLConnection." - [conn options] + [#^HttpURLConnection conn options] (.setRequestMethod conn (:method options)) (.setInstanceFollowRedirects conn (:follow-redirects options)) (doseq [[name value] (:headers options)] @@ -87,16 +89,16 @@ (c/start-http-connection conn (:body options)) (assoc state ::state ::started))) -(defn- connection-success? [conn] +(defn- connection-success? [#^HttpURLConnection conn] "Returns true if the HttpURLConnection response code is in the 2xx range." (= 2 (unchecked-divide (.getResponseCode conn) 100))) (defn- open-response "Agent action that opens the response body stream on the HTTP - request; this will block until the response stream is available." + request; this will block until the response stream is available." ; [state options] - (let [conn (::connection state)] + (let [#^HttpURLConnection conn (::connection state)] (assoc state ::response-stream (if (connection-success? conn) (.getInputStream conn) @@ -117,8 +119,9 @@ "Agent action that closes the response body stream and disconnects the HttpURLConnection." [state options] - (.close (::response-stream state)) - (.disconnect (::connection state)) + (when (::response-stream state) + (.close #^InputStream (::response-stream state))) + (.disconnect #^HttpURLConnection (::connection state)) (assoc state ::response-stream nil ::state ::disconnected)) @@ -127,10 +130,11 @@ "Returns true if the response status of the HTTP agent begins with digit, an Integer." [digit http-agnt] - (= digit (unchecked-divide (.getResponseCode (::connection @http-agnt)) + (= digit (unchecked-divide (.getResponseCode + #^HttpURLConnection (::connection @http-agnt)) 100))) -(defn- get-byte-buffer [http-agnt] +(defn- #^ByteArrayOutputStream get-byte-buffer [http-agnt] (let [buffer (result http-agnt)] (if (instance? ByteArrayOutputStream buffer) buffer @@ -143,20 +147,20 @@ retrieved with the 'stream', 'string', and 'bytes' functions." [http-agnt] (let [output (ByteArrayOutputStream.)] - (duck/copy (stream http-agnt) output) + (duck/copy (or (stream http-agnt) "") output) output)) ;;; CONSTRUCTOR (def *http-agent-defaults* - {:method "GET" - :headers {} - :body nil - :connect-timeout 0 - :read-timeout 0 - :follow-redirects true - :handler buffer-bytes}) + {:method "GET" + :headers {} + :body nil + :connect-timeout 0 + :read-timeout 0 + :follow-redirects true + :handler buffer-bytes}) (defn http-agent "Creates (and immediately returns) an Agent representing an HTTP @@ -240,7 +244,8 @@ (let [a @http-agnt] (if (= (::state a) ::receiving) (::response-stream a) - (ByteArrayInputStream. (.toByteArray (result http-agnt)))))) + (ByteArrayInputStream. + (.toByteArray (get-byte-buffer http-agnt)))))) (defn bytes "Returns a Java byte array of the content returned by the server; @@ -256,9 +261,10 @@ headers, or clojure.contrib.duck-streams/*default-encoding* if it is not specified." ([http-agnt] - (string http-agnt (or (.getContentEncoding (::connection @http-agnt)) - duck/*default-encoding*))) - ([http-agnt encoding] + (string http-agnt (or (.getContentEncoding + #^HttpURLConnection (::connection @http-agnt)) + duck/*default-encoding*))) + ([http-agnt #^String encoding] (.toString (get-byte-buffer http-agnt) encoding))) @@ -302,14 +308,14 @@ received." [http-agnt] (when (done? http-agnt) - (.getResponseCode (::connection @http-agnt)))) + (.getResponseCode #^HttpURLConnection (::connection @http-agnt)))) (defn message "Returns the HTTP response message (e.g. 'Not Found'), for this request, or nil if the response has not yet been received." [http-agnt] (when (done? http-agnt) - (.getResponseMessage (::connection http-agnt)))) + (.getResponseMessage #^HttpURLConnection (::connection @http-agnt)))) (defn headers "Returns a map of HTTP response headers. Header names are converted @@ -318,15 +324,16 @@ [http-agnt] (reduce (fn [m [#^String k v]] (assoc m (when k (keyword (.toLowerCase k))) (last v))) - {} (.getHeaderFields (::connection @http-agnt)))) + {} (.getHeaderFields + #^HttpURLConnection (::connection @http-agnt)))) (defn headers-seq "Returns the HTTP response headers in order as a sequence of [String,String] pairs. The first 'header' name may be null for the HTTP status line." [http-agnt] - (let [conn (::connection @http-agnt) - f (fn thisfn [i] + (let [#^HttpURLConnection conn (::connection @http-agnt) + f (fn thisfn [#^Integer i] ;; Get value first because first key may be nil. (when-let [value (.getHeaderField conn i)] (cons [(.getHeaderFieldKey conn i) value] diff --git a/src/clojure/contrib/java_utils.clj b/src/clojure/contrib/java_utils.clj index 6944f9ee..579d1128 100644 --- a/src/clojure/contrib/java_utils.clj +++ b/src/clojure/contrib/java_utils.clj @@ -90,11 +90,29 @@ (reduce file (file parent child) more))) (defn as-str - "Returns the name or string representation of x" - [x] - (if (instance? clojure.lang.Named x) - (name x) - (str x))) + "Like clojure.core/str, but if an argument is a keyword or symbol, + its name will be used instead of its literal representation. + + Example: + (str :foo :bar) ;;=> \":foo:bar\" + (as-str :foo :bar) ;;=> \"foobar\" + + Note that this does not apply to keywords or symbols nested within + data structures; they will be rendered as with str. + + Example: + (str {:foo :bar}) ;;=> \"{:foo :bar}\" + (as-str {:foo :bar}) ;;=> \"{:foo :bar}\" " + ([] "") + ([x] (if (instance? clojure.lang.Named x) + (name x) + (str x))) + ([x & ys] + ((fn [#^StringBuilder sb more] + (if more + (recur (. sb (append (as-str (first more)))) (next more)) + (str sb))) + (new StringBuilder #^String (as-str x)) ys))) (defn get-system-property "Get a system property." diff --git a/src/clojure/contrib/macro_utils.clj b/src/clojure/contrib/macro_utils.clj index 08c743e1..98685b77 100644 --- a/src/clojure/contrib/macro_utils.clj +++ b/src/clojure/contrib/macro_utils.clj @@ -1,7 +1,7 @@ ;; Macrolet and symbol-macrolet ;; by Konrad Hinsen -;; last updated May 25, 2009 +;; last updated August 19, 2009 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use ;; and distribution terms for this software are covered by the Eclipse @@ -26,8 +26,7 @@ of another macro, they may be used anywhere. Global symbol macros can be used only inside a with-symbol-macros form."} clojure.contrib.macro-utils - (:use [clojure.contrib.def :only (defvar-)]) - (:use [clojure.walk :only (prewalk)])) + (:use [clojure.contrib.def :only (defvar-)])) ; A set of all special forms. Special forms are not macro-expanded, making ; it impossible to shadow them by macro definitions. For most special diff --git a/src/clojure/contrib/monads.clj b/src/clojure/contrib/monads.clj index 68e03c13..8d287105 100644 --- a/src/clojure/contrib/monads.clj +++ b/src/clojure/contrib/monads.clj @@ -1,7 +1,7 @@ ;; Monads in Clojure ;; by Konrad Hinsen -;; last updated June 23, 2009 +;; last updated June 30, 2009 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use ;; and distribution terms for this software are covered by the Eclipse @@ -335,7 +335,7 @@ ; State monad (defmonad state-m "Monad describing stateful computations. The monadic values have the - structure (fn [old-state] (list result new-state))." + structure (fn [old-state] [result new-state])." [m-result (fn m-result-state [v] (fn [s] [v s])) m-bind (fn m-bind-state [mv f] diff --git a/src/clojure/contrib/str_utils2.clj b/src/clojure/contrib/str_utils2.clj index 5a32df6f..9a1ea9f7 100644 --- a/src/clojure/contrib/str_utils2.clj +++ b/src/clojure/contrib/str_utils2.clj @@ -1,7 +1,7 @@ -;;; str_utils2.clj -- experimental new string utilities for Clojure +;;; str_utils2.clj -- functional string utilities for Clojure ;; by Stuart Sierra, http://stuartsierra.com/ -;; June 4, 2009 +;; August 19, 2009 ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use ;; and distribution terms for this software are covered by the Eclipse @@ -29,8 +29,8 @@ Some ideas are borrowed from http://github.com/francoisdevlin/devlinsf-clojure-utils/"} clojure.contrib.str-utils2 - (:refer-clojure :exclude (take replace drop butlast partition contains? get)) - (:require [clojure.contrib.java-utils :as j]) + (:refer-clojure :exclude (take replace drop butlast partition + contains? get repeat reverse partial)) (:import (java.util.regex Pattern))) @@ -88,12 +88,13 @@ (lazy-seq (f s 0)))) (defn escape - "Escapes characters in string according to a cmap, a function or map - from characters to their replacements." + "Returns a new String by applying cmap (a function or a map) to each + character in s. If cmap returns nil, the original character is + added to the output unchanged." [#^String s cmap] (let [buffer (StringBuilder. (.length s))] (dochars [c s] - (if-let [r (cmap s)] + (if-let [r (cmap c)] (.append buffer r) (.append buffer c))) (.toString buffer))) @@ -104,7 +105,10 @@ (every? (fn [#^Character c] (Character/isWhitespace c)) s)) (defn take - "Take first n characters from s, up to the length of s." + "Take first n characters from s, up to the length of s. + + Note the argument order is the opposite of clojure.core/take; this + is to keep the string as the first argument for use with ->" [#^String s n] (if (< (count s) n) s @@ -112,14 +116,20 @@ (defn drop [#^String s n] "Drops first n characters from s. Returns an empty string if n is - greater than the length of s." + greater than the length of s. + + Note the argument order is the opposite of clojure.core/drop; this + is to keep the string as the first argument for use with ->" (if (< (count s) n) "" (.substring s n))) (defn butlast "Returns s without the last n characters. Returns an empty string - if n is greater than the length of s." + if n is greater than the length of s. + + Note the argument order is the opposite of clojure.core/butlast; + this is to keep the string as the first argument for use with ->" [#^String s n] (if (< (count s) n) "" @@ -132,6 +142,16 @@ s (.substring s (- (count s) n)))) +(defn repeat + "Returns a new String containing s repeated n times." + [#^String s n] + (apply str (clojure.core/repeat n s))) + +(defn reverse + "Returns s with its characters reversed." + [#^String s] + (.toString (.reverse (StringBuilder. s)))) + (defmulti #^{:doc "Replaces all instances of pattern in string with replacement. @@ -224,9 +244,13 @@ (apply str (interpose separator coll))) (defn chop - "Removes the last character of string." + "Removes the last character of string, does nothing on a zero-length + string." [#^String s] - (subs s 0 (dec (count s)))) + (let [size (count s)] + (if (zero? size) + s + (subs s 0 (dec (count s)))))) (defn chomp "Removes all trailing newline \\n or return \\r characters from @@ -235,10 +259,34 @@ (replace s #"[\r\n]+$" "")) (defn title-case [#^String s] - (throw (IllegalStateException. "title-case not implemented yet."))) + (throw (Exception. "title-case not implemeted yet"))) + +(defn swap-case + "Changes upper case characters to lower case and vice-versa. + Handles Unicode supplementary characters correctly. Uses the + locale-sensitive String.toUpperCase() and String.toLowerCase() + methods." + [#^String s] + (let [buffer (StringBuilder. (.length s)) + ;; array to make a String from one code point + #^"[I" array (make-array Integer/TYPE 1)] + (docodepoints [c s] + (aset-int array 0 c) + (if (Character/isLowerCase c) + ;; Character.toUpperCase is not locale-sensitive, but + ;; String.toUpperCase is; so we use a String. + (.append buffer (.toUpperCase (String. array 0 1))) + (.append buffer (.toLowerCase (String. array 0 1))))) + (.toString buffer))) -(defn swap-case [#^String s] - (throw (IllegalStateException. "swap-case not implemented yet."))) +(defn capitalize + "Converts first character of the string to upper-case, all other + characters to lower-case." + [#^String s] + (if (< (count s) 2) + (.toUpperCase s) + (str (.toUpperCase #^String (subs s 0 1)) + (.toLowerCase #^String (subs s 1))))) (defn ltrim "Removes whitespace from the left side of string." @@ -255,6 +303,33 @@ [#^String s] (seq (.split #"\r?\n" s))) +;; borrowed from compojure.str-utils, by James Reeves, EPL 1.0 +(defn map-str + "Apply f to each element of coll, concatenate all results into a + String." + [f coll] + (apply str (map f coll))) + +;; borrowed from compojure.str-utils, by James Reeves, EPL 1.0 +(defn grep + "Filters elements of coll by a regular expression. The String + representation (with str) of each element is tested with re-find." + [re coll] + (filter (fn [x] (re-find re (str x))) coll)) + +(defn partial + "Like clojure.core/partial for functions that take their primary + argument first. + + Takes a function f and its arguments, NOT INCLUDING the first + argument. Returns a new function whose first argument will be the + first argument to f. + + Example: (str-utils2/partial str-utils2/take 2) + ;;=> (fn [s] (str-utils2/take s 2))" + [f & args] + (fn [s & more] (apply f s (concat args more)))) + ;;; WRAPPERS diff --git a/src/clojure/contrib/test_contrib.clj b/src/clojure/contrib/test_contrib.clj index 17f3e0e9..d7b2597b 100644 --- a/src/clojure/contrib/test_contrib.clj +++ b/src/clojure/contrib/test_contrib.clj @@ -20,7 +20,7 @@ [:complex-numbers :fnmap :macro-utils :monads :pprint.pretty :pprint.cl-format :str-utils :shell-out :test-graph :test-dataflow :test-java-utils :test-lazy-seqs - :test-trace :test-jmx]) + :test-trace :test-jmx :java-utils]) (def test-namespaces (map #(symbol (str "clojure.contrib.test-contrib." (name %))) diff --git a/src/clojure/contrib/test_contrib/java_utils.clj b/src/clojure/contrib/test_contrib/java_utils.clj new file mode 100644 index 00000000..44901ad1 --- /dev/null +++ b/src/clojure/contrib/test_contrib/java_utils.clj @@ -0,0 +1,10 @@ +(ns clojure.contrib.test-contrib.java-utils + (:use clojure.test clojure.contrib.java-utils)) + +(deftest t-as-str + (is (= "foo" (as-str "foo"))) + (is (= "foo" (as-str 'foo))) + (is (= "foo" (as-str :foo))) + (is (= "[1 2 3]" (as-str [1 2 3]))) + (is (= "Hello, World!" (as-str "Hello, " :World \!))) + (is (= (str {:foo :bar}) (as-str {:foo :bar})))) diff --git a/src/clojure/contrib/test_contrib/str_utils2.clj b/src/clojure/contrib/test_contrib/str_utils2.clj index dac0893a..ee6aa68e 100644 --- a/src/clojure/contrib/test_contrib/str_utils2.clj +++ b/src/clojure/contrib/test_contrib/str_utils2.clj @@ -2,6 +2,18 @@ (:require [clojure.contrib.str-utils2 :as s]) (:use clojure.test)) +(deftest t-codepoints + (is (= (list 102 111 111 65536 98 97 114) + (s/codepoints "foo\uD800\uDC00bar")) + "Handles Unicode supplementary characters")) + +(deftest t-escape + (is (= "<foo&bar>" + (s/escape "<foo&bar>" {\& "&" \< "<" \> ">"}))) + (is (= " \\\"foo\\\" " + (s/escape " \"foo\" " {\" "\\\""}))) + (is (= "faabor" (s/escape "foobar" {\a \o, \o \a})))) + (deftest t-blank (is (s/blank? nil)) (is (s/blank? "")) @@ -29,6 +41,12 @@ (is (= "foobar" (s/tail "foobar" 9))) (is (= "" (s/tail "foobar" 0)))) +(deftest t-repeat + (is (= "foofoofoo" (s/repeat "foo" 3)))) + +(deftest t-reverse + (is (= "tab" (s/reverse "bat")))) + (deftest t-replace (is (= "faabar" (s/replace "foobar" \o \a))) (is (= "barbarbar" (s/replace "foobarfoo" "foo" "bar"))) @@ -38,7 +56,64 @@ (is (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar"))) (is (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case)))) -(deftest t-codepoints - (is (= (list 102 111 111 65536 98 97 114) - (s/codepoints "foo\uD800\uDC00bar")) - "Handles Unicode supplementary characters"))) +(deftest t-partition + (is (= (list "" "abc" "123" "def") + (s/partition "abc123def" #"[a-z]+")))) + +(deftest t-join + (is (= "1,2,3" (s/join \, [1 2 3]))) + (is (= "" (s/join \, []))) + (is (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3])))) + +(deftest t-chop + (is (= "fo" (s/chop "foo"))) + (is (= "") (s/chop "f")) + (is (= "") (s/chop ""))) + +(deftest t-chomp + (is (= "foo" (s/chomp "foo\n"))) + (is (= "foo" (s/chomp "foo\r\n"))) + (is (= "foo" (s/chomp "foo"))) + (is (= "" (s/chomp "")))) + +(deftest t-swap-case + (is (= "fOO!bAR" (s/swap-case "Foo!Bar"))) + (is (= "" (s/swap-case "")))) + +(deftest t-capitalize + (is (= "Foobar" (s/capitalize "foobar"))) + (is (= "Foobar" (s/capitalize "FOOBAR")))) + +(deftest t-ltrim + (is (= "foo " (s/ltrim " foo "))) + (is (= "" (s/ltrim " ")))) + +(deftest t-rtrim + (is (= " foo" (s/rtrim " foo "))) + (is (= "" (s/rtrim " ")))) + +(deftest t-split-lines + (is (= (list "one" "two" "three") + (s/split-lines "one\ntwo\r\nthree"))) + (is (= (list "foo") (s/split-lines "foo")))) + +(deftest t-upper-case + (is (= "FOOBAR" (s/upper-case "Foobar")))) + +(deftest t-lower-case + (is (= "foobar" (s/lower-case "FooBar")))) + +(deftest t-trim + (is (= "foo" (s/trim " foo \r\n")))) + +(deftest t-contains + (is (s/contains? "foobar" "foo")) + (is (not (s/contains? "foobar" "baz")))) + +(deftest t-get + (is (= \o (s/get "foo" 1)))) + +(deftest t-partial + (is (= "bar" ((s/partial s/drop 3) "foobar"))) + (is (= "ooba" ((comp (s/partial s/take 4) + (s/partial s/drop 1)) "foobar")))) |