diff options
Diffstat (limited to 'src/clojure')
| -rw-r--r-- | src/clojure/contrib/cond/cond.clj | 31 | ||||
| -rw-r--r-- | src/clojure/contrib/def/def.clj | 75 | ||||
| -rw-r--r-- | src/clojure/contrib/except/except.clj | 79 | ||||
| -rw-r--r-- | src/clojure/contrib/lazy_seqs/lazy_seqs.clj | 94 | ||||
| -rw-r--r-- | src/clojure/contrib/memoize/memoize.clj | 31 | ||||
| -rw-r--r-- | src/clojure/contrib/miglayout/internal/internal.clj | 75 | ||||
| -rw-r--r-- | src/clojure/contrib/miglayout/miglayout.clj | 63 | ||||
| -rw-r--r-- | src/clojure/contrib/miglayout/test/test.clj | 86 | ||||
| -rw-r--r-- | src/clojure/contrib/ns_utils/ns_utils.clj | 86 | ||||
| -rw-r--r-- | src/clojure/contrib/pred/pred.clj | 70 | ||||
| -rw-r--r-- | src/clojure/contrib/sql/internal/internal.clj | 43 | ||||
| -rw-r--r-- | src/clojure/contrib/sql/sql.clj | 138 | ||||
| -rw-r--r-- | src/clojure/contrib/sql/test/test.clj | 85 | ||||
| -rw-r--r-- | src/clojure/contrib/test_clojure/numbers/numbers.clj | 69 | ||||
| -rw-r--r-- | src/clojure/contrib/test_clojure/printer/printer.clj | 81 | ||||
| -rw-r--r-- | src/clojure/contrib/test_clojure/reader/reader.clj | 171 | ||||
| -rw-r--r-- | src/clojure/contrib/test_clojure/test_clojure.clj | 32 |
17 files changed, 0 insertions, 1309 deletions
diff --git a/src/clojure/contrib/cond/cond.clj b/src/clojure/contrib/cond/cond.clj deleted file mode 100644 index 3277e2e4..00000000 --- a/src/clojure/contrib/cond/cond.clj +++ /dev/null @@ -1,31 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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. -;; -;; File: cond.clj -;; -;; scgilardi (gmail) -;; 2 October 2008 - -(ns clojure.contrib.cond) - -(defmacro cond-let - "Takes a binding-form and a set of test/expr pairs. Evaluates each test - one at a time. If a test returns logical true, cond-let evaluates and - returns expr with binding-form bound to the value of test and doesn't - evaluate any of the other tests or exprs. To provide a default value - either provide a literal that evaluates to logical true and is - binding-compatible with binding-form, or use :else as the test and don't - refer to any parts of binding-form in the expr. (cond-let binding-form) - returns nil." - [binding-form & clauses] - (when-let [test expr & more] clauses - (if (= test :else) - expr - `(if ~test - (let [~binding-form ~test] ~expr) - (cond-let ~binding-form ~@more))))) diff --git a/src/clojure/contrib/def/def.clj b/src/clojure/contrib/def/def.clj deleted file mode 100644 index d6eb14af..00000000 --- a/src/clojure/contrib/def/def.clj +++ /dev/null @@ -1,75 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. -;; The use and distribution terms for this software are covered by the -;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) -;; which can be found in the file CPL.TXT 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. -;; -;; File: def.clj -;; -;; def.clj provides variants of def that make including doc strings and -;; making private definitions more succinct. -;; -;; scgilardi (gmail) -;; 17 May 2008 - -(ns clojure.contrib.def) - -(defmacro init-once - "Initializes a var exactly once. The var must already exist. - (NOTE: Since SVN 1008, Clojure includes defonce. Please use that instead - of init-once.)" - [var init] - `(let [v# (resolve '~var)] - (when-not (.isBound v#) - (.bindRoot v# ~init)))) - -(defmacro defvar - "Defines a var with an optional intializer and doc string" - ([name] - (list `def name)) - ([name init] - (list `def name init)) - ([name init doc] - (list `def (with-meta name (assoc (meta name) :doc doc)) init))) - -(defmacro defunbound - "Defines an unbound var with optional doc string" - ([name] - (list `def name)) - ([name doc] - (list `def (with-meta name (assoc (meta name) :doc doc))))) - -(defmacro defmacro- - "Same as defmacro but yields a private definition" - [name & decls] - (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls)) - -(defmacro defvar- - "Same as defvar but yields a private definition" - [name & decls] - (list* `defvar (with-meta name (assoc (meta name) :private true)) decls)) - -(defmacro defunbound- - "Same as defunbound but yields a private definition" - [name & decls] - (list* `defunbound (with-meta name (assoc (meta name) :private true)) decls)) - -(defmacro defstruct- - "Same as defstruct but yields a private definition" - [name & decls] - (list* `defstruct (with-meta name (assoc (meta name) :private true)) decls)) - -(defmacro defalias - "Defines an alias for a var: a new var with the same value and metadata - as another with the exception of :namespace, :name, :file, :line, and - optionally :doc which are those of new var." - ([name orig] - `(let [v# (def ~name ~orig)] - (. v# (setMeta (merge (meta #'~orig) (meta #'~name)))) - v#)) - ([name orig doc] - `(let [v# (def ~name ~orig)] - (. v# (setMeta (merge (meta #'~orig) (assoc (meta #'~name) :doc ~doc)))) - v#))) diff --git a/src/clojure/contrib/except/except.clj b/src/clojure/contrib/except/except.clj deleted file mode 100644 index e65044dc..00000000 --- a/src/clojure/contrib/except/except.clj +++ /dev/null @@ -1,79 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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. -;; -;; except.clj -;; -;; Provides functions that make it easy to specify the class and message -;; when throwing an Exception or Error. The optional message is formatted -;; using clojure/format. -;; -;; scgilardi (gmail) -;; Created 07 July 2008 - -(ns clojure.contrib.except - (:import (clojure.lang Reflector))) - -(declare throwable) - -(defn throwf - "Throws an Exception or Error with an optional message formatted using - clojure/format. All arguments are optional: - - class? format? format-args* - - - class defaults to Exception, if present it must name a kind of - Throwable - - format is a format string for clojure/format - - format-args are objects that correspond to format specifiers in - format." - [& args] - (throw (throwable args))) - -(defn throw-if - "Throws an Exception or Error if test is true. args are those documented - for throwf." - [test & args] - (when test - (throw (throwable args)))) - -;; throw-if-not is synonymous with assert, but clojure/assert exists - -(defn throw-if-not - "Throws an Exception or Error if test is false. args are those documented - for throwf." - [test & args] - (when-not test - (throw (throwable args)))) - -(defn throw-arg - "Throws an IllegalArgumentException. All arguments are optional: - - format? format-args* - - - format is a format string for clojure/format - - format-args are objects that correspond to format specifiers in - format." - [& args] - (throw (throwable (cons IllegalArgumentException args)))) - -(defn- throwable - "Constructs a Throwable with an optional formatted message. Its stack - trace will begin with our caller's caller. Args are as described for - throwf except throwable accepts them as list rather than inline." - [args] - (let [[class & [fmt & fmt-args]] (if (class? (first args)) - args - (cons Exception args)) - ctor-args (into-array (if fmt [(apply format fmt fmt-args)] [])) - throwable (Reflector/invokeConstructor class ctor-args) - our-prefix "clojure.contrib.except.throwable" - not-us? #(not (.startsWith (.getClassName %) our-prefix)) - raw-trace (.getStackTrace throwable) - edited-trace (into-array (drop 3 (drop-while not-us? raw-trace)))] - (.setStackTrace throwable edited-trace) - throwable)) diff --git a/src/clojure/contrib/lazy_seqs/lazy_seqs.clj b/src/clojure/contrib/lazy_seqs/lazy_seqs.clj deleted file mode 100644 index 5736e20f..00000000 --- a/src/clojure/contrib/lazy_seqs/lazy_seqs.clj +++ /dev/null @@ -1,94 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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. -;; -;; lazy-seqs -;; -;; == Lazy sequences == -;; -;; primes - based on the "naive" implemention described in [1] plus a -;; small "wheel" which eliminates multiples of 2, 3, 5, and -;; 7 from consideration by incrementing past them. Also inspired -;; by code from Christophe Grand in [2]. -;; -;; fibs - based on code from Rich Hickey at the Clojure wiki [3] -;; -;; powers-of-2 - all the powers of 2 -;; -;; == Lazy sequence functions == -;; -;; rotations - returns a lazy seq of all the rotations of a seq -;; -;; permutations - returns a lazy seq of all the permutations of a seq -;; -;; [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf -;; [2] http://clj-me.blogspot.com/2008/06/primes.html -;; [3] http://en.wikibooks.org/wiki/Clojure_Programming#Examples -;; -;; scgilardi (gmail) -;; Created 07 June 2008 - -(ns clojure.contrib.lazy-seqs - (:use clojure.contrib.def)) - -(defvar primes - (lazy-cat [2 3 5 7] - (let [primes-from - (fn primes-from [n [f & r]] - (if (some #(zero? (rem n %)) - (take-while #(<= (* % %) n) primes)) - (recur (+ n f) r) - (lazy-cons n (primes-from (+ n f) r)))) - wheel (cycle [2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2 - 6 4 6 8 4 2 4 2 4 8 6 4 6 2 4 6 - 2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10])] - (primes-from 11 wheel))) - "A lazy sequence of all the prime numbers.") - -(defvar fibs - (lazy-cat [0 1] - (let [rest-fn - (fn rest-fn [a b] - (let [next (+ a b)] - (lazy-cons next (rest-fn b next))))] - (rest-fn 0 1))) - "A lazy sequence of all the fibonacci numbers.") - -(defvar powers-of-2 - (lazy-cons 1 (map #(bit-shift-left % 1) powers-of-2)) - "A lazy sequence of all the powers of 2") - -(defn rotations - "Returns a lazy seq of all rotations of a seq" - [x] - (if (seq x) - (map - (fn [n _] - (lazy-cat (drop n x) (take n x))) - (iterate inc 0) x) - (list nil))) - -(defn permutations - "Returns a lazy seq of all permutations of a seq" - [x] - (if (seq x) - (mapcat - (fn [[f & r]] - (map #(cons f %) (permutations r))) - (rotations x)) - (list nil))) - -(defn combinations - "Returns a lazy seq of all combinations built of one item from each seq given. - See also (doc for)" - [& acs] - (let [step (fn step [head [s & cs :as acs]] - (if acs - (mapcat #(step (conj head %) cs) s) - (list head)))] - (when acs - (step [] acs)))) diff --git a/src/clojure/contrib/memoize/memoize.clj b/src/clojure/contrib/memoize/memoize.clj deleted file mode 100644 index 558106c6..00000000 --- a/src/clojure/contrib/memoize/memoize.clj +++ /dev/null @@ -1,31 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. -;; The use and distribution terms for this software are covered by the -;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) -;; which can be found in the file CPL.TXT 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. -;; -;; File: memoize.clj -;; -;; scgilardi (gmail) -;; 02 June 2008 -;; -;; Based on Common Lisp code from: -;; http://asymmetrical-view.com/talks/lisp-presentation/lisp-presentation.pdf - -(ns clojure.contrib.memoize) - -(defn memoize - "Returns a memoized version of a referentially transparent function. The - memoized version of the function keeps a cache of the mapping from arguments - to results and, when calls with the same arguments are repeated often, has - higher performance at the expense of higher memory use." - [function] - (let [cache (ref {})] - (fn [& args] - (or (@cache args) - (let [result (apply function args)] - (dosync - (commute cache assoc args result)) - result))))) diff --git a/src/clojure/contrib/miglayout/internal/internal.clj b/src/clojure/contrib/miglayout/internal/internal.clj deleted file mode 100644 index 07391b77..00000000 --- a/src/clojure/contrib/miglayout/internal/internal.clj +++ /dev/null @@ -1,75 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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. -;; -;; clojure.contrib.miglayout.internal -;; -;; Internal functions for 'clojure.contrib.miglayout -;; -;; scgilardi (gmail) -;; Created 13 October 2008 - -(ns clojure.contrib.miglayout.internal - (:import (java.awt Component)) - (:use (clojure.contrib except fcase))) - -(defn format-constraint - "Returns a vector of vectors representing one or more constraints - separated by commas. Constraints may be specified in Clojure using - strings, keywords, vectors, and/or maps." - [c] - [[", "] - (fcase #(%1 %2) c - string? [c] - keyword? [c] - vector? (interpose " " c) - map? (apply concat (interpose [", "] (map #(interpose " " %) c))) - (throwf IllegalArgumentException - "unrecognized constraint: %s (%s)" c (class c)))]) - -(defn the-str - "Returns the string for x--its name if it's a keyword." - [x] - ((if (keyword? x) name str) x)) - -(defn format-constraints - "Returns a string representing all the constraints for one keyword-item - or component formatted for miglayout." - [& constraints] - (apply str - (map the-str - (rest (reduce concat [] - (mapcat format-constraint constraints)))))) - -(defn component? - "Returns true if x is a java.awt.Component" - [x] - (instance? Component x)) - -(defn constraint? - "Returns true if x is not a keyword-item or component" - [x] - (not - (or (component? x) - (#{:layout :column :row} x)))) - -(defn parse-item-constraints - "Iterates over args and builds a map containing :keywords, a map of from - keyword-item to constraints string and :components, a vector of vectors - each associating a component with its constraints string. :components is - a vector because ordering of components matters." - [& args] - (loop [[item & args] args - item-constraints {:components [] :keyword-items {}}] - (if item - (let [[constraints args] (split-with constraint? args)] - (recur args - (update-in - item-constraints - [(if (component? item) :components :keyword-items)] - conj [item (apply format-constraints constraints)]))) - item-constraints))) diff --git a/src/clojure/contrib/miglayout/miglayout.clj b/src/clojure/contrib/miglayout/miglayout.clj deleted file mode 100644 index 79a111b1..00000000 --- a/src/clojure/contrib/miglayout/miglayout.clj +++ /dev/null @@ -1,63 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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. -;; -;; clojure.contrib.miglayout -;; -;; Clojure support for the MiGLayout layout manager -;; http://www.miglayout.com/ -;; -;; Example: -;; -;; (require '[clojure.contrib.miglayout.test :as mlt]) -;; (doseq i (range 3) (mlt/run-test i)) -;; -;; scgilardi (gmail) -;; Created 5 October 2008 - -(ns clojure.contrib.miglayout - (:import (java.awt Container Component) - (net.miginfocom.swing MigLayout)) - (:use clojure.contrib.miglayout.internal)) - -(defn miglayout - "Adds java.awt.Components to a java.awt.Container with constraints - formatted for the MiGLayout layout manager. - - Arguments: container [item constraint*]* - - - container: the container for the specified components, its layout - manager will be set to a new instance of MigLayout - - - an inline series of items and constraints--each item may be followed - by zero or more constraints. - - Item: - - - An item is either a Component or one of the keywords :layout - :column or :row. Constraints for a keyword item affect the entire - layout. - - Constraint: string, keyword, vector, or map - - - A string specifies one or more constraints each with zero or more - arguments. - - A keyword specifies a single constraint without arguments - - A vector specifies a single constraint with one or more arguments - - A map specifies one or more constraints as keys, each mapped to a - single argument" - [#^Container container & args] - (let [{:keys [keyword-items components]} - (apply parse-item-constraints args)] - (.setLayout container - (MigLayout. - (:layout keyword-items) - (:column keyword-items) - (:row keyword-items))) - (doseq [#^Component component constraints] components - (.add container component constraints)) - container)) diff --git a/src/clojure/contrib/miglayout/test/test.clj b/src/clojure/contrib/miglayout/test/test.clj deleted file mode 100644 index 3ff7a97c..00000000 --- a/src/clojure/contrib/miglayout/test/test.clj +++ /dev/null @@ -1,86 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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. -;; -;; clojure.contrib.miglayout.test -;; -;; Test/example for clojure.contrib.miglayout -;; -;; scgilardi (gmail) -;; Created 5 October 2008 - -(ns clojure.contrib.miglayout.test - (:import (javax.swing JButton JFrame JLabel JList JPanel - JScrollPane JTabbedPane JTextField JSeparator)) - (:use clojure.contrib.miglayout)) - -(def tests) - -(defn run-test - [index] - (doto (JFrame. (format "MigLayout Test %d" index)) - (add ((tests index) (JPanel.))) - (pack) - (setVisible true))) - -(def tests [ - - (fn test0 - [panel] - (miglayout panel - (JLabel. "Hello") - (JLabel. "World") {:gap :unrelated} - (JTextField. 10) :wrap - (JLabel. "Bonus!") - (JButton. "Bang it") {:wmin :button :grow :x :span 2} :center)) - - ;; test1 and test2 are based on code from - ;; http://www.devx.com/java/Article/38017/1954 - - ;; constraints as strings exclusively - (fn test1 - [panel] - (miglayout panel - :column "[right]" - (JLabel. "General") "split, span" - (JSeparator.) "growx, wrap" - (JLabel. "Company") "gap 10" - (JTextField. "") "span, growx" - (JLabel. "Contact") "gap 10" - (JTextField. "") "span, growx, wrap" - (JLabel. "Propeller") "split, span, gaptop 10" - (JSeparator.) "growx, wrap, gaptop 10" - (JLabel. "PTI/kW") "gapx 10, gapy 15" - (JTextField. 10) - (JLabel. "Power/kW") "gap 10" - (JTextField. 10) "wrap" - (JLabel. "R/mm") "gap 10" - (JTextField. 10) - (JLabel. "D/mm") "gap 10" - (JTextField. 10))) - - ;; the same constraints as strings, keywords, vectors, and maps - (fn test2 - [panel] - (miglayout panel - :column "[right]" - (JLabel. "General") "split, span" - (JSeparator.) :growx :wrap - (JLabel. "Company") [:gap 10] - (JTextField. "") :span :growx - (JLabel. "Contact") [:gap 10] - (JTextField. "") :span :growx :wrap - (JLabel. "Propeller") :split :span [:gaptop 10] - (JSeparator.) :growx :wrap [:gaptop 10] - (JLabel. "PTI/kW") {:gapx 10 :gapy 15} - (JTextField. 10) - (JLabel. "Power/kW") [:gap 10] - (JTextField. 10) :wrap - (JLabel. "R/mm") [:gap 10] - (JTextField. 10) - (JLabel. "D/mm") [:gap 10] - (JTextField. 10)))]) diff --git a/src/clojure/contrib/ns_utils/ns_utils.clj b/src/clojure/contrib/ns_utils/ns_utils.clj deleted file mode 100644 index c4a33ddc..00000000 --- a/src/clojure/contrib/ns_utils/ns_utils.clj +++ /dev/null @@ -1,86 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. -;; The use and distribution terms for this software are covered by the -;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) -;; which can be found in the file CPL.TXT 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-utils -;; -;; Namespace Utilities -;; -;; 'get-ns' returns the namespace named by a symbol or throws -;; if the namespace does not exist -;; -;; 'ns-vars' returns a sorted seq of symbols naming public vars -;; in a namespace -;; -;; 'print-dir' prints a sorted directory of public vars in a -;; namespace -;; -;; 'print-docs' prints documentation for the public vars in a -;; namespace -;; -;; Convenience -;; -;; 'vars' returns a sorted seq of symbols naming public vars -;; in a namespace (macro) -;; -;; 'dir' prints a sorted directory of public vars in a -;; namespace (macro) -;; -;; 'docs' prints documentation for the public vars in a -;; namespace (macro) -;; -;; scgilardi (gmail) -;; 23 April 2008 - -(ns clojure.contrib.ns-utils - (:use clojure.contrib.except)) - -;; Namespace Utilities - -(defn get-ns - "Returns the namespace named by ns-sym or throws if the - namespace does not exist" - [ns-sym] - (let [ns (find-ns ns-sym)] - (throw-if (not ns) "Unable to find namespace: %s" ns-sym) - ns)) - -(defn ns-vars - "Returns a sorted seq of symbols naming public vars in - a namespace" - [ns] - (sort (map first (ns-publics ns)))) - -(defn print-dir - "Prints a sorted directory of public vars in a namespace" - [ns] - (doseq item (ns-vars ns) - (println item))) - -(defn print-docs - "Prints documentation for the public vars in a namespace" - [ns] - (doseq item (ns-vars ns) - (print-doc (ns-resolve ns item)))) - -;; Convenience - -(defmacro vars - "Returns a sorted seq of symbols naming public vars in - a namespace" - [nsname] - `(ns-vars (get-ns '~nsname))) - -(defmacro dir - "Prints a sorted directory of public vars in a namespace" - [nsname] - `(print-dir (get-ns '~nsname))) - -(defmacro docs - "Prints documentation for the public vars in a namespace" - [nsname] - `(print-docs (get-ns '~nsname))) diff --git a/src/clojure/contrib/pred/pred.clj b/src/clojure/contrib/pred/pred.clj deleted file mode 100644 index 9760ec0e..00000000 --- a/src/clojure/contrib/pred/pred.clj +++ /dev/null @@ -1,70 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. -;; The use and distribution terms for this software are covered by the -;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) -;; which can be found in the file CPL.TXT 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. -;; -;; pred.clj -;; -;; Some clojure predicates -;; -;; Items commented out below are defined in the clojure namespace -;; -;; scgilardi (gmail) -;; 28 June 2008 - -(ns clojure.contrib.pred) - -;; coll? -;; list? -;; map? -;; set? - -(defn stack? - "Returns true if x implements IPersistentStack" - [x] - (instance? clojure.lang.IPersistentStack x)) - -;; vector? - -(defn ref? - "Returns true if x implements IRef" - [x] - (instance? clojure.lang.IRef x)) - -;; seq? -;; var? - -(defn map-entry? - "Returns true if x is a MapEntry" - [x] - (instance? clojure.lang.MapEntry x)) - -(defn atom? - "Returns true if x is not a collection" - [x] - (not (coll? x))) - -;; number? -;; ratio? - -(defn range? - "Returns true if x is a Range" - [x] - (instance? clojure.lang.Range x)) - -;; function? -> fn? - -(defmacro macro? - "Returns true if x is a function and the symbol of the - same name can be resolved and has its :macro metadata - set" - [x] - `(and (fn? ~x) (boolean (:macro ^#'~x)))) - -;; integer? -;; even? -;; odd? -;; empty? diff --git a/src/clojure/contrib/sql/internal/internal.clj b/src/clojure/contrib/sql/internal/internal.clj deleted file mode 100644 index 6221d1e2..00000000 --- a/src/clojure/contrib/sql/internal/internal.clj +++ /dev/null @@ -1,43 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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. -;; -;; internal definitions for clojure.contrib.sql -;; -;; scgilardi (gmail) -;; Created 3 October 2008 - -(ns clojure.contrib.sql.internal) - -(def *db* {:connection nil :level 0}) - -(defn connection - "Returns the current database connection or throws an exception." - [] - (or (:connection *db*) - (throw (Exception. "no current database connection")))) - -(defn the-str - "Returns the name or string representation of x" - [x] - (if (instance? clojure.lang.Named x) - (name x) - (str x))) - -(defn properties - "Converts a map from keywords or symbols to values into a - java.util.Properties object that maps the same keys to the values with - all represented as strings." - [m] - (let [p (java.util.Properties.)] - (when m - (loop [[key & keys] (keys m) - [val & vals] (vals m)] - (.setProperty p (the-str key) (the-str val)) - (when keys - (recur keys vals)))) - p)) diff --git a/src/clojure/contrib/sql/sql.clj b/src/clojure/contrib/sql/sql.clj deleted file mode 100644 index 312a561c..00000000 --- a/src/clojure/contrib/sql/sql.clj +++ /dev/null @@ -1,138 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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. -;; -;; sql.clj -;; -;; A Clojure interface to sql databases via jdbc -;; -;; See clojure.contrib.sql.test for an example -;; -;; scgilardi (gmail) -;; Created 2 April 2008 - -(ns clojure.contrib.sql - (:use clojure.contrib.except - clojure.contrib.sql.internal)) - -(defmacro with-connection - "Evaluates body in the context of a new connection to a database then - closes it. db-spec is a map containing string values for these required - keys: - :classname the jdbc driver class name - :subprotocol the jdbc subprotocol - :subname the jdbc subname - db-spec may contain additional key-value pairs that are passed along to - the driver as properties such as :user, :password, etc." - [db-spec & body] - `(do - (Class/forName (:classname ~db-spec)) - (with-open con# - (java.sql.DriverManager/getConnection - (format "jdbc:%s:%s" (:subprotocol ~db-spec) (:subname ~db-spec)) - (properties (dissoc ~db-spec :classname :subprotocol :subname))) - (binding [*db* (assoc *db* :connection con# :level 0)] - ~@body)))) - -(defmacro transaction - "Evaluates body as a transaction on the open database connection. Updates - are committed together as a group after evaluating body or rolled back on - any uncaught exception. Any nested transactions will be absorbed into the - outermost transaction." - [& body] - `(let [con# (connection) - level# (:level *db*)] - (binding [*db* (assoc *db* :level (inc level#))] - (let [auto-commit# (.getAutoCommit con#)] - (when (zero? level#) - (.setAutoCommit con# false)) - (try - (let [value# (do ~@body)] - (when (zero? level#) - (.commit con#)) - value#) - (catch Exception e# - (.rollback con#) - (throw (Exception. - (format "transaction rolled back: %s" - (.getMessage e#)) e#))) - (finally - (when (zero? level#) - (.setAutoCommit con# auto-commit#)))))))) - -(defn do-commands - "Executes SQL commands that don't return results on the open database - connection" - [& commands] - (with-open stmt (.createStatement (connection)) - (doseq cmd commands - (.addBatch stmt cmd)) - (.executeBatch stmt))) - -(defn do-prepared - "Executes a prepared statement on the open database connection with - parameter sets" - [sql & sets] - (with-open stmt (.prepareStatement (connection) sql) - (doseq set sets - (doseq [index value] (map vector (iterate inc 1) set) - (.setObject stmt index value)) - (.addBatch stmt)) - (.executeBatch stmt))) - -(defn create-table - "Creates a table on the open database connection given a name (a string - or keyword) and column specs. A column spec is a vector containing a name - and optionally a type and other items such as constraints, each a string - or keyword." - [name & column-specs] - (do-commands - (format "create table %s (%s)" - (the-str name) - (apply str - (map the-str - (apply concat - (interpose [", "] - (map (partial interpose " ") column-specs)))))))) - -(defn drop-table - "Drops a table on the open database connection given its name (a string - or keyword)" - [name] - (do-commands - (format "drop table %s" (the-str name)))) - -(defn insert-values - "Inserts values into columns of a table. columns is a vector of column - names (strings or keywords) and each value is a vector of values for - those columns. To insert complete rows (all columns), use insert-rows." - [table column-names & values] - (let [count (count (first values)) - template (apply str (interpose "," (replicate count "?"))) - columns (if (seq column-names) - (format "(%s)" - (apply str (interpose "," (map the-str column-names)))) - "")] - (apply do-prepared - (format "insert into %s %s values (%s)" - (the-str table) columns template) - values))) - -(defn insert-rows - "Inserts complete rows into a table. Each row is a vect |