Page Not Found
9 |
10 |
11 |
--------------------------------------------------------------------------------
/public/javascripts/clojure.js:
--------------------------------------------------------------------------------
1 | // (?=[\[\]\{\}\(\) \^\,\#\']|$) is to avoid \b matching '-' boundaries
2 | CodeHighlighter.addStyle("clojure",{
3 | "comment": {
4 | exp: /;[^\n]+/
5 | },
6 | "parens": {
7 | exp: /\(|\)/
8 | },
9 | "brackets": {
10 | exp: /\[|\]/
11 | },
12 | "curlybrackets": {
13 | exp: /\{|\}/
14 | },
15 | "keyword": {
16 | exp: /(:{1,2}[\w|-]+)/
17 | },
18 | "specialvar": {
19 | exp: /\b(\*print-length\*)(?=[\[\]\{\}\(\) \^\,\#\']|$)/
20 | },
21 | "specialops": {
22 | exp: /\b(new|quote|\&|var|set\!|monitor-enter|recur|\.|do|fn\*|throw|monitor-exit|finally|let\*|loop\*|try|catch|if|def)(?=[\[\]\{\}\(\) \^\,\#\']|$)/
23 | },
24 | "function": {
25 | exp: /\b(def|sorted-map|read-line|re-pattern|keyword\?|val|!|max-key|list\*|ns-aliases|\=\=|longs|special-form-anchor|instance\?|syntax-symbol-anchor|format|sequential\?|fn\?|empty|dorun|gensym|not\=|unchecked-multiply|bit-or|aset-byte|hash-set|add-watch|unchecked-dec|some|nil\?|string\?|second|keys|long-array|bit-set|sorted\?|ns-unalias|ns-publics|all-ns|long|add-classpath|false\?|await1|true\?|short|ns-unmap|repeat|zipmap|distinct|get-in|bit-xor|complement|get-validator|derive|aset-float|scan|commute|rem|set-validator|odd\?|symbol\?|proxy-call-with-super|ns-interns|re-matches|split-with|find-doc|rfirst|gen-and-load-class|import|symbol|vals|print-doc|select-keys|re-matcher|rand|deref|unchecked-inc|read|make-hierarchy|\+|number\?|descendants|into-array|last|unchecked-negate|integer\?|alter|prn|with-meta|floats|fnseq|butlast|-|reversible\?|rseq|send-off|seq\?|identical\?|print|bit-flip|zero\?|bit-and|re-groups|newline|cache-seq|replicate|distinct\?|remove-ns|ratio\?|xml-seq|vec|concat|update-in|vector|conj|bases|\/|unchecked-add|ref-set|assoc|seque|aset-char|boolean|read-string|neg\?|float-array|doubles|isa\?|remove-watch|print-str|gen-and-save-class|rsubseq|vector\?|split-at|ns-refers|create-struct|int-array|float|rrest|map|double-array|accessor|class\?|rand-int|aset-short|prn-str|iterate|slurp|mapcat|assoc-in|special-symbol\?|ref|find-var|inc|unchecked-subtract|ns-name|re-find|bit-not|construct-proxy|destructure|seq|to-array-2d|sorted-map-by|filter|var\?|key|class|re-seq|empty\?|test|create-ns|name|list\?|nthrest|aset|doall|macroexpand-1|not-any\?|resultset-seq|into|ffirst|bit-clear|load-reader|hash|print-ctor|associative\?|float\?|drop-last|replace|decimal\?|parents|map\?|quot|file-seq|send|reverse|count|get-proxy-class|set|comp|nth|byte|constantly|load|namespace|pr-str|<|rationalize|sort-by|cycle|peek|reduce|interleave|cons|macroexpand|var-set|str|aset-boolean|ns-imports|first|bean|\=|var-get|range|tree-seq|aset-double|enumeration-seq|ensure|find-ns|not-every\?|struct-map|>|max|proxy-mappings|identity|ints|min-key|subs|agent-errors|clear-agent-errors|printf|ns-resolve|method-sig|>\=|shutdown-agents|even\?|require|bit-shift-left|touch|compare|cast|supers|load-string|get|<\=|await|resolve|loaded-libs|force|partial|pmap|comparator|pos\?|char|take-while|refer|underive|in-ns|iterator-seq|ancestors|partition|contains\?|update-proxy|interpose|aset-int|load-file|apply|subvec|rest|keyword|ns-map|int|bigdec|aset-long|struct|array-map|bigint|dec|println|aget|pr|drop|gen-class|eval|aclone|pop|bit-shift-right|delay\?|num|disj|rational\?|merge-with|take-nth|double|line-seq|take|set\?|make-array|alias|use|alength|to-array|hash-map|bit-and-not|repeatedly|frest|remove|find|coll\?|drop-while|not-empty|print-special-doc|println-str|list|every\?|flush|sort|dissoc|not|agent|sorted-set|alter-var-root|merge|subseq|min|print-simple|bit-test|await-for|meta|unchecked-divide|rename-keys|union|select|project|join|intersection|map-invert|difference|rename|index|startparse-sax|parse|emit-element|emit|lefts|down|insert-left|up|next|path|children|vector-zip|append-child|zipper|branch\?|end\?|edit|replace|insert-right|root|insert-child|seq-zip|xml-zip|make-node|rights|node|right|left|remove|pany|par|pdistinct|pfilter-dupes|pfilter-nils|pmax|pmin|preduce|psort|psummary|pvec)(?=[\[\]\{\}\(\) \^\,\#\']|$)/
26 | },
27 | "macro": {
28 | exp: /\b(time|remove-method|doseq|for|cond|fn|dosync|with-open|sync|let|dotimes|defmethod|lazy-cat|defstruct|with-in-str|loop|with-out-str|when-not|refer-clojure|\.\.|doto|proxy-super|assert|memfn|when-first|definline|defn-|comment|ns|with-precision|or|defn|with-local-vars|when-let|amap|->|defmacro|prefer-method|if-let|and|lazy-seq|declare|locking|delay|defmulti|proxy|defonce|when|areduce|binding|doc)(?=[\[\]\{\}\(\) \^\,\#\']|$)/
29 | },
30 | "string": {
31 | exp: /"(\\"|[^"])*"/
32 | },
33 | /* "preencoded" is just a hack to stop the comment rule from inseting a semicolon after -> */
34 | "preencoded": {
35 | exp: />|<|&/
36 | }
37 | });
38 |
--------------------------------------------------------------------------------
/public/javascripts/code-highlighter.js:
--------------------------------------------------------------------------------
1 | /* Unobtrustive Code Highlighter By Dan Webb 11/2005
2 | Version: 0.4
3 |
4 | Usage:
5 | Add a script tag for this script and any stylesets you need to use
6 | to the page in question, add correct class names to CODE elements,
7 | define CSS styles for elements. That's it!
8 |
9 | Known to work on:
10 | IE 5.5+ PC
11 | Firefox/Mozilla PC/Mac
12 | Opera 7.23 + PC
13 | Safari 2
14 |
15 | Known to degrade gracefully on:
16 | IE5.0 PC
17 |
18 | Note: IE5.0 fails due to the use of lookahead in some stylesets. To avoid script errors
19 | in older browsers use expressions that use lookahead in string format when defining stylesets.
20 |
21 | This script is inspired by star-light by entirely cunning Dean Edwards
22 | http://dean.edwards.name/star-light/.
23 | */
24 |
25 | // replace callback support for safari.
26 | if ("a".replace(/a/, function() {return "b"}) != "b") (function(){
27 | var default_replace = String.prototype.replace;
28 | String.prototype.replace = function(search,replace){
29 | // replace is not function
30 | if(typeof replace != "function"){
31 | return default_replace.apply(this,arguments)
32 | }
33 | var str = "" + this;
34 | var callback = replace;
35 | // search string is not RegExp
36 | if(!(search instanceof RegExp)){
37 | var idx = str.indexOf(search);
38 | return (
39 | idx == -1 ? str :
40 | default_replace.apply(str,[search,callback(search, idx, str)])
41 | )
42 | }
43 | var reg = search;
44 | var result = [];
45 | var lastidx = reg.lastIndex;
46 | var re;
47 | while((re = reg.exec(str)) != null){
48 | var idx = re.index;
49 | var args = re.concat(idx, str);
50 | result.push(
51 | str.slice(lastidx,idx),
52 | callback.apply(null,args).toString()
53 | );
54 | if(!reg.global){
55 | lastidx += RegExp.lastMatch.length;
56 | break
57 | }else{
58 | lastidx = reg.lastIndex;
59 | }
60 | }
61 | result.push(str.slice(lastidx));
62 | return result.join("")
63 | }
64 | })();
65 |
66 | var CodeHighlighter = { styleSets : new Array };
67 |
68 | CodeHighlighter.addStyle = function(name, rules) {
69 | // using push test to disallow older browsers from adding styleSets
70 | if ([].push) this.styleSets.push({
71 | name : name,
72 | rules : rules,
73 | ignoreCase : arguments[2] || false
74 | })
75 |
76 | function setEvent() {
77 | // set highlighter to run on load (use LowPro if present)
78 | if (typeof Event != 'undefined' && typeof Event.onReady == 'function')
79 | return Event.onReady(CodeHighlighter.init.bind(CodeHighlighter));
80 |
81 | var old = window.onload;
82 |
83 | if (typeof window.onload != 'function') {
84 | window.onload = function() { CodeHighlighter.init() };
85 | } else {
86 | window.onload = function() {
87 | old();
88 | CodeHighlighter.init();
89 | }
90 | }
91 | }
92 |
93 | // only set the event when the first style is added
94 | if (this.styleSets.length==1) setEvent();
95 | }
96 |
97 | CodeHighlighter.init = function() {
98 | if (!document.getElementsByTagName) return;
99 | if ("a".replace(/a/, function() {return "b"}) != "b") return; // throw out Safari versions that don't support replace function
100 | // throw out older browsers
101 |
102 | var codeEls = document.getElementsByTagName("CODE");
103 | // collect array of all pre elements
104 | codeEls.filter = function(f) {
105 | var a = new Array;
106 | for (var i = 0; i < this.length; i++) if (f(this[i])) a[a.length] = this[i];
107 | return a;
108 | }
109 |
110 | var rules = new Array;
111 | rules.toString = function() {
112 | // joins regexes into one big parallel regex
113 | var exps = new Array;
114 | for (var i = 0; i < this.length; i++) exps.push(this[i].exp);
115 | return exps.join("|");
116 | }
117 |
118 | function addRule(className, rule) {
119 | // add a replace rule
120 | var exp = (typeof rule.exp != "string")?String(rule.exp).substr(1, String(rule.exp).length-2):rule.exp;
121 | // converts regex rules to strings and chops of the slashes
122 | rules.push({
123 | className : className,
124 | exp : "(" + exp + ")",
125 | length : (exp.match(/(^|[^\\])\([^?]/g) || "").length + 1, // number of subexps in rule
126 | replacement : rule.replacement || null
127 | });
128 | }
129 |
130 | function parse(text, ignoreCase) {
131 | // main text parsing and replacement
132 | return text.replace(new RegExp(rules, (ignoreCase)?"gi":"g"), function() {
133 | var i = 0, j = 1, rule;
134 | while (rule = rules[i++]) {
135 | if (arguments[j]) {
136 | // if no custom replacement defined do the simple replacement
137 | if (!rule.replacement) return "" + arguments[0] + "";
138 | else {
139 | // replace $0 with the className then do normal replaces
140 | var str = rule.replacement.replace("$0", rule.className);
141 | for (var k = 1; k <= rule.length - 1; k++) str = str.replace("$" + k, arguments[j + k]);
142 | return str;
143 | }
144 | } else j+= rule.length;
145 | }
146 | });
147 | }
148 |
149 | function highlightCode(styleSet) {
150 | // clear rules array
151 | var parsed, clsRx = new RegExp("(\\s|^)" + styleSet.name + "(\\s|$)");
152 | rules.length = 0;
153 |
154 | // get stylable elements by filtering out all code elements without the correct className
155 | var stylableEls = codeEls.filter(function(item) { return clsRx.test(item.className) });
156 |
157 | // add style rules to parser
158 | for (var className in styleSet.rules) addRule(className, styleSet.rules[className]);
159 |
160 |
161 | // replace for all elements
162 | for (var i = 0; i < stylableEls.length; i++) {
163 | // EVIL hack to fix IE whitespace badness if it's inside a
164 | if (/MSIE/.test(navigator.appVersion) && stylableEls[i].parentNode.nodeName == 'PRE') {
165 | stylableEls[i] = stylableEls[i].parentNode;
166 |
167 | parsed = stylableEls[i].innerHTML.replace(/(]*>)([^<]*)<\/code>/i, function() {
168 | return arguments[1] + parse(arguments[2], styleSet.ignoreCase) + ""
169 | });
170 | parsed = parsed.replace(/\n( *)/g, function() {
171 | var spaces = "";
172 | for (var i = 0; i < arguments[1].length; i++) spaces+= " ";
173 | return "\n" + spaces;
174 | });
175 | parsed = parsed.replace(/\t/g, " ");
176 | parsed = parsed.replace(/\n(<\/\w+>)?/g, "
$1").replace(/
[\n\r\s]*
/g, "
");
177 |
178 | } else parsed = parse(stylableEls[i].innerHTML, styleSet.ignoreCase);
179 |
180 | stylableEls[i].innerHTML = parsed;
181 | }
182 | }
183 |
184 | // run highlighter on all stylesets
185 | for (var i=0; i < this.styleSets.length; i++) {
186 | highlightCode(this.styleSets[i]);
187 | }
188 | }
--------------------------------------------------------------------------------
/public/stylesheets/code-highlighter.css:
--------------------------------------------------------------------------------
1 | .clojure .comment { color: gray; }
2 | .clojure .string { color: teal; }
3 | .clojure .function { color: #00c; }
4 | .clojure .macro, .specialops { color: #60c; }
5 | .clojure .parens { color: #000; }
6 | .clojure .keyword { color: #c09; }
7 | .clojure .brackets { color: #006; }
8 | .clojure .curlybrackets { color: #906; }
9 |
--------------------------------------------------------------------------------
/src/examples/atom_snake.clj:
--------------------------------------------------------------------------------
1 | ; Inspired by the snakes the have gone before:
2 | ; Abhishek Reddy's snake: http://www.plt1.com/1070/even-smaller-snake/
3 | ; Mark Volkmann's snake: http://www.ociweb.com/mark/programming/ClojureSnake.html
4 |
5 | (ns examples.atom-snake
6 | (:import (java.awt Color Dimension)
7 | (javax.swing JPanel JFrame Timer JOptionPane)
8 | (java.awt.event ActionListener KeyListener))
9 | (:use examples.import-static))
10 | (import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_UP VK_DOWN)
11 |
12 | ; ----------------------------------------------------------
13 | ; functional model
14 | ; ----------------------------------------------------------
15 | (def width 75)
16 | (def height 50)
17 | (def point-size 10)
18 | (def turn-millis 75)
19 | (def win-length 5)
20 | (def dirs { VK_LEFT [-1 0]
21 | VK_RIGHT [ 1 0]
22 | VK_UP [ 0 -1]
23 | VK_DOWN [ 0 1]})
24 |
25 | (defn add-points [& pts]
26 | (vec (apply map + pts)))
27 |
28 | (defn point-to-screen-rect [pt]
29 | (map #(* point-size %)
30 | [(pt 0) (pt 1) 1 1]))
31 |
32 | (defn create-apple []
33 | {:location [(rand-int width) (rand-int height)]
34 | :color (Color. 210 50 90)
35 | :type :apple})
36 |
37 | (defn create-snake []
38 | {:body (list [1 1])
39 | :dir [1 0]
40 | :type :snake
41 | :color (Color. 15 160 70)})
42 |
43 | (defn move [{:keys [body dir] :as snake} & grow]
44 | (assoc snake :body (cons (add-points (first body) dir)
45 | (if grow body (butlast body)))))
46 |
47 | (defn turn [snake newdir]
48 | (if newdir (assoc snake :dir newdir) snake))
49 |
50 | (defn win? [{body :body}]
51 | (>= (count body) win-length))
52 |
53 | (defn head-overlaps-body? [{[head & body] :body}]
54 | (contains? (set body) head))
55 |
56 | (def lose? head-overlaps-body?)
57 |
58 | (defn eats? [{[snake-head] :body} {apple :location}]
59 | (= snake-head apple))
60 |
61 | ; START: update-positions
62 | (defn update-positions [{snake :snake, apple :apple, :as game}]
63 | (if (eats? snake apple)
64 | (merge game {:apple (create-apple) :snake (move snake :grow)})
65 | (merge game {:snake (move snake)})))
66 | ; END: update-positions
67 |
68 | (defn update-direction [{snake :snake :as game} newdir]
69 | (merge game {:snake (turn snake newdir)}))
70 |
71 | (defn reset-game [game]
72 | (merge game {:apple (create-apple) :snake (create-snake)}))
73 |
74 | ; ----------------------------------------------------------
75 | ; gui
76 | ; ----------------------------------------------------------
77 | (defn fill-point [g pt color]
78 | (let [[x y width height] (point-to-screen-rect pt)]
79 | (.setColor g color)
80 | (.fillRect g x y width height)))
81 |
82 | (defmulti paint (fn [g object & _] (:type object)))
83 |
84 | (defmethod paint :apple [g {:keys [location color]}]
85 | (fill-point g location color))
86 |
87 | (defmethod paint :snake [g {:keys [body color]}]
88 | (doseq [point body]
89 | (fill-point g point color)))
90 |
91 | (defn game-panel [frame game]
92 | (proxy [JPanel ActionListener KeyListener] []
93 | (paintComponent [g]
94 | (proxy-super paintComponent g)
95 | (paint g (@game :snake))
96 | (paint g (@game :apple)))
97 | ; START: swap!
98 | (actionPerformed [e]
99 | (swap! game update-positions)
100 | (when (lose? (@game :snake))
101 | (swap! game reset-game)
102 | (JOptionPane/showMessageDialog frame "You lose!"))
103 | ; END: swap!
104 | (when (win? (@game :snake))
105 | (swap! game reset-game)
106 | (JOptionPane/showMessageDialog frame "You win!"))
107 | (.repaint this))
108 | (keyPressed [e]
109 | (swap! game update-direction (dirs (.getKeyCode e))))
110 | (getPreferredSize []
111 | (Dimension. (* (inc width) point-size)
112 | (* (inc height) point-size)))
113 | (keyReleased [e])
114 | (keyTyped [e])))
115 |
116 | (defn game []
117 | (let [game (atom (reset-game {}))
118 | frame (JFrame. "Snake")
119 | panel (game-panel frame game)
120 | timer (Timer. turn-millis panel)]
121 | (doto panel
122 | (.setFocusable true)
123 | (.addKeyListener panel))
124 | (doto frame
125 | (.add panel)
126 | (.pack)
127 | (.setVisible true))
128 | (.start timer)
129 | [game, timer]))
130 |
131 |
--------------------------------------------------------------------------------
/src/examples/chat.clj:
--------------------------------------------------------------------------------
1 | (ns examples.chat)
2 |
3 | ; START: message
4 | (defrecord Message [sender text])
5 | ; END: message
6 |
7 | ; START: messages
8 | (def messages (ref ()))
9 | ; END: messages
10 |
11 | ; START: validate-message-list
12 | (def validate-message-list
13 | (partial every? #(and (:sender %) (:text %))))
14 |
15 | (def messages (ref () :validator validate-message-list))
16 | ; END: validate-message-list
17 |
18 | ; START: naive-add-message
19 | ; bad idea
20 | (defn naive-add-message [msg]
21 | (dosync (ref-set messages (cons msg @messages))))
22 | ; END: naive-add-message
23 |
24 | ; START: add-message
25 | (defn add-message [msg]
26 | (dosync (alter messages conj msg)))
27 | ; END: add-message
28 |
29 | ; START: add-message-commute
30 | (defn add-message-commute [msg]
31 | (dosync (commute messages conj msg)))
32 | ; END: add-message-commute
33 |
--------------------------------------------------------------------------------
/src/examples/concurrency.clj:
--------------------------------------------------------------------------------
1 | (ns examples.concurrency
2 | (:use examples.chat))
3 |
4 | ; START: counter
5 | (def counter (ref 0))
6 | ; END: counter
7 |
8 | ; START: next-counter
9 | (defn next-counter [] (dosync (alter counter inc)))
10 | ; END: next-counter
11 |
12 | ; START: slow-double
13 | (defn ^:dynamic slow-double [n]
14 | (Thread/sleep 100)
15 | (* n 2))
16 | ; END: slow-double
17 |
18 | ; START: calls-slow-double
19 | (defn calls-slow-double []
20 | (map slow-double [1 2 1 2 1 2]))
21 | ; END: calls-slow-double
22 |
23 | ; START: demo-memoize
24 | (defn demo-memoize []
25 | (time
26 | (dorun
27 | (binding [slow-double (memoize slow-double)]
28 | (calls-slow-double)))))
29 | ; END: demo-memoize
30 |
31 | ; START: backup-agent
32 | (def backup-agent (agent "output/messages-backup.clj"))
33 | ; END: backup-agent
34 |
35 | ; START: add-message-with-backup
36 | (defn add-message-with-backup [msg]
37 | (dosync
38 | (let [snapshot (commute messages conj msg)]
39 | (send-off backup-agent (fn [filename]
40 | (spit filename snapshot)
41 | filename))
42 | snapshot)))
43 | ; END: add-message-with-backup
44 |
45 |
46 |
--------------------------------------------------------------------------------
/src/examples/cryptovault.clj:
--------------------------------------------------------------------------------
1 | ; START: context
2 | (ns examples.cryptovault
3 | (:use [examples.io :only [IOFactory make-reader make-writer]])
4 | (:require [clojure.java.io :as io])
5 | (:import (java.security KeyStore KeyStore$SecretKeyEntry
6 | KeyStore$PasswordProtection)
7 | (javax.crypto KeyGenerator Cipher CipherOutputStream
8 | CipherInputStream)
9 | (java.io FileOutputStream)))
10 | (deftype CryptoVault [filename keystore password]
11 | Vault
12 | (init-vault [vault]
13 | ... define method body here ...)
14 |
15 | (vault-output-stream [vault]
16 | ... define method body here ...)
17 |
18 | (vault-input-stream [vault]
19 | ... define method body here ...)
20 |
21 | IOFactory
22 | (make-reader [vault]
23 | (make-reader (vault-input-stream vault)))
24 | (make-writer [vault]
25 | (make-writer (vault-output-stream vault))))
26 | ; END: context
27 |
28 | ; START: init-vault
29 | (init-vault [vault]
30 | (let [password (.toCharArray (.password vault))
31 | key (.generateKey (KeyGenerator/getInstance "AES"))
32 | keystore (doto (KeyStore/getInstance "JCEKS")
33 | (.load nil password)
34 | (.setEntry "vault-key"
35 | (KeyStore$SecretKeyEntry. key)
36 | (KeyStore$PasswordProtection. password)))]
37 | (with-open [fos (FileOutputStream. (.keystore vault))]
38 | (.store keystore fos password))))
39 | ; END: init-vault
40 |
41 | ; START: vault-key
42 | (defn vault-key [vault]
43 | (let [password (.toCharArray (.password vault))]
44 | (with-open [fis (FileInputStream. (.keystore vault))]
45 | (-> (doto (KeyStore/getInstance "JCEKS")
46 | (.load fis password))
47 | (.getKey "vault-key" password)))))
48 | ; END: vault-key
49 |
50 | ; START: vault-output-stream
51 | (vault-output-stream [vault]
52 | (let [cipher (doto (Cipher/getInstance "AES")
53 | (.init Cipher/ENCRYPT_MODE (vault-key vault)))]
54 | (CipherOutputStream. (io/output-stream (.filename vault)) cipher)))
55 | ; END: vault-output-stream
56 |
57 | ; START: vault-input-stream
58 | (vault-input-stream [vault]
59 | (let [cipher (doto (Cipher/getInstance "AES")
60 | (.init Cipher/DECRYPT_MODE (vault-key vault)))]
61 | (CipherInputStream. (io/input-stream (.filename vault)) cipher)))
62 | ; END: vault-input-stream
63 |
64 | ; START: extend-cryptovault
65 | (extend CryptoVault
66 | clojure.java.io/IOFactory
67 | (assoc clojure.java.io/default-streams-impl
68 | :make-input-stream (fn [x opts] (vault-input-stream x))
69 | :make-output-stream (fn [x opts] (vault-output-stream x))))
70 | ; END: extend-cryptovault
--------------------------------------------------------------------------------
/src/examples/cryptovault_complete.clj:
--------------------------------------------------------------------------------
1 | (ns examples.cryptovault-complete
2 | (:require [clojure.java.io :as io]
3 | [examples.protocols.io :as proto])
4 | (:import (java.security KeyStore KeyStore$SecretKeyEntry
5 | KeyStore$PasswordProtection)
6 | (javax.crypto Cipher KeyGenerator CipherOutputStream
7 | CipherInputStream)
8 | (java.io FileInputStream FileOutputStream)))
9 | (defprotocol Vault
10 | (init-vault [vault])
11 | (vault-output-stream [vault])
12 | (vault-input-stream [vault]))
13 | (defn vault-key [vault]
14 | (let [password (.toCharArray (.password vault))]
15 | (with-open [fis (FileInputStream. (.keystore vault))]
16 | (-> (doto (KeyStore/getInstance "JCEKS")
17 | (.load fis password))
18 | (.getKey "vault-key" password)))))
19 | (deftype CryptoVault [filename keystore password]
20 | Vault
21 | (init-vault [vault]
22 | (let [password (.toCharArray (.password vault))
23 | key (.generateKey (KeyGenerator/getInstance "AES"))
24 | keystore (doto (KeyStore/getInstance "JCEKS")
25 | (.load nil password)
26 | (.setEntry "vault-key"
27 | (KeyStore$SecretKeyEntry. key)
28 | (KeyStore$PasswordProtection. password)))]
29 | (with-open [fos (FileOutputStream. (.keystore vault))]
30 | (.store keystore fos password))))
31 |
32 | (vault-output-stream [vault]
33 | (let [cipher (doto (Cipher/getInstance "AES")
34 | (.init Cipher/ENCRYPT_MODE (vault-key vault)))]
35 | (CipherOutputStream. (io/output-stream (.filename vault)) cipher)))
36 |
37 | (vault-input-stream [vault]
38 | (let [cipher (doto (Cipher/getInstance "AES")
39 | (.init Cipher/DECRYPT_MODE (vault-key vault)))]
40 | (CipherInputStream. (io/input-stream (.filename vault)) cipher)))
41 |
42 | proto/IOFactory
43 | (make-reader [vault]
44 | (proto/make-reader (vault-input-stream vault)))
45 | (make-writer [vault]
46 | (proto/make-writer (vault-output-stream vault))))
47 |
48 | (extend CryptoVault
49 | clojure.java.io/IOFactory
50 | (assoc io/default-streams-impl
51 | :make-input-stream (fn [x opts] (vault-input-stream x))
52 | :make-output-stream (fn [x opts] (vault-output-stream x))))
53 |
--------------------------------------------------------------------------------
/src/examples/error_kit.clj:
--------------------------------------------------------------------------------
1 | ; example inspired by http://gigamonkeys.com/book/beyond-exception-handling-conditions-and-restarts.html
2 | (ns examples.error-kit
3 | (:use [clojure.contrib.error-kit]))
4 |
5 | (deferror malformed-log-entry [] [msg]
6 | {:msg msg
7 | :unhandled (throw-msg IllegalArgumentException)})
8 |
9 | ; imaginary log message format:
10 | ; 2008-10-05 12:14:00 WARN Some warning message here...
11 | (defn parse-log-entry [entry]
12 | (or
13 | (next (re-matches #"(\d+-\d+-\d+) (\d+:\d+:\d+) (\w+) (.*)" entry))
14 | (raise malformed-log-entry entry)))
15 |
16 | (def bad-log
17 | ["2008-10-05 12:14:00 WARN Some warning message here..."
18 | "<>"
19 | "2008-10-05 12:14:00 INFO End of the current log..."])
20 |
21 | (def good-log
22 | ["2008-10-05 12:14:00 WARN Some warning message here..."
23 | "2008-10-05 12:14:00 INFO End of the current log..."])
24 |
25 | ; Example 1. Continue calculation with replacement value
26 | (defn parse-or-nil [logseq]
27 | (with-handler
28 | (vec (map parse-log-entry logseq))
29 | (handle malformed-log-entry [msg]
30 | (continue-with nil))))
31 |
32 | ; Example 2. Continue calculation with logging & replacement value
33 | (defn parse-or-warn [logseq]
34 | (with-handler
35 | (vec (map parse-log-entry logseq))
36 | (handle malformed-log-entry [msg]
37 | (continue-with (println "****warning****: invalid log: " msg)))))
38 |
39 | ; Example 3. Caller can choose from a fixed set of contiue strategies.
40 | (defn parse-or-continue [logseq]
41 | (let [parse-log-entry
42 | (fn [entry]
43 | (with-handler (parse-log-entry entry)
44 | (bind-continue skip [msg] nil)
45 | (bind-continue log [msg] (println "****warning****: invalid log: " msg))))]
46 | (vec (map parse-log-entry logseq))))
47 |
48 |
49 |
50 |
51 |
52 |
53 |
--------------------------------------------------------------------------------
/src/examples/expectorate.clj:
--------------------------------------------------------------------------------
1 | (ns examples.expectorate
2 | (:import (java.io FileOutputStream OutputStreamWriter BufferedWriter)))
3 |
4 | (defn expectorate [dst content]
5 | (with-open [writer (-> dst
6 | FileOutputStream.
7 | OutputStreamWriter.
8 | BufferedWriter.)]
9 | (.write writer (str content))))
10 |
--------------------------------------------------------------------------------
/src/examples/exploring.clj:
--------------------------------------------------------------------------------
1 | ; START:ns
2 | (ns examples.exploring
3 | (:require [clojure.string :as str])
4 | (:import (java.io File)))
5 | ; END:ns
6 |
7 | ; START:date
8 | (defn date [person-1 person-2 & chaperones]
9 | (println person-1 "and" person-2
10 | "went out with" (count chaperones) "chaperones."))
11 | ; END:date
12 |
13 | ; START:if
14 | (defn is-small? [number]
15 | (if (< number 100) "yes"))
16 | ; END:if
17 | (def is-small-with-if? is-small?)
18 |
19 | ; START:if-else
20 | (defn is-small? [number]
21 | (if (< number 100) "yes" "no"))
22 | ; END:if-else
23 | (def is-small-with-else? is-small?)
24 |
25 | ; START:do
26 | (defn is-small? [number]
27 | (if (< number 100)
28 | "yes"
29 | (do
30 | (println "Saw a big number" number)
31 | "no")))
32 | ; END:do
33 | (def is-small-with-do? is-small?)
34 |
35 | (defn demo-loop []
36 | ; START: loop
37 | (loop [result [] x 5]
38 | (if (zero? x)
39 | result
40 | (recur (conj result x) (dec x))))
41 | ; END: loop
42 | )
43 |
44 | ; START:countdown
45 | (defn countdown [result x]
46 | (if (zero? x)
47 | result
48 | (recur (conj result x) (dec x))))
49 | ; END:countdown
50 |
51 | ; START: indexed
52 | (defn indexed [coll] (map-indexed vector coll))
53 | ; END: indexed
54 |
55 | ; START: index-filter
56 | (defn index-filter [pred coll]
57 | (when pred
58 | (for [[idx elt] (indexed coll) :when (pred elt)] idx)))
59 | ; END: index-filter
60 | ; START:index-of-any
61 | (defn index-of-any [pred coll]
62 | (first (index-filter pred coll)))
63 | ; END: index-of-any
64 |
65 | ; START:greeting
66 | (defn greeting
67 | "Returns a greeting of the form 'Hello, username.'"
68 | [username]
69 | (str "Hello, " username))
70 | ; END:greeting
71 | (def simple-greeting greeting)
72 |
73 | ; START:greeting-with-default
74 | (defn greeting
75 | "Returns a greeting of the form 'Hello, username.'
76 | Default username is 'world'."
77 | ([] (greeting "world"))
78 | ([username] (str "Hello, " username)))
79 | ; END:greeting-with-default
80 | (def greeting-with-default greeting)
81 |
82 | ; START:indexable-word
83 | (defn indexable-word? [word]
84 | (> (count word) 2))
85 | ; END:indexable-word
86 |
87 | ; START:indexable-words
88 | (defn indexable-words [text]
89 | (let [indexable-word? (fn [w] (> (count w) 2))]
90 | (filter indexable-word? (str/split text #"\W+"))))
91 | ; END:indexable-words
92 |
93 | ; START:make-greeter
94 | (defn make-greeter [greeting-prefix]
95 | (fn [username] (str greeting-prefix ", " username)))
96 | ; END:make-greeter
97 |
98 | ; START:square-corners
99 | (defn square-corners [bottom left size]
100 | (let [top (+ bottom size)
101 | right (+ left size)]
102 | [[bottom left] [top left] [top right] [bottom right]]))
103 | ; END:square-corners
104 |
105 | ; START:busted
106 | (defn ^{:test (fn []
107 | (assert (nil? (busted))))}
108 | busted [] "busted")
109 | ; END:busted
110 |
111 | (def vinge {:first-name "Vernor" :last-name "Vinge"})
112 |
113 | ; START:greet-author-1
114 | (defn greet-author-1 [author]
115 | (println "Hello," (:first-name author)))
116 | ; END:greet-author-1
117 |
118 | ; START:greet-author-2
119 | (defn greet-author-2 [{fname :first-name}]
120 | (println "Hello," fname))
121 | ; END:greet-author-2
122 |
123 | ; START:ellipsize
124 | (require '[clojure.string :as str])
125 | (defn ellipsize [words]
126 | (let [[w1 w2 w3] (str/split words #"\s+")]
127 | (str/join " " [w1 w2 w3 "..."])))
128 | ; END:ellipsize
129 |
--------------------------------------------------------------------------------
/src/examples/functional.clj:
--------------------------------------------------------------------------------
1 | (ns examples.functional)
2 |
3 | ; START: stack-consuming-fibo
4 | ; bad idea
5 | (defn stack-consuming-fibo [n]
6 | (cond
7 | (= n 0) 0 ;
8 | (= n 1) 1 ;
9 | :else (+ (stack-consuming-fibo (- n 1)) ;
10 | (stack-consuming-fibo (- n 2))))) ;
11 | ; END: stack-consuming-fibo
12 |
13 | ; START: tail-fibo
14 | (defn tail-fibo [n]
15 | (letfn [(fib ;
16 | [current next n] ;
17 | (if (zero? n)
18 | current ;
19 | (fib next (+ current next) (dec n))))] ;
20 | (fib 0N 1N n))) ;
21 | ; END: tail-fibo
22 |
23 | ; START: recur-fibo
24 | ; better but not great
25 | (defn recur-fibo [n]
26 | (letfn [(fib
27 | [current next n]
28 | (if (zero? n)
29 | current
30 | (recur next (+ current next) (dec n))))] ;
31 | (fib 0N 1N n)))
32 | ; END: recur-fibo
33 |
34 | ; START: lazy-seq-fibo
35 | (defn lazy-seq-fibo
36 | ([]
37 | (concat [0 1] (lazy-seq-fibo 0N 1N))) ;
38 | ([a b]
39 | (let [n (+ a b)] ;
40 | (lazy-seq ;
41 | (cons n (lazy-seq-fibo b n)))))) ;
42 | ; END: lazy-seq-fibo
43 |
44 | ; START: fibo
45 | (defn fibo []
46 | (map first (iterate (fn [[a b]] [b (+ a b)]) [0N 1N])))
47 | ; END: fibo
48 |
49 | ; START: head-fibo
50 | ; holds the head (avoid!)
51 | (def head-fibo (lazy-cat [0N 1N] (map + head-fibo (rest head-fibo))))
52 | ; END: head-fibo
53 |
54 | ; START: count-heads-pairs
55 | (defn count-heads-pairs [coll]
56 | (loop [cnt 0 coll coll] ;
57 | (if (empty? coll) ;
58 | cnt
59 | (recur (if (= :h (first coll) (second coll)) ;
60 | (inc cnt)
61 | cnt)
62 | (rest coll)))))
63 | ; END: count-heads-pairs
64 | (def count-heads-loop count-heads-pairs)
65 |
66 | ; START: by-pairs
67 | ; overly complex, better approaches follow...
68 | (defn by-pairs [coll]
69 | (let [take-pair (fn [c] ;
70 | (when (next c) (take 2 c)))]
71 | (lazy-seq ;
72 | (when-let [pair (seq (take-pair coll))] ;
73 | (cons pair (by-pairs (rest coll))))))) ;
74 | ; END: by-pairs
75 |
76 | ; START: count-heads-by-pairs
77 | (defn count-heads-pairs [coll]
78 | (count (filter (fn [pair] (every? #(= :h %) pair))
79 | (by-pairs coll))))
80 | ; END: count-heads-by-pairs
81 | (def count-heads-by-pairs count-heads-pairs)
82 |
83 | ; START: count-if
84 | (def ^{:doc "Count items matching a filter"}
85 | count-if (comp count filter))
86 | ; END: count-if
87 |
88 | ; START: count-runs
89 | (defn count-runs
90 | "Count runs of length n where pred is true in coll."
91 | [n pred coll]
92 | (count-if #(every? pred %) (partition n 1 coll)))
93 | ; END: count-runs
94 |
95 | ; START: count-heads-by-runs
96 | (def ^{:doc "Count runs of length two that are both heads"}
97 | count-heads-pairs (partial count-runs 2 #(= % :h)))
98 | ; END: count-heads-by-runs
99 | (def count-heads-by-runs count-heads-pairs)
100 |
101 | ; START: my-odd-even
102 | (declare my-odd? my-even?)
103 |
104 | (defn my-odd? [n]
105 | (if (= n 0)
106 | false
107 | (my-even? (dec n))))
108 |
109 | (defn my-even? [n]
110 | (if (= n 0)
111 | true
112 | (my-odd? (dec n))))
113 | ; END: my-odd-even
114 |
115 | ; START: parity
116 | (defn parity [n]
117 | (loop [n n par 0]
118 | (if (= n 0)
119 | par
120 | (recur (dec n) (- 1 par)))))
121 | ; END: parity
122 |
123 | ; START: my-odd-even-parity
124 | (defn my-even? [n] (= 0 (parity n)))
125 | (defn my-odd? [n] (= 1 (parity n)))
126 | ; END: my-odd-even-parity
127 |
128 | ; START: curry
129 | ; almost a curry
130 | (defn faux-curry [& args] (apply partial partial args))
131 | ; END: curry
132 |
133 | ; --------------------------------------------------------------------------------------
134 | ; -- See www.cs.brown.edu/~sk/Publications/Papers/Published/sk-automata-macros/paper.pdf
135 | ; --------------------------------------------------------------------------------------
136 | (defn machine [stream]
137 | (let [step {[:init 'c] :more
138 | [:more 'a] :more
139 | [:more 'd] :more
140 | [:more 'r] :end
141 | [:end nil] true}]
142 | (loop [state :init
143 | stream stream]
144 | (let [next (step [state (first stream)])]
145 | (when next
146 | (if (= next true)
147 | true
148 | (recur next (rest stream))))))))
149 |
150 |
151 | (declare init more end)
152 |
153 | (defn init [stream]
154 | (if (#{'c} (first stream))
155 | (more (rest stream))))
156 |
157 | (defn more [stream]
158 | (cond
159 | (#{'a 'd} (first stream)) (more (rest stream))
160 | (#{'r} (first stream)) (end (rest stream))))
161 |
162 | (defn end [stream]
163 | (when-not (seq stream) true))
164 |
165 |
166 |
167 |
--------------------------------------------------------------------------------
/src/examples/generator.clj:
--------------------------------------------------------------------------------
1 | (ns examples.generator)
2 |
3 | ; START: midinote
4 | (import '[examples.datatypes.midi MidiNote])
5 | (let [min-duration 250
6 | min-velocity 64
7 | rand-note (reify
8 | MidiNote
9 | (to-msec [this tempo] (+ (rand-int 1000) min-duration))
10 | (key-number [this] (rand-int 100))
11 | (play [this tempo midi-channel]
12 | (let [velocity (+ (rand-int 100) min-velocity)]
13 | (.noteOn midi-channel (key-number this) velocity)
14 | (Thread/sleep (to-msec this tempo)))))]
15 | (perform (repeat 15 rand-note)))
16 | ; END: midinote
--------------------------------------------------------------------------------
/src/examples/gulp.clj:
--------------------------------------------------------------------------------
1 | (ns examples.gulp
2 | (:import (java.io FileInputStream InputStreamReader BufferedReader)))
3 | (defn gulp [src]
4 | (let [sb (StringBuilder.)]
5 | (with-open [reader (-> src
6 | FileInputStream.
7 | InputStreamReader.
8 | BufferedReader.)]
9 | (loop [c (.read reader)]
10 | (if (neg? c)
11 | (str sb)
12 | (do
13 | (.append sb (char c))
14 | (recur (.read reader))))))))
15 |
--------------------------------------------------------------------------------
/src/examples/import_static.clj:
--------------------------------------------------------------------------------
1 | ;;; import_static.clj -- import static Java methods/fields into Clojure
2 |
3 | ;; by Stuart Sierra, http://stuartsierra.com/
4 | ;; June 1, 2008
5 |
6 | ;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use
7 | ;; and distribution terms for this software are covered by the Eclipse
8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
9 | ;; which can be found in the file epl-v10.html at the root of this
10 | ;; distribution. By using this software in any fashion, you are
11 | ;; agreeing to be bound by the terms of this license. You must not
12 | ;; remove this notice, or any other, from this software.
13 |
14 | (ns ^{:author "Stuart Sierra",
15 | :doc "Import static Java methods/fields into Clojure"}
16 | examples.import-static
17 | (:use clojure.set))
18 |
19 | (defmacro import-static
20 | "Imports the named static fields and/or static methods of the class
21 | as (private) symbols in the current namespace.
22 |
23 | Example:
24 | user=> (import-static java.lang.Math PI sqrt)
25 | nil
26 | user=> PI
27 | 3.141592653589793
28 | user=> (sqrt 16)
29 | 4.0
30 |
31 | Note: The class name must be fully qualified, even if it has already
32 | been imported. Static methods are defined as MACROS, not
33 | first-class fns."
34 | [class & fields-and-methods]
35 | (let [only (set (map str fields-and-methods))
36 | the-class (. Class forName (str class))
37 | static? (fn [x]
38 | (. java.lang.reflect.Modifier
39 | (isStatic (. x (getModifiers)))))
40 | statics (fn [array]
41 | (set (map (memfn getName)
42 | (filter static? array))))
43 | all-fields (statics (. the-class (getFields)))
44 | all-methods (statics (. the-class (getMethods)))
45 | fields-to-do (intersection all-fields only)
46 | methods-to-do (intersection all-methods only)
47 | make-sym (fn [string]
48 | (with-meta (symbol string) {:private true}))
49 | import-field (fn [name]
50 | (list 'def (make-sym name)
51 | (list '. class (symbol name))))
52 | import-method (fn [name]
53 | (list 'defmacro (make-sym name)
54 | '[& args]
55 | (list 'list ''. (list 'quote class)
56 | (list 'apply 'list
57 | (list 'quote (symbol name))
58 | 'args))))]
59 | `(do ~@(map import-field fields-to-do)
60 | ~@(map import-method methods-to-do))))
61 |
--------------------------------------------------------------------------------
/src/examples/index_of_any.clj:
--------------------------------------------------------------------------------
1 | (ns examples.index-of-any)
2 |
3 | ; START: index-of-any
4 | (defn index-filter [pred coll]
5 | (when pred (keep-indexed (fn [idx item] (when (pred item) idx)) coll)))
6 |
7 | (defn ^{:test (fn []
8 | (assert (nil? (index-of-any #{\a} nil)))
9 | (assert (nil? (index-of-any #{\a} "")))
10 | (assert (nil? (index-of-any nil "foo")))
11 | (assert (nil? (index-of-any #{} "foo")))
12 | (assert (zero? (index-of-any #{\z \a} "zzabyycdxx")))
13 | (assert (= 3 (index-of-any #{\b \y} "zzabyycdxx")))
14 | (assert (nil? (index-of-any #{\z} "aba"))))}
15 | index-of-any
16 | [pred coll]
17 | (first (index-filter pred coll)))
18 | ; END: index-of-any
19 |
--------------------------------------------------------------------------------
/src/examples/interop.clj:
--------------------------------------------------------------------------------
1 | (ns examples.interop)
2 |
3 | ; START:sum-to
4 | ; performance demo only, don't write code like this
5 | (defn sum-to [n]
6 | (loop [i 1 sum 0]
7 | (if (<= i n)
8 | (recur (inc i) (+ i sum))
9 | sum)))
10 | ; END:sum-to
11 |
12 | ; START:integer-sum-to
13 | (defn integer-sum-to [n]
14 | (let [n (int n)]
15 | (loop [i (int 1) sum (int 0)]
16 | (if (<= i n)
17 | (recur (inc i) (+ i sum))
18 | sum))))
19 | ; END:integer-sum-to
20 |
21 | ; START:unchecked-sum-to
22 | (defn unchecked-sum-to [n]
23 | (let [n (int n)]
24 | (loop [i (int 1) sum (int 0)]
25 | (if (<= i n)
26 | (recur (inc i) (unchecked-add i sum))
27 | sum))))
28 | ; END:unchecked-sum-to
29 |
30 | (defn better-sum-to [n]
31 | (reduce + (range 1 (inc n))))
32 |
33 | (defn best-sum-to [n]
34 | (/ (* n (inc n)) 2))
35 | ; TODO: a better timer?
36 |
37 | (defn painstakingly-create-array []
38 | (let [arr (make-array String 5)]
39 | (aset arr 0 "Painstaking")
40 | (aset arr 1 "to")
41 | (aset arr 2 "fill")
42 | (aset arr 3 "in")
43 | (aset arr 4 "arrays")
44 | arr))
45 |
46 | ; START:xml-imports
47 | (import '(org.xml.sax InputSource)
48 | '(org.xml.sax.helpers DefaultHandler)
49 | '(java.io StringReader)
50 | '(javax.xml.parsers SAXParserFactory))
51 | ; END:xml-imports
52 |
53 | ; START:print-element-handler
54 | (def print-element-handler
55 | (proxy [DefaultHandler] []
56 | (startElement
57 | [uri local qname atts]
58 | (println (format "Saw element: %s" qname)))))
59 | ; END:print-element-handler
60 |
61 | ; START:demo-sax-parse
62 | (defn demo-sax-parse [string handler]
63 | (.. SAXParserFactory newInstance newSAXParser
64 | (parse (InputSource. (StringReader. string))
65 | handler)))
66 | ; END:demo-sax-parse
67 |
68 | (defn demo-threads []
69 | ; START:demo-threads
70 | (dotimes [i 5]
71 | (.start
72 | (Thread.
73 | (fn []
74 | (Thread/sleep (rand 500))
75 | (println (format "Finished %d on %s" i (Thread/currentThread)))))))
76 | ; END:demo-threads
77 | )
78 |
79 | (defn demo-try-finally []
80 | ; START:try-finally
81 | (try
82 | (throw (Exception. "something failed"))
83 | (finally
84 | (println "we get to clean up")))
85 | ; END:try-finally
86 | )
87 |
88 | ; START:poor-class-available
89 | ; not caller-friendly
90 | (defn class-available? [class-name]
91 | (Class/forName class-name))
92 | ; END:poor-class-available
93 | (def poor-class-available? class-available?)
94 |
95 | ; START:better-class-available
96 | (defn class-available? [class-name]
97 | (try
98 | (Class/forName class-name) true
99 | (catch ClassNotFoundException _ false)))
100 | ; END:better-class-available
101 |
102 | ; START:untyped-describe-class
103 | (defn describe-class [c]
104 | {:name (.getName c)
105 | :final (java.lang.reflect.Modifier/isFinal (.getModifiers c))})
106 | ; END:untyped-describe-class
107 | (def untyped-describe-class describe-class)
108 |
109 | ; START:typed-describe-class
110 | (defn describe-class [#^Class c]
111 | {:name (.getName c)
112 | :final (java.lang.reflect.Modifier/isFinal (.getModifiers c))})
113 | ; END:typed-describe-class
114 | (def typed-describe-class describe-class)
115 |
116 |
117 |
--------------------------------------------------------------------------------
/src/examples/introduction.clj:
--------------------------------------------------------------------------------
1 | (ns examples.introduction)
2 |
3 | ; START:blank
4 | (defn blank? [str]
5 | (every? #(Character/isWhitespace %) str))
6 | ; END:blank
7 |
8 | (def accounts (ref #{}))
9 | (defstruct account :id :balance)
10 |
11 | ; START:hello-world
12 | (defn hello-world [username]
13 | (println (format "Hello, %s" username)))
14 | ; END:hello-world
15 |
16 | (def fibs (lazy-cat [0 1] (map + fibs (rest fibs))))
17 |
18 | ; START:hello-docstring
19 | (defn hello
20 | "Writes hello message to *out*. Calls you by username"
21 | [username]
22 | (println (str "Hello, " username)))
23 | ; END:hello-docstring
24 | (def hello-docstring hello)
25 |
26 | (def visitors (atom #{}))
27 |
28 | ; START:hello
29 | (defn hello
30 | "Writes hello message to *out*. Calls you by username.
31 | Knows if you have been here before."
32 | [username]
33 | (swap! visitors conj username)
34 | (str "Hello, " username))
35 | ; END:hello
36 |
37 | (def hello-with-memory hello)
--------------------------------------------------------------------------------
/src/examples/io.clj:
--------------------------------------------------------------------------------
1 | (ns examples.io
2 | (:import (java.io File FileInputStream FileOutputStream
3 | InputStream InputStreamReader
4 | OutputStream OutputStreamWriter
5 | BufferedReader BufferedWriter)
6 | (java.net Socket URL)))
7 |
8 | (defprotocol IOFactory
9 | "A protocol for things that can be read from and written to."
10 | (make-reader [this] "Creates a BufferedReader.")
11 | (make-writer [this] "Creates a BufferedWriter."))
12 |
13 | (defn gulp [src]
14 | (let [sb (StringBuilder.)]
15 | (with-open [reader (make-reader src)]
16 | (loop [c (.read reader)]
17 | (if (neg? c)
18 | (str sb)
19 | (do
20 | (.append sb (char c))
21 | (recur (.read reader))))))))
22 |
23 | (defn expectorate [dst content]
24 | (with-open [writer (make-writer dst)]
25 | (.write writer (str content))))
26 |
27 | (extend-protocol IOFactory
28 | InputStream
29 | (make-reader [src]
30 | (-> src InputStreamReader. BufferedReader.))
31 |
32 | (make-writer [dst]
33 | (throw
34 | (IllegalArgumentException.
35 | "Can't open as an InputStream.")))
36 |
37 | OutputStream
38 | (make-reader [src]
39 | (throw
40 | (IllegalArgumentException.
41 | "Can't open as an OutputStream.")))
42 |
43 | (make-writer [dst]
44 | (-> dst OutputStreamWriter. BufferedWriter.))
45 |
46 | File
47 | (make-reader [src]
48 | (make-reader (FileInputStream. src)))
49 |
50 | (make-writer [dst]
51 | (make-writer (FileOutputStream. dst)))
52 |
53 | Socket
54 | (make-reader [src]
55 | (make-reader (.getInputStream src)))
56 |
57 | (make-writer [dst]
58 | (make-writer (.getOutputStream dst)))
59 |
60 | URL
61 | (make-reader [src]
62 | (make-reader
63 | (if (= "file" (.getProtocol src))
64 | (-> src .getPath FileInputStream.)
65 | (.openStream src))))
66 |
67 |
68 | (make-writer [dst]
69 | (make-writer
70 | (if (= "file" (.getProtocol dst))
71 | (-> dst .getPath FileInputStream.)
72 | (throw (IllegalArgumentException.
73 | "Can't write to non-file URL"))))))
--------------------------------------------------------------------------------
/src/examples/lazy_index_of_any.clj:
--------------------------------------------------------------------------------
1 | (ns examples.lazy-index-of-any)
2 |
3 | (defn logging-seq [coll]
4 | (lazy-seq
5 | (when-let [s (seq coll)]
6 | (do (println "Iterating over" (first s))
7 | (cons (first s) (logging-seq (rest s)))))))
8 |
9 | (defn indexed [s] (map vector (iterate inc 0) s (logging-seq s)))
10 | (defn index-filter [pred coll]
11 | (when pred (for [[idx elt] (indexed coll) :when (pred elt)] idx)))
12 | (defn index-of-any [pred coll]
13 | (first (index-filter pred coll)))
14 |
15 |
--------------------------------------------------------------------------------
/src/examples/life_without_multi.clj:
--------------------------------------------------------------------------------
1 | (ns examples.life-without-multi)
2 |
3 | ; START: my-println-1
4 | (defn my-print [ob]
5 | (.write *out* ob))
6 | ; END: my-println-1
7 | (def my-print-1 my-print)
8 |
9 | ; START: my-println
10 | (defn my-println [ob]
11 | (my-print ob)
12 | (.write *out* "\n"))
13 | ; END: my-println
14 |
15 | ; START: my-println-2
16 | (defn my-print [ob]
17 | (cond
18 | (nil? ob) (.write *out* "nil")
19 | (string? ob) (.write *out* ob)))
20 | ; END: my-println-2
21 |
22 | (def my-print-2 my-print)
23 |
24 | ; START: my-println-3
25 | (require '[clojure.string :as str])
26 | (defn my-print-vector [ob]
27 | (.write *out*"[")
28 | (.write *out* (str/join " " ob))
29 | (.write *out* "]"))
30 |
31 | (defn my-print [ob]
32 | (cond
33 | (vector? ob) (my-print-vector ob)
34 | (nil? ob) (.write *out* "nil")
35 | (string? ob) (.write *out* ob)))
36 | ; END: my-println-3
37 |
38 | (def my-print-3 my-print)
39 |
--------------------------------------------------------------------------------
/src/examples/macros.clj:
--------------------------------------------------------------------------------
1 | (ns examples.macros)
2 |
3 | ; START: unless-1
4 | ; This is doomed to fail...
5 | (defn unless [expr form]
6 | (if expr nil form))
7 | ; END: unless-1
8 | (def unless-1 unless)
9 |
10 | ; START: unless-2
11 | (defn unless [expr form]
12 | (println "About to test...")
13 | (if expr nil form))
14 | ; END: unless-2
15 | (def unless-2 unless)
16 |
17 | ; START: unless-3
18 | (defmacro unless [expr form]
19 | (list 'if expr nil form))
20 | ; END: unless-3
21 |
22 | ; START: unless-4
23 | (defmacro bad-unless [expr form]
24 | (list 'if 'expr nil form))
25 | ; END: unless-4
26 |
27 | ; START: with-out-str-as-fn
28 | (defn with-out-str-as-fn [f]
29 | (let [s# (new java.io.StringWriter)]
30 | (binding [*out* s#]
31 | (f)
32 | (str s#))))
33 | ; END: with-out-str-as-fn
34 |
35 | ; Don't tell Rich I showed you how to do this.
36 | (defmacro evil-bench [expr]
37 | `(let [~'start (System/nanoTime)
38 | ~'result ~expr]
39 | {:result ~'result :elapsed (- (System/nanoTime) ~'start)}))
40 |
41 | ; START: bench-2
42 | (defmacro bench [expr]
43 | `(let [start# (System/nanoTime)
44 | result# ~expr]
45 | {:result result# :elapsed (- (System/nanoTime) start#)}))
46 | ; END: bench-2
47 |
48 | ; START: bench-fn
49 | (defn bench-fn [f]
50 | (let [start (System/nanoTime)
51 | result (f)]
52 | {:result result :elapsed (- (System/nanoTime) start)}))
53 | ; END: bench-fn
54 |
55 |
56 |
57 |
58 |
59 |
--------------------------------------------------------------------------------
/src/examples/macros/bench_1.clj:
--------------------------------------------------------------------------------
1 | (ns examples.macros.bench-1)
2 |
3 | ; START: bench
4 | ; This won't work
5 | (defmacro bench [expr]
6 | `(let [start (System/nanoTime)
7 | result ~expr]
8 | {:result result :elapsed (- (System/nanoTime) start)}))
9 | ; END: bench
10 |
11 |
12 |
--------------------------------------------------------------------------------
/src/examples/macros/chain_1.clj:
--------------------------------------------------------------------------------
1 | (ns examples.macros.chain-1)
2 | ; START: chain
3 | ; chain reimplements Clojure's .. macro
4 | (defmacro chain [x form]
5 | (list '. x form))
6 | ; END: chain
7 |
--------------------------------------------------------------------------------
/src/examples/macros/chain_2.clj:
--------------------------------------------------------------------------------
1 | (ns examples.macros.chain-2)
2 | ; START: chain
3 | (defmacro chain
4 | ([x form] (list '. x form))
5 | ([x form & more] (concat (list 'chain (list '. x form)) more)))
6 | ; END: chain
7 |
--------------------------------------------------------------------------------
/src/examples/macros/chain_3.clj:
--------------------------------------------------------------------------------
1 | (ns examples.macros.chain-3)
2 | ; START: chain
3 | (defmacro chain [x form]
4 | `(. ~x ~form))
5 | ; END: chain
--------------------------------------------------------------------------------
/src/examples/macros/chain_4.clj:
--------------------------------------------------------------------------------
1 | (ns examples.macros.chain-4)
2 | ; START: chain
3 | ; Does not quite work
4 | (defmacro chain
5 | ([x form] `(. ~x ~form))
6 | ([x form & more] `(chain (. ~x ~form) ~more)))
7 | ; END: chain
--------------------------------------------------------------------------------
/src/examples/macros/chain_5.clj:
--------------------------------------------------------------------------------
1 | (ns examples.macros.chain-5)
2 | ; START: chain
3 | (defmacro chain
4 | ([x form] `(. ~x ~form))
5 | ([x form & more] `(chain (. ~x ~form) ~@more)))
6 | ; END: chain
7 |
--------------------------------------------------------------------------------
/src/examples/male_female.clj:
--------------------------------------------------------------------------------
1 | (ns examples.male-female)
2 |
3 | ; START: m-f
4 | ; do not use these directly
5 | (declare m f)
6 | (defn m [n]
7 | (if (zero? n)
8 | 0
9 | (- n (f (m (dec n))))))
10 | (defn f [n]
11 | (if (zero? n)
12 | 1
13 | (- n (m (f (dec n))))))
14 | ; END: m-f
15 |
16 |
--------------------------------------------------------------------------------
/src/examples/male_female_seq.clj:
--------------------------------------------------------------------------------
1 | (ns examples.male-female-seq)
2 |
3 | (declare m f)
4 | (defn- m [n]
5 | (if (zero? n)
6 | 0
7 | (- n (f (m (dec n))))))
8 |
9 | (defn- f [n]
10 | (if (zero? n)
11 | 1
12 | (- n (m (f (dec n))))))
13 |
14 | (def ^:private m (memoize m))
15 | (def ^:private f (memoize f))
16 |
17 | ; START: m-f-seq
18 | (def m-seq (map m (iterate inc 0)))
19 | (def f-seq (map f (iterate inc 0)))
20 | ; END: m-f-seq
21 |
22 |
--------------------------------------------------------------------------------
/src/examples/memoized_male_female.clj:
--------------------------------------------------------------------------------
1 | (ns examples.memoized-male-female)
2 |
3 | ; Hofstadter's Male and Female Sequences from GEB
4 | ; See http://en.wikipedia.org/wiki/Hofstadter_sequence
5 | (declare m f)
6 | (defn- m [n]
7 | (if (zero? n)
8 | 0
9 | (- n (f (m (dec n))))))
10 |
11 | (defn- f [n]
12 | (if (zero? n)
13 | 1
14 | (- n (m (f (dec n))))))
15 |
16 | ; START: m-f-memoize
17 | (def m (memoize m))
18 | (def f (memoize f))
19 | ; END: m-f-memoize
20 |
21 |
--------------------------------------------------------------------------------
/src/examples/midi.clj:
--------------------------------------------------------------------------------
1 | (ns examples.datatypes.midi
2 | (:import [javax.sound.midi MidiSystem]))
3 | (defprotocol MidiNote
4 | (to-msec [this tempo])
5 | (key-number [this])
6 | (play [this tempo midi-channel]))
7 |
8 | (defn perform [notes & {:keys [tempo] :or {tempo 88}}]
9 | (with-open [synth (doto (MidiSystem/getSynthesizer).open)]
10 | (let [channel (aget (.getChannels synth) 0)]
11 | (doseq [note notes]
12 | (play note tempo channel)))))
13 |
14 | (defrecord Note [pitch octave duration]
15 | MidiNote
16 | (to-msec [this tempo]
17 | (let [duration-to-bpm {1 240, 1/2 120, 1/4 60, 1/8 30, 1/16 15}]
18 | (* 1000 (/ (duration-to-bpm (:duration this))
19 | tempo))))
20 | (key-number [this]
21 | (let [scale {:C 0, :C# 1, :Db 1, :D 2,
22 | :D# 3, :Eb 3, :E 4, :F 5,
23 | :F# 6, :Gb 6, :G 7, :G# 8,
24 | :Ab 8, :A 9, :A# 10, :Bb 10,
25 | :B 11}]
26 | (+ (* 12 (inc (:octave this)))
27 | (scale (:pitch this)))))
28 | (play [this tempo midi-channel]
29 | (let [velocity (or (:velocity this) 64)]
30 | (.noteOn midi-channel (key-number this) velocity)
31 | (Thread/sleep (to-msec this tempo)))))
32 |
--------------------------------------------------------------------------------
/src/examples/multimethods.clj:
--------------------------------------------------------------------------------
1 | (ns examples.multimethods)
2 |
3 | ; START: defmulti
4 | (defmulti my-print class)
5 | ; END: defmulti
6 |
7 | (defn my-println [ob]
8 | (my-print ob)
9 | (.write *out* "\n"))
10 |
11 | ; START: defmethod-string
12 | (defmethod my-print String [s]
13 | (.write *out* s))
14 | ; END: defmethod-string
15 |
16 | ; START: defmethod-nil
17 | (defmethod my-print nil [s]
18 | (.write *out* "nil"))
19 | ; END: defmethod-nil
20 |
21 | ; START: defmethod-number
22 | (defmethod my-print Number [n]
23 | (.write *out* (.toString n)))
24 | ; END: defmethod-number
25 |
26 | ; START: defmethod-default
27 | (defmethod my-print :default [s]
28 | (.write *out* "#<")
29 | (.write *out* (.toString s))
30 | (.write *out* ">"))
31 | ; END: defmethod-default
32 |
33 | ; START: defmethod-collection
34 | (require '[clojure.string :as str])
35 | (defmethod my-print java.util.Collection [c]
36 | (.write *out* "(")
37 | (.write *out* (str/join " " c))
38 | (.write *out* ")"))
39 | ; END: defmethod-collection
40 |
41 | ; START: defmethod-vector
42 | (defmethod my-print clojure.lang.IPersistentVector [c]
43 | (.write *out* "[")
44 | (.write *out* (str/join " " c))
45 | (.write *out* "]"))
46 | ; END: defmethod-vector
47 |
48 | ; START:prefer-method
49 | (prefer-method
50 | my-print clojure.lang.IPersistentVector java.util.Collection)
51 | ; END:prefer-method
52 |
53 | ; START: my-class
54 | (defmulti my-class identity)
55 | (defmethod my-class nil [_] nil)
56 | (defmethod my-class :default [x] (.getClass x))
57 | ; END: my-class
58 |
59 |
--------------------------------------------------------------------------------
/src/examples/multimethods/account.clj:
--------------------------------------------------------------------------------
1 | ; START:account
2 | (ns examples.multimethods.account)
3 |
4 | (defstruct account :id :tag :balance)
5 | ; END:account
6 |
7 | (alias 'acc 'examples.multimethods.account)
8 |
9 | ; START:interest-rate
10 | (defmulti interest-rate :tag)
11 | (defmethod interest-rate ::acc/Checking [_] 0M)
12 | (defmethod interest-rate ::acc/Savings [_] 0.05M)
13 | ; END:interest-rate
14 |
15 | ; START:account-level
16 | (defmulti account-level :tag)
17 | (defmethod account-level ::acc/Checking [acct]
18 | (if (>= (:balance acct) 5000) ::acc/Premium ::acc/Basic))
19 | (defmethod account-level ::acc/Savings [acct]
20 | (if (>= (:balance acct) 1000) ::acc/Premium ::acc/Basic))
21 | ; END:account-level
22 |
23 |
--------------------------------------------------------------------------------
/src/examples/multimethods/default.clj:
--------------------------------------------------------------------------------
1 | (ns examples.multimethods.default)
2 |
3 | ; START: multimethod-default
4 | (defmulti my-print class :default :everything-else)
5 | (defmethod my-print String [s]
6 | (.write *out* s))
7 | (defmethod my-print :everything-else [_]
8 | (.write *out* "Not implemented yet..."))
9 | ; END: multimethod-default
10 |
--------------------------------------------------------------------------------
/src/examples/multimethods/service_charge_1.clj:
--------------------------------------------------------------------------------
1 | (ns examples.multimethods.service-charge-1
2 | (:require examples.multimethods.account))
3 |
4 | ; namespace hackery for segregating multiple service-charge impls
5 | (in-ns 'examples.multimethods.account)
6 | (clojure.core/use 'clojure.core)
7 |
8 | ; START:service-charge
9 | ; bad approach
10 | (defmulti service-charge account-level)
11 | (defmethod service-charge ::Basic [acct]
12 | (if (= (:tag acct) ::Checking) 25 10))
13 | (defmethod service-charge ::Premium [_] 0)
14 | ; END:service-charge
15 |
16 |
--------------------------------------------------------------------------------
/src/examples/multimethods/service_charge_2.clj:
--------------------------------------------------------------------------------
1 | (ns examples.multimethods.service-charge-2
2 | (:require examples.multimethods.account))
3 |
4 | (in-ns 'examples.multimethods.account)
5 | (clojure.core/use 'clojure.core)
6 |
7 | ; START:service-charge
8 | (defmulti service-charge (fn [acct] [(account-level acct) (:tag acct)]))
9 | (defmethod service-charge [::acc/Basic ::acc/Checking] [_] 25)
10 | (defmethod service-charge [::acc/Basic ::acc/Savings] [_] 10)
11 | (defmethod service-charge [::acc/Premium ::acc/Checking] [_] 0)
12 | (defmethod service-charge [::acc/Premium ::acc/Savings] [_] 0)
13 | ; END:service-charge
14 |
--------------------------------------------------------------------------------
/src/examples/multimethods/service_charge_3.clj:
--------------------------------------------------------------------------------
1 | (ns examples.multimethods.service-charge-3
2 | (:require examples.multimethods.account))
3 |
4 | (in-ns 'examples.multimethods.account)
5 | (clojure.core/use 'clojure.core)
6 |
7 | ; START: derive
8 | (derive ::acc/Savings ::acc/Account)
9 | (derive ::acc/Checking ::acc/Account)
10 | ; END: derive
11 |
12 | ; START: service-charge
13 | (defmulti service-charge (fn [acct] [(account-level acct) (:tag acct)]))
14 | (defmethod service-charge [::acc/Basic ::acc/Checking] [_] 25)
15 | (defmethod service-charge [::acc/Basic ::acc/Savings] [_] 10)
16 | (defmethod service-charge [::acc/Premium ::acc/Account] [_] 0)
17 | ; END: service-charge
18 |
19 |
20 |
--------------------------------------------------------------------------------
/src/examples/pi.clj:
--------------------------------------------------------------------------------
1 | (ns examples.pi)
2 |
3 | (defn in-circle? [[x y]]
4 | (<= (Math/sqrt (+ (* x x) (* y y))) 1))
5 |
6 | ; there is no great math behind this, but at least the seeds are different...
7 | (def seed (ref (System/currentTimeMillis)))
8 | (defn next-seed [] (dosync (alter seed inc)))
9 |
10 | (def *random* nil)
11 |
12 | (defn tl-rand
13 | ([] (.nextDouble *random*))
14 | ([n] (* n (.nextDouble *random*))))
15 |
16 | (defn random-point []
17 | (let [random-coord (fn [] (dec (tl-rand 2)))]
18 | [(random-coord) (random-coord)]))
19 |
20 | (defstruct sample-results :in-circle :total)
21 | (def default-sample-count 10000)
22 |
23 | (defmulti run-simulation (fn [& args] (into [] (map class args))))
24 |
25 | (defmethod run-simulation [Number]
26 | [n] (run-simulation (struct sample-results 0 0) n))
27 |
28 | (defmethod run-simulation [java.util.Map]
29 | [results] (run-simulation results default-sample-count))
30 |
31 | (defmethod run-simulation [java.util.Map Number]
32 | [results n]
33 | (binding [*random* (java.util.Random. (next-seed))]
34 | (reduce (fn [{in-circle :in-circle total :total} point]
35 | (struct sample-results
36 | (if (in-circle? point) (inc in-circle) in-circle)
37 | (inc total)))
38 | results
39 | (take n (repeatedly random-point)))))
40 |
41 | (defmulti guess-pi class)
42 |
43 | (defmethod guess-pi java.util.Map [results]
44 | (/ (* 4.0 (:in-circle results)) (:total results)))
45 |
46 | (defmethod guess-pi Number [n]
47 | (guess-pi (run-simulation n)))
48 |
49 | (defn parallel-guess-pi [agent-count trials]
50 | (let [trials (quot trials agent-count)
51 | agents (for [_ (range agent-count)] (agent trials))]
52 | (doseq [a agents] (send a run-simulation))
53 | (apply await agents)
54 | (guess-pi (apply merge-with + (map deref agents)))))
55 |
56 | ; runs an agent forever
57 | (defn background-pi [iter-count]
58 | (let [agt (agent {:in-circle 0 :total 0})
59 | continue (atom true)
60 | iter (fn sim [a-val]
61 | (when continue (send-off *agent* sim))
62 | (run-simulation a-val iter-count))]
63 | (send-off agt iter)
64 | {:guesser agt :continue atom}))
65 |
--------------------------------------------------------------------------------
/src/examples/preface.clj:
--------------------------------------------------------------------------------
1 | (ns examples.preface)
2 |
3 | ; START: listing
4 | (println "hello")
5 | ; END: listing
6 |
--------------------------------------------------------------------------------
/src/examples/primes.clj:
--------------------------------------------------------------------------------
1 | (ns examples.primes)
2 | ;; Taken from clojure.contrib.lazy-seqs
3 | ; primes cannot be written efficiently as a function, because
4 | ; it needs to look back on the whole sequence. contrast with
5 | ; fibs and powers-of-2 which only need a fixed buffer of 1 or 2
6 | ; previous values.
7 | (def primes
8 | (concat
9 | [2 3 5 7]
10 | (lazy-seq
11 | (let [primes-from
12 | (fn primes-from [n [f & r]]
13 | (if (some #(zero? (rem n %))
14 | (take-while #(<= (* % %) n) primes))
15 | (recur (+ n f) r)
16 | (lazy-seq (cons n (primes-from (+ n f) r)))))
17 | wheel (cycle [2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2
18 | 6 4 6 8 4 2 4 2 4 8 6 4 6 2 4 6
19 | 2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10])]
20 | (primes-from 11 wheel)))))
21 |
--------------------------------------------------------------------------------
/src/examples/protocols.clj:
--------------------------------------------------------------------------------
1 | (ns examples.protocols
2 | (:import (java.net Socket URL)
3 | (java.io File FileInputStream FileOutputStream
4 | InputStream InputStreamReader
5 | BufferedReader BufferedWriter
6 | OutputStream OutputStreamWriter)))
7 |
8 | ; START: gulp-2
9 | (defn gulp [src]
10 | (let [sb (StringBuilder.)]
11 | (with-open [reader (make-reader src)]
12 | (loop [c (.read reader)]
13 | (if (neg? c)
14 | (str sb)
15 | (do
16 | (.append sb (char c))
17 | (recur (.read reader))))))))
18 |
19 | ; END: gulp-2
20 |
21 | ; START: expectorate-2
22 | (defn expectorate [dst content]
23 | (with-open [writer (make-writer dst)]
24 | (.write writer (str content))))
25 |
26 | ; END: expectorate-2
27 |
28 | ; START: make-reader-2
29 | (defn make-reader [src]
30 | (-> (condp = (type src)
31 | java.io.InputStream src
32 | java.lang.String (FileInputStream. src)
33 | java.io.File (FileInputStream. src)
34 | java.net.Socket (.getInputStream src)
35 | java.net.URL (if (= "file" (.getProtocol src))
36 | (-> src .getPath FileInputStream.)
37 | (.openStream src)))
38 | InputStreamReader.
39 | BufferedReader.))
40 |
41 | ; END: make-reader-2
42 |
43 | ; START: make-writer-2
44 | (defn make-writer [dst]
45 | (-> (condp = (type dst)
46 | java.io.OutputStream dst
47 | java.io.File (FileOutputStream. dst)
48 | java.lang.String (FileOutputStream. dst)
49 | java.net.Socket (.getOutputStream dst)
50 | java.net.URL (if (= "file" (.getProtocol dst))
51 | (-> dst .getPath FileOutputStream.)
52 | (throw (IllegalArgumentException.
53 | "Can't write to non-file URL"))))
54 | OutputStreamWriter.
55 | BufferedWriter.))
56 |
57 | ; END: make-writer-2
58 |
59 | ; START: extend-input-stream
60 | (extend InputStream
61 | IOFactory
62 | {:make-reader (fn [src]
63 | (-> src InputStreamReader. BufferedReader.))
64 | :make-writer (fn [dst]
65 | (throw (IllegalArgumentException.
66 | "Can't open as an InputStream.")))})
67 |
68 | ; END: extend-input-stream
69 |
70 | ; START: extend-output-stream
71 | (extend OutputStream
72 | IOFactory
73 | {:make-reader (fn [src]
74 | (throw
75 | (IllegalArgumentException.
76 | "Can't open as an OutputStream.")))
77 | :make-writer (fn [dst]
78 | (-> dst OutputStreamWriter. BufferedWriter.))})
79 | ; END: extend-output-stream
80 |
81 | ; START: extend-file
82 | (extend-type File
83 | IOFactory
84 | (make-reader [src]
85 | (make-reader (FileInputStream. src)))
86 | (make-writer [dst]
87 | (make-writer (FileOutputStream. dst))))
88 | ; END: extend-file
89 |
90 | ; START: extend-socket
91 | (extend-protocol IOFactory
92 | Socket
93 | (make-reader [src]
94 | (make-reader (.getInputStream src)))
95 |
96 | (make-writer [dst]
97 | (make-writer (.getOutputStream dst)))
98 |
99 | URL
100 | (make-reader [src]
101 | (make-reader
102 | (if (= "file" (.getProtocol src))
103 | (-> src .getPath FileInputStream.)
104 | (.openStream src))))
105 |
106 | (make-writer [dst]
107 | (make-writer
108 | (if (= "file" (.getProtocol dst))
109 | (-> dst .getPath FileInputStream.)
110 | (throw (IllegalArgumentException.
111 | "Can't write to non-file URL"))))))
112 | ; END: extend-socket
113 |
114 | ; START: midinote
115 | (defprotocol MidiNote
116 | (to-msec [this tempo])
117 | (key-number [this])
118 | (play [this tempo midi-channel]))
119 | ; END: midinote
120 |
121 | ; START: extend-note
122 | (import 'javax.sound.midi.MidiSystem)
123 | (extend-type Note
124 | MidiNote
125 | (to-msec [this tempo]
126 | (let [duration-to-bpm {1 240, 1/2 120, 1/4 60, 1/8 30, 1/16 15}]
127 | (* 1000 (/ (duration-to-bpm (:duration this))
128 | tempo))))
129 | ; END: extend-note
130 |
131 | ; START: key-number
132 | (key-number [this]
133 | (let [scale {:C 0, :C# 1, :Db 1, :D 2,
134 | :D# 3, :Eb 3, :E 4, :F 5,
135 | :F# 6, :Gb 6, :G 7, :G# 8,
136 | :Ab 8, :A 9, :A# 10, :Bb 10,
137 | :B 11}]
138 | (+ (* 12 (inc (:octave this)))
139 | (scale (:pitch this)))))
140 | ; END: key-number
141 |
142 | ; START: play
143 | (play [this tempo midi-channel]
144 | (let [velocity (or (:velocity this) 64)]
145 | (.noteOn midi-channel (key-number this) velocity)
146 | (Thread/sleep (to-msec this tempo)))))
147 | ; END: play
148 |
149 | ; START: perform
150 | (defn perform [notes & {:keys [tempo] :or {tempo 120}}]
151 | (with-open [synth (doto (MidiSystem/getSynthesizer) .open)]
152 | (let [channel (aget (.getChannels synth) 0)]
153 | (doseq [note notes]
154 | (play note tempo channel)))))
155 | ; END: perform
--------------------------------------------------------------------------------
/src/examples/replace_symbol.clj:
--------------------------------------------------------------------------------
1 | (ns examples.replace-symbol)
2 |
3 | ; inspired by http://www.cs.uni.edu/~wallingf/patterns/recursion.html#3
4 | ; START: replace-symbol
5 | (defn- coll-or-scalar [x & _] (if (coll? x) :collection :scalar))
6 | (defmulti replace-symbol coll-or-scalar) ;
7 | (defmethod replace-symbol :collection [coll oldsym newsym]
8 | (lazy-seq ;
9 | (when (seq coll)
10 | (cons (replace-symbol (first coll) oldsym newsym)
11 | (replace-symbol (rest coll) oldsym newsym)))))
12 | (defmethod replace-symbol :scalar [obj oldsym newsym]
13 | (if (= obj oldsym) newsym obj))
14 | ; END: replace-symbol
15 |
16 | ; START: deeply-nested
17 | (defn deeply-nested [n]
18 | (loop [n n
19 | result '(bottom)]
20 | (if (= n 0)
21 | result
22 | (recur (dec n) (list result)))))
23 | ; END: deeply-nested
24 |
25 |
26 |
--------------------------------------------------------------------------------
/src/examples/sequences.clj:
--------------------------------------------------------------------------------
1 | (ns examples.sequences
2 | (:use examples.utils clojure.set clojure.xml))
3 |
4 | ; START:song
5 | (def song {:name "Agnus Dei"
6 | :artist "Krzysztof Penderecki"
7 | :album "Polish Requiem"
8 | :genre "Classical"})
9 | ; END:song
10 |
11 | ; START:compositions
12 | (def compositions
13 | #{{:name "The Art of the Fugue" :composer "J. S. Bach"}
14 | {:name "Musical Offering" :composer "J. S. Bach"}
15 | {:name "Requiem" :composer "Giuseppe Verdi"}
16 | {:name "Requiem" :composer "W. A. Mozart"}})
17 | (def composers
18 | #{{:composer "J. S. Bach" :country "Germany"}
19 | {:composer "W. A. Mozart" :country "Austria"}
20 | {:composer "Giuseppe Verdi" :country "Italy"}})
21 | (def nations
22 | #{{:nation "Germany" :language "German"}
23 | {:nation "Austria" :language "German"}
24 | {:nation "Italy" :language "Italian"}})
25 |
26 | ; END:compositions
27 |
28 | ; TODO: add pretty-print that works with book margins.
29 | (defdemo demo-map-builders
30 | (assoc song :kind "MPEG Audio File")
31 | (dissoc song :genre)
32 | (select-keys song [:name :artist])
33 | (merge song {:size 8118166 :time 507245}))
34 |
35 | (defdemo demo-merge-with
36 | (merge-with
37 | concat
38 | {:flintstone, ["Fred"], :rubble ["Barney"]}
39 | {:flintstone, ["Wilma"], :rubble ["Betty"]}
40 | {:flintstone, ["Pebbles"], :rubble ["Bam-Bam"]}))
41 |
42 | ; START:sets
43 | (def languages #{"java" "c" "d" "clojure"})
44 | (def beverages #{"java" "chai" "pop"})
45 | ; END: sets
46 |
47 | (defdemo demo-mutable-re
48 | ; START:mutable-re
49 | ; don't do this!
50 | (let [m (re-matcher #"\w+" "the quick brown fox")]
51 | (loop [match (re-find m)]
52 | (when match
53 | (println match)
54 | (recur (re-find m)))))
55 | ; END:mutable-re
56 | )
57 |
58 | ; START:filter
59 | (defn minutes-to-millis [mins] (* mins 1000 60))
60 |
61 | (defn recently-modified? [file]
62 | (> (.lastModified file)
63 | (- (System/currentTimeMillis) (minutes-to-millis 30))))
64 | ; END:filter
65 |
66 | ; START:clojure-loc
67 | (use '[clojure.java.io :only (reader)])
68 | (defn non-blank? [line] (if (re-find #"\S" line) true false))
69 |
70 | (defn non-svn? [file] (not (.contains (.toString file) ".svn")))
71 |
72 | (defn clojure-source? [file] (.endsWith (.toString file) ".clj"))
73 |
74 | (defn clojure-loc [base-file]
75 | (reduce
76 | +
77 | (for [file (file-seq base-file)
78 | :when (and (clojure-source? file) (non-svn? file))]
79 | (with-open [rdr (reader file)]
80 | (count (filter non-blank? (line-seq rdr)))))))
81 | ; END:clojure-loc
82 |
83 | (defn demo-xml-seq []
84 | ; START:xml-seq
85 | (for [x (xml-seq
86 | (parse (java.io.File. "data/sequences/compositions.xml")))
87 | :when (= :composition (:tag x))]
88 | (:composer (:attrs x)))
89 | ; END:xml-seq
90 | )
91 |
92 |
93 |
94 |
--------------------------------------------------------------------------------
/src/examples/server/complete.clj:
--------------------------------------------------------------------------------
1 | (ns examples.server.complete
2 | (:use [compojure.core :only (defroutes GET POST)]
3 | [examples.snippet]
4 | [ring.util.response :only (redirect)])
5 | (:require [hiccup.core :as hiccup]
6 | [hiccup.form-helpers :as form]
7 | [hiccup.page-helpers :as page]
8 | [compojure.route :as route]
9 | [compojure.handler :as handler]))
10 |
11 | (defn layout [title & body]
12 | (hiccup/html
13 | [:head
14 | [:title title]
15 | (page/include-js "/public/javascripts/code-highlighter.js"
16 | "/public/javascripts/clojure.js")
17 | (page/include-css "/public/stylesheets/code-highlighter.css")]
18 | [:body
19 | [:h2 title]
20 | body]))
21 |
22 | (defn new-snippet []
23 | (layout "Create a Snippet"
24 | (form/form-to [:post "/"]
25 | (form/text-area {:rows 20 :cols 73} "body")
26 | [:br]
27 | (form/submit-button "Save"))))
28 |
29 | (defn create-snippet [body]
30 | (if-let [id (insert-snippet body)]
31 | (redirect (str "/" id))
32 | (redirect "/")))
33 |
34 | (defn show-snippet [id]
35 | (layout (str "Snippet " id)
36 | (let [snippet (select-snippet id)]
37 | (hiccup/html
38 | [:div [:pre [:code.clojure (:body snippet)]]]
39 | [:div (:created_at snippet)]))))
40 |
41 | (defroutes routes
42 | (GET "/" [] (new-snippet))
43 | (GET "/:id" [id] (show-snippet id))
44 | (POST "/" [body] (create-snippet body))
45 | (route/files "/")
46 | (route/not-found "Not Found
"))
47 | ; END: public
48 |
49 | (def application
50 | (handler/site routes))
51 |
52 | (ensure-snippets-table-exists)
53 | (run-jetty application {:port 8080
54 | :join? false})
--------------------------------------------------------------------------------
/src/examples/server/step_1.clj:
--------------------------------------------------------------------------------
1 | (ns examples.server.step-1)
2 |
3 | ; START: defroutes
4 | (use '[compojure.core :only (defroutes GET)])
5 | (use '[ring.adapter.jetty :only (run-jetty)])
6 | (require '[compojure.route :as route])
7 |
8 | (defroutes routes
9 | (GET "/ping" [] "pong")
10 | (route/not-found "Not Found
"))
11 | ; END: defroutes
12 |
13 | ; START: run-server
14 | (run-jetty routes {:port 8080 :join? false})
15 | ; END: run-server
16 |
17 |
18 |
--------------------------------------------------------------------------------
/src/examples/server/step_2.clj:
--------------------------------------------------------------------------------
1 | (ns examples.server.step-2
2 | (:use [compojure.core :only (defroutes GET POST)]
3 | [examples.snippet]
4 | [ring.util.response :only (redirect)])
5 | (:require [hiccup.core :as hiccup]
6 | [hiccup.form-helpers :as form]
7 | [compojure.route :as route]
8 | [compojure.handler :as handler]
9 | [ring.adapter.jetty :as ring]))
10 |
11 | ; START: new-snippet
12 | (defn new-snippet []
13 | (hiccup/html
14 | (form/form-to [:post "/"]
15 | (form/text-area {:rows 20 :cols 73} "body")
16 | [:br]
17 | (form/submit-button "Save"))))
18 | ; END: new-snippet
19 |
20 | ; START: create-snippet
21 | (defn create-snippet [body]
22 | (if-let [id (insert-snippet body)]
23 | (redirect (str "/" id))
24 | (redirect "/")))
25 | ; END: create-snippet
26 |
27 | ; START: show-snippet
28 | (defn show-snippet [id]
29 | (let [snippet (select-snippet id)]
30 | (hiccup/html
31 | [:div [:pre [:code (:body snippet)]]]
32 | [:div (:created_at snippet)])))
33 | ; END: show-snippet
34 |
35 | ; START: routes
36 | (defroutes routes
37 | (GET "/" [] (new-snippet))
38 | (GET "/:id" [id] (show-snippet id))
39 | (POST "/" [body] (create-snippet body))
40 | (route/not-found "Not Found
"))
41 | ; END: routes
42 |
43 | ; START: site
44 | (def application (handler/site routes))
45 | ; END: site
--------------------------------------------------------------------------------
/src/examples/server/step_3.clj:
--------------------------------------------------------------------------------
1 | (ns examples.server.step-3
2 | (:use [compojure.core :only (defroutes GET POST)]
3 | [examples.snippet]
4 | [ring.util.response :only (redirect)])
5 | (:require [hiccup.core :as hiccup]
6 | [hiccup.form-helpers :as form]
7 | [hiccup.page-helpers :as page]
8 | [compojure.route :as route]
9 | [compojure.handler :as handler]))
10 |
11 | ; START: layout
12 | (defn layout [title & body]
13 | (hiccup/html
14 | [:head
15 | [:title title]
16 | (page/include-js "/public/javascripts/code-highlighter.js"
17 | "/public/javascripts/clojure.js")
18 | (page/include-css "/public/stylesheets/code-highlighter.css")]
19 | [:body
20 | [:h2 title]
21 | body]))
22 | ; END: layout
23 |
24 | ; START: new-snippet
25 | (defn new-snippet []
26 | (layout "Create a Snippet"
27 | (form/form-to [:post "/"]
28 | (form/text-area {:rows 20 :cols 73} "body")
29 | [:br]
30 | (form/submit-button "Save"))))
31 | ; END: new-snippet
32 |
33 | (defn create-snippet [body]
34 | (if-let [id (insert-snippet body)]
35 | (redirect (str "/" id))
36 | (redirect "/")))
37 |
38 | ; START: show-snippet
39 | (defn show-snippet [id]
40 | (layout (str "Snippet " id)
41 | (let [snippet (select-snippet id)]
42 | (hiccup/html
43 | [:div [:pre [:code.clojure (:body snippet)]]]
44 | [:div (:created_at snippet)]))))
45 | ; END: show-snippet
46 |
47 | ; START: public
48 | (defroutes routes
49 | (GET "/" [] (new-snippet))
50 | (GET "/:id" [id] (show-snippet id))
51 | (POST "/" [body] (create-snippet body))
52 | (route/files "/")
53 | (route/not-found "Not Found
"))
54 | ; END: public
55 |
56 | (def application
57 | (handler/site routes))
--------------------------------------------------------------------------------
/src/examples/snake.clj:
--------------------------------------------------------------------------------
1 | ; Inspired by the snakes that have gone before:
2 | ; Abhishek Reddy's snake: http://www.plt1.com/1070/even-smaller-snake/
3 | ; Mark Volkmann's snake: http://www.ociweb.com/mark/programming/ClojureSnake.html
4 |
5 | ; The START:/END: pairs are production artifacts for the book and not
6 | ; part of normal Clojure style
7 |
8 | (ns examples.snake
9 | (:import (java.awt Color Dimension)
10 | (javax.swing JPanel JFrame Timer JOptionPane)
11 | (java.awt.event ActionListener KeyListener))
12 | (:use examples.import-static))
13 | (import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_UP VK_DOWN)
14 |
15 | ; ----------------------------------------------------------
16 | ; functional model
17 | ; ----------------------------------------------------------
18 | ; START: constants
19 | (def width 75)
20 | (def height 50)
21 | (def point-size 10)
22 | (def turn-millis 75)
23 | (def win-length 5)
24 | (def dirs { VK_LEFT [-1 0]
25 | VK_RIGHT [ 1 0]
26 | VK_UP [ 0 -1]
27 | VK_DOWN [ 0 1]})
28 | ; END: constants
29 |
30 | ; START: board math
31 | (defn add-points [& pts]
32 | (vec (apply map + pts)))
33 |
34 | (defn point-to-screen-rect [pt]
35 | (map #(* point-size %)
36 | [(pt 0) (pt 1) 1 1]))
37 | ; END: board math
38 |
39 | ; START: apple
40 | (defn create-apple []
41 | {:location [(rand-int width) (rand-int height)]
42 | :color (Color. 210 50 90)
43 | :type :apple})
44 | ; END: apple
45 |
46 | ; START: snake
47 | (defn create-snake []
48 | {:body (list [1 1])
49 | :dir [1 0]
50 | :type :snake
51 | :color (Color. 15 160 70)})
52 | ; END: snake
53 |
54 | ; START: move
55 | (defn move [{:keys [body dir] :as snake} & grow]
56 | (assoc snake :body (cons (add-points (first body) dir)
57 | (if grow body (butlast body)))))
58 | ; END: move
59 |
60 | ; START: turn
61 | (defn turn [snake newdir]
62 | (assoc snake :dir newdir))
63 | ; END: turn
64 |
65 | ; START: win?
66 | (defn win? [{body :body}]
67 | (>= (count body) win-length))
68 | ; END: win?
69 |
70 | ; START: lose?
71 | (defn head-overlaps-body? [{[head & body] :body}]
72 | (contains? (set body) head))
73 |
74 | (def lose? head-overlaps-body?)
75 | ; END: lose?
76 |
77 | ; START: eats?
78 | (defn eats? [{[snake-head] :body} {apple :location}]
79 | (= snake-head apple))
80 | ; END: eats?
81 |
82 | ; ----------------------------------------------------------
83 | ; mutable model
84 | ; ----------------------------------------------------------
85 | ; START: update-positions
86 | (defn update-positions [snake apple]
87 | (dosync
88 | (if (eats? @snake @apple)
89 | (do (ref-set apple (create-apple))
90 | (alter snake move :grow))
91 | (alter snake move)))
92 | nil)
93 | ; END: update-positions
94 |
95 | ; START: update-direction
96 | (defn update-direction [snake newdir]
97 | (when newdir (dosync (alter snake turn newdir))))
98 | ; END: update-direction
99 |
100 | ; START: reset-game
101 | (defn reset-game [snake apple]
102 | (dosync (ref-set apple (create-apple))
103 | (ref-set snake (create-snake)))
104 | nil)
105 | ; END: reset-game
106 |
107 | ; ----------------------------------------------------------
108 | ; gui
109 | ; ----------------------------------------------------------
110 | ; START: fill-point
111 | (defn fill-point [g pt color]
112 | (let [[x y width height] (point-to-screen-rect pt)]
113 | (.setColor g color)
114 | (.fillRect g x y width height)))
115 | ; END: fill-point
116 |
117 | ; START: paint
118 | (defmulti paint (fn [g object & _] (:type object)))
119 |
120 | (defmethod paint :apple [g {:keys [location color]}] ;
121 | (fill-point g location color))
122 |
123 | (defmethod paint :snake [g {:keys [body color]}] ;
124 | (doseq [point body]
125 | (fill-point g point color)))
126 | ; END: paint
127 |
128 | ; START: game-panel
129 | (defn game-panel [frame snake apple]
130 | (proxy [JPanel ActionListener KeyListener] []
131 | (paintComponent [g] ;
132 | (proxy-super paintComponent g)
133 | (paint g @snake)
134 | (paint g @apple))
135 | (actionPerformed [e] ;
136 | (update-positions snake apple)
137 | (when (lose? @snake)
138 | (reset-game snake apple)
139 | (JOptionPane/showMessageDialog frame "You lose!"))
140 | (when (win? @snake)
141 | (reset-game snake apple)
142 | (JOptionPane/showMessageDialog frame "You win!"))
143 | (.repaint this))
144 | (keyPressed [e] ;
145 | (update-direction snake (dirs (.getKeyCode e))))
146 | (getPreferredSize []
147 | (Dimension. (* (inc width) point-size)
148 | (* (inc height) point-size)))
149 | (keyReleased [e])
150 | (keyTyped [e])))
151 | ; END: game-panel
152 |
153 | ; START: game
154 | (defn game []
155 | (let [snake (ref (create-snake)) ;
156 | apple (ref (create-apple))
157 | frame (JFrame. "Snake")
158 | panel (game-panel frame snake apple)
159 | timer (Timer. turn-millis panel)]
160 | (doto panel ;
161 | (.setFocusable true)
162 | (.addKeyListener panel))
163 | (doto frame ;
164 | (.add panel)
165 | (.pack)
166 | (.setVisible true))
167 | (.start timer) ;
168 | [snake, apple, timer])) ;
169 | ; END: game
170 |
171 |
--------------------------------------------------------------------------------
/src/examples/snippet.clj:
--------------------------------------------------------------------------------
1 | (ns examples.snippet)
2 |
3 | ; START: create-snippets
4 | (require '[clojure.java.jdbc :as sql])
5 | (defn create-snippets []
6 | (sql/create-table :snippets
7 | [:id :int "IDENTITY" "PRIMARY KEY"]
8 | [:body :varchar "NOT NULL"]
9 | [:created_at :datetime]))
10 | ; END: create-snippets
11 |
12 | ; START: db
13 | ; replace "snippet-db" with a full path!
14 | (def db {:classname "org.hsqldb.jdbcDriver"
15 | :subprotocol "hsqldb"
16 | :subname "file:snippet-db"})
17 | ; END: db
18 |
19 | (defn drop-snippets []
20 | (try
21 | (sql/drop-table :snippets)
22 | (catch Exception e)))
23 |
24 | ; START: insert-snippets
25 | (defn insert-snippets []
26 | (let [timestamp (java.sql.Timestamp. (.getTime (java.util.Date.)))]
27 | (sql/insert-records :snippets
28 | {:body "(println :boo)" :created_at timestamp}
29 | {:body "(defn foo [] 1)" :created_at timestamp})))
30 | ; END: insert-snippets
31 |
32 | (defn sample-snippets []
33 | (sql/with-connection db
34 | (drop-snippets)
35 | (create-snippets)
36 | (insert-snippets)))
37 |
38 | (defn reset-snippets []
39 | (sql/with-connection db
40 | (drop-snippets)
41 | (create-snippets)))
42 |
43 | (defn ensure-snippets-table-exists []
44 | (try
45 | (sql/with-connection db (create-snippets))
46 | (catch Exception _)))
47 |
48 |
49 | ; START: print-snippets
50 | (defn print-snippets []
51 | (sql/with-query-results res ["select * from snippets"]
52 | (println res)))
53 | ; END: print-snippets
54 |
55 | ; START: broken-select-snippets
56 | ; Broken!
57 | (defn select-snippets []
58 | (sql/with-query-results res ["select * from snippets"] res))
59 | ; END: broken-select-snippets
60 |
61 | (def broken-select-snippets select-snippets)
62 |
63 | (defmulti coerce (fn [dest-class src-inst] [dest-class (class src-inst)]))
64 | (defmethod coerce [Long String] [_ inst] (Long/parseLong inst))
65 | (defmethod coerce :default [dest-cls obj] (cast dest-cls obj))
66 |
67 | ; START: select-snippets-doall
68 | (defn select-snippets []
69 | (sql/with-connection db
70 | (sql/with-query-results res
71 | ["select * from snippets"]
72 | (doall res))))
73 | ; END: select-snippets-doall
74 |
75 | ; START: sql-query
76 | (defn sql-query [q]
77 | (sql/with-query-results res
78 | q
79 | (doall res)))
80 | ; END: sql-query
81 |
82 | (defn select-snippet [id]
83 | (sql/with-connection db
84 | (first (sql-query ["select * from snippets where id = ?" (coerce Long id)]))))
85 |
86 | ; START: last-created-id
87 | (defn last-created-id
88 | "Extract the last created id. Must be called in a transaction
89 | that performed an insert. Expects HSQLDB return structure of
90 | the form [{:@p0 id}]."
91 | []
92 | (first (vals (first (sql-query ["CALL IDENTITY()"])))))
93 | ; END: last-created-id
94 |
95 | ; START: insert-snippet
96 | (defn insert-snippet [body]
97 | (let [timestamp (java.sql.Timestamp. (.getTime (java.util.Date.)))]
98 | (sql/with-connection db
99 | (sql/transaction
100 | (sql/insert-records :snippets
101 | {:body body :created_at timestamp})
102 | (last-created-id)))))
103 | ; END: insert-snippet
104 |
--------------------------------------------------------------------------------
/src/examples/tasklist.clj:
--------------------------------------------------------------------------------
1 | (ns examples.tasklist
2 | (:gen-class
3 | :extends org.xml.sax.helpers.DefaultHandler
4 | :init init
5 | :state state)
6 | (:use [clojure.java.io :only (reader)])
7 | (:import [java.io File]
8 | [org.xml.sax InputSource]
9 | [org.xml.sax.helpers DefaultHandler]
10 | [javax.xml.parsers SAXParserFactory]))
11 |
12 | ; START: task-list
13 | (defn task-list [arg]
14 | (let [handler (new examples.tasklist)] ;
15 | (.. SAXParserFactory newInstance newSAXParser
16 | (parse (InputSource. (reader (File. arg)))
17 | handler))
18 | @(.state handler))) ;
19 | ; END: task-list
20 |
21 | ; START: init
22 | (defn -init []
23 | [[] (atom [])])
24 | ; END: init
25 |
26 | ; START: startElement
27 | (defn -startElement
28 | [this uri local qname atts]
29 | (when (= qname "target")
30 | (swap! (.state this) conj (.getValue atts "name")))) ;
31 | ; END: startElement
32 |
33 | ; START: main
34 | (defn -main [& args]
35 | (doseq [arg args]
36 | (println (task-list arg))))
37 | ; END: main
38 |
--------------------------------------------------------------------------------
/src/examples/test.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test
2 | (:use clojure.test))
3 |
4 | (def examples-tests
5 | (map #(symbol (str "examples.test." (name %)))
6 | [:chat :exploring :interop :introduction :multimethods :preface
7 | :multimethods.account :multimethods.service-charge-1
8 | :multimethods.service-charge-2 :multimethods.service-charge-3
9 | :sequences :index-of-any :life-without-multi :multimethods.default
10 | :macros :macros.chain-1 :macros.chain-2 :macros.chain-3 :macros.chain-4
11 | :macros.chain-5 :lazy-index-of-any :macros.bench-1
12 | :concurrency :functional :snake :snippet :replace-symbol
13 | :wallingford :trampoline :tasklist
14 | :male-female :memoized-male-female :male-female-seq]))
15 |
16 | (def lancet-tests
17 | (map #(symbol (str "lancet.test." (name %)))
18 | [:step-1-repl :step-1-complete
19 | :step-2-repl :step-2-complete
20 | :step-3-repl :step-3-complete
21 | :step-4-repl :step-4-complete
22 | :step-5-repl :step-5-complete
23 | :deftarget-1]))
24 |
25 | (def all-tests (concat examples-tests lancet-tests))
26 |
27 | (doseq [test all-tests] (require test))
28 |
29 | (apply run-tests all-tests)
30 |
31 | (shutdown-agents)
32 |
--------------------------------------------------------------------------------
/src/examples/trampoline.clj:
--------------------------------------------------------------------------------
1 | (ns examples.trampoline)
2 |
3 | ; START: trampoline-fibo
4 | ; Example only. Don't write code like this.
5 | (defn trampoline-fibo [n]
6 | (let [fib (fn fib [f-2 f-1 current]
7 | (let [f (+ f-2 f-1)]
8 | (if (= n current)
9 | f
10 | #(fib f-1 f (inc current)))))] ;
11 | (cond
12 | (= n 0) 0
13 | (= n 1) 1
14 | :else (fib 0N 1 2))))
15 | ; END: trampoline-fibo
16 |
17 | ; START: odd-even
18 | (declare my-odd? my-even?)
19 |
20 | (defn my-odd? [n]
21 | (if (= n 0)
22 | false
23 | #(my-even? (dec n)))) ;
24 |
25 | (defn my-even? [n]
26 | (if (= n 0)
27 | true
28 | #(my-odd? (dec n)))) ;
29 | ; END: odd-even
30 |
31 |
32 |
--------------------------------------------------------------------------------
/src/examples/utils.clj:
--------------------------------------------------------------------------------
1 | (ns examples.utils
2 | (:import [java.io BufferedReader InputStreamReader]))
3 |
4 | (require 'clojure.test)
5 | (defmacro re-test [test-sym]
6 | `(do
7 | (require :reload-all '~test-sym)
8 | (clojure.test/run-tests '~test-sym)))
9 |
10 | (defn classloader-seq
11 | ([] (classloader-seq (clojure.lang.RT/baseLoader)))
12 | ([cl]
13 | (loop [loaders (vector cl)]
14 | (if (nil? (last loaders))
15 | (drop-last loaders)
16 | (recur (conj loaders (.getParent (last loaders))))))))
17 |
18 | (defn classpath-url-seq [& args]
19 | (map (memfn toExternalForm)
20 | (reduce concat
21 | (map (memfn getURLs)
22 | (apply classloader-seq args)))))
23 |
24 | (defmacro show-publics [ns]
25 | `(doseq [p# (ns-publics (quote ~ns))]
26 | (println (first p#))))
27 |
28 | ; TODO: update book or add to Clojure
29 | (defmacro ?.
30 | "like .. but drops out on null object"
31 | ([x form]
32 | `(. ~x ~form))
33 | ([x form & more]
34 | `(if-let x# (. ~x ~form) (.? x# ~@more))))
35 |
36 | (defn files-on-classpath-at [path]
37 | (when-let [url (.findResource (.getContextClassLoader (Thread/currentThread)) path)]
38 | (file-seq (java.io.File. (.getFile url)))))
39 |
40 | (defmacro defdemo [nm & forms]
41 | `(defn ~nm []
42 | (let [result# (with-out-str (format-for-book ~@forms))]
43 | (spit ~(str "output/" (name nm) ".out") result#)
44 | result#)))
45 |
46 | (defmacro format-for-book [& forms]
47 | `(do
48 | ~@(map (fn [form]
49 | (if (instance? String `~form)
50 | `(do
51 | (println ~form)
52 | (print "-> ")
53 | (prn (load-string ~form))
54 | (println))
55 | `(do
56 | (prn '~form)
57 | (print "-> ")
58 | (prn ~form)
59 | (println))))
60 | forms)))
61 |
62 | (defn jar-urls [dir]
63 | (map #(.toURL %)
64 | (filter #(re-find #"jar$" (.getName %)) (.listFiles (java.io.File. dir)))))
65 |
--------------------------------------------------------------------------------
/src/examples/wallingford.clj:
--------------------------------------------------------------------------------
1 | (ns examples.wallingford
2 | (:require [examples.replace-symbol :only (deeply-nested)]))
3 |
4 | ; based on http://www.cs.uni.edu/~wallingf/patterns/recursion.html#3
5 | ; START: replace-symbol
6 | ; overly-literal port, do not use
7 | (declare replace-symbol replace-symbol-expression)
8 | (defn replace-symbol [coll oldsym newsym]
9 | (if (empty? coll)
10 | ()
11 | (cons (replace-symbol-expression
12 | (first coll) oldsym newsym)
13 | (replace-symbol
14 | (rest coll) oldsym newsym))))
15 | (defn replace-symbol-expression [symbol-expr oldsym newsym]
16 | (if (symbol? symbol-expr)
17 | (if (= symbol-expr oldsym)
18 | newsym
19 | symbol-expr)
20 | (replace-symbol symbol-expr oldsym newsym)))
21 | ; END: replace-symbol
--------------------------------------------------------------------------------
/src/reader/snake.clj:
--------------------------------------------------------------------------------
1 | ; START: namespace
2 | (ns reader.snake
3 | (:import (java.awt Color Dimension)
4 | (javax.swing JPanel JFrame Timer JOptionPane)
5 | (java.awt.event ActionListener KeyListener))
6 | (:use examples.import-static))
7 | (import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_UP VK_DOWN)
8 | ; END: namespace
9 |
10 | ; TODO: implement the Snake!
11 |
--------------------------------------------------------------------------------
/src/reader/snippet_server.clj:
--------------------------------------------------------------------------------
1 | (ns reader.snippet-server
2 | (:use compojure examples.snippet))
3 |
4 | (println "TODO: implement reader/snippet_server.clj!")
5 |
--------------------------------------------------------------------------------
/src/reader/tasklist.clj:
--------------------------------------------------------------------------------
1 | (ns reader.tasklist
2 | (:gen-class ;
3 | :extends org.xml.sax.helpers.DefaultHandler ;
4 | :state state ;
5 | :init init) ;
6 | (:use [clojure.java.io :only (reader)])
7 | (:import [java.io File]
8 | [org.xml.sax InputSource]
9 | [org.xml.sax.helpers DefaultHandler]
10 | [javax.xml.parsers SAXParserFactory]))
11 |
--------------------------------------------------------------------------------
/test/examples/test/chat.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.chat
2 | (:use clojure.test)
3 | (:require [examples.chat :as c]))
4 |
5 | (deftest naive-add-message
6 | (dosync (ref-set c/messages ()))
7 | (c/naive-add-message (c/->Message "jdoe" "hello"))
8 | (is (= [#examples.chat.Message{:sender "jdoe" :text "hello"}]
9 | @c/messages)))
10 |
11 | (deftest add-message
12 | (dosync (ref-set c/messages ()))
13 | (c/add-message (c/->Message "jdoe" "goodbye"))
14 | (is (= [#examples.chat.Message{:sender "jdoe" :text "goodbye"}]
15 | @c/messages)))
16 |
17 | (deftest add-message-commute
18 | (dosync (ref-set c/messages ()))
19 | (c/add-message-commute (c/->Message "jdoe" "goodbye"))
20 | (is (= [#examples.chat.Message{:sender "jdoe" :text "goodbye"}]
21 | @c/messages)))
22 |
23 | (deftest validate-message-list
24 | (is (true? (c/validate-message-list ())))
25 | (is (true? (c/validate-message-list '({:sender "X" :text "Y"}))))
26 | (is (false? (c/validate-message-list '({})))))
27 |
--------------------------------------------------------------------------------
/test/examples/test/concurrency.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.concurrency
2 | (:use clojure.test
3 | examples.concurrency
4 | [clojure.java.io :only (reader)])
5 | (:require [examples.chat :as chat]))
6 |
7 | (deftest test-next-counter
8 | (dosync (ref-set counter 0))
9 | (is (= (next-counter) 1)))
10 |
11 | (deftest test-slow-double
12 | (is (= [2 4 2 4 2 4] (calls-slow-double))))
13 |
14 | (deftest test-demos
15 | (let [out-str (with-out-str (demo-memoize))]
16 | (is (re-find #"Elapsed time: \d+\.\d+ msecs" out-str)
17 | out-str)))
18 |
19 | (deftest test-add-message-with-backup
20 | (let [msg (chat/->Message "unit test" "test message")]
21 | (.delete (java.io.File. "output/messages-backup.clj"))
22 | (dosync (ref-set chat/messages ()))
23 | (add-message-with-backup msg)
24 | (await backup-agent)
25 | (is (= (read (java.io.PushbackReader. (reader "output/messages-backup.clj")))
26 | (list msg)))))
--------------------------------------------------------------------------------
/test/examples/test/exploring.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.exploring
2 | (:use clojure.test examples.exploring))
3 |
4 | (defn call-date [& args]
5 | (with-out-str (apply date args)))
6 |
7 | (deftest test-date
8 | (is (= "a and b went out with 2 chaperones.\n"
9 | (call-date "a" "b" "c" "d"))))
10 |
11 | (deftest test-is-small-with-if?
12 | (is (= "yes" (is-small-with-if? 99)))
13 | (is (= nil (is-small-with-if? 100)))
14 | (is (= nil (is-small-with-if? 101))))
15 |
16 | (deftest test-is-small-with-else?
17 | (is (= "yes" (is-small-with-else? 99)))
18 | (is (= "no" (is-small-with-else? 100)))
19 | (is (= "no" (is-small-with-else? 101))))
20 |
21 | (deftest test-is-small-with-do?
22 | (is (=
23 | "Saw a big number 100\nSaw a big number 101\n"
24 | (with-out-str
25 | (is (= "yes" (is-small-with-do? 99)))
26 | (is (= "no" (is-small-with-do? 100)))
27 | (is (= "no" (is-small-with-do? 101)))))))
28 |
29 | (deftest test-demo-loop
30 | (is (= [5 4 3 2 1] (demo-loop))))
31 |
32 | (deftest test-countdown
33 | (is (= [4 3 2 1] (countdown [] 4))))
34 |
35 | (deftest test-index-of-any
36 | (is (= nil (index-of-any #{\d \e \f \g} "abc")))
37 | (is (= 1 (index-of-any #{\d \e \f \g} "add"))))
38 |
39 | (deftest test-greeting
40 | (is (= "Hello, foo" (simple-greeting "foo"))))
41 |
42 | (deftest test-greeting-with-default
43 | (is (= "Hello, world" (greeting-with-default)))
44 | (is (= "Hello, foo" (greeting-with-default "foo"))))
45 |
46 | (deftest test-indexable-word
47 | (is (indexable-word? "super"))
48 | (is (false? (indexable-word? "at"))))
49 |
50 | (deftest test-indexable-words
51 | (is (= ["this" "working"] (indexable-words "this is working"))))
52 |
53 | (deftest test-make-greeter
54 | (let [g (make-greeter "howdy")]
55 | (is (= "howdy, podner" (g "podner")))))
56 |
57 | (deftest test-square-corners
58 | (is (= [[0 0] [2 0] [2 2] [0 2]]
59 | (square-corners 0 0 2))))
60 |
61 | (deftest test-busted
62 | (is (thrown? AssertionError (test #'busted))))
63 |
64 | (deftest test-greet-author-1
65 | (is (= "Hello, John\n" (with-out-str (greet-author-1 {:first-name "John"})))))
66 |
67 | (deftest test-greet-author-2
68 | (is (= "Hello, John\n" (with-out-str (greet-author-2 {:first-name "John"})))))
69 |
70 | (deftest test-ellipsize
71 | (is (= "This had better ..."
72 | (ellipsize "This had better work!")))
73 | (is (= "This had better ..."
74 | (ellipsize "This had better work too!"))))
75 |
76 | ; START: thrown
77 | (deftest test-divide-by-zero
78 | (is (thrown? ArithmeticException (/ 5 0))))
79 | ; END: thrown
80 |
--------------------------------------------------------------------------------
/test/examples/test/fail.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.fail
2 | (:use examples.index-of-any clojure.test))
3 |
4 | ; START:test-failure
5 | (deftest test-that-demonstrates-failure
6 | (is (= 5 (+ 2 2))))
7 | ; END:test-failure
8 |
9 | ; START:test-error-message
10 | (deftest test-that-demonstrates-error-message
11 | (is (= 3 Math/PI) "PI is an integer!?"))
12 | ; END:test-error-message
13 |
14 | (run-tests)
15 |
--------------------------------------------------------------------------------
/test/examples/test/functional.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.functional
2 | (:use clojure.test
3 | examples.functional))
4 |
5 | (def ten-fibs [0 1 1 2 3 5 8 13 21 34])
6 |
7 | (deftest test-stack-crushing-fibo
8 | (is (= ten-fibs (map stack-consuming-fibo (range 0 10))))
9 | (is (thrown? StackOverflowError (stack-consuming-fibo 1000000N))))
10 |
11 | (deftest test-tail-fibo
12 | (is (= ten-fibs (map tail-fibo (range 0 10))))
13 | (is (thrown? StackOverflowError (tail-fibo 1000000N))))
14 |
15 | (deftest test-recur-fibo
16 | (is (= ten-fibs (map recur-fibo (range 0 10)))))
17 |
18 | (deftest test-fibo
19 | (is (= ten-fibs (take 10 (fibo)))))
20 |
21 | (deftest test-head-fibo
22 | (is (= ten-fibs (take 10 head-fibo))))
23 |
24 | (deftest test-faux-curry
25 | (is (fn? (faux-curry + 1)))
26 | (is (fn? ((faux-curry + 1) 1)))
27 | (is (= 2 (((faux-curry + 1) 1)))))
28 |
29 | (deftest test-count-heads-pairs
30 | (doseq [count-fn [count-heads-loop count-heads-by-pairs count-heads-by-runs]]
31 | (are [x y] (= x y)
32 | 0 (count-fn [:h :t])
33 | 1 (count-fn [:t :h :h :t])
34 | 2 (count-fn [:h :h :h])
35 | )))
36 |
--------------------------------------------------------------------------------
/test/examples/test/index_of_any.clj:
--------------------------------------------------------------------------------
1 | ; START:test
2 | (ns examples.test.index-of-any
3 | (:use examples.index-of-any clojure.test))
4 |
5 | (deftest test-index-of-any-with-nil-args
6 | (is (nil? (index-of-any #{\a} nil)))
7 | (is (nil? (index-of-any nil "foo"))))
8 |
9 | (deftest test-index-of-any-with-empty-args
10 | (is (nil? (index-of-any #{\a} "")))
11 | (is (nil? (index-of-any #{} "foo"))))
12 |
13 | (deftest test-index-of-any-with-match
14 | (is (zero? (index-of-any #{\z \a} "zzabyycdxx")))
15 | (is (= 3 (index-of-any #{\b \y} "zzabyycdxx"))))
16 |
17 | (deftest test-index-of-any-without-match
18 | (is (nil? (index-of-any #{\z} "aba"))))
19 | ; END:test
20 |
21 |
22 |
--------------------------------------------------------------------------------
/test/examples/test/interop.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.interop
2 | (:use clojure.test)
3 | (:use examples.interop))
4 |
5 | (deftest sum-to-variants
6 | (is (= (sum-to 10) 55))
7 | (is (= (integer-sum-to 10) 55))
8 | (is (= (unchecked-sum-to 10) 55))
9 | (is (= (better-sum-to 10) 55))
10 | (is (= (best-sum-to 10) 55))
11 | )
12 |
13 | (deftest test-painstakingly-create-array
14 | (is (= (seq (painstakingly-create-array))
15 | ["Painstaking" "to" "fill" "in" "arrays"])))
16 |
17 | (deftest sax-parsing
18 | (is (= (with-out-str (demo-sax-parse "hello" print-element-handler))
19 | "Saw element: foo\nSaw element: bar\n")))
20 |
21 | ;; skipping test of demo-threads
22 | ;; to write this test you would need a cross-thread with-out-str
23 |
24 | (deftest test-try-finally
25 | (is (= (with-out-str (is (thrown? Exception (demo-try-finally))))
26 | "we get to clean up\n"))
27 | )
28 |
29 | (deftest test-class-available
30 | (is (thrown? ClassNotFoundException (poor-class-available? "java.lang.MicrosoftRocks")))
31 | (is (= String (poor-class-available? "java.lang.String")))
32 | (is (false? (class-available? "java.lang.MicrosoftRocks")))
33 | (is (class-available? "java.lang.String"))
34 | )
35 |
36 | (deftest test-describe-class
37 | (is (= {:name "java.lang.String", :final true} (untyped-describe-class String)))
38 | (is (= {:name "java.lang.String", :final true} (typed-describe-class String)))
39 | (is (thrown? IllegalArgumentException (untyped-describe-class "foo")))
40 | (is (thrown? ClassCastException (typed-describe-class "foo")))
41 | )
42 |
43 |
44 |
45 |
46 |
--------------------------------------------------------------------------------
/test/examples/test/introduction.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.introduction
2 | (:use clojure.test
3 | examples.introduction))
4 |
5 | (deftest test-blank?
6 | (is (blank? nil))
7 | (is (blank? ""))
8 | (is (blank? " "))
9 | (is (false? (blank? "boo"))))
10 |
11 | (deftest test-accounts
12 | (dosync (commute accounts conj (struct account "CLSS" 0)))
13 | (is (= #{{:id "CLSS" :balance 0}} @accounts)))
14 |
15 | (deftest test-fibs
16 | (is (= [0 1 1 2 3 5 8 13 21 34] (take 10 fibs))))
17 |
18 | (deftest test-hello-docstring
19 | (is (= (with-out-str (hello-docstring "Aaron")) "Hello, Aaron\n")))
20 |
21 | ; multiple hellos in this chapter. Last one should have a docstring
22 | (deftest test-hello-has-a-docstring
23 | (is (= "Writes hello message to *out*. Calls you by username.\n Knows if you have been here before."
24 | (:doc (meta #'hello)))))
25 |
--------------------------------------------------------------------------------
/test/examples/test/lazy_index_of_any.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.lazy-index-of-any
2 | (:use examples.lazy-index-of-any clojure.test))
3 |
4 | (deftest test-lazy-index-of-any-with-match
5 | (is (= (with-out-str (is (zero? (index-of-any #{\z \a} "zzabyycdxx"))))
6 | "Iterating over z\n"))
7 | (is (= (with-out-str (is (= 3 (index-of-any #{\b \y} "zzabyycdxx"))))
8 | "Iterating over z\nIterating over z\nIterating over a\nIterating over b\n")))
9 |
10 |
11 |
12 |
--------------------------------------------------------------------------------
/test/examples/test/life_without_multi.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.life-without-multi
2 | (:use clojure.test examples.life-without-multi))
3 |
4 | (deftest test-my-println
5 | (is (= (with-out-str (my-println "foo")) "foo\n")))
6 |
7 | (deftest test-my-print
8 | (is (thrown? NullPointerException (my-print-1 nil)))
9 | (are [x y] (= x y)
10 | (with-out-str (my-print-1 "foo")) "foo"
11 |
12 | (with-out-str (my-print-2 "foo")) "foo"
13 | (with-out-str (my-print-2 nil)) "nil"
14 | (with-out-str (my-print-2 [1 2 3])) ""
15 |
16 | (with-out-str (my-print-3 "foo")) "foo"
17 | (with-out-str (my-print-3 nil)) "nil"
18 | (with-out-str (my-print-3 [1 2 3])) "[1 2 3]"))
19 |
20 |
21 |
22 |
23 |
24 |
--------------------------------------------------------------------------------
/test/examples/test/macros.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.macros
2 | (:use clojure.test examples.macros))
3 |
4 | ; unless-1 evals args before test
5 | (deftest test-unless-1
6 | (is (thrown? Exception (unless-1 false (throw (Exception.)))))
7 | (is (thrown? Exception (unless-1 true (throw (Exception.))))))
8 |
9 | ; unless-2 evals args before test
10 | (deftest test-unless-2
11 | (are [x y] (= x y)
12 | (with-out-str (unless-2 false :foo)) "About to test...\n"
13 | (with-out-str (unless-2 true :foo)) "About to test...\n"))
14 |
15 | ; unless-3 is a macro and does the right thing
16 | (deftest test-unless
17 | (is (thrown? Exception (unless false (throw (Exception.)))))
18 | (unless true (throw (Exception.))))
19 |
20 | ; bad-unless captures a symbol
21 | (deftest test-expansions
22 | (are [x y] (= x y)
23 | (macroexpand-1 '(examples.macros/unless false :foo)) '(if false nil :foo)
24 | (macroexpand-1 '(examples.macros/bad-unless false :foo)) '(if expr nil :foo)))
25 |
26 | (deftest test-bench-2
27 | (are [x y] (= x y)
28 | (:result (examples.macros/bench (+ 1 2)))
29 | 3))
30 |
31 | (deftest test-bench-fn
32 | (are [x y] (= x y)
33 | (:result (examples.macros/bench-fn (fn [] (+ 2 2))))
34 | 4))
35 |
36 |
37 |
38 |
39 |
--------------------------------------------------------------------------------
/test/examples/test/macros/bench_1.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.macros.bench-1
2 | (:use clojure.test examples.macros.bench-1))
3 |
4 | (deftest test-bench-1
5 | (are [x y] (= x y)
6 | (macroexpand-1 '(examples.macros.bench-1/bench :foo))
7 | '(clojure.core/let [examples.macros.bench-1/start (java.lang.System/nanoTime)
8 | examples.macros.bench-1/result :foo]
9 | {:elapsed (clojure.core/- (java.lang.System/nanoTime) examples.macros.bench-1/start),
10 | :result examples.macros.bench-1/result})))
11 |
12 |
--------------------------------------------------------------------------------
/test/examples/test/macros/chain_1.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.macros.chain-1
2 | (:use clojure.test examples.macros.chain-1))
3 |
4 | (deftest test-chain-1
5 | (are [x y] (= x y)
6 | (macroexpand-1 '(examples.macros.chain-1/chain a b)) '(. a b))
7 | (is (thrown? IllegalArgumentException (macroexpand-1 '(examples.macros.chain-1/chain a b c)))))
8 |
--------------------------------------------------------------------------------
/test/examples/test/macros/chain_2.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.macros.chain-2
2 | (:use clojure.test examples.macros.chain-2))
3 |
4 | (deftest test-chain-2
5 | (are [x y] (= x y)
6 | (macroexpand-1 '(examples.macros.chain-2/chain a b)) '(. a b)
7 | (macroexpand-1 '(examples.macros.chain-2/chain a b c)) '(chain (. a b) c)))
8 |
--------------------------------------------------------------------------------
/test/examples/test/macros/chain_3.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.macros.chain-3
2 | (:use clojure.test examples.macros.chain-3))
3 |
4 | (deftest test-chain-3
5 | (are [x y] (= x y)
6 | (macroexpand-1 '(examples.macros.chain-3/chain a b)) '(. a b))
7 | (is (thrown? IllegalArgumentException (macroexpand-1 '(examples.macros.chain-3/chain a b c)))))
8 |
--------------------------------------------------------------------------------
/test/examples/test/macros/chain_4.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.macros.chain-4
2 | (:use clojure.test examples.macros.chain-4))
3 |
4 | (deftest test-chain-4
5 | (are [x y] (= x y)
6 | (macroexpand-1 '(examples.macros.chain-4/chain a b)) '(. a b)
7 | (macroexpand-1 '(examples.macros.chain-4/chain a b c)) '(examples.macros.chain-4/chain (. a b) (c))))
8 |
--------------------------------------------------------------------------------
/test/examples/test/macros/chain_5.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.macros.chain-5
2 | (:use clojure.test examples.macros.chain-5))
3 |
4 | (deftest test-chain-5
5 | (are [x y] (= x y)
6 | (macroexpand-1 '(examples.macros.chain-5/chain a b)) '(. a b)
7 | (macroexpand-1 '(examples.macros.chain-5/chain a b c)) '(examples.macros.chain-5/chain (. a b) c)))
8 |
--------------------------------------------------------------------------------
/test/examples/test/male_female.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.male-female
2 | (:use clojure.test
3 | examples.male-female))
4 |
5 | (deftest test-hofstadter-m-f
6 | (are [x y] (= x y)
7 | [0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12]
8 | (map m (range 21))
9 | [1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13]
10 | (map f (range 21))))
11 |
12 |
--------------------------------------------------------------------------------
/test/examples/test/male_female_seq.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.male-female-seq
2 | (:use clojure.test
3 | examples.male-female-seq))
4 |
5 | (deftest test-hofstadter-m-f
6 | (are [x y] (= x y)
7 | [0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12]
8 | (take 21 m-seq)
9 | [1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13]
10 | (take 21 f-seq)))
11 |
12 |
--------------------------------------------------------------------------------
/test/examples/test/memoized_male_female.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.memoized-male-female
2 | (:use clojure.test
3 | examples.memoized-male-female))
4 |
5 | (deftest test-hofstadter-m-f
6 | (are [x y] (= x y)
7 | [0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12]
8 | (map m (range 21))
9 | [1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13]
10 | (map f (range 21))))
11 |
12 |
--------------------------------------------------------------------------------
/test/examples/test/multimethods.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.multimethods
2 | (:use clojure.test examples.multimethods))
3 |
4 | (deftest test-my-println
5 | (is (= (with-out-str (my-println "foo")) "foo\n")))
6 |
7 | (deftest test-my-print
8 | (let [my-print-str (fn [& args] (with-out-str (apply my-print args)))]
9 | (are [x y] (= x y)
10 | (my-print-str "strval") "strval"
11 | (my-print-str nil) "nil"
12 | (my-print-str 42) "42"
13 | (my-print-str '(1 2 3)) "(1 2 3)"
14 | (my-print-str [4 5 6]) "[4 5 6]"
15 | (my-print-str (java.io.File. "foo")) "#")))
16 |
17 | (deftest test-my-class
18 | (are [x y] (= x y)
19 | String (my-class "foo")
20 | nil (my-class nil)))
21 |
22 |
23 |
24 |
25 |
26 |
--------------------------------------------------------------------------------
/test/examples/test/multimethods/account.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.multimethods.account
2 | (:use clojure.test examples.multimethods.account))
3 |
4 | (alias 'acc 'examples.multimethods.account)
5 |
6 | (deftest test-interest-rate
7 | (are [x y] (= x y)
8 | (interest-rate {:tag ::acc/Checking}) 0M
9 | (interest-rate {:tag ::acc/Savings}) 0.05M))
10 |
11 | (deftest test-account-level
12 | (are [x y] (= x y)
13 | (account-level {:tag ::acc/Checking, :balance 4999}) ::acc/Basic
14 | (account-level {:tag ::acc/Checking, :balance 5000}) ::acc/Premium
15 | (account-level {:tag ::acc/Savings, :balance 999}) ::acc/Basic
16 | (account-level {:tag ::acc/Savings, :balance 1000}) ::acc/Premium))
17 |
18 |
19 |
--------------------------------------------------------------------------------
/test/examples/test/multimethods/default.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.multimethods.default
2 | (:use clojure.test examples.multimethods.default))
3 |
4 | (deftest test-my-print
5 | (are [x y] (= x y)
6 | (with-out-str (my-print "foo")) "foo"
7 | (with-out-str (my-print 42)) "Not implemented yet..."))
8 |
9 |
10 |
11 |
--------------------------------------------------------------------------------
/test/examples/test/multimethods/service_charge_1.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.multimethods.service-charge-1
2 | (:use clojure.test examples.multimethods.service-charge-1 examples.multimethods.account))
3 |
4 | (alias 'acc 'examples.multimethods.account)
5 |
6 | (deftest test-service-charge
7 | (are [x y] (= x y)
8 | (service-charge {:tag ::acc/Checking, :balance 4999}) 25
9 | (service-charge {:tag ::acc/Checking, :balance 5000}) 0
10 | (service-charge {:tag ::acc/Savings, :balance 999}) 10
11 | (service-charge {:tag ::acc/Savings, :balance 1000}) 0))
12 |
13 |
14 |
--------------------------------------------------------------------------------
/test/examples/test/multimethods/service_charge_2.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.multimethods.service-charge-2
2 | (:use clojure.test examples.multimethods.service-charge-2 examples.multimethods.account))
3 |
4 | (alias 'acc 'examples.multimethods.account)
5 |
6 | (deftest test-service-charge
7 | (are [x y] (= x y)
8 | (service-charge {:tag ::acc/Checking, :balance 4999}) 25
9 | (service-charge {:tag ::acc/Checking, :balance 5000}) 0
10 | (service-charge {:tag ::acc/Savings, :balance 999}) 10
11 | (service-charge {:tag ::acc/Savings, :balance 1000}) 0))
12 |
13 |
14 |
--------------------------------------------------------------------------------
/test/examples/test/multimethods/service_charge_3.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.multimethods.service-charge-3
2 | (:use clojure.test examples.multimethods.service-charge-3 examples.multimethods.account))
3 |
4 | (alias 'acc 'examples.multimethods.account)
5 |
6 | (deftest test-service-charge
7 | (are [x y] (= x y)
8 | (service-charge {:tag ::acc/Checking, :balance 4999}) 25
9 | (service-charge {:tag ::acc/Checking, :balance 5000}) 0
10 | (service-charge {:tag ::acc/Savings, :balance 999}) 10
11 | (service-charge {:tag ::acc/Savings, :balance 1000}) 0))
12 |
13 |
14 |
--------------------------------------------------------------------------------
/test/examples/test/preface.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.preface
2 | (:use clojure.test))
3 |
4 | (deftest test-load-preface
5 | (is (= "hello\n"
6 | (with-out-str (use :reload 'examples.preface))))
7 | )
8 |
9 |
10 |
11 |
12 |
--------------------------------------------------------------------------------
/test/examples/test/replace_symbol.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.replace-symbol
2 | (:use clojure.test
3 | examples.replace-symbol))
4 |
5 | (deftest test-replace-symbol
6 | (are [x y] (= x y)
7 | () (replace-symbol () 'a 'b)
8 | '(a) (replace-symbol '(a) 'b 'c)
9 | '(c) (replace-symbol '(b) 'b 'c)
10 | '(a (d e)) (replace-symbol '(a (d e)) 'b 'c)
11 | '(c (c c)) (replace-symbol '(b (b b)) 'b 'c)
12 | '((a a) (((a g r) (f r)) c (d e)) a)
13 | (replace-symbol '((a b) (((b g r) (f r)) c (d e)) b) 'b 'a)))
14 |
15 |
--------------------------------------------------------------------------------
/test/examples/test/sequences.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.sequences
2 | (:import java.io.File)
3 | (:use clojure.test clojure.set examples.sequences))
4 |
5 |
6 | (deftest test-demo-xml-seq
7 | (is (= (demo-xml-seq) '("J. S. Bach" "F. Chopin" "W. A. Mozart"))))
8 |
9 | (deftest test-clojure-loc
10 | (are [x y] (= x y)
11 | (non-svn? ".svn") false
12 | (non-svn? "/foo/bar/.svn") false
13 | (non-svn? ".svn/foo/bar") false
14 | (non-svn? "foo") true
15 | (clojure-source? "foo.clj") true
16 | (clojure-source? "foo.java") false
17 | (non-blank? " . ") true
18 | (non-blank? " \t") false))
19 |
20 | (deftest test-recently-modified?
21 | (let [now #(System/currentTimeMillis)
22 | recent (proxy [File] ["recent"] (lastModified [] (now)))
23 | older (proxy [File] ["older"] (lastModified [] (- (now) (minutes-to-millis 1000))))]
24 | (are [x y] (= x y)
25 | (recently-modified? recent) true
26 | (recently-modified? older) false)))
27 |
28 | (deftest test-sets
29 | (are [x y] (= x y)
30 | (union languages beverages) #{"java" "c" "d" "clojure" "chai" "pop"}
31 | (difference languages beverages) #{"c" "d" "clojure"}
32 | (intersection languages beverages) #{"java"}
33 | (select #(= 1 (.length %)) languages) #{"c" "d"}))
34 |
35 | (deftest test-joins
36 | (are [x y] (= x y)
37 | (join composers nations {:country :nation})
38 | #{{:language "German", :nation "Austria", :composer "W. A. Mozart", :country "Austria"}
39 | {:language "German", :nation "Germany", :composer "J. S. Bach", :country "Germany"}
40 | {:language "Italian", :nation "Italy", :composer "Giuseppe Verdi", :country "Italy"}}))
41 |
42 | (deftest run-demos
43 | (demo-map-builders)
44 | (demo-merge-with)
45 | (demo-mutable-re))
46 |
47 |
48 |
--------------------------------------------------------------------------------
/test/examples/test/snake.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.snake
2 | (:use clojure.test
3 | examples.snake))
4 |
5 | (deftest test-add-points
6 | (is (= [2,0] (add-points [1,1] [1,-1]))))
7 |
8 | (deftest test-point-to-screen-rect
9 | (is (= [20 50 10 10] (point-to-screen-rect [2,5]))))
10 |
11 | (deftest test-create-apple
12 | (let [apple (create-apple)]
13 | (is (<= 0 (first (:location apple)) width))
14 | (is (<= 0 (second (:location apple)) height))
15 | (is (= (:apple (:type apple))))))
16 |
17 | (let [snake (create-snake)]
18 | (deftest test-move
19 | (is (= [[2 1]] (:body (move snake))))
20 | (is (= [[2 1] [1 1]] (:body (move snake :grow)))))
21 |
22 | (deftest test-turn
23 | (is (= [-1 0] (:dir (turn snake [-1 0])))))
24 |
25 | (deftest test-win
26 | (let [growing-snakes (iterate #(move %1 :grow) snake)]
27 | (is (= (take 4 (map win? growing-snakes))
28 | (replicate 4 false)))
29 | (is (= (take 10 (drop 4 (map win? growing-snakes)))
30 | (replicate 10 true)))))
31 |
32 | (deftest test-lose
33 | (let [grow #(move %1 :grow)]
34 | (is (not (lose? snake)))
35 | (is (not (lose? (grow snake))))
36 | (is (not (lose? (-> snake grow grow))))
37 | (is (lose? (-> snake (turn [1 0]) grow (turn [-1 0]) grow)))))
38 |
39 | (deftest test-eats
40 | (let [eat-me {:location (first (:body snake))}
41 | dont-eat {:location [-1 -1]}]
42 | (is (eats? snake eat-me))
43 | (is (not (eats? snake dont-eat))))))
44 |
--------------------------------------------------------------------------------
/test/examples/test/snippet.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.snippet
2 | (:use clojure.test
3 | examples.snippet)
4 | (:require [clojure.java.jdbc :as sql]))
5 |
6 | (deftest insert-and-select-some-snippets
7 | (sample-snippets)
8 | (is (= [{:id 0, :body "(println :boo)"}
9 | {:id 1, :body "(defn foo [] 1)"}]
10 | (map #(select-keys % [:id :body]) (select-snippets))))
11 | (insert-snippet "boo!")
12 | (is (= {:id 2, :body "boo!"}
13 | (select-keys (select-snippet 2) [:id :body]))))
14 |
15 | (deftest drop-and-create-snippets-table
16 | (sql/with-connection db (drop-snippets))
17 | (is (= "Table not found in statement [select * from snippets]"
18 | (.getMessage (is (thrown? java.sql.SQLException (select-snippets))))))
19 | (ensure-snippets-table-exists)
20 | (is (nil? (select-snippets))))
21 |
--------------------------------------------------------------------------------
/test/examples/test/tasklist.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.tasklist
2 | (:use clojure.test)
3 | (:require examples.tasklist))
4 |
5 | (deftest tasklist-main
6 | (is (=
7 | "[init compile-java compile-clojure clojure jar all clean]\n"
8 | (with-out-str (examples.tasklist/-main "data/snippets/example-build.xml"))))
9 | )
10 |
11 | (deftest tasklist-compilation
12 | (compile 'examples.tasklist)
13 | )
14 |
15 |
16 |
17 |
--------------------------------------------------------------------------------
/test/examples/test/trampoline.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.trampoline
2 | (:use clojure.test examples.trampoline))
3 |
4 | (def ten-fibs [0 1 1 2 3 5 8 13 21 34])
5 |
6 | (deftest test-tail-fibo
7 | (is (= ten-fibs
8 | (map (partial trampoline trampoline-fibo) (range 0 10)))))
9 |
10 | (deftest test-my-odd
11 | (is (= [false true false true false]
12 | (map (partial trampoline my-odd?) (range 5)))))
13 |
14 | (deftest test-my-even
15 | (is (= [true false true false true]
16 | (map (partial trampoline my-even?) (range 5)))))
17 |
--------------------------------------------------------------------------------
/test/examples/test/wallingford.clj:
--------------------------------------------------------------------------------
1 | (ns examples.test.wallingford
2 | (:use clojure.test
3 | examples.wallingford))
4 |
5 | (deftest test-replace
6 | (are [x y] (= x y)
7 | () (replace-symbol () 'a 'b)
8 | '(a) (replace-symbol '(a) 'b 'c)
9 | '(c) (replace-symbol '(b) 'b 'c)
10 | '(a (d e)) (replace-symbol '(a (d e)) 'b 'c)
11 | '(c (c c)) (replace-symbol '(b (b b)) 'b 'c)
12 | '((a a) (((a g r) (f r)) c (d e)) a)
13 | (replace-symbol '((a b) (((b g r) (f r)) c (d e)) b) 'b 'a)))
14 |
--------------------------------------------------------------------------------