├── .gitignore ├── README.md ├── ch01-welcome-repl-interactions.clj ├── ch02-FP-repl-interactions.clj ├── ch03-array-set ├── project.clj ├── src │ └── com │ │ └── clojurebook │ │ ├── array_set.clj │ │ └── array_set_broken.clj └── test │ └── com │ └── clojurebook │ └── test_array_set.clj ├── ch03-collections-repl-interactions.clj ├── ch03-game-of-life ├── project.clj └── src │ └── com │ └── clojurebook │ └── collections │ └── life.clj ├── ch04-concurrency-game ├── .gitignore ├── project.clj └── src │ └── com │ └── clojurebook │ ├── concurrency.clj │ └── concurrency │ ├── game.clj │ └── game_validators.clj ├── ch04-concurrency-repl-interactions.clj ├── ch04-concurrency-webcrawler ├── project.clj └── src │ └── com │ └── clojurebook │ └── concurrency │ └── webcrawler.clj ├── ch05-macros-repl-interactions.clj ├── ch06-datatypes-repl-interactions.clj ├── ch07-multimethods-repl-interactions.clj ├── ch08-lein-mixed-source ├── project.clj ├── src │ └── mixed │ │ └── core.clj └── srcj │ └── mixed │ └── JavaClass.java ├── ch08-leiningen ├── project.clj └── src │ └── simple │ └── core.clj ├── ch08-maven ├── pom.xml └── src │ └── main │ └── clojure │ └── simple │ └── core.clj ├── ch08-projects-repl-interactions.clj ├── ch09-annotations ├── .gitignore ├── README.md ├── pom.xml └── src │ └── main │ └── clojure │ └── com │ └── clojurebook │ └── annotations │ ├── jaxrs.clj │ ├── jaxws.clj │ └── junit.clj ├── ch09-gen-class ├── README.md ├── clojure.png ├── project.clj ├── resized.png └── src │ ├── BatchJob.java │ ├── ResizeClient.java │ └── com │ └── clojurebook │ ├── CustomException.clj │ └── imaging.clj ├── ch09-interop-repl-interactions.clj ├── ch09-interop ├── .gitignore └── pom.xml ├── ch10-REPL-oriented-repl-interactions.clj ├── ch11-mandelbrot ├── README.md ├── mandelbrot-zoomed.png ├── mandelbrot.png ├── project.clj └── src │ └── com │ └── clojurebook │ └── mandelbrot.clj ├── ch11-maths-repl-interactions.clj ├── ch12-aspectj └── src │ └── com │ └── clojurebook │ ├── AspectJExample.java │ ├── AspectJExampleMain.java │ └── Timing.aj ├── ch12-patterns-repl-interactions.clj ├── ch13-testing-repl-interactions.clj ├── ch14-rdbms-repl-interactions.clj ├── ch14-rdbms ├── java │ └── com │ │ └── clojurebook │ │ └── hibernate │ │ └── Author.java ├── project.clj ├── rsrc │ └── hibernate.cfg.xml └── src │ └── com │ └── clojurebook │ └── hibernate.clj ├── ch15-couchdb-repl-interactions.clj ├── ch15-couchdb ├── project.clj └── src │ ├── eventing │ ├── processing.clj │ └── types.clj │ └── salesorg │ └── event_handling.clj ├── ch16-web-leiningen ├── README ├── project.clj ├── src │ ├── com │ │ └── clojurebook │ │ │ ├── url_shortener.clj │ │ │ └── url_shortener │ │ │ └── beanstalk.clj │ └── web │ │ └── core.clj └── test │ └── web │ └── test │ └── core.clj ├── ch16-web-repl-interactions.clj ├── ch17-webapp-lein ├── project.clj ├── resources │ └── public │ │ └── wright_pond.jpg └── src │ └── com │ └── clojurebook │ └── hello_world.clj ├── ch17-webapp-maven ├── .gitignore ├── README.md ├── pom.xml └── src │ └── main │ ├── clojure │ └── com │ │ └── clojurebook │ │ └── hello_world.clj │ └── webapp │ ├── WEB-INF │ └── web.xml │ └── wright_pond.jpg ├── ch20-nextsteps-repl-interactions.clj └── epl-v10.html /.gitignore: -------------------------------------------------------------------------------- 1 | # emacs + vi backup files 2 | *~ 3 | .*.sw* 4 | 5 | # various IDE junk 6 | *.ipr 7 | *.iml 8 | *.iws 9 | .project 10 | .classpath 11 | .settings 12 | 13 | target 14 | classes 15 | *.jar 16 | *.war 17 | 18 | 19 | lib 20 | native 21 | .lein-failures 22 | checkouts 23 | .lein-deps-sum 24 | 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | The official repository of sample projects and example code featured in 2 | [Clojure Programming](http://www.clojurebook.com). 3 | 4 | **Please note that this repo is in flux**. We have moved all of the 5 | code from the book and the sample projects over from O'Reilly's 6 | repository. The REPL interaction files for each chapter might come in 7 | handy if you are working from the print book, but still want to 8 | copy/paste code into a REPL; the projects from each chapter are 9 | self-contained examples highlighting different aspects of working with 10 | Clojure in different domains. 11 | 12 | You can take a look at the issues on this repo to get a sense of what's 13 | left to be done. If you see any problems, by all means submit a new 14 | issue. 15 | 16 | Of course, please feel free to watch this repo, [follow @ClojureBook on 17 | Twitter](http://twitter.com/ClojureBook), or subscribe to the book's 18 | mailing list on [clojurebook.com](http://clojurebook.com) to be notified 19 | when significant changes and improvements happen here. 20 | 21 | ## License 22 | 23 | Copyright © 2012 Chas Emerick, Brian Carper, and Christophe Grand. 24 | 25 | Distributed under the Eclipse Public License (see included 26 | `epl-v10.html`), the same as Clojure. 27 | 28 | -------------------------------------------------------------------------------- /ch01-welcome-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | (defn average 3 | [numbers] 4 | (/ (apply + numbers) (count numbers))) 5 | 6 | 7 | ;----- 8 | (defn average 9 | [numbers] 10 | (/ (apply + numbers) (count numbers))) 11 | ;= #'user/average 12 | (average [60 80 100 400]) 13 | ;= 160 14 | 15 | 16 | ;----- 17 | (println (average [60 80 100 400])) 18 | ; 160 19 | ;= nil 20 | 21 | 22 | ;----- 23 | (read-string "42") 24 | ;= 42 25 | (read-string "(+ 1 2)") 26 | ;= (+ 1 2) 27 | 28 | 29 | ;----- 30 | (pr-str [1 2 3]) 31 | ;= "[1 2 3]" 32 | (read-string "[1 2 3]") 33 | ;= [1 2 3] 34 | 35 | 36 | ;----- 37 | "hello there" 38 | ;= "hello there" 39 | 40 | 41 | ;----- 42 | "multiline strings 43 | are very handy" 44 | ;= "multiline strings\nare very handy" 45 | 46 | 47 | ;----- 48 | (class \c) 49 | ;= java.lang.Character 50 | 51 | 52 | ;----- 53 | \u00ff 54 | ;= \ÿ 55 | \o41 56 | ;= \! 57 | 58 | 59 | ;----- 60 | (def person {:name "Sandra Cruz" 61 | :city "Portland, ME"}) 62 | ;= #'user/person 63 | (:city person) 64 | ;= "Portland, ME" 65 | 66 | 67 | ;----- 68 | (def pizza {:name "Ramunto's" 69 | :location "Claremont, NH" 70 | ::location "43.3734,-72.3365"}) 71 | ;= #'user/pizza 72 | pizza 73 | ;= {:name "Ramunto's", :location "Claremont, NH", :user/location "43.3734,-72.3365"} 74 | (:user/location pizza) 75 | ;= "43.3734,-72.3365" 76 | 77 | 78 | ;----- 79 | (name :user/location) 80 | ;= "location" 81 | (namespace :user/location) 82 | ;= "user" 83 | (namespace :location) 84 | ;= nil 85 | 86 | 87 | ;----- 88 | (average [60 80 100 400]) 89 | ;= 160 90 | 91 | 92 | ;----- 93 | (class #"(p|h)ail") 94 | ;= java.util.regex.Pattern 95 | 96 | 97 | ;----- 98 | (re-seq #"(...) (...)" "foo bar") 99 | ;= (["foo bar" "foo" "bar"]) 100 | 101 | 102 | ;----- 103 | (re-seq #"(\d+)-(\d+)" "1-3") ;; would be "(\\d+)-(\\d+)" in Java 104 | ;= (["1-3" "1" "3"]) 105 | 106 | 107 | ;----- 108 | (read-string "(+ 1 2 #_(* 2 2) 8)") 109 | ;= (+ 1 2 8) 110 | 111 | 112 | ;----- 113 | (when true 114 | (comment (println "hello"))) 115 | ;= nil 116 | 117 | 118 | ;----- 119 | (+ 1 2 (comment (* 2 2)) 8) 120 | ;= # 121 | 122 | 123 | ;----- 124 | (defn silly-adder 125 | [x y] 126 | (+ x y)) 127 | 128 | 129 | ;----- 130 | (defn silly-adder 131 | [x, y] 132 | (+, x, y)) 133 | 134 | 135 | ;----- 136 | (= [1 2 3] [1, 2, 3]) 137 | ;= true 138 | 139 | 140 | ;----- 141 | (create-user {:name new-username, :email email}) 142 | 143 | 144 | ;----- 145 | '(a b :name 12.5) ;; list 146 | 147 | ['a 'b :name 12.5] ;; vector 148 | 149 | {:name "Chas" :age 31} ;; map 150 | 151 | #{1 2 3} ;; set 152 | 153 | 154 | ;----- 155 | (def a 10) 156 | ;= #'user/a 157 | (defn diff 158 | [a b] 159 | (- a b)) 160 | ;= #'user/diff 161 | (diff 5 5) 162 | ;= 0 163 | a 164 | ;= 10 165 | 166 | 167 | ;----- 168 | (def x 1) 169 | ;= #'user/x 170 | 171 | 172 | ;----- 173 | x 174 | ;= 1 175 | 176 | 177 | ;----- 178 | (def x "hello") 179 | ;= #'user/x 180 | x 181 | ;= "hello" 182 | 183 | 184 | ;----- 185 | *ns* 186 | ;= # 187 | (ns foo) 188 | ;= nil 189 | *ns* 190 | ;= # 191 | user/x 192 | ;= "hello" 193 | x 194 | ;= # 196 | 197 | 198 | ;----- 199 | String 200 | ;= java.lang.String 201 | Integer 202 | ;= java.lang.Integer 203 | java.util.List 204 | ;= java.util.List 205 | java.net.Socket 206 | ;= java.net.Socket 207 | 208 | 209 | ;----- 210 | filter 211 | ;= # 212 | 213 | 214 | ;----- 215 | (defn average 216 | [numbers] 217 | (/ (apply + numbers) (count numbers))) 218 | 219 | 220 | ;----- 221 | (average [60 80 100 400]) 222 | ;= 160 223 | 224 | 225 | ;----- 226 | (quote x) 227 | ;= x 228 | (symbol? (quote x)) 229 | ;= true 230 | 231 | 232 | ;----- 233 | 'x 234 | ;= x 235 | 236 | 237 | ;----- 238 | '(+ x x) 239 | ;= (+ x x) 240 | (list? '(+ x x)) 241 | ;= true 242 | 243 | 244 | ;----- 245 | (list '+ 'x 'x) 246 | ;= (+ x x) 247 | 248 | 249 | ;----- 250 | ''x 251 | ;= (quote x) 252 | 253 | 254 | ;----- 255 | '@x 256 | ;= (clojure.core/deref x) 257 | '#(+ % %) 258 | ;= (fn* [p1__3162792#] (+ p1__3162792# p1__3162792#)) 259 | '`(a b ~c) 260 | ;= (seq (concat (list (quote user/a)) 261 | ;= (list (quote user/b)) 262 | ;= (list c))) 263 | 264 | 265 | ;----- 266 | (do 267 | (println "hi") 268 | (apply * [4 5 6])) 269 | ; hi 270 | ;= 120 271 | 272 | 273 | ;----- 274 | (let [a (inc (rand-int 6)) 275 | b (inc (rand-int 6))] 276 | (println (format "You rolled a %s and a %s" a b)) 277 | (+ a b)) 278 | 279 | 280 | ;----- 281 | (let [a (inc (rand-int 6)) 282 | b (inc (rand-int 6))] 283 | (do 284 | (println (format "You rolled a %s and a %s" a b)) 285 | (+ a b))) 286 | 287 | 288 | ;----- 289 | (def p "foo") 290 | ;= #'user/p 291 | p 292 | ;= "foo" 293 | 294 | 295 | 296 | ;----- 297 | (defn hypot 298 | [x y] 299 | (let [x2 (* x x) 300 | y2 (* y y)] 301 | (Math/sqrt (+ x2 y2)))) 302 | 303 | 304 | ;----- 305 | (def v [42 "foo" 99.2 [5 12]]) 306 | ;= #'user/v 307 | 308 | 309 | ;----- 310 | (first v) 311 | ;= 42 312 | (second v) 313 | ;= "foo" 314 | (last v) 315 | ;= [5 12] 316 | (nth v 2) 317 | ;= 99.2 318 | (v 2) 319 | ;= 99.2 320 | (.get v 2) 321 | ;= 99.2 322 | 323 | 324 | ;----- 325 | (+ (first v) (v 2)) 326 | ;= 141.2 327 | 328 | 329 | ;----- 330 | (+ (first v) (first (last v))) 331 | ;= 47 332 | 333 | 334 | ;----- 335 | (def v [42 "foo" 99.2 [5 12]]) 336 | ;= #'user/v 337 | (let [[x y z] v] 338 | (+ x z)) 339 | ;= 141.2 340 | 341 | 342 | ;----- 343 | (let [x (nth v 0) 344 | y (nth v 1) 345 | z (nth v 2)] 346 | (+ x z)) 347 | ;= 141.2 348 | 349 | 350 | 351 | ;----- 352 | [x y z] 353 | [42 "foo" 99.2 [5 12]] 354 | 355 | 356 | ;----- 357 | (let [[x _ _ [y z]] v] 358 | (+ x y z)) 359 | ;= 59 360 | 361 | 362 | ;----- 363 | [x _ _ [y z ]] 364 | [42 "foo" 99.2 [5 12]] 365 | 366 | 367 | ;----- 368 | (let [[x & rest] v] 369 | rest) 370 | ;= ("foo" 99.2 [5 12]) 371 | 372 | 373 | ;----- 374 | (let [[x _ z :as original-vector] v] 375 | (conj original-vector (+ x z))) 376 | ;= [42 "foo" 99.2 [5 12] 141.2] 377 | 378 | 379 | ;----- 380 | (def m {:a 5 :b 6 381 | :c [7 8 9] 382 | :d {:e 10 :f 11} 383 | "foo" 88 384 | 42 false}) 385 | ;= #'user/m 386 | (let [{a :a b :b} m] 387 | (+ a b)) 388 | ;= 11 389 | 390 | 391 | ;----- 392 | {a :a b :b} 393 | {:a 5 :b 6} 394 | 395 | 396 | ;----- 397 | (let [{f "foo"} m] 398 | (+ f 12)) 399 | ;= 100 400 | (let [{v 42} m] 401 | (if v 1 0)) 402 | ;= 0 403 | 404 | 405 | ;----- 406 | (let [{x 3 y 8} [12 0 0 -18 44 6 0 0 1]] 407 | (+ x y)) 408 | ;= -17 409 | 410 | 411 | ;----- 412 | (let [{{e :e} :d} m] 413 | (* 2 e)) 414 | ;= 20 415 | 416 | 417 | ;----- 418 | (let [{[x _ y] :c} m] 419 | (+ x y)) 420 | ;= 16 421 | (def map-in-vector ["James" {:birthday (java.util.Date. 73 1 6)}]) 422 | ;= #'user/map-in-vector 423 | (let [[name {bd :birthday}] map-in-vector] 424 | (str name " was born on " bd)) 425 | ;= "James was born on Thu Feb 06 00:00:00 EST 1973" 426 | 427 | 428 | ;----- 429 | (let [{r1 :x r2 :y :as randoms} 430 | (zipmap [:x :y :z] (repeatedly (partial rand-int 10)))] 431 | (assoc randoms :sum (+ r1 r2))) 432 | ;= {:sum 17, :z 3, :y 8, :x 9} 433 | 434 | 435 | ;----- 436 | (let [{k :unknown x :a 437 | :or {k 50}} m] 438 | (+ k x)) 439 | ;= 55 440 | 441 | 442 | ;----- 443 | (let [{k :unknown x :a} m 444 | k (or k 50)] 445 | (+ k x)) 446 | ;= 55 447 | 448 | 449 | ;----- 450 | (let [{opt1 :option} {:option false} 451 | opt1 (or opt1 true) 452 | {opt2 :option :or {opt2 true}} {:option false}] 453 | {:opt1 opt1 :opt2 opt2}) 454 | ;= {:opt1 true, :opt2 false} 455 | 456 | 457 | ;----- 458 | (def chas {:name "Chas" :age 31 :location "Massachusetts"}) 459 | ;= #'user/chas 460 | (let [{name :name age :age location :location} chas] 461 | (format "%s is %s years old and lives in %s." name age location)) 462 | ;= "Chas is 31 years old and lives in Massachusetts." 463 | 464 | 465 | ;----- 466 | (let [{:keys [name age location]} chas] 467 | (format "%s is %s years old and lives in %s." name age location)) 468 | ;= "Chas is 31 years old and lives in Massachusetts." 469 | 470 | 471 | ;----- 472 | (def brian {"name" "Brian" "age" 31 "location" "British Columbia"}) 473 | ;= #'user/brian 474 | (let [{:strs [name age location]} brian] 475 | (format "%s is %s years old and lives in %s." name age location)) 476 | ;= "Brian is 31 years old and lives in British Columbia." 477 | 478 | (def christophe {'name "Christophe" 'age 33 'location "Rhône-Alpes"}) 479 | ;= #'user/christophe 480 | (let [{:syms [name age location]} christophe] 481 | (format "%s is %s years old and lives in %s." name age location)) 482 | ;= "Christophe is 31 years old and lives in Rhône-Alpes." 483 | 484 | 485 | ;----- 486 | (def user-info ["robert8990" 2011 :name "Bob" :city "Boston"]) 487 | ;= #'user/user-info 488 | 489 | 490 | ;----- 491 | (let [[username account-year & extra-info] user-info 492 | {:keys [name city]} (apply hash-map extra-info)] 493 | (format "%s is in %s" name city)) 494 | ;= "Bob is in Boston" 495 | 496 | 497 | ;----- 498 | (let [[username account-year & {:keys [name city]}] user-info] 499 | (format "%s is in %s" name city)) 500 | ;= "Bob is in Boston" 501 | 502 | 503 | ;----- 504 | (fn [x] 505 | (+ 10 x)) 506 | 507 | 508 | ;----- 509 | ((fn [x] (+ 10 x)) 8) 510 | ;= 18 511 | 512 | 513 | ;----- 514 | (let [x 8] 515 | (+ 10 x)) 516 | 517 | 518 | ;----- 519 | ((fn [x y z] (+ x y z)) 520 | 3 4 12) 521 | ;= 19 522 | 523 | 524 | ;----- 525 | (let [x 3 526 | y 4 527 | z 12] 528 | (+ x y z)) 529 | 530 | 531 | ;----- 532 | (def strange-adder (fn adder-self-reference 533 | ([x] (adder-self-reference x 1)) 534 | ([x y] (+ x y)))) 535 | ;= #'user/strange-adder 536 | (strange-adder 10) 537 | ;= 11 538 | (strange-adder 10 50) 539 | ;= 60 540 | 541 | 542 | ;----- 543 | (letfn [(odd? [n] 544 | (if (zero? n) 545 | false 546 | (even? (dec n)))) 547 | (even? [n] 548 | (or (zero? n) 549 | (odd? (dec n))))] 550 | (odd? 11)) 551 | ;= true 552 | 553 | 554 | ;----- 555 | (def strange-adder (fn strange-adder 556 | ([x] (strange-adder x 1)) 557 | ([x y] (+ x y)))) 558 | 559 | (defn strange-adder 560 | ([x] (strange-adder x 1)) 561 | ([x y] (+ x y)))) 562 | 563 | 564 | ;----- 565 | (def redundant-adder (fn redundant-adder 566 | [x y z] 567 | (+ x y z))) 568 | 569 | (defn redundant-adder 570 | [x y z] 571 | (+ x y z)) 572 | 573 | 574 | ;----- 575 | (defn concat-rest 576 | [x & rest] 577 | (apply str (butlast rest))) 578 | ;= #'user/concat-rest 579 | (concat-rest 0 1 2 3 4) 580 | ;= "123" 581 | 582 | 583 | ;----- 584 | (defn make-user 585 | [& [user-id]] 586 | {:user-id (or user-id 587 | (str (java.util.UUID/randomUUID)))}) 588 | ;= #'user/make-user 589 | (make-user) 590 | ;= {:user-id "ef165515-6d6f-49d6-bd32-25eeb024d0b4"} 591 | (make-user "Bobby") 592 | ;= {:user-id "Bobby"} 593 | 594 | 595 | ;----- 596 | (defn make-user 597 | [username & {:keys [email join-date] 598 | :or {join-date (java.util.Date.)}}] 599 | {:username username 600 | :join-date join-date 601 | :email email 602 | ;; 2.592e9 -> one month in ms 603 | :exp-date (java.util.Date. (long (+ 2.592e9 (.getTime join-date))))}) 604 | ;= #'user/make-user 605 | (make-user "Bobby") 606 | ;= {:username "Bobby", :join-date #, 607 | ;= :email nil, :exp-date #} 608 | (make-user "Bobby" 609 | :join-date (java.util.Date. 111 0 1) 610 | :email "bobby@example.com") 611 | ;= {:username "Bobby", :join-date #, 612 | ;= :email "bobby@example.com", :exp-date #} 613 | 614 | 615 | ;----- 616 | (defn foo 617 | [& {k ["m" 9]}] 618 | (inc k)) 619 | ;= #'user/foo 620 | (foo ["m" 9] 19) 621 | ;= 20 622 | 623 | 624 | ;----- 625 | (fn [x y] (Math/pow x y)) 626 | 627 | #(Math/pow %1 %2) 628 | 629 | 630 | ;----- 631 | (read-string "#(Math/pow %1 %2)") 632 | ;= (fn* [p1__285# p2__286#] (Math/pow p1__285# p2__286#)) 633 | 634 | 635 | ;----- 636 | (fn [x y] 637 | (println (str x \^ y)) 638 | (Math/pow x y)) 639 | 640 | 641 | ;----- 642 | #(do (println (str %1 \^ %2)) 643 | (Math/pow %1 %2)) 644 | 645 | 646 | ;----- 647 | (fn [x & rest] 648 | (- x (apply + rest))) 649 | 650 | #(- % (apply + %&)) 651 | 652 | 653 | ;----- 654 | (fn [x] 655 | (fn [y] 656 | (+ x y))) 657 | 658 | 659 | ;----- 660 | #(#(+ % %)) 661 | ;= # 663 | 664 | 665 | ;----- 666 | (if "hi" \t) 667 | ;= \t 668 | (if 42 \t) 669 | ;= \t 670 | (if nil "unevaluated" \f) 671 | ;= \f 672 | (if false "unevaluated" \f) 673 | ;= \f 674 | (if (not true) \t) 675 | ;= nil 676 | 677 | 678 | ;----- 679 | (true? "string") 680 | ;= false 681 | (if "string" \t \f) 682 | ;= \t 683 | 684 | 685 | ;----- 686 | (loop [x 5] 687 | (if (neg? x) 688 | x 689 | (recur (dec x)))) 690 | ;= -1 691 | 692 | 693 | ;----- 694 | (defn countdown 695 | [x] 696 | (if (zero? x) 697 | :blastoff! 698 | (do (println x) 699 | (recur (dec x))))) 700 | ;= #'user/countdown 701 | (countdown 5) 702 | ; 5 703 | ; 4 704 | ; 3 705 | ; 2 706 | ; 1 707 | ;= :blastoff! 708 | 709 | 710 | ;----- 711 | (def x 5) 712 | ;= #'user/x 713 | x 714 | ;= 5 715 | 716 | 717 | ;----- 718 | (var x) 719 | ;= #'user/x 720 | 721 | 722 | ;----- 723 | #'x 724 | ;= #'user/x 725 | 726 | 727 | ;----- 728 | (defn average 729 | [numbers] 730 | (/ (apply + numbers) (count numbers))) 731 | 732 | 733 | ;----- 734 | (def average (fn average 735 | [numbers] 736 | (/ (apply + numbers) (count numbers)))) 737 | 738 | 739 | ;----- 740 | (eval :foo) 741 | ;= :foo 742 | (eval [1 2 3]) 743 | ;= [1 2 3] 744 | (eval "text") 745 | ;= "text" 746 | 747 | 748 | ;----- 749 | (eval '(average [60 80 100 400])) 750 | ;= 160 751 | 752 | 753 | ;----- 754 | (eval (read-string "(average [60 80 100 400])")) 755 | ;= 160 756 | 757 | 758 | ;----- 759 | (defn embedded-repl 760 | "A naive Clojure REPL implementation. Enter `:quit` 761 | to exit." 762 | [] 763 | (print (str (ns-name *ns*) ">>> ")) 764 | (flush) 765 | (let [expr (read) 766 | value (eval expr)] 767 | (when (not= :quit value) 768 | (println value) 769 | (recur)))) 770 | 771 | (embedded-repl) 772 | ; user>>> (defn average2 773 | ; [numbers] 774 | ; (/ (apply + numbers) (count numbers))) 775 | ; #'user/average2 776 | ; user>>> (average2 [3 7 5]) 777 | ; 5 778 | ; user>>> :quit 779 | ;= nil 780 | 781 | 782 | -------------------------------------------------------------------------------- /ch02-FP-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | true false 5 14.2 \T "hello" nil 3 | 4 | 5 | ;----- 6 | (= 5 5) 7 | 8 | (= 5 (+ 2 3)) 9 | 10 | (= "boot" (str "bo" "ot")) 11 | 12 | (= nil nil) 13 | 14 | (let [a 5] 15 | (do-something-with-a-number a) 16 | (= a 5)) 17 | 18 | 19 | ;----- 20 | public class StatefulInteger extends Number { 21 | private int state; 22 | 23 | public StatefulInteger (int initialState) { 24 | this.state = initialState; 25 | } 26 | 27 | public void setInt (int newState) { 28 | this.state = newState; 29 | } 30 | 31 | public int intValue () { 32 | return state; 33 | } 34 | 35 | public int hashCode () { 36 | return state; 37 | } 38 | 39 | public boolean equals (Object obj) { 40 | return obj instanceof StatefulInteger && 41 | state == ((StatefulInteger)obj).state; 42 | } 43 | 44 | // remaining xxxValue() methods from java.lang.Number... 45 | } 46 | 47 | 48 | ;----- 49 | (def five (StatefulInteger. 5)) 50 | ;= #'user/five 51 | (def six (StatefulInteger. 6)) 52 | ;= #'user/six 53 | (.intValue five) 54 | ;= 5 55 | (= five six) 56 | ;= false 57 | (.setInt five 6) 58 | ;= nil 59 | (= five six) 60 | ;= true 61 | 62 | 63 | ;----- 64 | (defn print-number 65 | [n] 66 | (println (.intValue n)) 67 | (.setInt n 42)) 68 | ;= #'user/print-number 69 | (print-number six) 70 | ; 6 71 | ;= nil 72 | (= five six) 73 | ;= false 74 | (= five (StatefulInteger. 42)) 75 | ;= true 76 | 77 | 78 | 79 | ;----- 80 | (def h {[1 2] 3}) 81 | ;= #'user/h 82 | (h [1 2]) 83 | ;= 3 84 | (conj (first (keys h)) 3) 85 | ;= [1 2 3] 86 | (h [1 2]) 87 | ;= 3 88 | h 89 | ;= {[1 2] 3} 90 | 91 | 92 | ;----- 93 | (defn call-twice [f x] 94 | (f x) 95 | (f x)) 96 | 97 | (call-twice println 123) 98 | ; 123 99 | ; 123 100 | 101 | 102 | 103 | ;----- 104 | (max 5 6) 105 | ;= 6 106 | (require 'clojure.string) 107 | ;= nil 108 | (clojure.string/lower-case "Clojure") 109 | ;= "clojure" 110 | 111 | 112 | ;----- 113 | (map clojure.string/lower-case ["Java" "Imperative" "Weeping" 114 | "Clojure" "Learning" "Peace"]) 115 | ;= ("java" "imperative" "weeping" "clojure" "learning" "peace") 116 | (map * [1 2 3 4] [5 6 7 8]) 117 | ;= (5 12 21 32) 118 | 119 | 120 | ;----- 121 | (reduce max [0 -3 10 48]) 122 | ;= 10 123 | 124 | 125 | ;----- 126 | (max 0 -3) 127 | ;= 0 128 | (max 0 10) 129 | ;= 10 130 | (max 10 48) 131 | ;= 48 132 | 133 | 134 | ;----- 135 | (max (max (max 0 -3) 10) 48) 136 | ;= 48 137 | 138 | 139 | ;----- 140 | (reduce + 50 [1 2 3 4]) 141 | ;= 60 142 | 143 | 144 | ;----- 145 | (reduce 146 | (fn [m v] 147 | (assoc m v (* v v))) 148 | {} 149 | [1 2 3 4]) 150 | ;= {4 16, 3 9, 2 4, 1 1} 151 | 152 | 153 | ;----- 154 | (reduce 155 | #(assoc % %2 (* %2 %2)) 156 | {} 157 | [1 2 3 4]) 158 | ;= {4 16, 3 9, 2 4, 1 1} 159 | 160 | 161 | ;----- 162 | ((complement pos?) 5) 163 | ;= false 164 | ((complement string?) "hello") 165 | ;= false 166 | ((complement string?) :hello) 167 | ;= true 168 | 169 | 170 | ;----- 171 | (take 10 (repeatedly #(rand-int 10))) 172 | ;= (5 3 5 5 9 0 8 0 1 0) 173 | (take 3 (repeatedly (fn [] 174 | (Thread/sleep 1000) 175 | (System/currentTimeMillis)))) 176 | ;= (1322663857960 1322663858961 1322663859961) 177 | 178 | 179 | 180 | ;----- 181 | (apply hash-map [:a 5 :b 6]) 182 | ;= {:a 5, :b 6} 183 | 184 | 185 | ;----- 186 | (def args [2 -2 10]) 187 | ;= #'user/args 188 | (apply * 0.5 3 args) 189 | ;= -60.0 190 | 191 | 192 | 193 | ;----- 194 | (def only-strings (partial filter string?)) 195 | ;= #'user/only-strings 196 | (only-strings ["a" 5 "b" 6]) 197 | ;= ("a" "b") 198 | 199 | 200 | ;----- 201 | (def database-lookup (partial get-data "jdbc:mysql://...")) 202 | 203 | 204 | ;----- 205 | (#(filter string? %) ["a" 5 "b" 6]) 206 | ;= ("a" "b") 207 | 208 | 209 | ;----- 210 | (#(filter % ["a" 5 "b" 6]) string?) 211 | ;= ("a" "b") 212 | (#(filter % ["a" 5 "b" 6]) number?) 213 | ;= (5 6) 214 | 215 | 216 | ;----- 217 | (#(map *) [1 2 3] [4 5 6] [7 8 9]) 218 | ;= # 220 | (#(map * % %2 %3) [1 2 3] [4 5 6] [7 8 9]) 221 | ;= (28 80 162) 222 | (#(map * % %2 %3) [1 2 3] [4 5 6]) 223 | ;= # 225 | (#(apply map * %&) [1 2 3] [4 5 6] [7 8 9]) 226 | ;= (28 80 162) 227 | (#(apply map * %&) [1 2 3]) 228 | ;= (1 2 3) 229 | 230 | ((partial map *) [1 2 3] [4 5 6] [7 8 9]) 231 | ;= (28 80 162) 232 | 233 | 234 | ;----- 235 | (defn negated-sum-str 236 | [& numbers] 237 | (str (- (apply + numbers)))) 238 | ;= #'user/negated-sum-str 239 | (negated-sum-str 10 12 3.4) 240 | ;= "-25.4" 241 | 242 | 243 | ;----- 244 | (def negated-sum-str (comp str - +)) 245 | ;= #'user/negated-sum-str 246 | (negated-sum-str 10 12 3.4) 247 | ;= "-25.4" 248 | 249 | 250 | ;----- 251 | ((comp + - str) 5 10) 252 | ;= # 254 | 255 | 256 | ;----- 257 | (require '[clojure.string :as str]) 258 | 259 | (def camel->keyword (comp keyword 260 | str/join 261 | (partial interpose \-) 262 | (partial map str/lower-case) 263 | #(str/split % #"(?<=[a-z])(?=[A-Z])"))) 264 | ;= #'user/camel->keyword 265 | (camel->keyword "CamelCase") 266 | ;= :camel-case 267 | (camel->keyword "lowerCamelCase") 268 | ;= :lower-camel-case 269 | 270 | 271 | ;----- 272 | (defn camel->keyword 273 | [s] 274 | (->> (str/split s #"(?<=[a-z])(?=[A-Z])") 275 | (map str/lower-case) 276 | (interpose \-) 277 | str/join 278 | keyword)) 279 | 280 | 281 | ;----- 282 | (def camel-pairs->map (comp (partial apply hash-map) 283 | (partial map-indexed (fn [i x] 284 | (if (odd? i) 285 | x 286 | (camel->keyword x)))))) 287 | ;= #'user/camel-pairs->map 288 | (camel-pairs->map ["CamelCase" 5 "lowerCamelCase" 3]) 289 | ;= {:camel-case 5, :lower-camel-case 3} 290 | 291 | 292 | ;----- 293 | (defn adder 294 | [n] 295 | (fn [x] (+ n x))) 296 | ;= #'user/adder 297 | ((adder 5) 18) 298 | ;= 23 299 | 300 | 301 | ;----- 302 | (defn doubler 303 | [f] 304 | (fn [& args] 305 | (* 2 (apply f args)))) 306 | ;= #'user/doubler 307 | (def double-+ (doubler +)) 308 | ;= #'user/double-+ 309 | (double-+ 1 2 3) 310 | ;= 12 311 | 312 | 313 | ;----- 314 | (defn print-logger 315 | [writer] 316 | #(binding [*out* writer] 317 | (println %))) 318 | 319 | 320 | ;----- 321 | (def *out*-logger (print-logger *out*)) 322 | ;= #'user/*out*-logger 323 | (*out*-logger "hello") 324 | ; hello 325 | ;= nil 326 | 327 | 328 | ;----- 329 | (def writer (java.io.StringWriter.)) 330 | ;= #'user/writer 331 | (def retained-logger (print-logger writer)) 332 | ;= #'user/retained-logger 333 | (retained-logger "hello") 334 | ;= nil 335 | (str writer) 336 | ;= "hello\n" 337 | 338 | 339 | ;----- 340 | (require 'clojure.java.io) 341 | 342 | (defn file-logger 343 | [file] 344 | #(with-open [f (clojure.java.io/writer file :append true)] 345 | ((print-logger f) %))) 346 | 347 | 348 | ;----- 349 | (def log->file (file-logger "messages.log")) 350 | ;= #'user/log->file 351 | (log->file "hello") 352 | ;= nil 353 | 354 | % more messages.log 355 | hello 356 | 357 | 358 | ;----- 359 | (defn multi-logger 360 | [& logger-fns] 361 | #(doseq [f logger-fns] 362 | (f %))) 363 | 364 | 365 | ;----- 366 | (def log (multi-logger 367 | (print-logger *out*) 368 | (file-logger "messages.log"))) 369 | ;= #'user/log 370 | (log "hello again") 371 | ; hello again 372 | ;= nil 373 | 374 | % more messages.log 375 | hello 376 | hello again 377 | 378 | 379 | ;----- 380 | (defn timestamped-logger 381 | [logger] 382 | #(logger (format "[%1$tY-%1$tm-%1$te %1$tH:%1$tM:%1$tS] %2$s" (java.util.Date.) %))) 383 | 384 | (def log-timestamped (timestamped-logger 385 | (multi-logger 386 | (print-logger *out*) 387 | (file-logger "messages.log")))) 388 | 389 | (log-timestamped "goodbye, now") 390 | ; [2011-11-30 08:54:00] goodbye, now 391 | ;= nil 392 | 393 | % more messages.log 394 | hello 395 | hello again 396 | [2011-11-30 08:54:00] goodbye, now 397 | 398 | 399 | ;----- 400 | (defn perform-bank-transfer! 401 | [from-account to-account amount] 402 | ...) 403 | 404 | (defn authorize-medical-treatment! 405 | [patient-id treatment-id] 406 | ...) 407 | 408 | (defn launch-missiles! 409 | [munition-type target-coordinates] 410 | ...) 411 | 412 | 413 | ;----- 414 | (require 'clojure.xml) 415 | 416 | (defn twitter-followers 417 | [username] 418 | (->> (str "https://api.twitter.com/1/users/show.xml?screen_name=" username) 419 | clojure.xml/parse 420 | :content 421 | (filter (comp #{:followers_count} :tag)) 422 | first 423 | :content 424 | first 425 | Integer/parseInt)) 426 | 427 | (twitter-followers "ClojureBook") 428 | ;= 106 429 | (twitter-followers "ClojureBook") 430 | ;= 107 431 | 432 | 433 | ;----- 434 | (+ 1 2) (- 10 7) (count [-1 0 1]) 435 | 436 | 437 | ;----- 438 | (defn prime? 439 | [n] 440 | (cond 441 | (== 1 n) false 442 | (== 2 n) true 443 | (even? n) false 444 | :else (->> (range 3 (inc (Math/sqrt n)) 2) 445 | (filter #(zero? (rem n %))) 446 | empty?))) 447 | 448 | (time (prime? 1125899906842679)) 449 | ; "Elapsed time: 2181.014 msecs" 450 | ;= true 451 | (let [m-prime? (memoize prime?)] 452 | (time (m-prime? 1125899906842679)) 453 | (time (m-prime? 1125899906842679))) 454 | ; "Elapsed time: 2085.029 msecs" 455 | ; "Elapsed time: 0.042 msecs" 456 | ;= true 457 | 458 | 459 | ;----- 460 | (repeatedly 10 (partial rand-int 10)) 461 | ;= (3 0 2 9 8 8 5 7 3 5) 462 | (repeatedly 10 (partial (memoize rand-int) 10)) 463 | ;= (4 4 4 4 4 4 4 4 4 4) 464 | 465 | 466 | -------------------------------------------------------------------------------- /ch03-array-set/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook/array-set "1.0.0" 2 | :description "An array-backed set implementation, analogous to 3 | Clojure's array-map, explored in chapter 3 of 'Clojure Programming' by 4 | Emerick, Carper, and Grand." 5 | :url "http://github.com/clojurebook/ClojureProgramming" 6 | :dependencies [[org.clojure/clojure "1.3.0"]] 7 | :profiles {:1.4 {:dependencies [[org.clojure/clojure "1.4.0-beta6"]]}}) 8 | -------------------------------------------------------------------------------- /ch03-array-set/src/com/clojurebook/array_set.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.array-set) 2 | 3 | (declare empty-array-set) 4 | (def ^:private ^:const max-size 4) 5 | 6 | (deftype ArraySet [^objects items ^int size ^:unsynchronized-mutable ^int hashcode] 7 | clojure.lang.IPersistentSet 8 | (get [this x] 9 | (loop [i 0] 10 | (when (< i size) 11 | (if (= x (aget items i)) 12 | (aget items i) 13 | (recur (inc i)))))) 14 | (contains [this x] 15 | (boolean 16 | (loop [i 0] 17 | (when (< i size) 18 | (or (= x (aget items i)) (recur (inc i))))))) 19 | (disjoin [this x] 20 | (loop [i 0] 21 | (if (== i size) 22 | this 23 | (if (not= x (aget items i)) 24 | (recur (inc i)) 25 | (ArraySet. (doto (aclone items) 26 | (aset i (aget items (dec size))) 27 | (aset (dec size) nil)) 28 | (dec size) 29 | -1))))) 30 | clojure.lang.IPersistentCollection 31 | (count [this] size) 32 | (cons [this x] 33 | (cond 34 | (.contains this x) this 35 | (== size max-size) (into #{x} this) 36 | :else (ArraySet. (doto (aclone items) 37 | (aset size x)) 38 | (inc size) 39 | -1))) 40 | (empty [this] empty-array-set) 41 | (equiv [this that] (.equals this that)) 42 | clojure.lang.Seqable 43 | (seq [this] (take size items)) 44 | Object 45 | (hashCode [this] 46 | (when (== -1 hashcode) 47 | (set! hashcode (int (areduce items idx ret 0 48 | (unchecked-add-int ret (hash (aget items idx))))))) 49 | hashcode) 50 | (equals [this that] 51 | (or 52 | (identical? this that) 53 | (and (instance? java.util.Set that) 54 | (= (count this) (count that)) 55 | (every? #(contains? this %) that)))) 56 | clojure.lang.IFn 57 | (invoke [this key] (.get this key)) 58 | (applyTo [this args] 59 | (when (not= 1 (count args)) 60 | (throw (clojure.lang.ArityException. (count args) "ArraySet"))) 61 | (this (first args))) 62 | java.util.Set 63 | (isEmpty [this] (zero? size)) 64 | (size [this] size) 65 | (toArray [this array] 66 | (.toArray ^java.util.Collection (sequence items) array)) 67 | (toArray [this] (into-array (seq this))) 68 | (iterator [this] (.iterator ^java.util.Collection (sequence this))) 69 | (containsAll [this coll] 70 | (every? #(contains? this %) coll))) 71 | 72 | (def ^:private empty-array-set (ArraySet. (object-array max-size) 0 -1)) 73 | 74 | (defn array-set 75 | "Creates an array-backed set containing the given values." 76 | [& vals] 77 | (into empty-array-set vals)) 78 | -------------------------------------------------------------------------------- /ch03-array-set/src/com/clojurebook/array_set_broken.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.broken-array-set) 2 | 3 | (declare empty-array-set) 4 | (def ^:private ^:const max-size 4) 5 | 6 | (deftype ArraySet [^objects items ^int size ^:unsynchronized-mutable ^int hashcode] 7 | clojure.lang.IPersistentSet 8 | (get [this x] 9 | (loop [i 0] 10 | (when (< i size) 11 | (if (= x (aget items i)) 12 | (aget items i) 13 | (recur (inc i)))))) 14 | (contains [this x] 15 | (boolean 16 | (loop [i 0] 17 | (when (< i size) 18 | (or (= x (aget items i)) (recur (inc i))))))) 19 | (disjoin [this x] 20 | (loop [i 0] 21 | (if (== i size) 22 | this 23 | (if (not= x (aget items i)) 24 | (recur (inc i)) 25 | (ArraySet. (doto (aclone items) 26 | (aset i (aget items (dec size))) 27 | (aset (dec size) nil)) 28 | (dec size) 29 | -1))))) 30 | clojure.lang.IPersistentCollection 31 | (count [this] size) 32 | (cons [this x] 33 | (cond 34 | (.contains this x) this 35 | (== size max-size) (into #{x} this) 36 | :else (ArraySet. (doto (aclone items) 37 | (aset size x)) 38 | (inc size) 39 | -1))) 40 | (empty [this] empty-array-set) 41 | (equiv [this that] (.equals this that)) 42 | clojure.lang.Seqable 43 | (seq [this] (take size items)) 44 | Object 45 | (hashCode [this] 46 | (when (== -1 hashcode) 47 | (set! hashcode (int (areduce items idx ret 0 48 | (unchecked-add-int ret (hash (aget items idx))))))) 49 | hashcode) 50 | (equals [this that] 51 | (or 52 | (identical? this that) 53 | (and (or (instance? java.util.Set that) 54 | (instance? clojure.lang.IPersistentSet that)) 55 | (= (count this) (count that)) 56 | (every? #(contains? this %) that))))) 57 | 58 | (def ^:private empty-array-set (ArraySet. (object-array max-size) 0 -1)) 59 | 60 | (defn array-set 61 | "Creates an array-backed set containing the given values." 62 | [& vals] 63 | (into empty-array-set vals)) 64 | -------------------------------------------------------------------------------- /ch03-array-set/test/com/clojurebook/test_array_set.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.test-array-set 2 | (:use [com.clojurebook.array-set :only (array-set)]) 3 | (:use [clojure.test])) 4 | 5 | (deftest test-array-set 6 | (is (array-set)) 7 | (is (= (array-set) #{})) 8 | (is (= #{} (array-set))) 9 | (is (= #{1} (array-set 1))) 10 | (is (false? ((array-set false) false))) 11 | (is (nil? ((array-set nil) nil))) 12 | (let [hello (apply array-set "hello")] 13 | (is (= #{\h \e \l \o} hello)) 14 | (is (nil? (get hello \w))) 15 | (is (nil? (hello \w))) 16 | (is (= \h (hello \h))) 17 | (is (= \h (apply hello [\h]))) 18 | (is (contains? hello \h)) 19 | (is (= (hash (into #{} "hello")) (hash hello))))) 20 | 21 | (deftest verify-immutability 22 | (let [hello (apply array-set "hello")] 23 | (is (= (apply array-set "hello") 24 | (into (reduce disj hello "hello") "hello"))) 25 | (is (= (apply array-set "hello") hello)))) 26 | 27 | (deftest verify-promotion 28 | (is (instance? clojure.lang.PersistentHashSet (apply array-set (range 20))))) 29 | 30 | (defn bench-set 31 | [f & {:keys [size trials] :or {size 4 trials 1e6}}] 32 | (let [items (repeatedly size gensym)] 33 | (time (loop [s (apply f items) 34 | n trials] 35 | (when (pos? n) 36 | (doseq [x items] (contains? s x)) 37 | (let [x (rand-nth items)] 38 | (recur (-> s (disj x) (conj x)) (dec n)))))))) 39 | 40 | (defn microbenchmark [] 41 | (doseq [n (range 1 5) 42 | f [#'array-set #'hash-set]] 43 | (print "size" n (-> f meta :name) ": ") 44 | (bench-set @f :size n))) 45 | -------------------------------------------------------------------------------- /ch03-game-of-life/project.clj: -------------------------------------------------------------------------------- 1 | (defproject game-of-life "1.0.0-SNAPSHOT" 2 | :description "A generic life-like automaton by Emerick, Carper, and Grand." 3 | :url "http://github.com/clojurebook/ClojureProgramming" 4 | :dependencies [[org.clojure/clojure "1.3.0"]] 5 | :profiles {:1.4 {:dependencies [[org.clojure/clojure "1.4.0-beta6"]]}} 6 | :run-aliases {:rect com.clojurebook.collections.life/rect-demo}) 7 | -------------------------------------------------------------------------------- /ch03-game-of-life/src/com/clojurebook/collections/life.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.collections.life) 2 | 3 | (defn empty-board 4 | "Creates a rectangular empty board of the specified width 5 | and height." 6 | [w h] 7 | (vec (repeat w (vec (repeat h nil))))) 8 | 9 | 10 | (defn populate 11 | "Turns :on each of the cells specified as [y, x] coordinates." 12 | [board living-cells] 13 | (reduce (fn [board coordinates] 14 | (assoc-in board coordinates :on)) 15 | board 16 | living-cells)) 17 | 18 | (def glider (populate (empty-board 6 6) #{[2 0] [2 1] [2 2] [1 2] [0 1]})) 19 | 20 | (defn neighbours 21 | [[x y]] 22 | (for [dx [-1 0 1] dy [-1 0 1] :when (not= 0 dx dy)] 23 | [(+ dx x) (+ dy y)])) 24 | 25 | (defn count-neighbours 26 | [board loc] 27 | (count (filter #(get-in board %) (neighbours loc)))) 28 | 29 | (defn indexed-step 30 | "Yields the next state of the board, using indices to determine neighbors, 31 | liveness, etc." 32 | [board] 33 | (let [w (count board) 34 | h (count (first board))] 35 | (loop [new-board board x 0 y 0] 36 | (cond 37 | (>= x w) new-board 38 | (>= y h) (recur new-board (inc x) 0) 39 | :else 40 | (let [new-liveness 41 | (case (count-neighbours board [x y]) 42 | 2 (get-in board [x y]) 43 | 3 :on 44 | nil)] 45 | (recur (assoc-in new-board [x y] new-liveness) x (inc y))))))) 46 | 47 | 48 | (defn indexed-step2 49 | [board] 50 | (let [w (count board) 51 | h (count (first board))] 52 | (reduce 53 | (fn [new-board x] 54 | (reduce 55 | (fn [new-board y] 56 | (let [new-liveness 57 | (case (count-neighbours board [x y]) 58 | 2 (get-in board [x y]) 59 | 3 :on 60 | nil)] 61 | (assoc-in new-board [x y] new-liveness))) 62 | new-board (range h))) 63 | board (range w)))) 64 | 65 | 66 | (defn indexed-step3 67 | [board] 68 | (let [w (count board) 69 | h (count (first board))] 70 | (reduce 71 | (fn [new-board [x y]] 72 | (let [new-liveness 73 | (case (count-neighbours board [x y]) 74 | 2 (get-in board [x y]) 75 | 3 :on 76 | nil)] 77 | (assoc-in new-board [x y] new-liveness))) 78 | board (for [x (range h) y (range w)] [x y])))) 79 | 80 | 81 | (defn window 82 | "Returns a lazy sequence of 3-item windows centered 83 | around each item of coll, padded as necessary with 84 | pad or nil." 85 | ([coll] (window nil coll)) 86 | ([pad coll] 87 | (partition 3 1 (concat [pad] coll [pad])))) 88 | 89 | (defn cell-block 90 | "Creates a sequences of 3x3 windows from a triple of 3 sequences." 91 | [[left mid right]] 92 | (window (map vector left mid right))) 93 | 94 | (defn liveness 95 | "Returns the liveness (nil or :on) of the center cell for 96 | the next step." 97 | [block] 98 | (let [[_ [_ center _] _] block] 99 | (case (- (count (filter #{:on} (apply concat block))) 100 | (if (= :on center) 1 0)) 101 | 2 center 102 | 3 :on 103 | nil))) 104 | 105 | (defn- step-row 106 | "Yields the next state of the center row." 107 | [rows-triple] 108 | (vec (map liveness (cell-block rows-triple)))) 109 | 110 | (defn index-free-step 111 | "Yields the next state of the board." 112 | [board] 113 | (vec (map step-row (window (repeat nil) board)))) 114 | 115 | (defn step 116 | "Yields the next state of the world" 117 | [cells] 118 | (set (for [[loc n] (frequencies (mapcat neighbours cells)) 119 | :when (or (= n 3) (and (= n 2) (cells loc)))] 120 | loc))) 121 | 122 | (defn stepper 123 | "Returns a step function for Life-like cell automata. 124 | neighbours takes a location and return a sequential collection 125 | of locations. survive? and birth? are predicates on the number 126 | of living neighbours." 127 | [neighbours birth? survive?] 128 | (fn [cells] 129 | (set (for [[loc n] (frequencies (mapcat neighbours cells)) 130 | :when (if (cells loc) (survive? n) (birth? n))] 131 | loc)))) 132 | 133 | (defn hex-neighbours 134 | [[x y]] 135 | (for [dx [-1 0 1] dy (if (zero? dx) [-2 2] [-1 1])] 136 | [(+ dx x) (+ dy y)])) 137 | 138 | (def hex-step (stepper hex-neighbours #{2} #{3 4})) 139 | 140 | (defn rect-stepper 141 | "Returns a step function for standard game of life on a (bounded) rectangular 142 | board of specified size." 143 | [w h] 144 | (stepper #(filter (fn [[i j]] (and (< -1 i w) (< -1 j h))) 145 | (neighbours %)) #{2 3} #{3})) 146 | 147 | (defn draw 148 | [w h step cells] 149 | (let [state (atom cells) 150 | run (atom true) 151 | listener (proxy [java.awt.event.WindowAdapter] [] 152 | (windowClosing [_] (reset! run false))) 153 | pane 154 | (doto (proxy [javax.swing.JPanel] [] 155 | (paintComponent [^java.awt.Graphics g] 156 | (let [g (doto ^java.awt.Graphics2D (.create g) 157 | (.setColor java.awt.Color/BLACK) 158 | (.fillRect 0 0 (* w 10) (* h 10)) 159 | (.setColor java.awt.Color/WHITE))] 160 | (doseq [[x y] @state] 161 | (.fillRect g (inc (* 10 x)) (inc (* 10 y)) 8 8))))) 162 | (.setPreferredSize (java.awt.Dimension. (* 10 w) (* 10 h))))] 163 | (doto (javax.swing.JFrame. "Quad Life") 164 | (.setContentPane pane) 165 | (.addWindowListener listener) 166 | .pack 167 | (.setVisible true)) 168 | (future (while @run 169 | (Thread/sleep 80) 170 | (swap! state step) 171 | (.repaint pane))))) 172 | 173 | (defn rect-demo [] 174 | (draw 30 30 (rect-stepper 30 30) 175 | #{[15 15] [15 17] [16 16] [15 16]})) -------------------------------------------------------------------------------- /ch04-concurrency-game/.gitignore: -------------------------------------------------------------------------------- 1 | character-states.log 2 | -------------------------------------------------------------------------------- /ch04-concurrency-game/project.clj: -------------------------------------------------------------------------------- 1 | (defproject concurrency "1.0.0-SNAPSHOT" 2 | :description "An array-backed set implementation, analogous to 3 | Clojure's array-map, explored in chapter 3 of 'Clojure Programming' by 4 | Emerick, Carper, and Grand." 5 | :url "http://github.com/clojurebook/ClojureProgramming" 6 | :dependencies [[org.clojure/clojure "1.3.0"]] 7 | :profiles {:1.4 {:dependencies [[org.clojure/clojure "1.4.0-beta6"]]}} 8 | :run-aliases {:loot com.clojurebook.concurrency.game/-loot-demo 9 | :battle com.clojurebook.concurrency.game/-battle-demo 10 | :logged-battle com.clojurebook.concurrency.game-validators/-main}) 11 | -------------------------------------------------------------------------------- /ch04-concurrency-game/src/com/clojurebook/concurrency.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.concurrency) 2 | 3 | (defmacro futures 4 | [n & exprs] 5 | (->> (for [expr exprs] 6 | `(future ~expr)) 7 | (repeat n) 8 | (mapcat identity) 9 | vec)) 10 | 11 | (defmacro wait-futures 12 | [& args] 13 | `(doseq [f# (futures ~@args)] 14 | @f#)) -------------------------------------------------------------------------------- /ch04-concurrency-game/src/com/clojurebook/concurrency/game.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.concurrency.game 2 | (:use [com.clojurebook.concurrency :only (futures wait-futures)]) 3 | (:require clojure.pprint 4 | [clojure.set :as set])) 5 | 6 | (defn character 7 | [name & {:as opts}] 8 | (ref (merge {:name name :items #{} :health 500} 9 | opts))) 10 | 11 | (defn attack 12 | "Attacks `target` based on `:strength` of `aggressor`." 13 | [aggressor target] 14 | (dosync 15 | (let [damage (* (rand 0.1) (:strength @aggressor))] 16 | (commute target update-in [:health] #(max 0 (- % damage)))))) 17 | 18 | (defn heal 19 | "Heals `target` based on available `:mana` of `healer`; the latter 20 | is decreased proportional to the amount of health restored to `target`." 21 | [healer target] 22 | (dosync 23 | (let [aid (* (rand 0.1) (:mana @healer))] 24 | (when (pos? aid) 25 | (commute healer update-in [:mana] - (max 5 (/ aid 5))) 26 | (commute target update-in [:health] + aid))))) 27 | 28 | (defn idle 29 | [x] 30 | (dosync 31 | (doseq [stat #{:mana :health} 32 | :when (stat @x)] 33 | (commute x update-in [stat] + (rand-int 100))))) 34 | 35 | (defn change-name 36 | [x] 37 | (dosync 38 | (commute x assoc :name x))) 39 | 40 | (defn loot 41 | "Transfers one value from (:items @from) to (:items @to). 42 | Assumes that each is a set. Returns the new state of 43 | from." 44 | [from to] 45 | (dosync 46 | (when-let [item (first (:items @from))] 47 | (commute to update-in [:items] conj item) 48 | (alter from update-in [:items] disj item)))) 49 | 50 | (defn flawed-loot 51 | "Transfers one value from (:items @from) to (:items @to). 52 | Assumes that each is a set. Returns the new state of 53 | from. 54 | 55 | *Will* produce invalid results, due to inappropriate use 56 | of commute instead of alter." 57 | [from to] 58 | (dosync 59 | (when-let [item (first (:items @from))] 60 | (commute to update-in [:items] conj item) 61 | (commute from update-in [:items] disj item)))) 62 | 63 | (def alive? (comp pos? :health)) 64 | 65 | (defn- play 66 | [character action other] 67 | (while (and (alive? @character) 68 | (alive? @other) 69 | (action character other)) 70 | (Thread/sleep (rand-int 100)))) 71 | 72 | (defn -battle-demo [] 73 | (def smaug (character "Smaug" :health 500 :strength 400)) 74 | (def bilbo (character "Bilbo" :health 100 :strength 100)) 75 | (def gandalf (character "Gandalf" :health 75 :mana 1000)) 76 | 77 | (wait-futures 1 78 | (play bilbo attack smaug) 79 | (play smaug attack bilbo) 80 | (play gandalf heal bilbo)) 81 | 82 | (clojure.pprint/pprint 83 | (map 84 | (comp #(select-keys % [:name :health :mana]) deref) 85 | [smaug bilbo gandalf])) 86 | 87 | (shutdown-agents)) 88 | 89 | 90 | (defn -loot-demo [] 91 | (def smaug (character "Smaug" :health 500 :strength 400 :items (set (range 50)))) 92 | (def bilbo (character "Bilbo" :health 100 :strength 100)) 93 | (def gandalf (character "Gandalf" :health 75 :mana 1000)) 94 | (wait-futures 1 95 | (while (loot smaug bilbo)) 96 | (while (loot smaug gandalf))) 97 | 98 | (println "Bilbo's and Gandalf's item counts (should always == 50):" 99 | (map (comp count :items deref) [bilbo gandalf])) 100 | (println "Overlap in Bilbo's and Gandalf's items (should always be empty):" 101 | (filter (:items @bilbo) (:items @gandalf))) 102 | 103 | (shutdown-agents)) 104 | 105 | 106 | 107 | -------------------------------------------------------------------------------- /ch04-concurrency-game/src/com/clojurebook/concurrency/game_validators.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.concurrency.game-validators 2 | (:use [com.clojurebook.concurrency :only (futures wait-futures)]) 3 | (:require [clojure.set :as set] 4 | [clojure.java.io :as io] 5 | clojure.pprint)) 6 | 7 | (def console (agent *out*)) ;(java.io.PrintWriter. System/out) 8 | (def character-log (agent (io/writer "character-states.log" :append true))) 9 | 10 | (defn write 11 | [^java.io.Writer w & content] 12 | (doseq [x (interpose " " content)] 13 | (.write w (str x))) 14 | (doto w 15 | (.write "\n") 16 | .flush)) 17 | 18 | (defn log-reference 19 | [reference & writer-agents] 20 | (add-watch reference :log 21 | (fn [_ reference old new] 22 | (doseq [writer-agent writer-agents] 23 | (send-off writer-agent write new))))) 24 | 25 | 26 | 27 | (def alive? (comp pos? :health)) 28 | 29 | (defn- enforce-max-health 30 | [name max-health] 31 | (fn [character-data] 32 | (or (<= (:health character-data) max-health) 33 | (throw (IllegalStateException. (str name " is already at max health!")))))) 34 | 35 | (defn character 36 | [name & {:as opts}] 37 | (let [cdata (merge {:name name :items #{} :health 500} 38 | opts) 39 | cdata (assoc cdata :max-health (:health cdata)) 40 | validators (list* (enforce-max-health name (:health cdata)) 41 | (:validator cdata))] 42 | (ref (dissoc cdata :validator) 43 | :validator #(every? (fn [v] (v %)) validators)))) 44 | 45 | (def daylight (ref 1)) 46 | 47 | (defn attack 48 | "Attacks `target` based on `:strength` of `aggressor`." 49 | [aggressor target] 50 | (dosync 51 | (let [damage (* (rand 0.1) (:strength @aggressor) (ensure daylight))] 52 | (send-off console write 53 | (:name @aggressor) "hits" (:name @target) "for" damage) 54 | (commute target update-in [:health] #(max 0 (- % damage)))))) 55 | 56 | (defn sunset! 57 | [] 58 | (dosync (ref-set daylight 0.1))) 59 | 60 | (defn heal 61 | "Heals `target` based on available `:mana` of `healer`; the latter 62 | is decreased proportional to the amount of health restored to `target`. 63 | Also ensures that heals never increase `target`'s health beyond their 64 | `:max-health` value." 65 | [healer target] 66 | (dosync 67 | (let [aid (min (* (rand 0.1) (:mana @healer)) 68 | (- (:max-health @target) (:health @target)))] 69 | (when (pos? aid) 70 | (send-off console write 71 | (:name @healer) "heals" (:name @target) "for" aid) 72 | (commute healer update-in [:mana] - (max 5 (/ aid 5))) 73 | (alter target update-in [:health] + aid))))) 74 | 75 | (defn- play 76 | [character action other] 77 | (while (and (alive? @character) 78 | (alive? @other) 79 | (action character other)) 80 | (Thread/sleep (rand-int 100)))) 81 | 82 | (defn -main [] 83 | (def smaug (character "Smaug" :health 500 :strength 400)) 84 | (def bilbo (character "Bilbo" :health 100 :strength 100)) 85 | (def gandalf (character "Gandalf" :health 75 :mana 1000)) 86 | 87 | (log-reference bilbo console character-log) 88 | (log-reference smaug console character-log) 89 | 90 | (wait-futures 1 91 | (play bilbo attack smaug) 92 | (play smaug attack bilbo) 93 | (play gandalf heal bilbo)) 94 | 95 | (clojure.pprint/pprint 96 | (map 97 | (comp #(select-keys % [:name :health :mana]) deref) 98 | [smaug bilbo gandalf])) 99 | 100 | (shutdown-agents)) 101 | 102 | 103 | 104 | 105 | -------------------------------------------------------------------------------- /ch04-concurrency-webcrawler/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook.concurrency.webcrawler "1.0.0-SNAPSHOT" 2 | :description "A naive agent-based webcrawler, explored in chapter 4 of 3 | 'Clojure Programming' by Emerick, Carper, and Grand." 4 | :url "http://github.com/clojurebook/ClojureProgramming" 5 | :dependencies [[org.clojure/clojure "1.3.0"] 6 | [enlive "1.0.0"]] 7 | :profiles {:1.4 {:dependencies [[org.clojure/clojure "1.4.0-beta6"]]}} 8 | :main ^:skip-aot com.clojurebook.concurrency.webcrawler) 9 | -------------------------------------------------------------------------------- /ch04-concurrency-webcrawler/src/com/clojurebook/concurrency/webcrawler.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.concurrency.webcrawler 2 | (:require [net.cgrand.enlive-html :as enlive]) 3 | (:use [clojure.java.io :only (as-url)] 4 | [clojure.string :only (lower-case)]) 5 | (:import (java.net URL MalformedURLException) 6 | (java.util.concurrent BlockingQueue LinkedBlockingQueue))) 7 | 8 | (defn- links-from 9 | [base-url html] 10 | (remove nil? (for [link (enlive/select html [:a])] 11 | (when-let [href (-> link :attrs :href)] 12 | (try 13 | (URL. base-url href) 14 | ; ignore bad URLs 15 | (catch MalformedURLException e)))))) 16 | 17 | (defn- words-from 18 | [html] 19 | (let [chunks (-> html 20 | (enlive/at [:script] nil) 21 | (enlive/select [:body enlive/text-node]))] 22 | (->> chunks 23 | (mapcat (partial re-seq #"\w+")) 24 | (remove (partial re-matches #"\d+")) 25 | (map lower-case)))) 26 | 27 | (def url-queue (LinkedBlockingQueue.)) 28 | (def crawled-urls (atom #{})) 29 | (def word-freqs (atom {})) 30 | 31 | (declare run process handle-results) 32 | 33 | (defn ^::blocking get-url 34 | [{:keys [^BlockingQueue queue] :as state}] 35 | (let [url (as-url (.take queue))] 36 | (try 37 | (if (@crawled-urls url) 38 | state 39 | {:url url 40 | :content (slurp url) 41 | ::t #'process}) 42 | (catch Exception e 43 | ;; skip URL we failed to load 44 | state) 45 | (finally (run *agent*))))) 46 | 47 | (defn process 48 | [{:keys [url content]}] 49 | (try 50 | (let [html (enlive/html-resource (java.io.StringReader. content))] 51 | {::t #'handle-results 52 | :url url 53 | :links (links-from url html) 54 | :words (reduce (fn [m word] 55 | (update-in m [word] (fnil inc 0))) 56 | {} 57 | (words-from html))}) 58 | (finally (run *agent*)))) 59 | 60 | (defn ^::blocking handle-results 61 | [{:keys [url links words]}] 62 | (try 63 | (swap! crawled-urls conj url) 64 | (doseq [url links] 65 | (.put url-queue url)) 66 | (swap! word-freqs (partial merge-with +) words) 67 | 68 | {::t #'get-url :queue url-queue} 69 | (finally (run *agent*)))) 70 | 71 | (def agents (set (repeatedly 25 #(agent {::t #'get-url :queue url-queue})))) 72 | 73 | (defn paused? [agent] (::paused (meta agent))) 74 | 75 | (defn run 76 | ([] (doseq [a agents] (run a))) 77 | ([a] 78 | (when (agents a) 79 | (send a (fn [{transition ::t :as state}] 80 | (when-not (paused? *agent*) 81 | (let [dispatch-fn (if (-> transition meta ::blocking) 82 | send-off 83 | send)] 84 | (dispatch-fn *agent* transition))) 85 | state))))) 86 | 87 | (defn pause 88 | ([] (doseq [a agents] (pause a))) 89 | ([a] (alter-meta! a assoc ::paused true))) 90 | 91 | (defn restart 92 | ([] (doseq [a agents] (restart a))) 93 | ([a] 94 | (alter-meta! a dissoc ::paused) 95 | (run a))) 96 | 97 | (defn test-crawler 98 | "Resets all state associated with the crawler, adds the given URL to the 99 | url-queue, and runs the crawler for 60 seconds, returning a vector 100 | containing the number of URLs crawled, and the number of URLs 101 | accumulated through crawling that have yet to be visited." 102 | [agent-count starting-url] 103 | (def agents (set (repeatedly agent-count #(agent {::t #'get-url :queue url-queue})))) 104 | (.clear url-queue) 105 | (swap! crawled-urls empty) 106 | (swap! word-freqs empty) 107 | (.add url-queue starting-url) 108 | (run) 109 | (Thread/sleep 60000) 110 | (pause) 111 | [(count @crawled-urls) (count url-queue)]) 112 | 113 | (defn -main 114 | [& [starting-url agent-count]] 115 | (when-not starting-url 116 | (println "Must provide a starting URL. 117 | e.g. `lein run http://www.bbc.co.uk [agent-count]`")) 118 | (let [agent-count (or agent-count "10") 119 | [crawled-count queued-count] (test-crawler (Integer/parseInt agent-count) starting-url)] 120 | (println (format "Crawled %s URLs in 60 seconds, %s additional URLs left in the queue" 121 | crawled-count queued-count)) 122 | (shutdown-agents))) 123 | 124 | -------------------------------------------------------------------------------- /ch07-multimethods-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | (defmulti fill 3 | "Fill a xml/html node (as per clojure.xml) 4 | with the provided value." 5 | (fn [node value] (:tag node))) 6 | 7 | (defmethod fill :div 8 | [node value] 9 | (assoc node :content [(str value)])) 10 | 11 | (defmethod fill :input 12 | [node value] 13 | (assoc-in node [:attrs :value] (str value))) 14 | 15 | 16 | ;----- 17 | (fill {:tag :div} "hello") 18 | ;= {:content ["hello"], :tag :div} 19 | (fill {:tag :input} "hello") 20 | ;= {:attrs {:value "hello"}, :tag :input} 21 | (fill {:span :input} "hello") 22 | ;= # 24 | 25 | 26 | ;----- 27 | (defmethod fill :default 28 | [node value] 29 | (assoc node :content [(str value)])) 30 | 31 | (fill {:span :input} "hello") 32 | ;= {:content ["hello"], :span :input} 33 | (fill {:span :input} "hello") 34 | ;= {:content ["hello"], :span :input} 35 | 36 | 37 | ;----- 38 | (defmulti fill 39 | "Fill a xml/html node (as per clojure.xml) 40 | with the provided value." 41 | (fn [node value] (:tag node)) 42 | :default nil) 43 | 44 | (defmethod fill nil 45 | [node value] 46 | (assoc node :content [(str value)])) 47 | 48 | (defmethod fill :input 49 | [node value] 50 | (assoc-in node [:attrs :value] (str value))) 51 | 52 | (defmethod fill :default 53 | [node value] 54 | (assoc-in node [:attrs :name] (str value))) 55 | 56 | 57 | ;----- 58 | (ns-unmap *ns* 'fill) 59 | 60 | (defn- fill-dispatch [node value] 61 | (if (= :input (:tag node)) 62 | [(:tag node) (-> node :attrs :type)] 63 | (:tag node))) 64 | 65 | (defmulti fill 66 | "Fill a xml/html node (as per clojure.xml) 67 | with the provided value." 68 | #'fill-dispatch 69 | :default nil) 70 | 71 | (defmethod fill nil 72 | [node value] 73 | (assoc node :content [(str value)])) 74 | 75 | (defmethod fill [:input nil] 76 | [node value] 77 | (assoc-in node [:attrs :value] (str value))) 78 | 79 | (defmethod fill [:input "hidden"] 80 | [node value] 81 | (assoc-in node [:attrs :value] (str value))) 82 | 83 | (defmethod fill [:input "text"] 84 | [node value] 85 | (assoc-in node [:attrs :value] (str value))) 86 | 87 | (defmethod fill [:input "radio"] 88 | [node value] 89 | (if (= value (-> node :attrs :value)) 90 | (assoc-in node [:attrs :checked] "checked") 91 | (update-in node [:attrs] dissoc :checked))) 92 | 93 | (defmethod fill [:input "checkbox"] 94 | [node value] 95 | (if (= value (-> node :attrs :value)) 96 | (assoc-in node [:attrs :checked] "checked") 97 | (update-in node [:attrs] dissoc :checked))) 98 | 99 | (defmethod fill :default 100 | [node value] 101 | (assoc-in node [:attrs :name] (str value))) 102 | 103 | 104 | ;----- 105 | (fill {:tag :input 106 | :attrs {:value "first choice" 107 | :type "checkbox"}} 108 | "first choice") 109 | ;= {:tag :input, 110 | ;= :attrs {:checked "checked", 111 | ;= :type "checkbox", 112 | ;= :value "first choice"}} 113 | (fill *1 "off") 114 | ;= {:tag :input 115 | ;= :attrs {:type "checkbox", 116 | ;= :value "first choice"}} 117 | 118 | 119 | ;----- 120 | (derive ::checkbox ::checkable) 121 | ;= nil 122 | (derive ::radio ::checkable) 123 | ;= nil 124 | (derive ::checkable ::input) 125 | ;= nil 126 | (derive ::text ::input) 127 | ;= nil 128 | 129 | 130 | ;----- 131 | (isa? ::radio ::input) 132 | ;= true 133 | (isa? ::radio ::text) 134 | ;= false 135 | 136 | 137 | ;----- 138 | (isa? java.util.ArrayList Object) 139 | ;= true 140 | (isa? java.util.ArrayList java.util.List) 141 | ;= true 142 | (isa? java.util.ArrayList java.util.Map) 143 | ;= false 144 | (derive java.util.Map ::collection) 145 | ;= nil 146 | (derive java.util.Collection ::collection) 147 | ;= nil 148 | (isa? java.util.ArrayList ::collection) 149 | ;= true 150 | (isa? java.util.HashMap ::collection) 151 | ;= true 152 | 153 | 154 | ;----- 155 | (def h (make-hierarchy)) 156 | ;= #'user/h 157 | (isa? h java.util.ArrayList java.util.Collection) 158 | ;= true 159 | 160 | 161 | ;----- 162 | (ns-unmap *ns* 'fill) 163 | 164 | (def fill-hierarchy (-> (make-hierarchy) 165 | (derive :input.radio ::checkable) 166 | (derive :input.checkbox ::checkable) 167 | (derive ::checkable :input) 168 | (derive :input.text :input) 169 | (derive :input.hidden :input))) 170 | 171 | (defn- fill-dispatch [node value] 172 | (if-let [type (and (= :input (:tag node)) 173 | (-> node :attrs :type))] 174 | (keyword (str "input." type)) 175 | (:tag node))) 176 | 177 | (defmulti fill 178 | "Fill a xml/html node (as per clojure.xml) 179 | with the provided value." 180 | #'fill-dispatch 181 | :default nil 182 | :hierarchy #'fill-hierarchy) 183 | 184 | (defmethod fill nil [node value] 185 | (assoc node :content [(str value)])) 186 | 187 | (defmethod fill :input [node value] 188 | (assoc-in node [:attrs :value] (str value))) 189 | 190 | (defmethod fill ::checkable [node value] 191 | (if (= value (-> node :attrs :value)) 192 | (assoc-in node [:attrs :checked] "checked") 193 | (update-in node [:attrs] dissoc :checked))) 194 | 195 | 196 | ;----- 197 | (fill {:tag :input 198 | :attrs {:type "date"}} 199 | "20110820") 200 | ;= {:content ["20110820"], :attrs {:type "date"}, :tag :input} 201 | 202 | 203 | ;----- 204 | (defmethod fill nil [node value] 205 | (if (= :input (:tag node)) 206 | (do 207 | (alter-var-root #'fill-hierarchy 208 | derive (fill-dispatch node value) :input) 209 | (fill node value)) 210 | (assoc node :content [(str value)]))) 211 | 212 | 213 | ;----- 214 | (fill {:tag :input 215 | :attrs {:type "date"}} 216 | "20110820") 217 | ;= {:attrs {:value "20110820", :type "date"}, :tag :input} 218 | 219 | 220 | ;----- 221 | (ns-unmap *ns* 'fill) 222 | 223 | (def input-hierarchy (-> (make-hierarchy) 224 | (derive :input.radio ::checkable) 225 | (derive :input.checkbox ::checkable))) 226 | 227 | (defn- fill-dispatch [node value] 228 | (:tag node)) 229 | 230 | (defmulti fill 231 | "Fill a xml/html node (as per clojure.xml) 232 | with the provided value." 233 | #'fill-dispatch 234 | :default nil) 235 | 236 | (defmulti fill-input 237 | "Fill an input field." 238 | (fn [node value] (-> node :attrs :type)) 239 | :default nil 240 | :hierarchy #'input-hierarchy) 241 | 242 | (defmethod fill nil [node value] 243 | (assoc node :content [(str value)])) 244 | 245 | (defmethod fill :input [node value] 246 | (fill-input node value)) 247 | 248 | (defmethod fill-input nil [node value] 249 | (assoc-in node [:attrs :value] (str value))) 250 | 251 | (defmethod fill-input ::checkable [node value] 252 | (if (= value (-> node :attrs :value)) 253 | (assoc-in node [:attrs :checked] "checked") 254 | (update-in node [:attrs] dissoc :checked))) 255 | 256 | 257 | ;----- 258 | (isa? fill-hierarchy [:input.checkbox :text] [::checkable :input]) 259 | ;= true 260 | 261 | 262 | ;----- 263 | (isa? fill-hierarchy [:input.checkbox String] [::checkable CharSequence]) 264 | ;= true 265 | 266 | 267 | ;----- 268 | (defn- fill-dispatch [node value] 269 | (if-let [type (and (= :input (:tag node)) 270 | (-> node :attrs :type))] 271 | [(keyword (str "input." type)) (class value)] 272 | [(:tag node) (class value)])) 273 | 274 | 275 | ;----- 276 | (ns-unmap *ns* 'fill) 277 | 278 | (def fill-hierarchy (-> (make-hierarchy) 279 | (derive :input.radio ::checkable) 280 | (derive :input.checkbox ::checkable))) 281 | 282 | (defn- fill-dispatch [node value] 283 | (if-let [type (and (= :input (:tag node)) 284 | (-> node :attrs :type))] 285 | [(keyword (str "input." type)) (class value)] 286 | [(:tag node) (class value)])) 287 | 288 | (defmulti fill 289 | "Fill a xml/html node (as per clojure.xml) 290 | with the provided value." 291 | #'fill-dispatch 292 | :default nil 293 | :hierarchy #'fill-hierarchy) 294 | 295 | (defmethod fill nil 296 | [node value] 297 | (if (= :input (:tag node)) 298 | (do 299 | (alter-var-root #'fill-hierarchy 300 | derive (first (fill-dispatch node value)) :input) 301 | (fill node value)) 302 | (assoc node :content [(str value)]))) 303 | 304 | (defmethod fill 305 | [:input Object] [node value] 306 | (assoc-in node [:attrs :value] (str value))) 307 | 308 | (defmethod fill [::checkable clojure.lang.IPersistentSet] 309 | [node value] 310 | (if (contains? value (-> node :attrs :value)) 311 | (assoc-in node [:attrs :checked] "checked") 312 | (update-in node [:attrs] dissoc :checked))) 313 | 314 | 315 | ;----- 316 | (fill {:tag :input 317 | :attrs {:value "yes" 318 | :type "checkbox"}} 319 | #{"yes" "y"}) 320 | ;= {:attrs {:checked "checked", :type "checkbox", :value "yes"}, :tag :input} 321 | (fill *1 #{"no" "n"}) 322 | ;= {:attrs {:type "checkbox", :value "yes"}, :tag :input} 323 | 324 | 325 | ;----- 326 | (fill {:tag :input :attrs {:type "text"}} "some text") 327 | ;= {:attrs {:value "some text", :type "text"}, :tag :input} 328 | (fill {:tag :h1} "Big Title!") 329 | ;= {:content ["Big Title!"], :tag :h1} 330 | 331 | 332 | ;----- 333 | (defmulti run "Executes the computation." class) 334 | 335 | (defmethod run Runnable 336 | [x] 337 | (.run x)) 338 | 339 | (defmethod run java.util.concurrent.Callable 340 | [x] 341 | (.call x)) 342 | 343 | 344 | ;----- 345 | (run #(println "hello!")) 346 | ;= # interface java.util.concurrent.Callable and 349 | ;= interface java.lang.Runnable, and neither is preferred> 350 | 351 | 352 | ;----- 353 | (prefer-method run java.util.concurrent.Callable Runnable) 354 | ;= # 355 | (run #(println "hello!")) 356 | ;= hello! 357 | ;= nil 358 | 359 | 360 | ;----- 361 | (macroexpand-1 '(defmethod mmethod-name dispatch-value [args] body)) 362 | ;= (. mmethod-name clojure.core/addMethod dispatch-value (clojure.core/fn [args] body)) 363 | 364 | 365 | ;----- 366 | (defn add-method [multifn dispatch-val f] 367 | (.addMethod multifn dispatch-val f)) 368 | 369 | 370 | ;----- 371 | (class {}) 372 | ;= clojure.lang.PersistentArrayMap 373 | (type {}) 374 | ;= clojure.lang.PersistentArrayMap 375 | (class ^{:type :a-tag} {}) 376 | ;= clojure.lang.PersistentArrayMap 377 | (type ^{:type :a-tag} {}) 378 | ;= :a-tag 379 | 380 | 381 | ;----- 382 | (ns-unmap *ns* 'run) 383 | 384 | (defmulti run "Executes the computation." type) 385 | 386 | (defmethod run Runnable 387 | [x] 388 | (.run x)) 389 | 390 | (defmethod run java.util.concurrent.Callable 391 | [x] 392 | (.call x)) 393 | 394 | (prefer-method run java.util.concurrent.Callable Runnable) 395 | 396 | (defmethod run :runnable-map 397 | [m] 398 | (run (:run m))) 399 | 400 | (run #(println "hello!")) 401 | ;= hello! 402 | ;= nil 403 | (run (reify Runnable 404 | (run [this] (println "hello!")))) 405 | ;= hello! 406 | ;= nil 407 | (run ^{:type :runnable-map} 408 | {:run #(println "hello!") :other :data}) 409 | ;= hello! 410 | ;= nil 411 | 412 | 413 | ;----- 414 | (def priorities (atom {:911-call :high 415 | :evacuation :high 416 | :pothole-report :low 417 | :tree-down :low})) 418 | 419 | (defmulti route-message 420 | (fn [message] (@priorities (:type message)))) 421 | 422 | (defmethod route-message :low 423 | [{:keys [type]}] 424 | (println (format "Oh, there's another %s. Put it in the log." (name type)))) 425 | 426 | (defmethod route-message :high 427 | [{:keys [type]}] 428 | (println (format "Alert the authorities, there's a %s!" (name type)))) 429 | 430 | 431 | ;----- 432 | (route-message {:type :911-call}) 433 | ;= Alert the authorities, there's a 911-call! 434 | ;= nil 435 | (route-message {:type :tree-down}) 436 | ;= Oh, there's another tree-down. Put it in the log. 437 | ;= nil 438 | 439 | 440 | ;----- 441 | (swap! priorities assoc :tree-down :high) 442 | ;= {:911-call :high, :pothole-report :low, :tree-down :high, :evacuation :high} 443 | (route-message {:type :tree-down}) 444 | ;= Alert the authorities, there's a tree-down! 445 | ;= nil 446 | 447 | 448 | -------------------------------------------------------------------------------- /ch08-lein-mixed-source/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook/lein-mixed-source "1.0.0" 2 | :description "An example of building a mixed-source project in 3 | Leiningen, with the additional requirement that some Java sources depend 4 | upon a type defined in the Clojure sources. From chapter 8 of 'Clojure 5 | Programming' by Emerick, Carper, and Grand." 6 | :url "http://github.com/clojurebook/ClojureProgramming" 7 | :dependencies [[org.clojure/clojure "1.3.0"]] 8 | :aot :all) 9 | 10 | (require '(leiningen compile javac) 11 | 'robert.hooke) 12 | 13 | (robert.hooke/add-hook #'leiningen.compile/compile 14 | (fn [compile project & args] 15 | (let [compile-result (apply compile project args)] 16 | (leiningen.javac/javac (assoc project 17 | ;; Leiningen 1 uses :java-source-path 18 | :java-source-path "srcj" 19 | ;; Lein 2 uses :java-source-paths 20 | :java-source-paths ["srcj"])) 21 | compile-result))) 22 | -------------------------------------------------------------------------------- /ch08-lein-mixed-source/src/mixed/core.clj: -------------------------------------------------------------------------------- 1 | (ns mixed.core) 2 | 3 | (deftype ClojureType []) -------------------------------------------------------------------------------- /ch08-lein-mixed-source/srcj/mixed/JavaClass.java: -------------------------------------------------------------------------------- 1 | package mixed; 2 | 3 | class JavaClass { 4 | static { 5 | new mixed.core.ClojureType(); 6 | } 7 | } -------------------------------------------------------------------------------- /ch08-leiningen/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook/sample-lein-project "1.0.0" 2 | :description "This is the simplest possible Leiningen project." 3 | :url "http://github.com/clojurebook/ClojureProgramming" 4 | :dependencies [[org.clojure/clojure "1.3.0"]]) 5 | -------------------------------------------------------------------------------- /ch08-leiningen/src/simple/core.clj: -------------------------------------------------------------------------------- 1 | (ns simple.core) 2 | -------------------------------------------------------------------------------- /ch08-maven/pom.xml: -------------------------------------------------------------------------------- 1 | 4 | 5 | This is the simplest possible Clojure Maven project. 6 | http://github.com/clojurebook/ClojureProgramming 7 | 8 | 4.0.0 9 | com.clojurebook 10 | sample-maven-project 11 | 1.0.0 12 | clojure 13 | 14 | 15 | 16 | org.clojure 17 | clojure 18 | 1.3.0 19 | 20 | 21 | 22 | 23 | 24 | 25 | src/main/clojure 26 | 27 | 28 | 29 | 30 | com.theoryinpractise 31 | clojure-maven-plugin 32 | 1.3.8 33 | true 34 | 35 | true 36 | true 37 | 38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /ch08-maven/src/main/clojure/simple/core.clj: -------------------------------------------------------------------------------- 1 | (ns simple.core) 2 | -------------------------------------------------------------------------------- /ch08-projects-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | *ns* 3 | ;= # 4 | (defn a [] 42) 5 | ;= #'user/a 6 | 7 | 8 | ;----- 9 | (in-ns 'physics.constants) 10 | ;= # 11 | (def ^:const planck 6.62606957e-34) 12 | ;= #'physics.constants/planck 13 | 14 | 15 | ;----- 16 | (+ 1 1) 17 | ;= # 19 | 20 | 21 | ;----- 22 | (clojure.core/range -20 20 4) 23 | ;= (-20 -16 -12 -8 -4 0 4 8 12 16) 24 | 25 | 26 | ;----- 27 | user/a 28 | ;= # 29 | (clojure.core/refer 'user) 30 | ;= nil 31 | (a) 32 | ;= 42 33 | 34 | 35 | ;----- 36 | (clojure.core/refer 'clojure.core 37 | :exclude '(range) 38 | :rename '{+ add 39 | - sub 40 | / div 41 | * mul}) 42 | ;= nil 43 | (-> 5 (add 18) (mul 2) (sub 6)) 44 | ;= 40 45 | (range -20 20 4) 46 | ;= # 48 | 49 | 50 | ;----- 51 | (clojure.set/union #{1 2 3} #{4 5 6}) 52 | ;= # 53 | 54 | 55 | ;----- 56 | (require 'clojure.set) 57 | ;= nil 58 | (clojure.set/union #{1 2 3} #{4 5 6}) 59 | ;= #{1 2 3 4 5 6} 60 | 61 | 62 | ;----- 63 | (require '[clojure.set :as set]) 64 | ;= nil 65 | (set/union #{1 2 3} #{4 5 6}) 66 | ;= #{1 2 3 4 5 6} 67 | 68 | 69 | ;----- 70 | (require '(clojure string [set :as set])) 71 | 72 | 73 | ;----- 74 | (require 'clojure.xml) 75 | (refer 'clojure.xml) 76 | 77 | 78 | ;----- 79 | (use '(clojure [string :only (join) :as str] 80 | [set :exclude (join)])) 81 | ;= nil 82 | join 83 | ;= # 84 | intersection 85 | ;= # 86 | str/trim 87 | ;= # 88 | 89 | 90 | ;----- 91 | (require '(clojure [string :as str] 92 | [set :as set])) 93 | 94 | 95 | ;----- 96 | (use '[clojure.set :as set :only (intersection)]) 97 | 98 | 99 | ;----- 100 | (Date.) 101 | ;= # 103 | (java.util.Date.) 104 | ;= # 105 | (import 'java.util.Date 'java.text.SimpleDateFormat) 106 | ;= java.text.SimpleDateFormat 107 | (.format (SimpleDateFormat. "MM/dd/yyyy") (Date.)) 108 | ;= "07/18/2011" 109 | 110 | 111 | ;----- 112 | (import '(java.util Arrays Collections)) 113 | ;= java.util.Collections 114 | (->> (iterate inc 0) 115 | (take 5) 116 | into-array 117 | Arrays/asList 118 | Collections/max) 119 | ;= 4 120 | 121 | 122 | ;----- 123 | (import 'java.awt.List 'java.util.List) 124 | ;= # 126 | 127 | 128 | ;----- 129 | (in-ns 'examples.ns) 130 | (clojure.core/refer 'clojure.core :exclude '[next replace remove]) 131 | (require '(clojure [string :as string] 132 | [set :as set]) 133 | '[clojure.java.shell :as sh]) 134 | (use '(clojure zip xml)) 135 | (import 'java.util.Date 136 | 'java.text.SimpleDateFormat 137 | '(java.util.concurrent Executors 138 | LinkedBlockingQueue)) 139 | 140 | 141 | ;----- 142 | (ns examples.ns 143 | (:refer-clojure :exclude [next replace remove]) 144 | (:require (clojure [string :as string] 145 | [set :as set]) 146 | [clojure.java.shell :as sh]) 147 | (:use (clojure zip xml)) 148 | (:import java.util.Date 149 | java.text.SimpleDateFormat 150 | (java.util.concurrent Executors 151 | LinkedBlockingQueue))) 152 | 153 | 154 | ;----- 155 | #/some/namespace/Y->[ /some/namespace/X ]> 158 | 159 | 160 | ;----- 161 | (defn a [x] (+ constant (b x))) 162 | ;= # 164 | 165 | 166 | ;----- 167 | (declare constant b) 168 | ;= #'user/b 169 | (defn a [x] (+ constant (b x))) 170 | ;= #'user/a 171 | (def constant 42) 172 | ;= #'user/constant 173 | (defn b [y] (max y constant)) 174 | ;= #'user/b 175 | (a 100) 176 | ;= 142 177 | 178 | 179 | ;----- 180 | java -cp '.:src:clojure.jar:lib/*' clojure.main 181 | 182 | 183 | ;----- 184 | '.;src;clojure.jar;lib\*' 185 | 186 | 187 | ;----- 188 | $ java -cp clojure.jar clojure.main 189 | Clojure 1.3.0 190 | (System/getProperty "java.class.path") 191 | ;= "clojure.jar" 192 | 193 | 194 | ;----- 195 | [org.clojure/clojure "1.3.0"] 196 | 197 | 198 | ;----- 199 | 200 | org.clojure 201 | clojure 202 | 1.3.0 203 | 204 | 205 | ;----- 206 | (defproject com.clojurebook/lein-mixed-source "1.0.0" 207 | :dependencies [[org.clojure/clojure "1.3.0"]] 208 | :aot :all) 209 | 210 | (require '(leiningen compile javac)) 211 | 212 | (add-hook #'leiningen.compile/compile 213 | (fn [compile project & args] 214 | (apply compile project args) 215 | (leiningen.javac/javac (assoc project :java-source-path "srcj")))) 216 | 217 | 218 | -------------------------------------------------------------------------------- /ch09-annotations/.gitignore: -------------------------------------------------------------------------------- 1 | # emacs + vi backup files 2 | *~ 3 | .*.sw* 4 | 5 | # various IDE junk 6 | *.ipr 7 | *.iml 8 | *.iws 9 | .project 10 | .classpath 11 | .settings 12 | 13 | target 14 | -------------------------------------------------------------------------------- /ch09-annotations/README.md: -------------------------------------------------------------------------------- 1 | ## _Clojure Programming_, Chapter 9 2 | 3 | ### Annotations 4 | 5 | This project contains two examples related to using Java 6 | annotations from within Clojure. 7 | 8 | #### Defining JUnit 4.x tests in Clojure 9 | 10 | The 11 | [`com.clojurebook.annotations.junit`](src/main/clojure/com/clojurebook/annotations/junit.clj) 12 | namespace defines a Java class using `gen-class` that defines three 13 | methods, each of which has an `org.junit.JUnitTest` annotation applied. 14 | 15 | Two of these tests are designed to fail (to demonstrate the expected 16 | effects of the annotations). All tests may be run via the standard 17 | JUnit test runner with: 18 | 19 | ``` 20 | mvn test 21 | ``` 22 | 23 | #### Defining JAX-RS services in Clojure 24 | 25 | The 26 | [`com.clojurebook.annotations.jaxrs`](src/main/clojure/com/clojurebook/annotations/jaxrs.clj) 27 | namespace defines a Java class using `deftype` that has a single `greet` 28 | method. That method, its argument, and the class itself each have 29 | `javax.ws.rs` annotations applied, which defines how the class and 30 | method should be exposed as an HTTP endpoint. 31 | 32 | To test this, start a REPL with `mvn clojure:repl`, and start the web 33 | service using the Grizzly embedded container: 34 | 35 | ```clojure 36 | (com.sun.jersey.api.container.grizzly.GrizzlyWebContainerFactory/create 37 | "http://localhost:8180/" 38 | {"com.sun.jersey.config.property.packages" "com.clojurebook.annotations.jaxrs"}) 39 | ``` 40 | 41 | In another terminal, you can get the web service's WADL at 42 | `http://localhost:8180/application.wadl`: 43 | 44 | ``` 45 | $ curl http://localhost:8180/application.wadl 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | ``` 61 | 62 | …and you can call the `greet` service implemented via the `deftype` 63 | class: 64 | 65 | ``` 66 | $ curl http://localhost:8180/greet/Rose 67 | Hello Rose! 68 | ``` 69 | 70 | 71 | -------------------------------------------------------------------------------- /ch09-annotations/pom.xml: -------------------------------------------------------------------------------- 1 | 3 | 4.0.0 4 | 5 | com.clojurebook 6 | annotations 7 | 1.0.0 8 | clojure 9 | 10 | 11 | 12 | true 13 | 14 | 15 | 16 | 17 | org.clojure 18 | clojure 19 | 1.3.0 20 | 21 | 22 | junit 23 | junit 24 | 4.8.2 25 | 26 | 27 | com.sun.jersey 28 | jersey-server 29 | 1.8 30 | 31 | 32 | com.sun.grizzly 33 | grizzly-servlet-webserver 34 | 1.9.18-i 35 | 36 | 37 | com.sun.jersey 38 | jersey-bundle 39 | 1.5 40 | 41 | 42 | 43 | 44 | 45 | 46 | src/main/clojure 47 | 48 | 49 | 50 | 51 | com.theoryinpractise 52 | clojure-maven-plugin 53 | 1.3.8 54 | true 55 | 56 | 57 | org.codehaus.mojo 58 | exec-maven-plugin 59 | 1.2 60 | 61 | org.junit.runner.JUnitCore 62 | 63 | com.clojurebook.annotations.JUnitTest 64 | 65 | 66 | 67 | 68 | run-test 69 | test 70 | 71 | java 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | maven2-repository.java.net 82 | http://download.java.net/maven/2/ 83 | 84 | 85 | 86 | 87 | -------------------------------------------------------------------------------- /ch09-annotations/src/main/clojure/com/clojurebook/annotations/jaxrs.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.annotations.jaxrs 2 | (:import (javax.ws.rs Path PathParam Produces GET))) 3 | 4 | (definterface Greeting 5 | (greet [^String visitor-name])) 6 | 7 | (deftype ^{Path "/greet/{visitorname}"} GreetingResource [] 8 | Greeting 9 | (^{GET true 10 | Produces ["text/plain"]} 11 | greet 12 | [this ^{PathParam "visitorname"} visitor-name] 13 | (format "Hello %s!" visitor-name))) 14 | 15 | ; to run, compile this namespace; then, in your REPL, invoke: 16 | ; 17 | ; => (com.sun.jersey.api.container.grizzly.GrizzlyWebContainerFactory/create 18 | ; "http://localhost:8080/" 19 | ; {"com.sun.jersey.config.property.packages" "com.clojurebook.annotations.jaxrs"}) 20 | ; 21 | ; The service's WADL will be available at http://localhost:8080/application.wadl, 22 | ; and URLs like http://localhost:8080/greet/James will say hello. -------------------------------------------------------------------------------- /ch09-annotations/src/main/clojure/com/clojurebook/annotations/jaxws.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.annotations.jaxws 2 | (:import (javax.jws WebService WebMethod) 3 | javax.xml.ws.Endpoint)) 4 | 5 | (definterface 6 | ^{WebService {:targetNamespace "com.clojurebook.annotations.jaxrs"}} 7 | EchoService 8 | (^{WebMethod true} echo [^String message])) 9 | 10 | (deftype ^{WebService {:endpointInterface 11 | "com.clojurebook.annotations.jaxrs.EchoService"}} 12 | EchoServiceImpl [] 13 | EchoService 14 | (echo [this message] message)) 15 | 16 | ; to run, load this file in your REPL and invoke: 17 | ; 18 | ; => (Endpoint/publish "http://localhost:8080/echo" (EchoServiceImpl.)) 19 | ; 20 | ; The service's WSDL will be available at http://localhost:8080/echo?wsdl 21 | 22 | -------------------------------------------------------------------------------- /ch09-annotations/src/main/clojure/com/clojurebook/annotations/junit.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.annotations.junit 2 | (:import (org.junit Test Assert)) 3 | (:gen-class 4 | :name com.clojurebook.annotations.JUnitTest 5 | :methods [[^{org.junit.Test true} simpleTest [] void] 6 | [^{org.junit.Test {:timeout 2000}} timeoutTest [] void] 7 | [^{org.junit.Test {:expected NullPointerException}} badException [] 8 | void]])) 9 | 10 | (defn -simpleTest 11 | [this] 12 | (Assert/assertEquals (class this) com.clojurebook.annotations.JUnitTest)) 13 | 14 | (defn -badException 15 | [this] 16 | (Integer/parseInt (System/getProperty "nonexistent"))) 17 | 18 | (defn -timeoutTest 19 | [this] 20 | (Thread/sleep 10000)) 21 | -------------------------------------------------------------------------------- /ch09-gen-class/README.md: -------------------------------------------------------------------------------- 1 | ## _Clojure Programming_, Chapter 9 2 | 3 | ### `gen-class` 4 | 5 | This project contains examples related to using `gen-class` to generate 6 | Java-style classes from within Clojure. 7 | 8 | 9 | #### "Wrapping" a Clojure API with a Java-friendly class 10 | 11 | The 12 | [`com.clojurebook.imaging`](src/com/clojurebook/imaging.clj) 13 | namespace defines a Clojure API for loading and resizing images. It then uses `gen-class` to produce a Java class (`ResizeImage` in the default package) whose static utility methods delegate to the API's `resize-image` function. 14 | 15 | You can see this in action by first building an uberjar containing all 16 | of the code in the project, and its dependencies: 17 | 18 | ``` 19 | $ lein uberjar 20 | ``` 21 | 22 | Then you can choose to run either `ResizeImage` directly: 23 | 24 | ``` 25 | $ java -cp target/gen-class-1.0.0-standalone.jar ResizeImage clojure.png small.png 0.3 26 | ``` 27 | 28 | …or you can run a [Java shim class](src/ResizeClient.java) that calls 29 | into `ResizeImage` to demonstrate that Java->Clojure interop: 30 | 31 | ``` 32 | $ java -cp target/gen-class-1.0.0-standalone.jar ResizeClient clojure.png java-small.png 0.3 33 | ``` 34 | 35 | #### A custom `Exception` type 36 | 37 | The 38 | [`com.clojurebook.CustomException`](src/com/clojurebook/CustomException.clj) 39 | namespace defines a custom `Exception` subclass that has a couple of interesting properties: 40 | 41 | * a `java.util.Map` value can be provided when constructing an instance 42 | of `CustomException` 43 | * `CustomException` implements Clojure's `IDeref` interface, so 44 | instances can be dereferenced (i.e. `@e`) to easily obtain the 45 | aforementioned `java.util.Map`. 46 | 47 | The [`BatchJob`](src/BatchJob.java) class shows an example of using this 48 | custom `Exception` type from Java. Assuming you've built an uberjar 49 | (`lein uberjar`), you can run `BatchJob`'s `main` method, which echos 50 | the contents of the exception's info map: 51 | 52 | ``` 53 | $ java -cp target/gen-class-1.0.0-standalone.jar BatchJobError! Operation failed {"timestamp" 1333488510315, "customer-id" 89045, "priority" "critical", "jobId" "verify-billings"} 54 | ``` 55 | 56 | 57 | 58 | 59 | -------------------------------------------------------------------------------- /ch09-gen-class/clojure.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojurebook/ClojureProgramming/bcc7c58862982a5793e22788fc11a9ed7ffc548f/ch09-gen-class/clojure.png -------------------------------------------------------------------------------- /ch09-gen-class/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook/gen-class "1.0.0" 2 | :description "A set of examples showing how you can use the 3 | `gen-class` form to produce full-featured Java classes from Clojure. 4 | From chapter 9 of 'Clojure Programming' by Emerick, Carper, and Grand." 5 | :url "http://github.com/clojurebook/ClojureProgramming" 6 | :dependencies [[org.clojure/clojure "1.3.0"]] 7 | :aot :all) 8 | 9 | (require '(leiningen compile javac) 10 | 'robert.hooke) 11 | 12 | (robert.hooke/add-hook #'leiningen.compile/compile 13 | (fn [compile project & args] 14 | (let [compile-result (apply compile project args)] 15 | (leiningen.javac/javac (assoc project 16 | ;; Leiningen 1 uses :java-source-path 17 | :java-source-path "srcj" 18 | ;; Lein 2 uses :java-source-paths 19 | :java-source-paths ["srcj"])) 20 | compile-result))) 21 | 22 | -------------------------------------------------------------------------------- /ch09-gen-class/resized.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojurebook/ClojureProgramming/bcc7c58862982a5793e22788fc11a9ed7ffc548f/ch09-gen-class/resized.png -------------------------------------------------------------------------------- /ch09-gen-class/src/BatchJob.java: -------------------------------------------------------------------------------- 1 | import com.clojurebook.CustomException; 2 | import clojure.lang.PersistentHashMap; 3 | 4 | public class BatchJob { 5 | private static void performOperation (String jobId, String priority) { 6 | throw new CustomException(PersistentHashMap.create("jobId", jobId, "priority", priority), 7 | "Operation failed"); 8 | } 9 | 10 | private static void runBatchJob (int customerId) { 11 | try { 12 | performOperation("verify-billings", "critical"); 13 | } catch (CustomException e) { 14 | e.addInfo("customer-id", customerId); 15 | e.addInfo("timestamp", System.currentTimeMillis()); 16 | throw e; 17 | } 18 | } 19 | 20 | public static void main (String[] args) { 21 | try { 22 | runBatchJob(89045); 23 | } catch (CustomException e) { 24 | System.out.println("Error! " + e.getMessage() + " " + e.getInfo()); 25 | } 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /ch09-gen-class/src/ResizeClient.java: -------------------------------------------------------------------------------- 1 | public class ResizeClient { 2 | public static void main (String[] args) { 3 | ResizeImage.resizeFile(args[0], args[1], Double.parseDouble(args[2])); 4 | } 5 | } -------------------------------------------------------------------------------- /ch09-gen-class/src/com/clojurebook/CustomException.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.CustomException 2 | (:gen-class :extends RuntimeException 3 | :implements [clojure.lang.IDeref] 4 | :constructors {[java.util.Map String] [String] 5 | [java.util.Map String Throwable] [String Throwable]} 6 | :state info 7 | :init init 8 | :methods [[getInfo [] java.util.Map] 9 | [addInfo [Object Object] void]])) 10 | 11 | (import 'com.clojurebook.CustomException) 12 | 13 | (defn- -init 14 | ([info message] 15 | [[message] (atom (into {} info))]) 16 | ([info message ex] 17 | [[message ex] (atom (into {} info))])) 18 | 19 | (defn- -deref 20 | [^CustomException this] 21 | @(.info this)) 22 | 23 | (defn- -getInfo 24 | [this] 25 | @this) 26 | 27 | (defn- -addInfo 28 | [^CustomException this key value] 29 | (swap! (.info this) assoc key value)) -------------------------------------------------------------------------------- /ch09-gen-class/src/com/clojurebook/imaging.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.imaging 2 | (:use [clojure.java.io :only (file)]) 3 | (:import (java.awt Image Graphics2D) 4 | javax.imageio.ImageIO 5 | java.awt.image.BufferedImage 6 | java.awt.geom.AffineTransform)) 7 | 8 | (defn load-image 9 | [file-or-path] 10 | (-> file-or-path file ImageIO/read)) 11 | 12 | (defn resize-image 13 | ^BufferedImage [^Image original factor] 14 | (let [scaled (BufferedImage. (* factor (.getWidth original)) 15 | (* factor (.getHeight original)) 16 | (.getType original))] 17 | (.drawImage ^Graphics2D (.getGraphics scaled) 18 | original 19 | (AffineTransform/getScaleInstance factor factor) 20 | nil) 21 | scaled)) 22 | 23 | (gen-class 24 | :name ResizeImage 25 | :main true 26 | :methods [^:static [resizeFile [String String double] void] 27 | ^:static [resize [java.awt.Image double] java.awt.image.BufferedImage]]) 28 | 29 | (def ^:private -resize resize-image) 30 | 31 | (defn- -resizeFile 32 | [path outpath factor] 33 | (ImageIO/write (-> path load-image (resize-image factor)) 34 | "png" 35 | (file outpath))) 36 | 37 | (defn -main 38 | [& [path outpath factor]] 39 | (when-not (and path outpath factor) 40 | (println "Usage: java -jar example-uberjar.jar ResizeImage [INFILE] [OUTFILE] [SCALE FACTOR]") 41 | (System/exit 1)) 42 | (-resizeFile path outpath (Double/parseDouble factor))) -------------------------------------------------------------------------------- /ch09-interop/.gitignore: -------------------------------------------------------------------------------- 1 | # emacs + vi backup files 2 | *~ 3 | .*.sw* 4 | 5 | # various IDE junk 6 | *.ipr 7 | *.iml 8 | *.iws 9 | .project 10 | .classpath 11 | .settings 12 | 13 | target 14 | -------------------------------------------------------------------------------- /ch09-interop/pom.xml: -------------------------------------------------------------------------------- 1 | 4 | 4.0.0 5 | 6 | com.clojurebook 7 | java-clojure-interop 8 | 1.0.0 9 | 10 | 11 | 12 | org.clojure 13 | clojure 14 | 1.3.0 15 | 16 | 17 | 18 | 19 | 20 | 21 | src/main/clojure 22 | 23 | 24 | 25 | 26 | com.theoryinpractise 27 | clojure-maven-plugin 28 | 1.3.8 29 | 30 | true 31 | false 32 | 33 | 34 | 35 | compile-clojure 36 | 39 | process-resources 40 | 41 | compile 42 | 43 | 44 | 45 | 46 | 47 | org.apache.maven.plugins 48 | maven-assembly-plugin 49 | 2.2.1 50 | 51 | 52 | jar-with-dependencies 53 | 54 | 55 | 56 | 57 | make-uberjar 58 | package 59 | 60 | single 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | -------------------------------------------------------------------------------- /ch10-REPL-oriented-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | (ns com.clojurebook.fn-browser 3 | (:import (javax.swing JList JFrame JScrollPane JButton) 4 | java.util.Vector)) 5 | 6 | (defonce fn-names (->> (ns-publics 'clojure.core) 7 | (map key) 8 | sort 9 | Vector. 10 | JList.)) 11 | 12 | (defn show-info [] ) 13 | 14 | (defonce window (doto (JFrame. "\"Interactive Development!\"") 15 | (.setSize (java.awt.Dimension. 400 300)) 16 | (.add (JScrollPane. fn-names)) 17 | (.add java.awt.BorderLayout/SOUTH 18 | (doto (JButton. "Show Info") 19 | (.addActionListener (reify java.awt.event.ActionListener 20 | (actionPerformed [_ e] (show-info)))))) 21 | (.setVisible true))) 22 | 23 | 24 | ;----- 25 | (in-ns 'com.clojurebook.fn-browser) 26 | 27 | (import '(javax.swing JOptionPane JTextArea)) 28 | 29 | (defn show-info 30 | [] 31 | (when-let [selected-fn (.getSelectedValue fn-names)] 32 | (JOptionPane/showMessageDialog 33 | window 34 | (-> (ns-resolve 'clojure.core selected-fn) 35 | meta 36 | :doc 37 | (JTextArea. 10 40) 38 | JScrollPane.) 39 | (str "Doc string for clojure.core/" selected-fn) 40 | JOptionPane/INFORMATION_MESSAGE))) 41 | 42 | 43 | ;----- 44 | (split-with keyword? [:a :b :c 1 2 3]) 45 | ;= [(:a :b :c) (1 2 3)] 46 | (zipmap (first *1) (second *1)) 47 | ;= {:c 3, :b 2, :a 1} 48 | (apply zipmap (split-with keyword? [:a :b :c 1 2 3])) 49 | ;= {:c 3, :b 2, :a 1} 50 | 51 | 52 | ;----- 53 | (throw (Exception. "foo")) 54 | ;= Exception foo user/eval1 (NO_SOURCE_FILE:1) 55 | (pst) 56 | ; Exception foo 57 | ; user/eval1 (NO_SOURCE_FILE:1) 58 | ; clojure.lang.Compiler.eval (Compiler.java:6465) 59 | ; ... 60 | 61 | 62 | ;----- 63 | (apropos #"^ref") 64 | ;= (ref-max-history refer-clojure ref-set ref-history-count ref ref-min-history refer) 65 | 66 | 67 | ;----- 68 | (source merge) 69 | ; (defn merge 70 | ; "Returns a map that consists of the rest of the maps conj-ed onto 71 | ; the first. If a key occurs in more than one map, the mapping from 72 | ; the latter (left-to-right) will be the mapping in the result." 73 | ; {:added "1.0" 74 | ; :static true} 75 | ; [& maps] 76 | ; (when (some identity maps) 77 | ; (reduce1 #(conj (or %1 {}) %2) maps))) 78 | 79 | 80 | ;----- 81 | (require 'clojure.string) 82 | ;= nil 83 | (dir clojure.string) 84 | ; blank? 85 | ; capitalize 86 | ; escape 87 | ; join 88 | ; lower-case 89 | ; replace 90 | ; replace-first 91 | ; reverse 92 | ; split 93 | ; split-lines 94 | ; trim 95 | ; trim-newline 96 | ; triml 97 | ; trimr 98 | ; upper-case 99 | 100 | 101 | ;----- 102 | (ns clean-namespace) 103 | ;= nil 104 | (ns-aliases *ns*) 105 | ;= {} 106 | (require '[clojure.set :as set]) 107 | ;= nil 108 | (ns-aliases *ns*) 109 | ;= {set #} 110 | (ns-publics *ns*) 111 | ;= {} 112 | (def x 0) 113 | ;= #'clean-namespace/x 114 | (ns-publics *ns*) 115 | ;= {x #'clean-namespace/x} 116 | 117 | 118 | ;----- 119 | (ns-unalias *ns* 'set) 120 | ;= nil 121 | (ns-aliases *ns*) 122 | ;= {} 123 | (ns-unmap *ns* 'x) 124 | ;= nil 125 | (ns-publics *ns*) 126 | ;= {} 127 | 128 | 129 | ;----- 130 | (in-ns 'user) 131 | ;= # 132 | (filter #(= 'clean-namespace (ns-name %)) (all-ns)) 133 | ;= (#) 134 | (remove-ns 'clean-namespace) 135 | ;= # 136 | (filter #(= 'clean-namespace (ns-name %)) (all-ns)) 137 | ;= () 138 | 139 | 140 | ;----- 141 | (setq inferior-lisp-program "lein repl") 142 | 143 | 144 | ;----- 145 | lein plugin install swank-clojure 1.3.4 146 | 147 | 148 | ;----- 149 | [swank-clojure "1.3.4"] 150 | 151 | 152 | ;----- 153 | (defn debug-me 154 | [x y] 155 | (let [z (merge x y)] 156 | (swank.core/break))) 157 | 158 | 159 | ;----- 160 | (let [log-capacity 5000 161 | events (agent [])] 162 | (defn log-event [e] 163 | (send events #(if (== log-capacity (count %)) 164 | (-> % (conj e) (subvec 1)) 165 | (conj % e))) 166 | e) 167 | (defn events [] @events)) 168 | 169 | 170 | ;----- 171 | (doseq [request (repeatedly 10000 (partial rand-nth [{:referrer "twitter.com"} 172 | {:referrer "facebook.com"} 173 | {:referrer "twitter.com"} 174 | {:referrer "reddit.com"}]))] 175 | (log-event request)) 176 | ;= nil 177 | (count (events)) 178 | ;= 5000 179 | 180 | 181 | ;----- 182 | (frequencies (events)) 183 | ;= {{:referrer "twitter.com"} 2502, 184 | {:referrer "facebook.com"} 1280, 185 | {:referrer "reddit.com"} 1218} 186 | 187 | 188 | ;----- 189 | (defn a [b] (+ 5 b)) 190 | ;= #'user/a 191 | (def b (partial a 5)) 192 | ;= #'user/b 193 | (b) 194 | ;= 10 195 | (defn a [b] (+ 10 b)) 196 | ;= #'user/a 197 | (b) 198 | ;= 10 199 | 200 | 201 | ;----- 202 | (def b (partial #'a 5)) 203 | ;= #'user/b 204 | (b) 205 | ;= 15 206 | (defn a [b] (+ 5 b)) 207 | ;= #'user/a 208 | (b) 209 | ;= 10 210 | 211 | 212 | -------------------------------------------------------------------------------- /ch11-mandelbrot/README.md: -------------------------------------------------------------------------------- 1 | ## _Clojure Programming_, Chapter 11 2 | 3 | ### Visualizing the Mandelbrot Set in Clojure 4 | 5 | This project contains a Mandelbrot Set implementation in Clojure that 6 | demonstrates the usage and impact of primitive type declarations on the 7 | runtime of numerically-intensive algorithms. 8 | 9 | #### Running 10 | 11 | A canonical rendering of the Mandelbrot Set can be obtained by running 12 | the `-main` entry point in the 13 | [`com.clojurebook.mandelbrot`](src/com/clojurebook/mandelbrot.clj) 14 | namespace using Leiningen: 15 | 16 | ``` 17 | $ lein run mandelbrot.png -2.25 0.75 -1.5 1.5 :width 800 :height 800 18 | ``` 19 | 20 | After running this, you'll see this in `mandelbrot.png`: 21 | 22 | ![](https://github.com/clojurebook/ClojureProgramming/raw/master/ch11-mandelbrot/mandelbrot.png) 23 | 24 | The run arguments correspond exactly to those required by 25 | `com.clojurebook.mandelbrot/mandelbrot`. 26 | 27 | You can change the view you get by modifying the coordinates provided to 28 | that function: 29 | 30 | ``` 31 | $ lein run mandelbrot-zoomed.png -1.5 -1.3 -0.1 0.1 :width 800 :height 800 32 | ``` 33 | 34 | ![](https://github.com/clojurebook/ClojureProgramming/raw/master/ch11-mandelbrot/mandelbrot-zoomed.png) 35 | 36 | Of course, if you're going to do a bunch of exploration of the 37 | Mandelbrot Set using this implementation, you'll be _way_ better off 38 | working from the REPL rather than paying the JVM and Leiningen startup 39 | cost repeatedly. Refer to the book or the sources here for 40 | REPL-oriented examples. 41 | 42 | #### Optimization via primitive type declarations 43 | A nearly order-of-magnitude improvement in the running time of 44 | `com.clojurebook.mandelbrot/mandelbrot` can be had by replacing its 45 | helper `escape` function with this implementation: 46 | 47 | ```clojure 48 | (defn- fast-escape 49 | [^double a0 ^double b0 depth] 50 | (loop [a a0 51 | b b0 52 | iteration 0] 53 | (cond 54 | (< 4 (+ (* a a) (* b b))) iteration 55 | (>= iteration depth) -1 56 | :else (recur (+ a0 (- (* a a) (* b b))) 57 | (+ b0 (* 2 (* a b))) 58 | (inc iteration))))) 59 | ``` 60 | 61 | Aside from the `^double` type declarations for the `a0` and `b0` 62 | arguments, this implemenation is otherwise unchanged compared to the 63 | default (boxing) `escape` function. 64 | 65 | An alternative `lein run` alias — called `:fast` — is set up to use `fast-escape`: 66 | 67 | ``` 68 | $ lein run :fast mandelbrot.png -2.25 0.75 -1.5 1.5 :width 800 :height 800 69 | ``` 70 | 71 | The above will run far faster than the first `lein run` invocation 72 | above. 73 | 74 | -------------------------------------------------------------------------------- /ch11-mandelbrot/mandelbrot-zoomed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojurebook/ClojureProgramming/bcc7c58862982a5793e22788fc11a9ed7ffc548f/ch11-mandelbrot/mandelbrot-zoomed.png -------------------------------------------------------------------------------- /ch11-mandelbrot/mandelbrot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojurebook/ClojureProgramming/bcc7c58862982a5793e22788fc11a9ed7ffc548f/ch11-mandelbrot/mandelbrot.png -------------------------------------------------------------------------------- /ch11-mandelbrot/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook.mandelbrot "1.0.0-SNAPSHOT" 2 | :description "A Mandelbrot Set implementation in Clojure that 3 | demonstrates the usage and impact of primitive type declarations on the 4 | runtime of numerically-intensive algorithms. From chapter 11 of 'Clojure 5 | Programming' by Emerick, Carper, and Grand." 6 | :url "http://github.com/clojurebook/ClojureProgramming" 7 | :dependencies [[org.clojure/clojure "1.3.0"]] 8 | :main ^:skip-aot com.clojurebook.mandelbrot 9 | :run-aliases {:fast com.clojurebook.mandelbrot/-fast-main}) 10 | -------------------------------------------------------------------------------- /ch11-mandelbrot/src/com/clojurebook/mandelbrot.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.mandelbrot 2 | (:import java.awt.image.BufferedImage 3 | (java.awt Color RenderingHints))) 4 | 5 | (defn- escape 6 | "Returns an integer indicating how many iterations were required 7 | before the value of z (using the components `a` and `b`) could 8 | be determined to have escaped the Mandelbrot set. If z 9 | will not escape, -1 is returned." 10 | [a0 b0 depth] 11 | (loop [a a0 12 | b b0 13 | iteration 0] 14 | (cond 15 | (< 4 (+ (* a a) (* b b))) iteration 16 | (>= iteration depth) -1 17 | :else (recur (+ a0 (- (* a a) (* b b))) 18 | (+ b0 (* 2 (* a b))) 19 | (inc iteration))))) 20 | 21 | (defn- fast-escape 22 | "A primitive-hinted variant of `escape` that can result in an 23 | order-of-magnitude performance improvement when used instead." 24 | [^double a0 ^double b0 depth] 25 | (loop [a a0 26 | b b0 27 | iteration 0] 28 | (cond 29 | (< 4 (+ (* a a) (* b b))) iteration 30 | (>= iteration depth) -1 31 | :else (recur (+ a0 (- (* a a) (* b b))) 32 | (+ b0 (* 2 (* a b))) 33 | (inc iteration))))) 34 | 35 | (defn mandelbrot 36 | "Calculates membership within and number of iterations to escape 37 | from the Mandelbrot set for the region defined by `rmin`, `rmax` 38 | `imin` and `imax` (real and imaginary components of z, respectively). 39 | 40 | Optional kwargs include `:depth` (maximum number of iterations 41 | to calculate escape of a point from the set), `:height` ('pixel' 42 | height of the rendering), and `:width` ('pixel' width of the 43 | rendering). 44 | 45 | Returns a seq of row vectors containing iteration numbers for when 46 | the corresponding point escaped from the set. -1 indicates points 47 | that did not escape in fewer than `depth` iterations, i.e. they 48 | belong to the set. These integers can be used to drive most common 49 | Mandelbrot set visualizations." 50 | [rmin rmax imin imax & {:keys [width height depth] 51 | :or {width 80 height 40 depth 1000}}] 52 | (let [rmin (double rmin) 53 | imin (double imin) 54 | stride-w (/ (- rmax rmin) width) 55 | stride-h (/ (- imax imin) height)] 56 | (loop [x 0 57 | y (dec height) 58 | escapes []] 59 | (if (== x width) 60 | (if (zero? y) 61 | (partition width escapes) 62 | (recur 0 (dec y) escapes)) 63 | (recur (inc x) y (conj escapes (escape (+ rmin (* x stride-w)) 64 | (+ imin (* y stride-h)) 65 | depth))))))) 66 | 67 | (defn render-text 68 | "Prints a basic textual rendering of mandelbrot set membership, 69 | as returned by a call to `mandelbrot`." 70 | [mandelbrot-grid] 71 | (doseq [row mandelbrot-grid] 72 | (doseq [escape-iter row] 73 | (print (if (neg? escape-iter) \* \space))) 74 | (println))) 75 | 76 | (defn render-image 77 | "Given a mandelbrot set membership grid as returned by a call to 78 | `mandelbrot`, returns a BufferedImage with the same resolution as the 79 | grid that uses a discrete grayscale color palette." 80 | [mandelbrot-grid] 81 | (let [palette (vec (for [c (range 500)] 82 | (Color/getHSBColor 0.0 0.0 (/ (Math/log c) (Math/log 500))))) 83 | height (count mandelbrot-grid) 84 | width (count (first mandelbrot-grid)) 85 | img (BufferedImage. width height BufferedImage/TYPE_INT_RGB) 86 | ^java.awt.Graphics2D g (.getGraphics img)] 87 | (doseq [[y row] (map-indexed vector mandelbrot-grid) 88 | [x escape-iter] (map-indexed vector row)] 89 | (.setColor g (if (neg? escape-iter) 90 | (palette 0) 91 | (palette (mod (dec (count palette)) (inc escape-iter))))) 92 | (.drawRect g x y 1 1)) 93 | (.dispose g) 94 | img)) 95 | 96 | (defn- coerce-mandelbrot-args 97 | [args] 98 | (for [x args] 99 | (if (= \: (first x)) 100 | (keyword (subs x 1)) 101 | (try 102 | (if (.contains x ".") 103 | (Double/parseDouble x) 104 | (Long/parseLong x)) 105 | (catch NumberFormatException e 106 | (println "Invalid number" x)))))) 107 | 108 | (defn- print-usage [] 109 | (println "Mandelbrot set visualization from 'Clojure Programming', chapter 11.") 110 | (println "Please refer to documentation for com.clojurebook.mandelbrot/mandelbrot for information on what rmin, rmax, etc. mean.") 111 | (println) 112 | (println "Usage: lein run [:fast] output-path rmin rmax imin imax [:width XXX] [:height YYY] [:depth DDD]") 113 | (println " e.g.: lein run mandelbrot.png -2.25 0.75 -1.5 1.5 :width 800 :height 800 :depth 500") 114 | (println) 115 | (println "Using the :fast option will result in the primitive-optimized `fast-escape` function being used instead of the default (boxing) `escape`.")) 116 | 117 | (defn -main 118 | [& [output-path & opts]] 119 | (let [args (coerce-mandelbrot-args opts)] 120 | (when (or (not output-path) 121 | (seq (filter nil? args)) 122 | (not (even? (count args)))) 123 | (print-usage) 124 | (System/exit 1)) 125 | (javax.imageio.ImageIO/write 126 | (render-image (apply mandelbrot args)) 127 | "png" (java.io.File. output-path)) 128 | (System/exit 0))) 129 | 130 | (defn -fast-main 131 | "Same as -main, but uses `with-redefs` to replace `escape` with its 132 | optimized variant `fast-escape`." 133 | [& args] 134 | (with-redefs [escape fast-escape] 135 | (apply -main args))) 136 | -------------------------------------------------------------------------------- /ch11-maths-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | (class (inc (Integer. 5))) 3 | ;= java.lang.Long 4 | 5 | 6 | ;----- 7 | (dec 1) 8 | ;= 0 9 | (dec 1.0) 10 | ;= 0.0 11 | (dec 1N) 12 | ;= 0N 13 | (dec 1M) 14 | ;= 0M 15 | (dec 5/4) 16 | ;= 1/4 17 | 18 | 19 | ;----- 20 | (* 3 0.08 1/4 6N 1.2M) 21 | ;= 0.432 22 | (< 1 1.6 7/3 9N 14e9000M) 23 | ;= true 24 | 25 | 26 | ;----- 27 | (+ 0.1 0.1 0.1) 28 | ;= 0.30000000000000004 29 | 30 | 31 | ;----- 32 | (+ 1/10 1/10 1/10) 33 | ;= 3/10 34 | 35 | 36 | ;----- 37 | (+ 7/10 1/10 1/10 1/10) 38 | ;= 1 39 | 40 | 41 | ;----- 42 | (double 1/3) 43 | ;= 0.3333333333333333 44 | 45 | 46 | ;----- 47 | (rationalize 0.45) 48 | ;= 9/20 49 | 50 | 51 | ;----- 52 | (+ 1 1) 53 | ;= 2 54 | (+ 1 1.5) 55 | ;= 2.5 56 | (+ 1 1N) 57 | ;= 2N 58 | (+ 1.1M 1N) 59 | ;= 2.1M 60 | 61 | 62 | ;----- 63 | (defn squares-sum 64 | [& vals] 65 | (reduce + (map * vals vals))) 66 | ;= #'user/squares-sum 67 | (squares-sum 1 4 10) 68 | ;= 117 69 | 70 | 71 | ;----- 72 | (squares-sum 1 4 10 20.5) 73 | ;= 537.25 74 | (squares-sum 1 4 10 9N) 75 | ;= 198N 76 | (squares-sum 1 4 10 9N 5.6M) 77 | ;= 229.36M 78 | (squares-sum 1 4 10 25/2) 79 | ;= 1093/4 80 | 81 | 82 | ;----- 83 | (.hashCode (BigInteger. "6948736584")) 84 | ;= -1641197977 85 | (.hashCode (Long. 6948736584)) 86 | ;= -1641198007 87 | 88 | 89 | ;----- 90 | (def k Long/MAX_VALUE) 91 | ;= #'user/k 92 | k 93 | ;= 9223372036854775807 94 | 95 | 96 | ;----- 97 | (inc k) 98 | ;= ArithmeticException integer overflow 99 | 100 | 101 | ;----- 102 | (inc (bigint k)) 103 | ;= 9223372036854775808N 104 | (* 100 (bigdec Double/MAX_VALUE)) 105 | ;= 1.797693134862315700E+310M 106 | 107 | 108 | ;----- 109 | (dec 10223372636454715900N) 110 | ;= 10223372636454715899N 111 | (* 0.5M 1e403M) 112 | ;= 5E+402M 113 | 114 | 115 | ;----- 116 | 10223372636454715900 117 | ;= 10223372636454715900N 118 | (* 2 10223372636454715900) 119 | ;= 20446745272909431800N 120 | 121 | 122 | ;----- 123 | (inc' k) 124 | ;= 9223372036854775808N 125 | 126 | 127 | ;----- 128 | (inc' 1) 129 | ;= 2 130 | (inc' (dec' Long/MAX_VALUE)) 131 | ;= 9223372036854775807 132 | 133 | 134 | ;----- 135 | System.out.println(Long.MAX_VALUE); 136 | System.out.println(Long.MAX_VALUE + 1); 137 | 138 | 139 | ;----- 140 | 9223372036854775807 141 | -9223372036854775808 142 | 143 | 144 | ;----- 145 | Long/MIN_VALUE 146 | ;= -9223372036854775808 147 | (dec Long/MIN_VALUE) 148 | ;= # 149 | 150 | 151 | ;----- 152 | (unchecked-dec Long/MIN_VALUE) 153 | ;= 9223372036854775807 154 | (unchecked-multiply 92233720368547758 1000) 155 | ;= -80 156 | 157 | 158 | ;----- 159 | (inc Long/MAX_VALUE) 160 | ;= # 161 | (set! *unchecked-math* true) 162 | ;= true 163 | (inc Long/MAX_VALUE) 164 | ;= -9223372036854775808 165 | (set! *unchecked-math* false) 166 | ;= false 167 | 168 | 169 | ;----- 170 | (binding [*unchecked-math* true] 171 | (inc Long/MAX_VALUE)) 172 | ;= # 173 | 174 | 175 | ;----- 176 | new BigDecimal(1).divide(new BigDecimal(3)); 177 | 178 | = java.lang.ArithmeticException: 179 | = Non-terminating decimal expansion; no exact representable decimal result. 180 | 181 | 182 | ;----- 183 | new BigDecimal(1).divide(new BigDecimal(3), new MathContext(10, RoundingMode.HALF_UP)); 184 | 185 | = 0.3333333333 186 | 187 | 188 | ;----- 189 | (/ 22M 7) 190 | ;= # 192 | (with-precision 10 (/ 22M 7)) 193 | ;= 3.142857143M 194 | (with-precision 10 :rounding FLOOR 195 | (/ 22M 7)) 196 | ;= 3.142857142M 197 | 198 | 199 | ;----- 200 | (set! *math-context* (java.math.MathContext. 10 java.math.RoundingMode/FLOOR)) 201 | ;= # 202 | (/ 22M 7) 203 | ;= 3.142857142M 204 | 205 | 206 | ;----- 207 | (identical? "foot" (str "fo" "ot")) 208 | ;= false 209 | (let [a (range 10)] 210 | (identical? a a)) 211 | ;= true 212 | 213 | 214 | ;----- 215 | (identical? 5/4 (+ 3/4 1/2)) 216 | ;= false 217 | (identical? 5.4321 5.4321) 218 | ;= false 219 | (identical? 2600 2600) 220 | ;= false 221 | 222 | 223 | ;----- 224 | (identical? 127 (dec 128)) 225 | ;= true 226 | (identical? 128 (dec 129)) 227 | ;= false 228 | 229 | 230 | ;----- 231 | (= {:a 1 :b ["hi"]} 232 | (into (sorted-map) [[:b ["hi"]] [:a 1]]) 233 | (doto (java.util.HashMap.) 234 | (.put :a 1) 235 | (.put :b ["hi"]))) 236 | ;= true 237 | 238 | 239 | ;----- 240 | (= 1 1N (Integer. 1) (Short. (short 1)) (Byte. (byte 1))) 241 | ;= true 242 | (= 1.25 (Float. 1.25)) 243 | ;= true 244 | 245 | 246 | ;----- 247 | (= 1 1.0) 248 | ;= false 249 | (= 1N 1M) 250 | ;= false 251 | (= 1.25 5/4) 252 | ;= false 253 | 254 | 255 | ;----- 256 | (== 0.125 0.125M 1/8) 257 | ;= true 258 | (== 4 4N 4.0 4.0M) 259 | ;= true 260 | 261 | 262 | ;----- 263 | (defn equiv? 264 | "Same as `==`, but doesn't throw an exception if any arguments are not numbers." 265 | [& args] 266 | (and (every? number? args) 267 | (apply == args))) 268 | ;= #'user/equiv? 269 | (equiv? "foo" 1) 270 | ;= false 271 | (equiv? 4 4N 4.0 4.0M) 272 | ;= true 273 | (equiv? 0.125 0.125M 1/8) 274 | ;= true 275 | 276 | 277 | ;----- 278 | java.util.Map m = new java.util.HashMap(); 279 | m.put(1, "integer"); 280 | m.put(1L, "long"); 281 | m.put(java.math.BigInteger.valueOf(1), "bigint"); 282 | System.out.println(m); 283 | 284 | >> {1=bigint, 1=long, 1=integer} 285 | 286 | 287 | ;----- 288 | (into #{} [1 1N (Integer. 1) (Short. (short 1))]) 289 | ;= #{1} 290 | (into {} 291 | [[1 :long] 292 | [1N :bigint] 293 | [(Integer. 1) :integer]]) 294 | ;= {1 :integer} 295 | 296 | 297 | ;----- 298 | (+ 0.1 0.2) 299 | ;= 0.30000000000000004 300 | 301 | 302 | ;----- 303 | (== 1.1 (float 1.1)) 304 | ;= false 305 | 306 | 307 | ;----- 308 | (double (float 1.1)) 309 | ;= 1.100000023841858 310 | 311 | 312 | ;----- 313 | 1.1f == 1.1d 314 | 315 | 316 | ;----- 317 | (defn foo [a] 0) 318 | ;= #'user/foo 319 | (seq (.getDeclaredMethods (class foo))) 320 | ;= (#) 321 | 322 | 323 | ;----- 324 | (defn foo [^Double a] 0) 325 | ;= #'user/foo 326 | (seq (.getDeclaredMethods (class foo))) 327 | ;= (#) 328 | 329 | 330 | ;----- 331 | (defn round ^long [^double a] (Math/round a)) 332 | ;= #'user/round 333 | (seq (.getDeclaredMethods (round foo))) 334 | ;= (# 335 | ;= #) 336 | 337 | 338 | ;----- 339 | (round "string") 340 | ;= # 342 | 343 | 344 | ;----- 345 | (defn idem ^long [^long x] x) 346 | ;= #'user/long 347 | (idem 18/5) 348 | ;= 3 349 | (idem 3.14M) 350 | ;= 3 351 | (idem 1e15) 352 | ;= 1000000000000000 353 | (idem 1e150) 354 | ;= # 356 | 357 | 358 | ;----- 359 | (map round [4.5 6.9 8.2]) 360 | ;= (5 7 8) 361 | (apply round [4.2]) 362 | ;= 4 363 | 364 | 365 | ;----- 366 | (defn foo ^long [a b c d e] 0) 367 | ;= # 369 | 370 | 371 | ;----- 372 | (defn foo ^long [^int a] 0) 373 | ;= # 375 | (defn foo ^long [^double a] a) 376 | ;= # 378 | 379 | 380 | ;----- 381 | (set! *warn-on-reflection* true) 382 | ;= true 383 | (loop [x 5] 384 | (when-not (zero? x) 385 | (recur (dec x)))) 386 | ;= nil 387 | 388 | 389 | ;----- 390 | (loop [x 5] 391 | (when-not (zero? x) 392 | (recur (dec' x)))) 393 | ; NO_SOURCE_FILE:2 recur arg for primitive local: 394 | ; x is not matching primitive, had: Object, needed: long 395 | ; Auto-boxing loop arg: x 396 | ;= nil 397 | 398 | 399 | ;----- 400 | (loop [x 5] 401 | (when-not (zero? x) 402 | (recur 0.0))) 403 | ; NO_SOURCE_FILE:2 recur arg for primitive local: 404 | ; x is not matching primitive, had: double, needed: long 405 | ; Auto-boxing loop arg: x 406 | ;= nil 407 | 408 | 409 | ;----- 410 | (defn dfoo ^double [^double a] a) 411 | ;= #'user/dfoo 412 | (loop [x 5] 413 | (when-not (zero? x) 414 | (recur (dfoo (dec x))))) 415 | ; NO_SOURCE_FILE:2 recur arg for primitive local: 416 | ; x is not matching primitive, had: double, needed: long 417 | ; Auto-boxing loop arg: x 418 | ;= nil 419 | 420 | 421 | ;----- 422 | (loop [x 5] 423 | (when-not (zero? x) 424 | (recur (long (dfoo (dec x)))))) 425 | ;= nil 426 | 427 | 428 | ;----- 429 | (defn round [v] 430 | (Math/round v)) 431 | ; Reflection warning, NO_SOURCE_PATH:2 - call to round can't be resolved. 432 | ;= #'user/round 433 | (defn round [v] 434 | (Math/round (double v))) 435 | ;= #'user/round 436 | 437 | 438 | ;----- 439 | (class (int 5)) 440 | ;= java.lang.Long 441 | 442 | 443 | ;----- 444 | (defn vector-histogram 445 | [data] 446 | (reduce (fn [hist v] 447 | (update-in hist [v] inc)) 448 | (vec (repeat 10 0)) 449 | data)) 450 | 451 | 452 | ;----- 453 | (def data (doall (repeatedly 1e6 #(rand-int 10)))) 454 | ;= #'user/data 455 | (time (vector-histogram data)) 456 | ; "Elapsed time: 505.409 msecs" 457 | ;= [100383 100099 99120 100694 100003 99940 100247 99731 99681 100102] 458 | 459 | 460 | ;----- 461 | (defn array-histogram 462 | [data] 463 | (vec 464 | (reduce (fn [^longs hist v] 465 | (aset hist v (inc (aget hist v))) 466 | hist) 467 | (long-array 10) 468 | data))) 469 | 470 | 471 | ;----- 472 | (time (array-histogram data)) 473 | ; "Elapsed time: 25.925 msecs" 474 | ;= [100383 100099 99120 100694 100003 99940 100247 99731 99681 100102] 475 | 476 | 477 | ;----- 478 | (into-array ["a" "b" "c"]) 479 | ;= # 480 | (into-array CharSequence ["a" "b" "c"]) 481 | ;= # 482 | 483 | 484 | ;----- 485 | (into-array Long/TYPE (range 5)) 486 | ;= # 487 | 488 | 489 | ;----- 490 | (long-array 10) 491 | ;= # 492 | (long-array (range 10)) 493 | ;= # 494 | 495 | 496 | ;----- 497 | (seq (long-array 20 (range 10))) 498 | ;= (0 1 2 3 4 5 6 7 8 9 0 0 0 0 0 0 0 0 0 0) 499 | 500 | 501 | ;----- 502 | (def arr (make-array String 5 5)) 503 | ;= #'user/arr 504 | (aget arr 0 0) 505 | ;= nil 506 | (def arr (make-array Boolean/TYPE 10)) 507 | ;= #'user/arr 508 | (aget arr 0) 509 | ;= false 510 | 511 | 512 | ;----- 513 | (class (make-array Character/TYPE 0 0 0)) 514 | ;= [[[C 515 | 516 | 517 | ;----- 518 | (Class/forName "[[Z") 519 | ;= [[Z 520 | (.getComponentType *1) 521 | ;= [Z 522 | (.getComponentType *1) 523 | ;= boolean 524 | 525 | 526 | ;----- 527 | ^objects 528 | ^booleans 529 | ^bytes 530 | ^chars 531 | ^longs 532 | ^ints 533 | ^shorts 534 | ^doubles 535 | ^floats 536 | 537 | 538 | ;----- 539 | (let [arr (long-array 10)] 540 | (aset arr 0 50) 541 | (aget arr 0)) 542 | ;= 50 543 | 544 | 545 | ;----- 546 | (let [a (int-array (range 10))] 547 | (amap a i res 548 | (inc (aget a i)))) 549 | ;= # 550 | (seq *1) 551 | ;= (1 2 3 4 5 6 7 8 9 10) 552 | 553 | 554 | ;----- 555 | (let [a (int-array (range 10))] 556 | (areduce a i sum 0 557 | (+ sum (aget a i)))) 558 | ;= 45 559 | 560 | 561 | ;----- 562 | (def arr (make-array Double/TYPE 1000 1000)) 563 | ;= #'user/arr 564 | (time (dotimes [i 1000] 565 | (dotimes [j 1000] 566 | (aset arr i j 1.0) 567 | (aget arr i j)))) 568 | ; "Elapsed time: 50802.798 msecs" 569 | 570 | 571 | ;----- 572 | (time (dotimes [i 1000] 573 | (dotimes [j 1000] 574 | (let [^doubles darr (aget ^objects arr i)] 575 | (aset darr j 1.0) 576 | (aget darr j))))) 577 | ; "Elapsed time: 21.543 msecs" 578 | ;= nil 579 | 580 | 581 | ;----- 582 | (defmacro deep-aget 583 | "Gets a value from a multidimensional array as if via `aget`, 584 | but with automatic application of appropriate type hints to 585 | each step in the array traversal as guided by the hint added 586 | to the source array. 587 | 588 | e.g. (deep-aget ^doubles arr i j)" 589 | ([array idx] 590 | `(aget ~array ~idx)) 591 | ([array idx & idxs] 592 | (let [a-sym (gensym "a")] 593 | `(let [~a-sym (aget ~(vary-meta array assoc :tag 'objects) ~idx)] 594 | (deep-aget ~(with-meta a-sym {:tag (-> array meta :tag)}) ~@idxs)))))<3> 595 | 596 | 597 | ;----- 598 | (defmacro deep-aset 599 | "Sets a value in a multidimensional array as if via `aset`, 600 | but with automatic application of appropriate type hints to 601 | each step in the array traversal as guided by the hint added 602 | to the target array. 603 | 604 | e.g. (deep-aset ^doubles arr i j 1.0)" 605 | [array & idxsv] 606 | (let [hints '{booleans boolean, bytes byte 607 | chars char, longs long 608 | ints int, shorts short 609 | doubles double, floats float} 610 | hint (-> array meta :tag) 611 | [v idx & sxdi] (reverse idxsv) 612 | idxs (reverse sxdi) 613 | v (if-let [h (hints hint)] (list h v) v) 614 | nested-array (if (seq idxs) 615 | `(deep-aget ~(vary-meta array assoc :tag 'objects) ~@idxs) 616 | array) 617 | a-sym (gensym "a")] 618 | `(let [~a-sym ~nested-array] 619 | (aset ~(with-meta a-sym {:tag hint}) ~idx ~v)))) 620 | 621 | 622 | ;----- 623 | (time (dotimes [i 1000] 624 | (dotimes [j 1000] 625 | (deep-aset ^doubles arr i j 1.0) 626 | (deep-aget ^doubles arr i j)))) 627 | ; "Elapsed time: 25.033 msecs" 628 | 629 | 630 | ;----- 631 | (render-text (mandlebrot -2.25 0.75 -1.5 1.5 :width 80 :height 40 :depth 100)) 632 | *** 633 | ****** 634 | **** 635 | ** ************* 636 | *********************** 637 | *********************** 638 | ************************** 639 | **************************** 640 | ******* ****************************** 641 | *********** ****************************** 642 | ************* ***************************** 643 | ************************************************************ 644 | ************* ***************************** 645 | *********** ****************************** 646 | ******* ****************************** 647 | **************************** 648 | ************************** 649 | *********************** 650 | *********************** 651 | ** ************* 652 | **** 653 | ****** 654 | *** 655 | 656 | 657 | ;----- 658 | (do (time (mandlebrot -2.25 0.75 -1.5 1.5 659 | :width 1600 :height 1200 :depth 1000)) 660 | nil) 661 | ; "Elapsed time: 82714.764 msecs" 662 | 663 | 664 | ;----- 665 | (defn- escape 666 | [^double a0 ^double b0 depth] 667 | (loop [a a0 668 | b b0 669 | iteration 0] 670 | (cond 671 | (< 4 (+ (* a a) (* b b))) iteration 672 | (>= iteration depth) -1 673 | :else (recur (+ a0 (- (* a a) (* b b))) 674 | (+ b0 (* 2 (* a b))) 675 | (inc iteration))))) 676 | 677 | 678 | ;----- 679 | (do (time (mandlebrot -2.25 0.75 -1.5 1.5 680 | :width 1600 :height 1200 :depth 1000)) 681 | nil) 682 | ; "Elapsed time: 8663.841 msecs" 683 | 684 | 685 | ;----- 686 | (render-image (mandlebrot -2.25 0.75 -1.5 1.5 :width 800 :height 800 :depth 500)) 687 | 688 | 689 | ;----- 690 | (render-image (mandlebrot -1.5 -1.3 -0.1 0.1 :width 800 :height 800 :depth 500)) 691 | 692 | 693 | ;----- 694 | (javax.imageio.ImageIO/write *1 "png" (java.io.File. "mandlebrot.png")) 695 | 696 | 697 | -------------------------------------------------------------------------------- /ch12-aspectj/src/com/clojurebook/AspectJExample.java: -------------------------------------------------------------------------------- 1 | package com.clojurebook; 2 | 3 | public class AspectJExample { 4 | public void longRunningMethod () { 5 | System.out.println("Starting long-running method"); 6 | try { 7 | Thread.sleep((long)(1000 + Math.random() * 2000)); 8 | } catch (InterruptedException e) { 9 | } 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /ch12-aspectj/src/com/clojurebook/AspectJExampleMain.java: -------------------------------------------------------------------------------- 1 | package com.clojurebook; 2 | 3 | public class AspectJExampleMain { 4 | public static void main(String[] args) { 5 | new AspectJExample().longRunningMethod(); 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /ch12-aspectj/src/com/clojurebook/Timing.aj: -------------------------------------------------------------------------------- 1 | package com.clojurebook; 2 | 3 | public aspect Timing { 4 | pointcut profiledMethods(): call(* AspectJExample.* (..)); 5 | 6 | long time; 7 | 8 | before(): profiledMethods() { 9 | time = System.currentTimeMillis(); 10 | } 11 | 12 | after(): profiledMethods() { 13 | System.out.println("Call to " + thisJoinPoint.getSignature() + 14 | " took " + (System.currentTimeMillis() - time) + "ms"); 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /ch12-patterns-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | (defn- update-status* 3 | [service-name service-endpoint-url request-data-fn] 4 | (fn [new-status] 5 | (log (format "Updating status @ %s to %s" service-name new-status)) 6 | (let [http-request-data (request-data-fn new-status) 7 | connection (-> service-endpoint-url java.net.URL. .openConnection)] 8 | ;; ...set request method, parameters, body on `connection` 9 | ;; ...perform actual request 10 | ;; ...return result based on HTTP response status 11 | ))) 12 | 13 | (def update-facebook-status (update-status* "Facebook" "http://facebook.com/apis/..." 14 | (fn [status] 15 | {:params {:_a "update_status" 16 | :_t status} 17 | :method "GET"}))) 18 | 19 | (def update-twitter-status ...) 20 | (def update-google-status ...) 21 | 22 | 23 | ;----- 24 | interface IDog { 25 | public String bark(); 26 | } 27 | 28 | class Chihuahua implements IDog { 29 | public String bark() { 30 | return "Yip!"; 31 | } 32 | } 33 | 34 | class Mastiff implements IDog { 35 | public String bark() { 36 | return "Woof!"; 37 | } 38 | } 39 | 40 | class PetStore { 41 | private IDog dog; 42 | public PetStore() { 43 | this.dog = new Mastiff(); 44 | } 45 | 46 | public IDog getDog() { 47 | return dog; 48 | } 49 | } 50 | 51 | static class MyApp { 52 | public static void main(String[] args) { 53 | PetStore store = new PetStore(); 54 | System.out.println(store.getDog().bark()); 55 | } 56 | } 57 | 58 | 59 | ;----- 60 | class PetStore { 61 | private IDog dog; 62 | public PetStore(IDog dog) { 63 | this.dog = dog; 64 | } 65 | 66 | public IDog getDog() { 67 | return dog; 68 | } 69 | } 70 | 71 | class MyApp { 72 | public static void main(String[] args) { 73 | PetStore store = new PetStore(new Chihuahua()); 74 | System.out.println(store.getDog().bark()); 75 | } 76 | } 77 | 78 | 79 | ;----- 80 | (defprotocol Bark 81 | (bark [this])) 82 | 83 | (defrecord Chihuahua [] 84 | Bark 85 | (bark [this] "Yip!")) 86 | 87 | (defrecord Mastiff [] 88 | Bark 89 | (bark [this] "Woof!")) 90 | 91 | 92 | ;----- 93 | (defrecord PetStore [dog]) 94 | 95 | (defn main 96 | [dog] 97 | (let [store (PetStore. dog)] 98 | (println (bark (:dog store))))) 99 | 100 | (main (Chihuahua.)) 101 | ;= Yip! 102 | 103 | (main (Mastiff.)) 104 | ;= Woof! 105 | 106 | 107 | ;----- 108 | (extend-protocol Bark 109 | java.util.Map 110 | (bark [this] 111 | (or (:bark this) 112 | (get this "bark")))) 113 | 114 | 115 | ;----- 116 | (main (doto (java.util.HashMap.) 117 | (.put "bark" "Ouah!"))) 118 | ;= Ouah! 119 | 120 | (main {:bark "Wan-wan!"}) 121 | ;= Wan wan! 122 | 123 | 124 | ;----- 125 | {:dog #user.Chihuahua{:weight 12, :price "$84.50"}} 126 | 127 | 128 | ;----- 129 | (defn configured-petstore 130 | [] 131 | (-> "petstore-config.clj" 132 | slurp 133 | read-string 134 | map->PetStore)) 135 | 136 | 137 | ;----- 138 | (configured-petstore) 139 | ;= #user.PetStore{:dog #user.Chihuahua{:weight 12, :price "$84.50"}} 140 | 141 | 142 | ;----- 143 | interface ISorter { 144 | public sort (int[] numbers); 145 | } 146 | 147 | class QuickSort implements ISorter { 148 | public sort (int[] numbers) { ... } 149 | } 150 | 151 | class MergeSort implements ISorter { 152 | public sort (int[] numbers) { ... } 153 | } 154 | 155 | class Sorter { 156 | private ISorter sorter; 157 | public Sorter (ISorter sorter) { 158 | this.sorter = sorter; 159 | } 160 | 161 | public execute (int[] numbers) { 162 | sorter.sort(numbers); 163 | } 164 | } 165 | 166 | class App { 167 | public ISorter chooseSorter () { 168 | if (...) { 169 | return new QuickSort(); 170 | } else { 171 | return new MergeSort(); 172 | } 173 | } 174 | public static void main(String[] args) { 175 | int[] numbers = {5,1,4,2,3}; 176 | 177 | Sorter s = new Sorter(chooseSorter()); 178 | 179 | s.execute(numbers); 180 | 181 | //... now use sorted numbers 182 | } 183 | } 184 | 185 | 186 | ;----- 187 | (defn quicksort [numbers] ...) 188 | 189 | (defn mergesort [numbers] ...) 190 | 191 | (defn choose-sorter 192 | [] 193 | (if ... 194 | quicksort 195 | mergesort)) 196 | 197 | (defn main 198 | [] 199 | (let [numbers [...]] 200 | ((choose-sorter) numbers))) 201 | 202 | 203 | ;----- 204 | ((comp reverse sort) [2 1 3]) 205 | ;= (3 2 1) 206 | 207 | 208 | ;----- 209 | abstract class Processor { 210 | protected Processor next; 211 | public addToChain(Processor p) { 212 | next = p; 213 | } 214 | public runChain(data) { 215 | Boolean continue = this.process(data); 216 | if(continue and next != null) { 217 | next.runChain(data); 218 | } 219 | } 220 | abstract public boolean process(String data); 221 | } 222 | 223 | class FooProcessor extends Processor { 224 | public boolean process(String data) { 225 | System.out.println("FOO says pass..."); 226 | return true; 227 | } 228 | } 229 | 230 | class BarProcessor extends Processor { 231 | public boolean process(String data) { 232 | System.out.println("BAR " + data + " and let's stop here"); 233 | return false; 234 | } 235 | } 236 | 237 | class BazProcessor extends Processor { 238 | public boolean process(String data) { 239 | System.out.println("BAZ?"); 240 | return true; 241 | } 242 | } 243 | 244 | Processor chain = new FooProcessor().addToChain(new BarProcessor).addToChain(new BazProcessor); 245 | chain.run("data123"); 246 | 247 | 248 | ;----- 249 | (defn foo [data] 250 | (println "FOO passes") 251 | true) 252 | 253 | (defn bar [data] 254 | (println "BAR" data "and let's stop here") 255 | false) 256 | 257 | (defn baz [data] 258 | (println "BAZ?") 259 | true) 260 | 261 | (defn wrap [f1 f2] 262 | (fn [data] 263 | (when (f1 data) 264 | (f2 data)))) 265 | 266 | (def chain (reduce wrap [foo bar baz])) 267 | 268 | 269 | ;----- 270 | (defn my-app 271 | [request] 272 | {:status 200 273 | :headers {"Content-type" "text/html"} 274 | :body (format "You requested: %s" 275 | (:uri request))}) 276 | 277 | 278 | ;----- 279 | (defn wrap-logger 280 | [handler] 281 | (fn [request] 282 | (println (:uri request)) 283 | (handler request))) 284 | 285 | 286 | ;----- 287 | (require '[ring.middleware cookies session]) 288 | 289 | (def my-app (-> my-app 290 | wrap-cookies 291 | wrap-session 292 | wrap-logger)) 293 | 294 | 295 | ;----- 296 | public class Foo 297 | public void expensiveComputation () { 298 | long start = System.currentTimeMillis(); 299 | try { 300 | // do computation 301 | } catch (Exception e) { 302 | // log error 303 | } finally { 304 | long stop = System.currentTimeMillis(); 305 | System.out.println("Run time: " + (stop - start) + "ms"); 306 | } 307 | } 308 | } 309 | 310 | 311 | ;----- 312 | public class AspectJExample { 313 | public void longRunningMethod () { 314 | System.out.println("Starting long-running method"); 315 | try { 316 | Thread.sleep((long)(1000 + Math.random() * 2000)); 317 | } catch (InterruptedException e) { 318 | } 319 | } 320 | } 321 | 322 | 323 | ;----- 324 | public aspect Timing { 325 | pointcut profiledMethods(): call(* AspectJExample.* (..)); 326 | 327 | long time; 328 | 329 | before(): profiledMethods() { 330 | time = System.currentTimeMillis(); 331 | } 332 | 333 | after(): profiledMethods() { 334 | System.out.println("Call to " + thisJoinPoint.getSignature() + 335 | " took " + (System.currentTimeMillis() - time) + "ms"); 336 | } 337 | } 338 | 339 | 340 | ;----- 341 | Starting long-running method 342 | Call to void com.clojurebook.AspectJExample.longRunningMethod() took 1599ms 343 | 344 | 345 | ;----- 346 | (defn time-it [f & args] 347 | (let [start (System/currentTimeMillis)] 348 | (try 349 | (apply f args) 350 | (finally 351 | (println "Run time: " (- (System/currentTimeMillis) start) "ms"))))) 352 | 353 | 354 | ;----- 355 | (require 'robert.hooke) 356 | 357 | (defn foo [x y] 358 | (Thread/sleep (rand-int 1000)) 359 | (+ x y)) 360 | 361 | (robert.hooke/add-hook #'foo time-it) 362 | 363 | 364 | ;----- 365 | (foo 1 2) 366 | ; Run time: 772 ms 367 | ;= 3 368 | 369 | 370 | ;----- 371 | (robert.hooke/with-hooks-disabled foo (foo 1 2)) 372 | ;= 3 373 | 374 | (robert.hooke/remove-hook #'foo time-it) 375 | ;= # 376 | (foo 1 2) 377 | ;= 3 378 | 379 | 380 | ;----- 381 | (require 'clojure.set) 382 | ;= nil 383 | (doseq [var (->> (ns-publics 'clojure.set) 384 | (map val))] 385 | (robert.hooke/add-hook var time-it)) 386 | ;= nil 387 | (clojure.set/intersection (set (range 100000)) 388 | (set (range -100000 10))) 389 | ; Run time: 97 ms 390 | ;= #{0 1 2 3 4 5 6 7 8 9} 391 | 392 | 393 | -------------------------------------------------------------------------------- /ch13-testing-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | (defn get-address 3 | [username] 4 | ;; access database 5 | ) 6 | 7 | 8 | ;----- 9 | (with-redefs [address-lookup (constantly "123 Main St.")] 10 | (println (address-lookup))) 11 | ; 123 Main St. 12 | 13 | 14 | ;----- 15 | (use 'clojure.test) 16 | 17 | (is (= 5 (+ 4 2)) "I never was very good at math...") 18 | ; FAIL in clojure.lang.PersistentList$EmptyList@1 (NO_SOURCE_FILE:1) 19 | ; I was never very good at math... 20 | ; expected: (= 5 (+ 4 2)) 21 | ; actual: (not (= 5 6)) 22 | ;= false 23 | 24 | (is (re-find #"foo" "foobar")) 25 | ;= "foo" 26 | 27 | 28 | ;----- 29 | (is (thrown? ArithmeticException (/ 1 0))) 30 | ;= # 31 | (is (thrown? ArithmeticException (/ 1 1))) 32 | ; FAIL in clojure.lang.PersistentList$EmptyList@1 (NO_SOURCE_FILE:1) 33 | ; expected: (thrown? ArithmeticException (/ 1 1)) 34 | ; actual: nil 35 | ;= nil 36 | 37 | 38 | ;----- 39 | (is (thrown-with-msg? ArithmeticException #"zero" (/ 1 0))) 40 | ;= # 41 | (is (thrown-with-msg? ArithmeticException #"zero" (inc Long/MAX_VALUE))) 42 | ; FAIL in clojure.lang.PersistentList$EmptyList@1 (NO_SOURCE_FILE:1) 43 | ; expected: (thrown-with-msg? ArithmeticException #"zero" (inc Long/MAX_VALUE)) 44 | ; actual: # 45 | ;= # 46 | 47 | 48 | ;----- 49 | (testing "Strings" 50 | (testing "regex" 51 | (is (re-find #"foo" "foobar")) 52 | (is (re-find #"foo" "bar"))) 53 | (testing ".contains" 54 | (is (.contains "foobar" "foo")))) 55 | ; FAIL in clojure.lang.PersistentList$EmptyList@1 (NO_SOURCE_FILE:1) 56 | ; Strings regex 57 | ; expected: (re-find #"foo" "bar") 58 | ; actual: (not (re-find #"foo" "bar")) 59 | 60 | 61 | ;----- 62 | (deftest test-foo 63 | (is (= 1 1))) 64 | ;= #'user/test-foo 65 | (test-foo) 66 | ;= nil 67 | 68 | 69 | ;----- 70 | (:test (meta #'test-foo)) 71 | ;= # 72 | 73 | 74 | ;----- 75 | (with-test 76 | (defn hello [name] 77 | (str "Hello, " name)) 78 | (is (= (hello "Brian") "Hello, Brian")) 79 | (is (= (hello nil) "Hello, nil"))) 80 | ;= #'user/hello 81 | 82 | 83 | ;----- 84 | (hello "Judy") 85 | ;= "Hello, Judy" 86 | 87 | 88 | ;----- 89 | ((:test (meta #'hello))) 90 | ; FAIL in clojure.lang.PersistentList$EmptyList@1 (NO_SOURCE_FILE:5) 91 | ; expected: (= (hello nil) "Hello, nil") 92 | ; actual: (not (= "Hello, " "Hello, nil")) 93 | ;= false 94 | 95 | 96 | ;----- 97 | (run-tests) 98 | ; Testing user 99 | ; 100 | ; FAIL in (hello) (NO_SOURCE_FILE:5) 101 | ; expected: (= (hello nil) "Hello, nil") 102 | ; actual: (not (= "Hello, " "Hello, nil")) 103 | ; 104 | ; Ran 2 tests containing 3 assertions. 105 | ; 1 failures, 0 errors. 106 | ;= {:type :summary, :pass 2, :test 2, :error 0, :fail 1} 107 | 108 | 109 | ;----- 110 | (ns-unmap *ns* 'hello) 111 | ;= nil 112 | (run-tests) 113 | ; Testing user 114 | ; 115 | ; Ran 1 tests containing 1 assertions. 116 | ; 0 failures, 0 errors. 117 | ;= {:type :summary, :pass 1, :test 1, :error 0, :fail 0} 118 | 119 | 120 | ;----- 121 | (with-test 122 | (defn hello [name] 123 | (str "Hello, " name)) 124 | (is (= (hello "Brian") "Hello, Brian")) 125 | (is (= (hello nil) "Hello, nil"))) 126 | ;= #'user/hello 127 | (alter-meta! #'hello dissoc :test) 128 | ;= {:ns #, :name hello, :arglists ([name]), 129 | ;= :line 2, :file "NO_SOURCE_PATH"} 130 | (run-tests *ns*) 131 | ; Testing user 132 | ; 133 | ; Ran 1 tests containing 1 assertions. 134 | ; 0 failures, 0 errors. 135 | ;= {:type :summary, :pass 1, :test 1, :error 0, :fail 0} 136 | (hello "Rebecca") 137 | ;= "Hello, Rebecca" 138 | 139 | 140 | ;----- 141 | (deftest a 142 | (is (== 0 (- 3 2)))) 143 | ;= #'user/a 144 | (deftest b (a)) 145 | ;= #'user/b 146 | (deftest c (b)) 147 | ;= #'user/c 148 | (c) 149 | ; FAIL in (c b a) (NO_SOURCE_FILE:2) 150 | ; expected: (== 0 (- 3 2)) 151 | ; actual: (not (== 0 1)) 152 | 153 | 154 | ;----- 155 | (run-tests) 156 | ; Testing user 157 | ; 158 | ; FAIL in (b a) (NO_SOURCE_FILE:2) 159 | ; expected: (== 0 (- 3 2)) 160 | ; actual: (not (== 0 1)) 161 | ; 162 | ; FAIL in (c b a) (NO_SOURCE_FILE:2) 163 | ; expected: (== 0 (- 3 2)) 164 | ; actual: (not (== 0 1)) 165 | ; 166 | ; FAIL in (a) (NO_SOURCE_FILE:2) 167 | ; expected: (== 0 (- 3 2)) 168 | ; actual: (not (== 0 1)) 169 | ; 170 | ; Ran 6 tests containing 3 assertions. 171 | ; 3 failures, 0 errors. 172 | ;= {:type :summary, :pass 0, :test 6, :error 0, :fail 3} 173 | 174 | 175 | ;----- 176 | (defn test-ns-hook [] (c)) 177 | ;= #'user/test-ns-hook 178 | (run-tests) 179 | ; Testing user 180 | ; 181 | ; FAIL in (c b a) (NO_SOURCE_FILE:2) 182 | ; expected: (== 0 (- 3 2)) 183 | ; actual: (not (== 0 1)) 184 | ; 185 | ; Ran 3 tests containing 1 assertions. 186 | ; 1 failures, 0 errors. 187 | ;= {:type :summary, :pass 0, :test 3, :error 0, :fail 1} 188 | 189 | 190 | ;----- 191 | (ns-unmap *ns* 'test-ns-hook) 192 | ;= nil 193 | (defn a 194 | [] 195 | (is (== 0 (- 3 2)))) 196 | ;= #'user/a 197 | (defn b [] (a)) 198 | ;= #'user/b 199 | (deftest c (b)) 200 | ;= #'user/c 201 | (run-tests) 202 | ; Testing user 203 | ; 204 | ; FAIL in (c) (NO_SOURCE_FILE:3) 205 | ; expected: (== 0 (- 3 2)) 206 | ; actual: (not (== 0 1)) 207 | ; 208 | ; Ran 1 tests containing 1 assertions. 209 | ; 1 failures, 0 errors. 210 | ;= {:type :summary, :pass 0, :test 1, :error 0, :fail 1} 211 | 212 | 213 | ;----- 214 | (defn some-fixture 215 | [f] 216 | (try 217 | ;; set up database connections, load test data, 218 | ;; mock out functions using `with-redefs` or `binding`, etc. 219 | (f) 220 | (finally 221 | ;; clean up database connections, files, etc. 222 | ))) 223 | 224 | 225 | ;----- 226 | (defprotocol Bark 227 | (bark [this])) 228 | 229 | (defrecord Chihuahua [weight price] 230 | Bark 231 | (bark [this] "Yip!")) 232 | 233 | (defrecord PetStore [dog]) 234 | 235 | (defn configured-petstore 236 | [] 237 | (-> "petstore-config.clj" 238 | slurp 239 | read-string 240 | map->PetStore)) 241 | 242 | 243 | ;----- 244 | (def ^:private dummy-petstore (PetStore. (Chihuahua. 12 "$84.50"))) 245 | 246 | (deftest test-configured-petstore 247 | (is (= (configured-petstore) dummy-petstore))) 248 | 249 | 250 | ;----- 251 | (run-tests) 252 | ; Testing user 253 | ; 254 | ; ERROR in (test-configured-petstore) (FileInputStream.java:-2) 255 | ; expected: (= (configured-petstore) dummy-petstore) 256 | ; actual: java.io.FileNotFoundException: petstore-config.clj (No such file or directory) 257 | ; at java.io.FileInputStream.open (FileInputStream.java:-2) 258 | ; ... 259 | ; 260 | ; Ran 1 tests containing 1 assertions. 261 | ; 0 failures, 1 errors. 262 | ;= {:type :summary, :pass 0, :test 1, :error 1, :fail 0} 263 | 264 | 265 | ;----- 266 | (defn petstore-config-fixture 267 | [f] 268 | (let [file (java.io.File. "petstore-config.clj")] 269 | (try 270 | (spit file (with-out-str (pr dummy-petstore))) 271 | (f) 272 | (finally 273 | (.delete file))))) 274 | 275 | 276 | ;----- 277 | (use-fixtures :once petstore-config-fixture) 278 | 279 | 280 | ;----- 281 | (run-tests) 282 | ; Testing user 283 | ; 284 | ; Ran 1 tests containing 1 assertions. 285 | ; 0 failures, 0 errors. 286 | ;= {:type :summary, :pass 1, :test 1, :error 0, :fail 0} 287 | 288 | 289 | ;----- 290 | [:html 291 | [:head [:title "Propaganda"]] 292 | [:body [:p "Visit us at " 293 | [:a {:href "http://clojureprogramming.com"} 294 | "our website"] 295 | "."]]] 296 | 297 | 298 | ;----- 299 | 300 | Propaganda 301 | 302 |

Visit us at our website.

303 | 304 | 305 | 306 | 307 | ;----- 308 | (deftest test-addition 309 | (are [x y z] (= x (+ y z)) 310 | 10 7 3 311 | 20 10 10 312 | 100 89 11)) 313 | 314 | 315 | ;----- 316 | (do 317 | (clojure.test/is (= 10 (+ 7 3))) 318 | (clojure.test/is (= 20 (+ 10 10))) 319 | (clojure.test/is (= 100 (+ 89 11)))) 320 | 321 | 322 | ;----- 323 | (defmacro are* [f & body] 324 | `(are [x# y#] (~'= (~f x#) y#) 325 | ~@body)) 326 | 327 | 328 | ;----- 329 | (deftest test-tostring 330 | (are* str 331 | 10 "10" 332 | :foo ":foo" 333 | "identity" "identity")) 334 | 335 | 336 | ;----- 337 | (require 'clojure.string) 338 | 339 | (declare html attrs) 340 | 341 | (deftest test-html 342 | (are* html 343 | [:html] 344 | "" 345 | 346 | [:a [:b]] 347 | "" 348 | 349 | [:a {:href "/"} "Home"] 350 | "Home" 351 | 352 | [:div "foo" [:span "bar"] "baz"] 353 | "
foobarbaz
")) 354 | 355 | (deftest test-attrs 356 | (are* (comp clojure.string/trim attrs) 357 | nil "" 358 | 359 | {:foo "bar"} 360 | "foo=\"bar\"" 361 | 362 | (sorted-map :a "b" :c "d") 363 | "a=\"b\" c=\"d\"")) 364 | 365 | 366 | ;----- 367 | (defn attrs 368 | [attr-map] 369 | (->> attr-map 370 | (mapcat (fn [[k v]] [k " =\"" v "\""])) 371 | (apply str))) 372 | 373 | (defn html 374 | [x] 375 | (if-not (sequential? x) 376 | (str x) 377 | (let [[tag & body] x 378 | [attr-map body] (if (map? (first body)) 379 | [(first body) (rest body)] 380 | [nil body])] 381 | (str "<" (name tag) (attrs attr-map) ">" 382 | (apply str (map html body)) 383 | "")))) 384 | 385 | 386 | ;----- 387 | (run-tests) 388 | ; Testing user 389 | ; 390 | ; FAIL in (test-html) (NO_SOURCE_FILE:6) 391 | ; expected: (= (html [:a {:href "/"} "Home"]) "Home") 392 | ; actual: (not (= "Home" "Home")) 393 | ; 394 | ; FAIL in (test-attrs) (NO_SOURCE_FILE:20) 395 | ; expected: (= ((comp clojure.string/trim attrs) {:foo "bar"}) "foo=\"bar\"") 396 | ; actual: (not (= ":foo =\"bar\"" "foo=\"bar\"")) 397 | ; 398 | ; FAIL in (test-attrs) (NO_SOURCE_FILE:20) 399 | ; expected: (= ((comp clojure.string/trim attrs) 400 | ; (sorted-map :a "b" :c "d")) 401 | ; "a=\"b\" c=\"d\"") 402 | ; actual: (not (= ":a =\"b\":c =\"d\"" "a=\"b\" c=\"d\"")) 403 | ; 404 | ; Ran 2 tests containing 7 assertions. 405 | ; 3 failures, 0 errors. 406 | ;= {:type :summary, :pass 4, :test 2, :error 0, :fail 3} 407 | 408 | 409 | ;----- 410 | (defn attrs 411 | [attrs] 412 | (->> attrs 413 | (mapcat (fn [[k v]] [(name k) "=\"" v "\""])) 414 | (apply str))) 415 | 416 | 417 | ;----- 418 | (test-attrs) 419 | ; FAIL in (test-attrs) (NO_SOURCE_FILE:20) 420 | ; expected: (= ((comp clojure.string/trim attrs) 421 | ; (sorted-map :a "b" :c "d")) 422 | ; "a=\"b\" c=\"d\"") 423 | ; actual: (not (= ":a =\"b\":c =\"d\"" "a=\"b\" c=\"d\"")) 424 | 425 | 426 | ;----- 427 | (defn attrs 428 | [attrs] 429 | (->> attrs 430 | (mapcat (fn [[k v]] [\space (name k) "=\"" v "\""])) 431 | (apply str))) 432 | 433 | 434 | ;----- 435 | (test-attrs) 436 | ;= nil 437 | (run-tests) 438 | ; Testing user 439 | ; 440 | ; Ran 2 tests containing 7 assertions. 441 | ; 0 failures, 0 errors. 442 | ;= {:type :summary, :pass 7, :test 2, :error 0, :fail 0} 443 | 444 | 445 | ;----- 446 | (html [:html 447 | [:head [:title "Propaganda"]] 448 | [:body [:p "Visit us at " 449 | [:a {:href "http://clojureprogramming.com"} 450 | "our website"] 451 | "."]]]) 452 | ;= " 453 | ;= Propaganda 454 | ;= 455 | ;=

Visit us at our website.

456 | ;= 457 | ;= " 458 | 459 | 460 | ;----- 461 | (html (list* :ul (for [author ["Chas Emerick" "Christophe Grand" "Brian Carper"]] 462 | [:li author]))) 463 | ;= "
  • Chas Emerick
  • Christophe Grand
  • Brian Carper
" 464 | 465 | 466 | ;----- 467 | {:tag :a, :attrs {:href "http://clojure.org"}, :content ["Clojure"]} 468 | 469 | 470 | ;----- 471 | (html {:tag :a, :attrs {:href "http://clojure.org"}, :content ["Clojure"]}) 472 | ;= "{:content [\"Clojure\"], :attrs {:href \"http://clojure.org\"}, :tag :a}" 473 | 474 | 475 | ;----- 476 | (defn attrs 477 | [attrs] 478 | (assert (or (map? attr-map) 479 | (nil? attr-map)) "attr-map must be nil, or a map") 480 | (->> attrs 481 | (mapcat (fn [[k v]] [\space (name k) "=\"" v "\""])) 482 | (apply str))) 483 | 484 | (attrs "hi") 485 | ;= # 488 | 489 | 490 | ;----- 491 | (set! *assert* false) 492 | ;= false 493 | (defn attrs 494 | [attr-map] 495 | (assert (or (map? attr-map) 496 | (nil? attr-map)) "attr-map must be nil, or a map") 497 | (->> attr-map 498 | (mapcat (fn [[k v]] [\space (name k) "=\"" v "\""])) 499 | (apply str))) 500 | ;= #'user/attrs 501 | (attrs "hi") 502 | ;= # 504 | (set! *assert* true) 505 | ;= true 506 | 507 | 508 | ;----- 509 | (defn attrs 510 | [attr-map] 511 | {:pre [(or (map? attr-map) 512 | (nil? attr-map))]} 513 | (->> attr-map 514 | (mapcat (fn [[k v]] [\space (name k) "=\"" v "\""])) 515 | (apply str))) 516 | 517 | (defn html 518 | [x] 519 | {:pre [(if (sequential? x) 520 | (some #(-> x first %) [keyword? symbol? string?]) 521 | (not (map? x)))] 522 | :post [(string? %)]} 523 | (if-not (sequential? x) 524 | (str x) 525 | (let [[tag & body] x 526 | [attr-map body] (if (map? (first body)) 527 | [(first body) (rest body)] 528 | [nil body])] 529 | (str "<" (name tag) (attrs attr-map) ">" 530 | (apply str (map html body)) 531 | "")))) 532 | 533 | 534 | ;----- 535 | (html {:tag :a, :attrs {:href "http://clojure.org"}, :content ["Clojure"]}) 536 | ;= # x first p1__843#)) 539 | ;= [keyword? symbol? string?]) 540 | ;= (not (map? x)))> 541 | 542 | 543 | -------------------------------------------------------------------------------- /ch14-rdbms-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | (require '[clojure.java.jdbc :as jdbc]) 3 | ;= nil 4 | (def db-spec {:classname "org.sqlite.JDBC" 5 | :subprotocol "sqlite" 6 | :subname "test.db"}) 7 | ;= #'user/db 8 | 9 | 10 | ;----- 11 | {:classname "com.mysql.jdbc.Driver" 12 | :subprotocol "mysql" 13 | :subname "//localhost:3306/databasename" 14 | :user "login" 15 | :password "password"} 16 | 17 | 18 | ;----- 19 | {:datasource datasource-instance 20 | :user "login" 21 | :password "password"} 22 | 23 | 24 | ;----- 25 | {:name "java:/comp/env/jdbc/postgres" 26 | :environment {}} ; optional JNDI parameters for initializing javax.naming.InitialContext 27 | 28 | 29 | 30 | ;----- 31 | (jdbc/with-connection db-spec) 32 | ;= nil 33 | 34 | 35 | ;----- 36 | (jdbc/with-connection db-spec 37 | (jdbc/create-table :authors 38 | [:id "integer primary key"] 39 | [:first_name "varchar"] 40 | [:last_name "varchar"])) 41 | ;= (0) 42 | 43 | 44 | ;----- 45 | (jdbc/with-connection db-spec 46 | (jdbc/insert-records :authors 47 | {:first_name "Chas" :last_name "Emerick"} 48 | {:first_name "Christophe" :last_name "Grand"} 49 | {:first_name "Brian" :last_name "Carper"})) 50 | ;= ({:last_insert_rowid() 1} 51 | ;= {:last_insert_rowid() 2} 52 | ;= {:last_insert_rowid() 3}) 53 | 54 | 55 | ;----- 56 | (jdbc/with-connection db-spec 57 | (jdbc/with-query-results res ["SELECT * FROM authors"] 58 | (doall res))) 59 | ;= ({:id 1, :first_name "Chas", :last_name "Emerick"} 60 | ;= {:id 2, :first_name "Christophe", :last_name "Grand"} 61 | ;= {:id 3, :first_name "Brian", :last_name "Carper"}) 62 | 63 | 64 | ;----- 65 | (jdbc/with-connection db-spec 66 | (jdbc/with-query-results res ["SELECT * FROM authors"] 67 | (doall (map #(str (:first_name %) " " (:last_name %)) res)))) 68 | ;= ("Chas Emerick" "Christophe Grand" "Brian Carper") 69 | 70 | 71 | ;----- 72 | (jdbc/with-connection db-spec 73 | (jdbc/with-query-results res ["SELECT * FROM authors WHERE id = ?" 2] 74 | (doall res))) 75 | ;= ({:id 2, :first_name "Christophe", :last_name "Grand"}) 76 | 77 | 78 | ;----- 79 | (jdbc/with-connection db-spec 80 | (jdbc/with-query-results res ["SELECT * FROM authors"] 81 | res)) 82 | ;= ({:id 1, :first_name "Chas", :last_name "Emerick"}) 83 | 84 | 85 | ;----- 86 | (defn fetch-results [db-spec query] 87 | (jdbc/with-connection db-spec 88 | (jdbc/with-query-results res query 89 | (doall res)))) 90 | ;= #'user/fetch-results 91 | (fetch-results db-spec ["SELECT * FROM authors"]) 92 | ;= ({:id 1, :first_name "Chas", :last_name "Emerick"} 93 | ;= {:id 2, :first_name "Christophe", :last_name "Grand"} 94 | ;= {:id 3, :first_name "Brian", :last_name "Carper"}) 95 | 96 | 97 | ;----- 98 | (jdbc/with-connection db-spec 99 | (jdbc/transaction 100 | (jdbc/delete-rows :authors ["id = ?" 1]) 101 | (throw (Exception. "Abort transaction!")))) 102 | ;= ; Exception Abort transaction! 103 | (fetch-results ["SELECT * FROM authors where id = ?" 1]) 104 | ;= ({:id 1, :first_name "Chas", :last_name "Emerick"}) 105 | 106 | 107 | ;----- 108 | (jdbc/with-connection db-spec 109 | (.setTransactionIsolation (jdbc/connection) java.sql.Connection/TRANSACTION_SERIALIZABLE) 110 | (jdbc/transaction 111 | (jdbc/delete-rows :authors ["id = ?" 2]))) 112 | 113 | 114 | 115 | ;----- 116 | (import 'com.mchange.v2.c3p0.ComboPooledDataSource) 117 | ; Feb 05, 2011 2:26:40 AM com.mchange.v2.log.MLog 118 | ; INFO: MLog clients using java 1.4+ standard logging. 119 | ;= com.mchange.v2.c3p0.ComboPooledDataSource 120 | 121 | (defn pooled-spec 122 | [{:keys [classname subprotocol subname username password] :as other-spec}] 123 | (let [cpds (doto (ComboPooledDataSource.) 124 | (.setDriverClass classname) 125 | (.setJdbcUrl (str "jdbc:" subprotocol ":" subname)) 126 | (.setUser username) 127 | (.setPassword password))] 128 | {:datasource cpds})) 129 | 130 | 131 | ;----- 132 | (def pooled-db (pooled-spec db-spec)) 133 | ; Dec 27, 2011 8:49:28 AM com.mchange.v2.c3p0.C3P0Registry banner 134 | ; INFO: Initializing c3p0-0.9.1.2 [built 21-May-2007 15:04:56; debug? true; trace: 10] 135 | ;= #'user/pooled-db 136 | 137 | (fetch-results pooled-db ["SELECT * FROM authors"]) 138 | ; Dec 27, 2011 8:56:40 AM com.mchange.v2.c3p0.impl.AbstractPoolBackedDataSource getPoolManager 139 | ; INFO: Initializing c3p0 pool... com.mchange.v2.c3p0.ComboPooledDataSource 140 | ; [ acquireIncrement -> 3, acquireRetryAttempts -> 30, acquireRetryDelay -> 1000, ... 141 | ;= ({:id 1, :first_name "Chas", :last_name "Emerick"} 142 | ;= {:id 2, :first_name "Christophe", :last_name "Grand"} 143 | ;= {:id 3, :first_name "Brian", :last_name "Carper"}) 144 | 145 | (fetch-results pooled-db ["SELECT * FROM authors"]) 146 | ;= ({:id 1, :first_name "Chas", :last_name "Emerick"} 147 | ;= {:id 2, :first_name "Christophe", :last_name "Grand"} 148 | ;= {:id 3, :first_name "Brian", :last_name "Carper"}) 149 | 150 | 151 | 152 | ;----- 153 | (require '[clojure.java.jdbc :as jdbc]) 154 | 155 | (def db-spec {:classname "org.sqlite.JDBC" 156 | :subprotocol "sqlite" 157 | :subname "test.db"}) 158 | 159 | (defn setup 160 | [] 161 | (jdbc/with-connection db-spec 162 | (jdbc/create-table :country 163 | [:id "integer primary key"] 164 | [:country "varchar"]) 165 | (jdbc/create-table :author 166 | [:id "integer primary key"] 167 | [:country_id "integer constraint fk_country_id references country (id)"] 168 | [:first_name "varchar"] 169 | [:last_name "varchar"]) 170 | (jdbc/insert-records :country 171 | {:id 1 :country "USA"} 172 | {:id 2 :country "Canada"} 173 | {:id 3 :country "France"}) 174 | (jdbc/insert-records :author 175 | {:first_name "Chas" :last_name "Emerick" :country_id 1} 176 | {:first_name "Christophe" :last_name "Grand" :country_id 3} 177 | {:first_name "Brian" :last_name "Carper" :country_id 2} 178 | {:first_name "Mark" :last_name "Twain" :country_id 1}))) 179 | 180 | (setup) 181 | ;= ({:id 1, :country_id 1, :first_name "Chas", :last_name "Emerick"} 182 | ;= {:id 2, :country_id 3, :first_name "Christophe", :last_name "Grand"} 183 | ;= {:id 3, :country_id 2, :first_name "Brian", :last_name "Carper"} 184 | ;= {:id 4, :country_id 1, :first_name "Mark", :last_name "Twain"}) 185 | 186 | 187 | ;----- 188 | (use '[korma db core]) 189 | (defdb korma-db db-spec) 190 | 191 | 192 | ;----- 193 | (declare author) 194 | 195 | (defentity country 196 | (pk :id) 197 | (has-many author)) 198 | 199 | (defentity author 200 | (pk :id) 201 | (table :author) 202 | (belongs-to country)) 203 | 204 | 205 | ;----- 206 | (select author 207 | (with country) 208 | (where {:first_name "Chas"})) 209 | ;= [{:id 1, :country_id 1, :first_name "Chas", :last_name "Emerick", :id_2 1, :country "USA"}] 210 | 211 | 212 | ;----- 213 | (select author 214 | (with country) 215 | (where (like :first_name "Ch%")) 216 | (order :last_name :asc) 217 | (limit 1) 218 | (offset 1)) 219 | ;= [{:id 2, :country_id 3, :first_name "Christophe", :last_name "Grand", :id_2 3, :country "France"}] 220 | 221 | 222 | ;----- 223 | (select author 224 | (fields :first_name :last_name) 225 | (where (or (like :last_name "C%") 226 | (= :first_name "Mark")))) 227 | ;= [{:first_name "Brian", :last_name "Carper"} 228 | ;= {:first_name "Mark", :last_name "Twain"}] 229 | 230 | 231 | ;----- 232 | (println (sql-only (select author 233 | (with country) 234 | (where (like :first_name "Ch%")) 235 | (order :last_name :asc) 236 | (limit 1) 237 | (offset 1)))) 238 | ;= ; SELECT "author".* FROM "author" LEFT JOIN "country" 239 | ;= ; ON "country"."id" = "author"."country_id" 240 | ;= ; WHERE "author"."first_name" LIKE ? 241 | ;= ; ORDER BY "author"."last_name" ASC LIMIT 1 OFFSET 1 242 | 243 | 244 | ;----- 245 | (def query (-> (select* author) 246 | (fields :last_name :first_name) 247 | (limit 5))) 248 | ;= #'user/query 249 | 250 | 251 | ;----- 252 | {:group [], 253 | :from 254 | [{:table "author", 255 | :name "author", 256 | :pk :id, 257 | :db nil, 258 | :transforms (), 259 | :prepares (), 260 | :fields [], 261 | :rel 262 | {"country" 263 | #}}], 270 | :joins [], 271 | :where [], 272 | :ent 273 | {:table "author", 274 | :name "author", 275 | :pk :id, 276 | :db nil, 277 | :transforms (), 278 | :prepares (), 279 | :fields [], 280 | :rel 281 | {"country" 282 | #}}, 288 | :limit 5, 289 | :type :select, 290 | :alias nil, 291 | :options nil, 292 | :fields (:last_name :first_name), 293 | :results :results, 294 | :table "author", 295 | :order [], 296 | :modifiers [], 297 | :db nil, 298 | :aliases #{}} 299 | 300 | 301 | 302 | ;----- 303 | (def employees (where (select* employees) {:type "employee"})) 304 | 305 | ;; ... later ... 306 | (let [managers (-> employees 307 | (where {:role "manager"}) 308 | (order :last_name))] 309 | (doseq [e (exec managers)] 310 | ; ... process results ... 311 | )) 312 | 313 | 314 | ;----- 315 | (def humans (-> (select* humans) 316 | (order :date_of_birth))) 317 | 318 | (let [kings-of-germany (-> humans 319 | (where {:country "Germany" :profession "King"}))] 320 | (doseq [start (range 0 100 10) 321 | k (select kings-of-germany 322 | (offset start) 323 | (limit 10))] 324 | ...) 325 | 326 | 327 | 328 | ;----- 329 | (import 'org.hibernate.SessionFactory 330 | 'org.hibernate.cfg.Configuration 331 | 'com.clojurebook.hibernate.Author) 332 | 333 | 334 | ;----- 335 | public class HibernateUtil { 336 | private static final SessionFactory sessionFactory = buildSessionFactory(); 337 | 338 | private static SessionFactory buildSessionFactory() { 339 | try { 340 | return new Configuration().configure().buildSessionFactory(); 341 | } 342 | catch (Throwable ex) { 343 | System.err.println("Initial SessionFactory creation failed." + ex); 344 | throw new ExceptionInInitializerError(ex); 345 | } 346 | } 347 | 348 | public static SessionFactory getSessionFactory() { 349 | return sessionFactory; 350 | } 351 | } 352 | 353 | 354 | ;----- 355 | (defonce session-factory 356 | (delay (-> (Configuration.) 357 | .configure 358 | .buildSessionFactory))) 359 | 360 | 361 | ;----- 362 | public static void saveAuthors (Author... authors) { 363 | Session session = sessionFactory.openSession(); 364 | session.beginTransaction(); 365 | for (Author author : authors) { 366 | session.save(author); 367 | } 368 | session.getTransaction().commit(); 369 | session.close(); 370 | } 371 | 372 | saveAuthors(new Author("Christophe", "Grand"), new Author("Brian", "Carper"), ...); 373 | 374 | 375 | ;----- 376 | (defn add-authors 377 | [& authors] 378 | (with-open [session (.openSession @session-factory)] 379 | (let [tx (.beginTransaction session)] 380 | (doseq [author authors] 381 | (.save session author)) 382 | (.commit tx)))) 383 | 384 | (add-authors (Author. "Christophe" "Grand") (Author. "Brian" "Carper") (Author. "Chas" "Emerick")) 385 | 386 | 387 | ;----- 388 | Session session = HibernateUtil.getSessionFactory().openSession(); 389 | 390 | try { 391 | return (List)newSession.createQuery("from Author").list(); 392 | } finally { 393 | session.close(); 394 | } 395 | 396 | 397 | ;----- 398 | (defn get-authors 399 | [] 400 | (with-open [session (.openSession @session-factory)] 401 | (-> session 402 | (.createQuery "from Author") 403 | .list))) 404 | 405 | 406 | ;----- 407 | (for [{:keys [firstName lastName]} (map bean (get-authors))] 408 | (str lastName ", " firstName)) 409 | ;= ("Carper, Brian" "Emerick, Chas" "Grand, Christophe") 410 | 411 | 412 | ;----- 413 | (defmacro with-session 414 | [session-factory & body] 415 | `(with-open [~'session (.openSession ~(vary-meta session-factory assoc :tag 'SessionFactory))] 416 | ~@body)) 417 | 418 | 419 | ;----- 420 | (defn get-authors 421 | [] 422 | (with-session @session-factory 423 | (-> session 424 | (.createQuery "from Author") 425 | .list))) 426 | 427 | 428 | ;----- 429 | (defmacro with-transaction 430 | [& body] 431 | `(let [~'tx (.beginTransaction ~'session)] 432 | ~@body 433 | (.commit ~'tx))) 434 | 435 | 436 | ;----- 437 | (defn add-authors 438 | [& authors] 439 | (with-session @session-factory 440 | (with-transaction 441 | (doseq [author authors] 442 | (.save session author))))) 443 | 444 | 445 | -------------------------------------------------------------------------------- /ch14-rdbms/java/com/clojurebook/hibernate/Author.java: -------------------------------------------------------------------------------- 1 | package com.clojurebook.hibernate; 2 | 3 | import javax.persistence.GeneratedValue; 4 | import javax.persistence.Id; 5 | import javax.persistence.Entity; 6 | import org.hibernate.annotations.GenericGenerator; 7 | 8 | @Entity 9 | public class Author { 10 | private Long id; 11 | private String firstName; 12 | private String lastName; 13 | 14 | public Author () {} 15 | 16 | public Author (String firstName, String lastName) { 17 | this.firstName = firstName; 18 | this.lastName = lastName; 19 | } 20 | 21 | @Id 22 | @GeneratedValue(generator="increment") 23 | @GenericGenerator(name="increment", strategy = "increment") 24 | public Long getId () { 25 | return this.id; 26 | } 27 | public String getFirstName () { 28 | return this.firstName; 29 | } 30 | public String getLastName () { 31 | return this.lastName; 32 | } 33 | 34 | public void setId (Long id) { 35 | this.id = id; 36 | } 37 | public void setFirstName (String firstName) { 38 | this.firstName = firstName; 39 | } 40 | public void setLastName (String lastName) { 41 | this.lastName = lastName; 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /ch14-rdbms/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook/rdbms "1.0.0" 2 | :description "Examples for working with relational databases using Clojure. 3 | SQLite is assumed here, but everything should translate to your 4 | preferred database with a minimal of hassle." 5 | :dependencies [[org.clojure/clojure "1.3.0"] 6 | [org.clojure/java.jdbc "0.1.1"] 7 | [c3p0/c3p0 "0.9.1.2"] 8 | 9 | ; SQLite JDBC driver 10 | [org.xerial/sqlite-jdbc "3.7.2"] 11 | 12 | ; only needed for korma 13 | [korma "0.3.0-alpha11"] 14 | 15 | ; only needed for hibernate 16 | [org.hibernate/hibernate-core "4.0.0.Final"]] 17 | 18 | ; only needed for hibernate 19 | :java-source-path "java" 20 | :resources-path "rsrc") -------------------------------------------------------------------------------- /ch14-rdbms/rsrc/hibernate.cfg.xml: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | org.sqlite.JDBC 6 | jdbc:sqlite::memory: 7 | org.hibernate.dialect.HSQLDialect 8 | 9 | create 10 | 11 | 12 | -------------------------------------------------------------------------------- /ch14-rdbms/src/com/clojurebook/hibernate.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.hibernate 2 | (:import (javax.persistence Id Entity GeneratedValue) 3 | org.hibernate.annotations.GenericGenerator 4 | org.hibernate.SessionFactory 5 | org.hibernate.cfg.Configuration 6 | com.clojurebook.hibernate.Author)) 7 | 8 | (defonce session-factory 9 | (delay (-> (Configuration.) 10 | .configure 11 | .buildSessionFactory))) 12 | 13 | (defn add-authors 14 | [& authors] 15 | (with-open [session (.openSession @session-factory)] 16 | (let [tx (.beginTransaction session)] 17 | (doseq [author authors] 18 | (.save session author)) 19 | (.commit tx)))) 20 | 21 | (defn get-authors 22 | [] 23 | (with-open [session (.openSession @session-factory)] 24 | (-> session 25 | (.createQuery "from Author") 26 | .list))) 27 | 28 | (defmacro with-session 29 | [session-factory & body] 30 | `(with-open [~'session (.openSession ~(with-meta session-factory '{:tag SessionFactory}))] 31 | ~@body)) 32 | 33 | (defn get-authors 34 | "A simplified implementation of get-authors, benefitting from the 35 | with-session macro." 36 | [] 37 | (with-session @session-factory 38 | (-> session 39 | (.createQuery "from Author") 40 | .list))) 41 | 42 | (defn get-authors 43 | "A simplified implementation of get-authors, benefitting from the 44 | with-session macro." 45 | [] 46 | (with-session @session-factory 47 | (-> session 48 | (.createQuery "from ClojureAuthor") 49 | .list))) 50 | 51 | (defmacro with-transaction 52 | [& body] 53 | `(let [tx# (.beginTransaction ~'session)] 54 | ~@body 55 | (.commit tx#))) 56 | 57 | (defn add-authors 58 | "A simplified implementation of add-authors, benefitting from the 59 | with-session and with-transaction macros." 60 | [& authors] 61 | (with-session @session-factory 62 | (with-transaction 63 | (doseq [author authors] 64 | (.save session author))))) 65 | -------------------------------------------------------------------------------- /ch15-couchdb-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | 2 | ;----- 3 | (use '[com.ashafa.clutch :only (create-database with-db put-document 4 | get-document delete-document) 5 | :as clutch]) 6 | 7 | (def db (create-database "repl-crud")) 8 | 9 | (put-document db {:_id "foo" :some-data "bar"}) 10 | ;= {:_rev "1-2bd2719826", :some-data "bar", :_id "foo"} 11 | (put-document db (assoc *1 :other-data "quux")) 12 | ;= {:other-data "quux", :_rev "2-9f29b39770", :some-data "bar", :_id "foo"} 13 | (get-document db "foo") 14 | ;= {:_id "foo", :_rev "2-9f29b39770", :other-data "quux", :some-data "bar"} 15 | (delete-document db *1) 16 | ;= {:ok true, :id "foo", :rev "3-3e98dd1028"} 17 | (get-document db "foo") 18 | ;= nil 19 | 20 | 21 | ;----- 22 | (clutch/create-document {:_id "foo" 23 | :data ["bar" {:details ["bat" false 42]}]}) 24 | ;= {:_id "foo", :data ["bar" {:details ["bat" false 42]}], 25 | ;= :_rev "1-6d7460947434b90bf88f033785f81cdd"} 26 | (->> (get-document db "foo") 27 | :data 28 | second 29 | :details 30 | (filter number?)) 31 | ;= (42) 32 | 33 | 34 | ;----- 35 | (clutch/bulk-update (create-database "logging") 36 | [{:evt-type "auth/new-user" :username "Chas"} 37 | {:evt-type "auth/new-user" :username "Dave"} 38 | {:evt-type "sales/purchase" :username "Chas" :products ["widget1"]} 39 | {:evt-type "sales/purchase" :username "Robin" :products ["widget14"]} 40 | {:evt-type "sales/RFQ" :username "Robin" :budget 20000}]) 41 | 42 | 43 | 44 | ;----- 45 | (clutch/save-view "logging" "jsviews" 46 | (clutch/view-server-fns :javascript 47 | {:type-counts 48 | {:map "function(doc) { 49 | emit(doc['evt-type'], null); 50 | }" 51 | :reduce "function (keys, vals, rereduce) { 52 | return vals.length; 53 | }"}})) 54 | 55 | 56 | ;----- 57 | (clutch/get-view "logging" "jsviews" :type-counts {:group true}) 58 | ;= ({:key "auth/new-user", :value 2} 59 | ;= {:key "sales/purchase", :value 2} 60 | ;= {:key "sales/RFQ", :value 1}) 61 | 62 | 63 | ;----- 64 | (->> (clutch/get-view "logging" "jsviews" :type-counts {:group true}) 65 | (map (juxt :key :value)) 66 | (into {})) 67 | ;= {"auth/new-user" 2, "sales/purchase" 2, "sales/RFQ" 1} 68 | 69 | 70 | ;----- 71 | (use '[com.ashafa.clutch.view-server :only (view-server-exec-string)]) 72 | 73 | (clutch/configure-view-server "http://localhost:5984" (view-server-exec-string)) 74 | ;= "" 75 | 76 | 77 | ;----- 78 | (clutch/save-view "logging" "clj-views" 79 | (clutch/view-server-fns :clojure 80 | {:type-counts 81 | {:map (fn [doc] 82 | [[(:evt-type doc) nil]]) 83 | :reduce (fn [keys vals rereduce] 84 | (count vals))}})) 85 | 86 | 87 | ;----- 88 | (->> (clutch/get-view "logging" "clj-views" :type-counts {:group true}) 89 | (map (juxt :key :value)) 90 | (into {})) 91 | ;= {"auth/new-user" 2, "sales/purchase" 2, "sales/RFQ" 1} 92 | 93 | 94 | ;----- 95 | (ns eventing.types) 96 | 97 | (derive 'sales/purchase 'sales/all) 98 | (derive 'sales/purchase 'finance/accounts-receivable) 99 | (derive 'finance/accounts-receivable 'finance/all) 100 | (derive 'finance/all 'events/all) 101 | (derive 'sales/all 'events/all) 102 | (derive 'sales/RFQ 'sales/lead-generation) 103 | (derive 'sales/lead-generation 'sales/all) 104 | (derive 'auth/new-user 'sales/lead-generation) 105 | (derive 'auth/new-user 'security/all) 106 | (derive 'security/all 'events/all) 107 | 108 | 109 | ;----- 110 | (clutch/save-view "logging" "clj-views" 111 | (clutch/view-server-fns :clojure 112 | {:type-counts 113 | {:map (do 114 | (require 'eventing.types) 115 | (fn [doc] 116 | (let [concrete-type (-> doc :evt-type symbol)] 117 | (for [evtsym (cons concrete-type 118 | (ancestors concrete-type))] 119 | [(str evtsym) nil])))) 120 | :reduce (fn [keys vals rereduce] 121 | (count vals))}})) 122 | 123 | (->> (clutch/with-db "logging" 124 | (clutch/get-view "clj-views" :type-counts {:group true})) 125 | (map (juxt :key :value)) 126 | (into {})) 127 | ;= {"events/all" 5, 128 | ;= "sales/all" 5, 129 | ;= "finance/all" 2, 130 | ;= "finance/accounts-receivable" 2, 131 | ;= "sales/lead-generation" 3, 132 | ;= "sales/purchase" 2, 133 | ;= "sales/RFQ" 1, 134 | ;= "security/all" 2, 135 | ;= "auth/new-user" 2} 136 | 137 | 138 | ;----- 139 | (clutch/create-database "changes") 140 | (clutch/watch-changes "changes" :echo (partial println "changes:")) 141 | 142 | (clutch/bulk-update "changes" [{:_id "doc1"} {:_id "doc2"}]) 143 | ;= [{:id "doc1", :rev "5-f36e792166"} 144 | ;= {:id "doc2", :rev "3-5570e8bbb3"}] 145 | ; change: {:seq 7, :id doc1, :changes [{:rev 5-f36e792166}]} 146 | ; change: {:seq 8, :id doc2, :changes [{:rev 3-5570e8bbb3}]} 147 | (clutch/delete-document "changes" (zipmap [:_id :_rev] 148 | ((juxt :id :rev) (first *1)))) 149 | ;= {:ok true, :id "doc1", :rev "6-616e3df68"} 150 | ; change: {:seq 9, :id doc1, :changes [{:rev 6-616e3df68}], :deleted true} 151 | (clutch/stop-changes "changes" :echo) 152 | ;= nil 153 | 154 | 155 | ;----- 156 | {:evt-type "auth/new-user" :username "Chas"} 157 | {:evt-type "auth/new-user" :username "Dave"} 158 | {:evt-type "sales/purchase" :username "Chas" :products ["widget1"]} 159 | {:evt-type "sales/purchase" :username "Robin" :products ["widget14"]} 160 | {:evt-type "sales/RFQ" :username "Robin" :budget 20000} 161 | 162 | 163 | ;----- 164 | (ns eventing.processing) 165 | 166 | (derive 'sales/lead-generation 'processing/realtime) 167 | (derive 'sales/purchase 'processing/realtime) 168 | 169 | (derive 'security/all 'processing/archive) 170 | (derive 'finance/all 'processing/archive) 171 | 172 | 173 | ;----- 174 | (clutch/save-filter "logging" "event-filters" 175 | (clutch/view-server-fns :clojure 176 | {:event-isa? (do 177 | (require '[eventing types processing]) 178 | (fn [doc request] 179 | (let [req-type (-> request :query :type) 180 | evt-type (:evt-type doc)] 181 | (and req-type evt-type 182 | (isa? (symbol evt-type) (symbol req-type))))))})) 183 | 184 | 185 | ;----- 186 | (clutch/watch-changes "logging" :echo-leads (partial println "change:") 187 | :filter "event-filters/event-isa?" 188 | :type "sales/lead-generation" 189 | :include_docs true) 190 | 191 | (clutch/put-document "logging" 192 | {:evt-type "sales/RFQ" :username "Lilly" :budget 20000}) 193 | ;= {:_id "8f264da359f887ec3e86c8d34801704b", 194 | ;= :_rev "1-eb10044985c9dccb731bd5f31d0188c6", 195 | ;= :budget 20000, :evt-type "sales/RFQ", :username "Lilly"} 196 | ; change: {:seq 26, :id 8f264da359f887ec3e86c8d34801704b, 197 | ; :changes [{:rev 1-eb10044985c9dccb731bd5f31d0188c6}], 198 | ; :doc {:_id 8f264da359f887ec3e86c8d34801704b, 199 | ; :_rev 1-eb10044985c9dccb731bd5f31d0188c6, 200 | ; :budget 20000, 201 | ; :evt-type sales/RFQ, 202 | ; :username Lilly}} 203 | (clutch/stop-changes "logging" :echo-leads) 204 | ;= nil 205 | 206 | 207 | ;----- 208 | (ns eventing.processing) 209 | 210 | (defmulti process-event :evt-type) 211 | 212 | 213 | ;----- 214 | (ns salesorg.event-handling 215 | (use [eventing.processing :only (process-event)])) 216 | 217 | (defmethod process-event 'sales/purchase 218 | [evt] 219 | (println (format "We made a sale of %s to %s!" (:products evt) (:username evt)))) 220 | 221 | (defmethod process-event 'sales/lead-generation 222 | [evt] 223 | (println "Add prospect to CRM system: " evt)) 224 | 225 | 226 | ;----- 227 | (require 'eventing.processing 'salesorg.event-handling) 228 | 229 | (clutch/watch-changes "logging" :process-events 230 | #(-> % 231 | :doc 232 | (dissoc :_id :_rev) 233 | (update-in [:evt-type] symbol) 234 | eventing.processing/process-event) 235 | :filter "event-filters/event-isa?" 236 | :type "processing/realtime" 237 | :include_docs true) 238 | 239 | (clutch/bulk-update "logging" 240 | [{:evt-type "auth/new-user" :username "Chas"} 241 | {:evt-type "auth/new-user" :username "Dave"} 242 | {:evt-type "sales/purchase" :username "Chas" :products ["widget1"]} 243 | {:evt-type "sales/purchase" :username "Robin" :products ["widget14"]} 244 | {:evt-type "sales/RFQ" :username "Robin" :budget 20000}]) 245 | ; Add prospect to CRM system: {:evt-type auth/new-user, :username Chas} 246 | ; Add prospect to CRM system: {:evt-type auth/new-user, :username Dave} 247 | ; We made a sale of ["widget1"] to Chas! 248 | ; We made a sale of ["widget14"] to Robin! 249 | ; Add prospect to CRM system: {:budget 20000, :evt-type sales/RFQ, :username Robin} 250 | 251 | 252 | -------------------------------------------------------------------------------- /ch15-couchdb/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook/couchdb-examples "1.0.0" 2 | :dependencies [[org.clojure/clojure "1.3.0"] 3 | [com.ashafa/clutch "0.3.0"]]) 4 | -------------------------------------------------------------------------------- /ch15-couchdb/src/eventing/processing.clj: -------------------------------------------------------------------------------- 1 | (ns eventing.processing) 2 | 3 | (derive 'sales/lead-generation 'processing/realtime) 4 | (derive 'sales/purchase 'processing/realtime) 5 | 6 | (derive 'security/all 'processing/archive) 7 | (derive 'finance/all 'processing/archive) 8 | 9 | 10 | 11 | (defmulti process-event :evt-type) 12 | -------------------------------------------------------------------------------- /ch15-couchdb/src/eventing/types.clj: -------------------------------------------------------------------------------- 1 | (ns eventing.types) 2 | 3 | (derive 'sales/purchase 'sales/all) 4 | (derive 'sales/purchase 'finance/accounts-receivable) 5 | (derive 'finance/accounts-receivable 'finance/all) 6 | (derive 'finance/all 'events/all) 7 | (derive 'sales/all 'events/all) 8 | (derive 'sales/RFQ 'sales/lead-generation) 9 | (derive 'sales/lead-generation 'sales/all) 10 | (derive 'auth/new-user 'sales/lead-generation) 11 | (derive 'auth/new-user 'security/all) 12 | (derive 'security/all 'events/all) 13 | -------------------------------------------------------------------------------- /ch15-couchdb/src/salesorg/event_handling.clj: -------------------------------------------------------------------------------- 1 | (ns salesorg.event-handling 2 | (use [eventing.processing :only (process-event)])) 3 | 4 | (defmethod process-event 'sales/purchase 5 | [evt] 6 | (println (format "We made a sale of %s to %s!" (:products evt) (:username evt)))) 7 | 8 | (defmethod process-event 'sales/lead-generation 9 | [evt] 10 | (println "Add prospect to CRM system: " evt)) 11 | -------------------------------------------------------------------------------- /ch16-web-leiningen/README: -------------------------------------------------------------------------------- 1 | # web 2 | 3 | FIXME: write description 4 | 5 | ## Usage 6 | 7 | FIXME: write 8 | 9 | ## License 10 | 11 | Copyright (C) 2011 FIXME 12 | 13 | Distributed under the Eclipse Public License, the same as Clojure. 14 | -------------------------------------------------------------------------------- /ch16-web-leiningen/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook/url-shortener "1.0.0-SNAPSHOT" 2 | :description "A toy URL shortener HTTP service written using Ring and Compojure." 3 | :dependencies [[org.clojure/clojure "1.3.0"] 4 | [compojure "1.0.1"] 5 | [ring "1.0.1"]] 6 | :plugins [[lein-beanstalk "0.2.2"]] 7 | :ring {:handler com.clojurebook.url-shortener.beanstalk/app}) 8 | -------------------------------------------------------------------------------- /ch16-web-leiningen/src/com/clojurebook/url_shortener.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.url-shortener 2 | (:use [compojure.core :only (GET PUT POST defroutes)]) 3 | (:require (compojure handler route) 4 | [ring.util.response :as response])) 5 | 6 | (def ^:private counter (atom 0)) 7 | 8 | (def ^:private mappings (ref {})) 9 | 10 | (defn url-for 11 | [id] 12 | (@mappings id)) 13 | 14 | (defn shorten! 15 | "Stores the given URL under a new unique identifier, or the given identifier 16 | if provided. Returns the identifier as a string. 17 | Modifies the global mapping accordingly." 18 | ([url] 19 | (let [id (swap! counter inc) 20 | id (Long/toString id 36)] 21 | (or (shorten! url id) 22 | (recur url)))) 23 | ([url id] 24 | (dosync 25 | (when-not (@mappings id) 26 | (alter mappings assoc id url) 27 | id)))) 28 | 29 | (defn retain 30 | [& [url id :as args]] 31 | (if-let [id (apply shorten! args)] 32 | {:status 201 33 | :headers {"Location" id} 34 | :body (format "URL %s assigned the short identifier %s" url id)} 35 | {:status 409 :body (format "Short URL %s is already taken" id)})) 36 | 37 | (defn redirect 38 | [id] 39 | (if-let [url (url-for id)] 40 | (response/redirect url) 41 | {:status 404 :body (str "No such short URL: " id)})) 42 | 43 | (defroutes app* 44 | (GET "/" request "Welcome!") 45 | (PUT "/:id" [id url] (retain url id)) 46 | (POST "/" [url] (if (empty? url) 47 | {:status 400 :body "No `url` parameter provided"} 48 | (retain url))) 49 | (GET "/:id" [id] (redirect id)) 50 | (GET "/list/" [] (interpose "\n" (keys @mappings))) 51 | (compojure.route/not-found "Sorry, there's nothing here.")) 52 | 53 | (def app (compojure.handler/api app*)) 54 | 55 | ;; ; To run locally: 56 | ;; (use '[ring.adapter.jetty :only (run-jetty)]) 57 | ;; (def server (run-jetty #'app {:port 8080 :join? false})) -------------------------------------------------------------------------------- /ch16-web-leiningen/src/com/clojurebook/url_shortener/beanstalk.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.url-shortener.beanstalk 2 | (:use [compojure.core :only (HEAD defroutes)]) 3 | (:require [com.clojurebook.url-shortener :as shortener] 4 | [compojure.core :as compojure])) 5 | 6 | (compojure/defroutes app 7 | ; This HEAD route is here because Amazon's Elastic Beanstalk determines if 8 | ; your application is up by whether it responds successfully to a 9 | ; HEAD request at / 10 | (compojure/HEAD "/" [] "") 11 | shortener/app) 12 | -------------------------------------------------------------------------------- /ch16-web-leiningen/src/web/core.clj: -------------------------------------------------------------------------------- 1 | (ns web.core) 2 | -------------------------------------------------------------------------------- /ch16-web-leiningen/test/web/test/core.clj: -------------------------------------------------------------------------------- 1 | (ns web.test.core 2 | (:use [web.core]) 3 | (:use [clojure.test])) 4 | 5 | (deftest replace-me ;; FIXME: write 6 | (is false "No tests have been written.")) 7 | -------------------------------------------------------------------------------- /ch16-web-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | {:remote-addr "127.0.0.1", 3 | :scheme :http, 4 | :request-method :get, 5 | :query-string "q=Acme", 6 | :content-type nil, 7 | :uri "/accounts", 8 | :server-name "company.com", 9 | :content-length nil, 10 | :server-port 8080, 11 | :body #, 12 | :headers 13 | {"user-agent" "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6) Firefox/8.0.1", 14 | "accept-charset" "ISO-8859-1,utf-8;q=0.7,*;q=0.7", 15 | "accept" "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8", 16 | "accept-encoding" "gzip, deflate", 17 | "accept-language" "en-us,en;q=0.5", 18 | "connection" "keep-alive"}} 19 | 20 | 21 | ;----- 22 | {:status 200 23 | :headers {"Content-Type" "text/html"} 24 | :body "..."} 25 | 26 | 27 | ;----- 28 | {:status 200 29 | :headers {"Content-Type" "image/png"} 30 | :body (java.io.File. "/path/to/file.png")} 31 | 32 | 33 | ;----- 34 | {:status 201 :headers {}} 35 | 36 | 37 | ;----- 38 | [ring "1.0.0"] 39 | 40 | 41 | ;----- 42 | (use '[ring.adapter.jetty :only (run-jetty)]) 43 | ;= nil 44 | (defn app 45 | [{:keys [uri]}] 46 | {:body (format "You requested %s" uri)}) 47 | ;= #'user/app 48 | (def server (run-jetty #'app {:port 8080 :join? false})) 49 | ;= #'user/server 50 | 51 | 52 | ;----- 53 | (defn app 54 | [{:keys [uri query-string]}] 55 | {:body (format "You requested %s with query %s" uri query-string)}) 56 | ;= #'user/app 57 | 58 | 59 | ;----- 60 | (use '[ring.middleware.params :only (wrap-params)]) 61 | ;= nil 62 | (defn app* 63 | [{:keys [uri params]}] 64 | {:body (format "You requested %s with query %s" uri params)}) 65 | ;= #'user/app* 66 | (def app (wrap-params app*)) 67 | ;= #'user/app 68 | 69 | 70 | ;----- 71 | [compojure "1.0.0"] 72 | [ring "1.0.0"] 73 | 74 | 75 | ;----- 76 | (def ^:private counter (atom 0)) 77 | 78 | (def ^:private mappings (ref {})) 79 | 80 | 81 | ;----- 82 | (defn url-for 83 | [id] 84 | (@mappings id)) 85 | 86 | (defn shorten! 87 | "Stores the given URL under a new unique identifier, or the given identifier 88 | if provided. Returns the identifier as a string. 89 | Modifies the global mapping accordingly." 90 | ([url] 91 | (let [id (swap! counter inc) 92 | id (Long/toString id 36)] 93 | (or (shorten! url id) 94 | (recur url)))) 95 | ([url id] 96 | (dosync 97 | (when-not (@mappings id) 98 | (alter mappings assoc id url) 99 | id)))) 100 | 101 | 102 | ;----- 103 | (shorten! "http://clojurebook.com") 104 | ;= "1" 105 | (shorten! "http://clojure.org" "clj") 106 | ;= "clj" 107 | (shorten! "http://id-already-exists.com" "clj") 108 | ;= nil 109 | @mappings 110 | ;= {"clj" "http://clojure.org", "1" "http://clojurebook.com"} 111 | 112 | 113 | ;----- 114 | (defn retain 115 | [& [url id :as args]] 116 | (if-let [id (apply shorten! args)] 117 | {:status 201 118 | :headers {"Location" id} 119 | :body (list "URL " url " assigned the short identifier " id)} 120 | {:status 409 :body (format "Short URL %s is already taken" id)})) 121 | 122 | 123 | ;----- 124 | (require 'ring.util.response) 125 | 126 | (defn redirect 127 | [id] 128 | (if-let [url (url-for id)] 129 | (ring.util.response/redirect url) 130 | {:status 404 :body (str "No such short URL: " id)})) 131 | 132 | 133 | ;----- 134 | (use '[compojure.core :only (GET PUT POST defroutes)]) 135 | (require 'compojure.route) 136 | 137 | (defroutes app* 138 | (GET "/" request "Welcome!") 139 | (PUT "/:id" [id url] (retain url id)) 140 | (POST "/" [url] (retain url)) 141 | (GET "/:id" [id] (redirect id)) 142 | (GET "/list/" [] (interpose "\n" (keys @mappings))) 143 | (compojure.route/not-found "Sorry, there's nothing here.")) 144 | 145 | 146 | ;----- 147 | (PUT "/:id" [id url] (retain url id)) 148 | 149 | 150 | ;----- 151 | ((PUT "/:id" 152 | [id url] 153 | (list "You requested that " url " be assigned id " id)) 154 | {:uri "/some-id" :params {:url "http://clojurebook.com"} :request-method :put}) 155 | ;= {:status 200, :headers {"Content-Type" "text/html"}, 156 | ;= :body ("You requested that " "http://clojurebook.com" " be assigned id " "some-id")} 157 | 158 | 159 | ;----- 160 | ((PUT ["/*/*/:id/:id"] 161 | [* id] 162 | (str * id)) 163 | {:uri "/abc/xyz/foo/bar" :request-method :put}) 164 | ;= {:status 200, :headers {"Content-Type" "text/html"}, 165 | ;= :body "[\"abc\" \"xyz\"][\"foo\" \"bar\"]"} 166 | 167 | 168 | ;----- 169 | ((PUT ["/:id" :id #"\d+"] 170 | [id url] 171 | (list "You requested that " url " be assigned id " id)) 172 | {:uri "/some-id" :params {:url "http://clojurebook.com"} :request-method :put}) 173 | ;= nil 174 | ((PUT ["/:id" :id #"\d+"] 175 | [id url] 176 | (list "You requested that " url " be assigned id " id)) 177 | {:uri "/590" :params {:url "http://clojurebook.com"} :request-method :put}) 178 | ;= {:status 200, :headers {"Content-Type" "text/html"}, 179 | ;= :body "You requested that http://clojurebook.com be assigned id 590"} 180 | 181 | 182 | ;----- 183 | ((PUT "/:id" req (str "You requested: " (:uri req))) 184 | {:uri "/foo" :request-method :put}) 185 | ;= {:status 200, :headers {"Content-Type" "text/html"}, :body "You requested: /foo"} 186 | ((PUT "/:id" {:keys [uri]} (str "You requested: " uri)) 187 | {:uri "/foo" :request-method :put}) 188 | ;= {:status 200, :headers {"Content-Type" "text/html"}, :body "You requested: /foo"} 189 | 190 | 191 | ;----- 192 | (require 'compojure.handler) 193 | 194 | (def app (compojure.handler/api app*)) 195 | 196 | 197 | ;----- 198 | (use '[ring.adapter.jetty :only (run-jetty)]) 199 | ;= nil 200 | (def server (run-jetty #'app {:port 8080 :join? false})) 201 | ;= #'user/server 202 | 203 | 204 | 205 | ;----- 206 | (defroutes app+admin 207 | (GET "/admin/" request ...) 208 | (POST "/admin/some-admin-action" request ...) 209 | app*) 210 | 211 | 212 | 213 | ;----- 214 | (require '[net.cgrand.enlive-html :as h]) 215 | ;= nil 216 | (h/sniptest "

Lorem Ipsum

") 217 | ;= "

Lorem Ipsum

" 218 | 219 | 220 | ;----- 221 | (h/sniptest "

Lorem Ipsum

" 222 | [:h1] (h/content "Hello Reader!")) 223 | ;= "

Hello Reader!

" 224 | 225 | 226 | ;----- 227 | (h/html-snippet "

x, y, z

") 228 | ;= ({:tag :p, 229 | ;= :attrs nil, 230 | ;= :content 231 | ;= ("x, " 232 | ;= {:tag :a, :attrs {:href "/", :id "home"}, :content ("y")} 233 | ;= ", " 234 | ;= {:tag :a, :attrs {:href ".."}, :content ("z")})}) 235 | 236 | 237 | ;----- 238 | (h/sniptest "

x, y, z

" 239 | [:a#home] (h/set-attr :href "http://clojurebook.com") 240 | [[:a (h/attr= :href "..")]] (h/content "go up")) 241 | ;= "

x, y, go up

" 242 | 243 | 244 | ;----- 245 | (h/sniptest "

" 246 | [[:p (h/attr? :class)]] (h/content "XXX")) 247 | ;= "

XXX

" 248 | 249 | (h/sniptest "

" 250 | [:p (h/attr? :class)] (h/content "XXX")) 251 | ;= "

XXX

" 252 | 253 | 254 | ;----- 255 | (defn some-attr= 256 | "Selector step, matches elements where at least one attribute 257 | has the specified value." 258 | [value] 259 | (h/pred (fn [node] 260 | (some #{value} (vals (:attrs node)))))) 261 | 262 | 263 | ;----- 264 | (h/sniptest "
  • A
  • B
  • C
" 265 | [(some-attr= "foo")] (h/set-attr :found "yes")) 266 | ;= "
    267 | ;=
  • A
    • 268 | ;=
  • B
    • 269 | ;=
  • C
    • 270 | ;=
" 271 | 272 | 273 | ;----- 274 | (defn display 275 | [msg] 276 | (h/sniptest "
" 277 | [:.msg] (when msg (h/content msg)))) 278 | ;= #'user/display 279 | (display "Welcome back!") 280 | ;= "
Welcome back!
" 281 | (display nil) 282 | ;= "
" 283 | 284 | 285 | ;----- 286 | (defn display 287 | [msg] 288 | (h/sniptest "
" 289 | [:.msg] (if msg 290 | (h/content msg) 291 | (h/add-class "hidden")))) 292 | ;= #'user/display 293 | (display nil) 294 | ;= "
" 295 | 296 | 297 | ;----- 298 | (defn countdown 299 | [n] 300 | (h/sniptest "
" 301 | [:li] (h/clone-for [i (range n 0 -1)] 302 | (h/content (str i))))) 303 | ;= #'user/countdown 304 | (countdown 0) 305 | ;= "
    " 306 | (countdown 3) 307 | ;= "
    • 3
    • 2
    • 1
    " 308 | 309 | 310 | ;----- 311 | (defn countdown 312 | [n] 313 | (h/sniptest "
    " 314 | [:#foo] (h/do-> 315 | (h/remove-attr :id) 316 | (h/clone-for [i (range n 0 -1)] 317 | (h/content (str i)))))) 318 | ;= #'user/countdown 319 | (countdown 3) 320 | ;= "
    • 3
    • 2
    • 1
    " 321 | 322 | 323 | 324 | ;----- 325 | (h/defsnippet footer "footer.html" [:.footer] 326 | [message] 327 | [:.footer] (h/content message)) 328 | 329 | 330 | ;----- 331 | (footer "hello") 332 | ;= ({:tag :div, :attrs {:class "footer"}, :content ("hello")}) 333 | 334 | 335 | 336 | ;----- 337 | (h/deftemplate friends-list "friends.html" 338 | [username friends] 339 | [:.username] (h/content username) 340 | [:ul.friends :li] (h/clone-for [f friends] 341 | (h/content f))) 342 | 343 | (friends-list "Chas" ["Christophe" "Brian"]) 344 | ;= ("" "" "

    " "Hello, " "" 345 | ;= "Chas" "" "

    " "\n" "

    These are your friends:

    " 346 | ;= "\n" "
      " "
    • " "Christophe" "
      • " "
    • " 347 | ;= "Brian" "
      • " "
    " "\n" "" "") 348 | 349 | 350 | ;----- 351 | (h/deftemplate friends-list "friends.html" 352 | [username friends friend-class] 353 | [:.username] (h/content username) 354 | [:ul.friends :li] (h/clone-for [f friends] 355 | (h/do-> (h/content f) 356 | (h/add-class friend-class)))) 357 | 358 | (friends-list "Chas" ["Christophe" "Brian"] "programmer") 359 | ;= ("" "" "

    " "Hello, " "" "Chas" 360 | ;= "" "

    " "\n" "

    These are your friends:

    " "\n" 361 | ;= "
      " "<" "li" " " "class" "=\"" "programmer" "\"" 362 | ;= ">" "Christophe" "" "<" "li" " " "class" "=\"" "programmer" 363 | ;= "\"" ">" "Brian" "" "
    " "\n" "" "") 364 | 365 | 366 | ;----- 367 | (h/deftemplate friends-list "friends.html" 368 | [username friends friend-class] 369 | [:.username] (h/content username) 370 | [:ul.friends :li] (h/clone-for [f friends] 371 | (h/do-> (h/content f) 372 | (h/add-class friend-class))) 373 | [:body] (h/append (footer (str "Goodbye, " username)))) 374 | 375 | (friends-list "Chas" ["Christophe" "Brian"] "programmer") 376 | ;= ("" "" "

    " "Hello, " "" "Chas" 377 | ;= "" "

    " "\n" "

    These are your friends:

    " "\n" 378 | ;= "
      " "<" "li" " " "class" "=\"" "programmer" "\"" 379 | ;= ">" "Christophe" "" "<" "li" " " "class" "=\"" "programmer" 380 | ;= "\"" ">" "Brian" "" "
    " "\n" "
    " 381 | ;= "Goodbye, Chas" "
    " "" "") 382 | 383 | 384 | -------------------------------------------------------------------------------- /ch17-webapp-lein/project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.clojurebook/sample-lein-web-project "1.0.0-SNAPSHOT" 2 | :dependencies [[org.clojure/clojure "1.3.0"] 3 | [compojure/compojure "1.0.0"] 4 | [ring/ring-servlet "1.0.1"]] 5 | :plugins [[lein-ring "0.6.2"]] 6 | :ring {:handler com.clojurebook.hello-world/routes}) 7 | -------------------------------------------------------------------------------- /ch17-webapp-lein/resources/public/wright_pond.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojurebook/ClojureProgramming/bcc7c58862982a5793e22788fc11a9ed7ffc548f/ch17-webapp-lein/resources/public/wright_pond.jpg -------------------------------------------------------------------------------- /ch17-webapp-lein/src/com/clojurebook/hello_world.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.hello-world 2 | (:use 3 | [compojure.core :only (GET defroutes)] 4 | [compojure.route :only (resources)])) 5 | 6 | (defroutes routes 7 | (resources "/") 8 | (GET "*" {:keys [uri]} 9 | (format " 10 | URL requested: %s 11 |

    12 | 13 | Image served by compojure.route/resources 14 | 15 |

    16 | " 17 | uri))) -------------------------------------------------------------------------------- /ch17-webapp-maven/.gitignore: -------------------------------------------------------------------------------- 1 | # emacs + vi backup files 2 | *~ 3 | .*.sw* 4 | 5 | # various IDE junk 6 | *.ipr 7 | *.iml 8 | *.iws 9 | .project 10 | .classpath 11 | .settings 12 | 13 | target 14 | -------------------------------------------------------------------------------- /ch17-webapp-maven/README.md: -------------------------------------------------------------------------------- 1 | ## _Clojure Programming_, Chapter 17 2 | 3 | ### Packaging and running Clojure web applications with Maven and Jetty 4 | 5 | This project contains a simple Clojure web application that can be 6 | started and reloaded using Maven and Jetty via the maven-jetty-plugin. 7 | 8 | #### Packaging 9 | 10 | Maven makes it easy to package up a Clojure webapp up as a standard war 11 | file, which can then be deployed directly to any standard Java web app 12 | container, or to any of the cloud platforms that support Java/war 13 | deployment. 14 | 15 | In a terminal: 16 | 17 | ``` 18 | $ mvn package 19 | ``` 20 | 21 | This will produce the war file in the `target` subdirectory. 22 | 23 | #### Running 24 | 25 | In a terminal: 26 | 27 | ``` 28 | $ mvn jetty:run 29 | ``` 30 | 31 | (…or, if you're using Eclipse or another IDE with "built 32 | in" Maven support, you can run the `jetty:run` goal in it…) 33 | 34 | This will start the Jetty server on port 8080, running the Clojure 35 | webapp. 36 | 37 | You can restart the Jetty server by hitting return in the terminal. It 38 | is possible to use this mechanism to reload the Clojure application 39 | after making changes, etc., but a far more flexible and efficient 40 | approach to interactive development would be to either: 41 | 42 | * include a REPL server (either 43 | [nREPL](http://github.com/clojure/tools.nrepl) or 44 | [swank](https://github.com/technomancy/swank-clojure)) in your webapp, 45 | and connect to it from your development environment (e.g. 46 | [Counterclockwise / Eclipse](http://code.google.com/p/counterclockwise/) 47 | or 48 | [Emacs](http://dev.clojure.org/display/doc/Getting+Started+with+Emacs) 49 | or [vim](http://dev.clojure.org/display/doc/Getting+Started+with+Vim) or 50 | your other favorite editor/IDE that provides quality Clojure REPL 51 | support). From there, you can load new code into the running webapp 52 | with abandon. 53 | * start the Jetty server from a REPL using the ring-jetty-adapter, to 54 | which you can provide the top-level var of your webapp. Of course, 55 | since you're using a REPL, and new code you load will be utilized 56 | immediately. 57 | -------------------------------------------------------------------------------- /ch17-webapp-maven/pom.xml: -------------------------------------------------------------------------------- 1 | 3 | 4.0.0 4 | 5 | com.clojurebook 6 | sample-maven-web-project 7 | 1.0.0 8 | war 9 | 10 | 11 | 12 | org.clojure 13 | clojure 14 | 1.3.0 15 | 16 | 17 | compojure 18 | compojure 19 | 1.0.0 20 | 21 | 22 | ring 23 | ring-servlet 24 | 1.0.1 25 | 26 | 27 | 28 | 29 | 30 | 31 | com.theoryinpractise 32 | clojure-maven-plugin 33 | 1.3.8 34 | true 35 | 36 | true 37 | false 38 | 39 | 40 | 41 | 42 | compile-clojure 43 | compile 44 | 45 | compile 46 | 47 | 48 | 49 | 50 | 51 | org.mortbay.jetty 52 | maven-jetty-plugin 53 | 6.1.15 54 | 55 | 56 | src/main/webapp,src/main/resources,src/main/clojure 57 | 58 | manual 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | clojars.org 67 | http://clojars.org/repo 68 | 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /ch17-webapp-maven/src/main/clojure/com/clojurebook/hello_world.clj: -------------------------------------------------------------------------------- 1 | (ns com.clojurebook.hello-world 2 | (:use 3 | [ring.util.servlet :only (defservice)] 4 | [compojure.core :only (GET)]) 5 | (:gen-class 6 | :extends javax.servlet.http.HttpServlet)) 7 | 8 | (defservice 9 | (GET "*" {:keys [uri]} 10 | (format " 11 | URL requested: %s 12 |

    13 | 14 | Image served by app server via web.xml 15 | 16 |

    17 | " 18 | uri))) -------------------------------------------------------------------------------- /ch17-webapp-maven/src/main/webapp/WEB-INF/web.xml: -------------------------------------------------------------------------------- 1 | 2 | 5 | 6 | app 7 | com.clojurebook.hello_world 8 | 9 | 10 | app 11 | / 12 | 13 | 14 | default 15 | *.css 16 | *.js 17 | *.png 18 | *.jpg 19 | *.gif 20 | *.ico 21 | *.swf 22 | 23 | 24 | -------------------------------------------------------------------------------- /ch17-webapp-maven/src/main/webapp/wright_pond.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojurebook/ClojureProgramming/bcc7c58862982a5793e22788fc11a9ed7ffc548f/ch17-webapp-maven/src/main/webapp/wright_pond.jpg -------------------------------------------------------------------------------- /ch20-nextsteps-repl-interactions.clj: -------------------------------------------------------------------------------- 1 | ;----- 2 | (use '[clojure.core.logic]) 3 | 4 | (run* [x] (conso 1 [2 3] x)) 5 | ;= ((1 2 3)) 6 | (run* [x] 7 | (fresh [_] 8 | (conso x _ [1 2 3]))) 9 | ;= (1) 10 | (run* [x] 11 | (fresh [_] 12 | (conso _ 3 [1 2 3]))) 13 | ;= ((2 3)) 14 | (run* [q] 15 | (fresh [x y] 16 | (conso x y [1 2 3]) 17 | (== q [x y]))) 18 | ;= ((1 (2 3))) 19 | 20 | 21 | -------------------------------------------------------------------------------- /epl-v10.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Eclipse Public License - Version 1.0 8 | 25 | 26 | 27 | 28 | 29 | 30 |

    Eclipse Public License - v 1.0

    31 | 32 |

    THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 33 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR 34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS 35 | AGREEMENT.

    36 | 37 |

    1. DEFINITIONS

    38 | 39 |

    "Contribution" means:

    40 | 41 |

    a) in the case of the initial Contributor, the initial 42 | code and documentation distributed under this Agreement, and

    43 |

    b) in the case of each subsequent Contributor:

    44 |

    i) changes to the Program, and

    45 |

    ii) additions to the Program;

    46 |

    where such changes and/or additions to the Program 47 | originate from and are distributed by that particular Contributor. A 48 | Contribution 'originates' from a Contributor if it was added to the 49 | Program by such Contributor itself or anyone acting on such 50 | Contributor's behalf. Contributions do not include additions to the 51 | Program which: (i) are separate modules of software distributed in 52 | conjunction with the Program under their own license agreement, and (ii) 53 | are not derivative works of the Program.

    54 | 55 |

    "Contributor" means any person or entity that distributes 56 | the Program.

    57 | 58 |

    "Licensed Patents" mean patent claims licensable by a 59 | Contributor which are necessarily infringed by the use or sale of its 60 | Contribution alone or when combined with the Program.

    61 | 62 |

    "Program" means the Contributions distributed in accordance 63 | with this Agreement.

    64 | 65 |

    "Recipient" means anyone who receives the Program under 66 | this Agreement, including all Contributors.

    67 | 68 |

    2. GRANT OF RIGHTS

    69 | 70 |

    a) Subject to the terms of this Agreement, each 71 | Contributor hereby grants Recipient a non-exclusive, worldwide, 72 | royalty-free copyright license to reproduce, prepare derivative works 73 | of, publicly display, publicly perform, distribute and sublicense the 74 | Contribution of such Contributor, if any, and such derivative works, in 75 | source code and object code form.

    76 | 77 |

    b) Subject to the terms of this Agreement, each 78 | Contributor hereby grants Recipient a non-exclusive, worldwide, 79 | royalty-free patent license under Licensed Patents to make, use, sell, 80 | offer to sell, import and otherwise transfer the Contribution of such 81 | Contributor, if any, in source code and object code form. This patent 82 | license shall apply to the combination of the Contribution and the 83 | Program if, at the time the Contribution is added by the Contributor, 84 | such addition of the Contribution causes such combination to be covered 85 | by the Licensed Patents. The patent license shall not apply to any other 86 | combinations which include the Contribution. No hardware per se is 87 | licensed hereunder.

    88 | 89 |

    c) Recipient understands that although each Contributor 90 | grants the licenses to its Contributions set forth herein, no assurances 91 | are provided by any Contributor that the Program does not infringe the 92 | patent or other intellectual property rights of any other entity. Each 93 | Contributor disclaims any liability to Recipient for claims brought by 94 | any other entity based on infringement of intellectual property rights 95 | or otherwise. As a condition to exercising the rights and licenses 96 | granted hereunder, each Recipient hereby assumes sole responsibility to 97 | secure any other intellectual property rights needed, if any. For 98 | example, if a third party patent license is required to allow Recipient 99 | to distribute the Program, it is Recipient's responsibility to acquire 100 | that license before distributing the Program.

    101 | 102 |

    d) Each Contributor represents that to its knowledge it 103 | has sufficient copyright rights in its Contribution, if any, to grant 104 | the copyright license set forth in this Agreement.

    105 | 106 |

    3. REQUIREMENTS

    107 | 108 |

    A Contributor may choose to distribute the Program in object code 109 | form under its own license agreement, provided that:

    110 | 111 |

    a) it complies with the terms and conditions of this 112 | Agreement; and

    113 | 114 |

    b) its license agreement:

    115 | 116 |

    i) effectively disclaims on behalf of all Contributors 117 | all warranties and conditions, express and implied, including warranties 118 | or conditions of title and non-infringement, and implied warranties or 119 | conditions of merchantability and fitness for a particular purpose;

    120 | 121 |

    ii) effectively excludes on behalf of all Contributors 122 | all liability for damages, including direct, indirect, special, 123 | incidental and consequential damages, such as lost profits;

    124 | 125 |

    iii) states that any provisions which differ from this 126 | Agreement are offered by that Contributor alone and not by any other 127 | party; and

    128 | 129 |

    iv) states that source code for the Program is available 130 | from such Contributor, and informs licensees how to obtain it in a 131 | reasonable manner on or through a medium customarily used for software 132 | exchange.

    133 | 134 |

    When the Program is made available in source code form:

    135 | 136 |

    a) it must be made available under this Agreement; and

    137 | 138 |

    b) a copy of this Agreement must be included with each 139 | copy of the Program.

    140 | 141 |

    Contributors may not remove or alter any copyright notices contained 142 | within the Program.

    143 | 144 |

    Each Contributor must identify itself as the originator of its 145 | Contribution, if any, in a manner that reasonably allows subsequent 146 | Recipients to identify the originator of the Contribution.

    147 | 148 |

    4. COMMERCIAL DISTRIBUTION

    149 | 150 |

    Commercial distributors of software may accept certain 151 | responsibilities with respect to end users, business partners and the 152 | like. While this license is intended to facilitate the commercial use of 153 | the Program, the Contributor who includes the Program in a commercial 154 | product offering should do so in a manner which does not create 155 | potential liability for other Contributors. Therefore, if a Contributor 156 | includes the Program in a commercial product offering, such Contributor 157 | ("Commercial Contributor") hereby agrees to defend and 158 | indemnify every other Contributor ("Indemnified Contributor") 159 | against any losses, damages and costs (collectively "Losses") 160 | arising from claims, lawsuits and other legal actions brought by a third 161 | party against the Indemnified Contributor to the extent caused by the 162 | acts or omissions of such Commercial Contributor in connection with its 163 | distribution of the Program in a commercial product offering. The 164 | obligations in this section do not apply to any claims or Losses 165 | relating to any actual or alleged intellectual property infringement. In 166 | order to qualify, an Indemnified Contributor must: a) promptly notify 167 | the Commercial Contributor in writing of such claim, and b) allow the 168 | Commercial Contributor to control, and cooperate with the Commercial 169 | Contributor in, the defense and any related settlement negotiations. The 170 | Indemnified Contributor may participate in any such claim at its own 171 | expense.

    172 | 173 |

    For example, a Contributor might include the Program in a commercial 174 | product offering, Product X. That Contributor is then a Commercial 175 | Contributor. If that Commercial Contributor then makes performance 176 | claims, or offers warranties related to Product X, those performance 177 | claims and warranties are such Commercial Contributor's responsibility 178 | alone. Under this section, the Commercial Contributor would have to 179 | defend claims against the other Contributors related to those 180 | performance claims and warranties, and if a court requires any other 181 | Contributor to pay any damages as a result, the Commercial Contributor 182 | must pay those damages.

    183 | 184 |

    5. NO WARRANTY

    185 | 186 |

    EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS 187 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS 188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, 189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY 190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely 191 | responsible for determining the appropriateness of using and 192 | distributing the Program and assumes all risks associated with its 193 | exercise of rights under this Agreement , including but not limited to 194 | the risks and costs of program errors, compliance with applicable laws, 195 | damage to or loss of data, programs or equipment, and unavailability or 196 | interruption of operations.

    197 | 198 |

    6. DISCLAIMER OF LIABILITY

    199 | 200 |

    EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT 201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, 202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING 203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF 204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR 206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED 207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

    208 | 209 |

    7. GENERAL

    210 | 211 |

    If any provision of this Agreement is invalid or unenforceable under 212 | applicable law, it shall not affect the validity or enforceability of 213 | the remainder of the terms of this Agreement, and without further action 214 | by the parties hereto, such provision shall be reformed to the minimum 215 | extent necessary to make such provision valid and enforceable.

    216 | 217 |

    If Recipient institutes patent litigation against any entity 218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 219 | Program itself (excluding combinations of the Program with other 220 | software or hardware) infringes such Recipient's patent(s), then such 221 | Recipient's rights granted under Section 2(b) shall terminate as of the 222 | date such litigation is filed.

    223 | 224 |

    All Recipient's rights under this Agreement shall terminate if it 225 | fails to comply with any of the material terms or conditions of this 226 | Agreement and does not cure such failure in a reasonable period of time 227 | after becoming aware of such noncompliance. If all Recipient's rights 228 | under this Agreement terminate, Recipient agrees to cease use and 229 | distribution of the Program as soon as reasonably practicable. However, 230 | Recipient's obligations under this Agreement and any licenses granted by 231 | Recipient relating to the Program shall continue and survive.

    232 | 233 |

    Everyone is permitted to copy and distribute copies of this 234 | Agreement, but in order to avoid inconsistency the Agreement is 235 | copyrighted and may only be modified in the following manner. The 236 | Agreement Steward reserves the right to publish new versions (including 237 | revisions) of this Agreement from time to time. No one other than the 238 | Agreement Steward has the right to modify this Agreement. The Eclipse 239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may 240 | assign the responsibility to serve as the Agreement Steward to a 241 | suitable separate entity. Each new version of the Agreement will be 242 | given a distinguishing version number. The Program (including 243 | Contributions) may always be distributed subject to the version of the 244 | Agreement under which it was received. In addition, after a new version 245 | of the Agreement is published, Contributor may elect to distribute the 246 | Program (including its Contributions) under the new version. Except as 247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no 248 | rights or licenses to the intellectual property of any Contributor under 249 | this Agreement, whether expressly, by implication, estoppel or 250 | otherwise. All rights in the Program not expressly granted under this 251 | Agreement are reserved.

    252 | 253 |

    This Agreement is governed by the laws of the State of New York and 254 | the intellectual property laws of the United States of America. No party 255 | to this Agreement will bring a legal action under this Agreement more 256 | than one year after the cause of action arose. Each party waives its 257 | rights to a jury trial in any resulting litigation.

    258 | 259 | 260 | 261 | --------------------------------------------------------------------------------