|
rlm@10
|
1 ;; Test routines for monads.clj
|
|
rlm@10
|
2
|
|
rlm@10
|
3 ;; by Konrad Hinsen
|
|
rlm@10
|
4 ;; last updated March 28, 2009
|
|
rlm@10
|
5
|
|
rlm@10
|
6 ;; Copyright (c) Konrad Hinsen, 2008. All rights reserved. The use
|
|
rlm@10
|
7 ;; and distribution terms for this software are covered by the Eclipse
|
|
rlm@10
|
8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
9 ;; which can be found in the file epl-v10.html at the root of this
|
|
rlm@10
|
10 ;; distribution. By using this software in any fashion, you are
|
|
rlm@10
|
11 ;; agreeing to be bound by the terms of this license. You must not
|
|
rlm@10
|
12 ;; remove this notice, or any other, from this software.
|
|
rlm@10
|
13
|
|
rlm@10
|
14 (ns clojure.contrib.test-monads
|
|
rlm@10
|
15 (:use [clojure.test :only (deftest is are run-tests)]
|
|
rlm@10
|
16 [clojure.contrib.monads
|
|
rlm@10
|
17 :only (with-monad domonad m-lift m-seq m-chain
|
|
rlm@10
|
18 sequence-m maybe-m state-m maybe-t sequence-t)]))
|
|
rlm@10
|
19
|
|
rlm@10
|
20 (deftest sequence-monad
|
|
rlm@10
|
21 (with-monad sequence-m
|
|
rlm@10
|
22 (are [a b] (= a b)
|
|
rlm@10
|
23 (domonad [x (range 3) y (range 2)] (+ x y))
|
|
rlm@10
|
24 '(0 1 1 2 2 3)
|
|
rlm@10
|
25 (domonad [x (range 5) y (range (+ 1 x)) :when (= (+ x y) 2)] (list x y))
|
|
rlm@10
|
26 '((1 1) (2 0))
|
|
rlm@10
|
27 ((m-lift 2 #(list %1 %2)) (range 3) (range 2))
|
|
rlm@10
|
28 '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1))
|
|
rlm@10
|
29 (m-seq (replicate 3 (range 2)))
|
|
rlm@10
|
30 '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
|
|
rlm@10
|
31 ((m-chain (replicate 3 range)) 5)
|
|
rlm@10
|
32 '(0 0 0 1 0 0 1 0 1 2)
|
|
rlm@10
|
33 (m-plus (range 3) (range 2))
|
|
rlm@10
|
34 '(0 1 2 0 1))))
|
|
rlm@10
|
35
|
|
rlm@10
|
36 (deftest maybe-monad
|
|
rlm@10
|
37 (with-monad maybe-m
|
|
rlm@10
|
38 (let [m+ (m-lift 2 +)
|
|
rlm@10
|
39 mdiv (fn [x y] (domonad [a x b y :when (not (zero? b))] (/ a b)))]
|
|
rlm@10
|
40 (are [a b] (= a b)
|
|
rlm@10
|
41 (m+ (m-result 1) (m-result 3))
|
|
rlm@10
|
42 (m-result 4)
|
|
rlm@10
|
43 (mdiv (m-result 1) (m-result 3))
|
|
rlm@10
|
44 (m-result (/ 1 3))
|
|
rlm@10
|
45 (m+ 1 (mdiv (m-result 1) (m-result 0)))
|
|
rlm@10
|
46 m-zero
|
|
rlm@10
|
47 (m-plus m-zero (m-result 1) m-zero (m-result 2))
|
|
rlm@10
|
48 (m-result 1)))))
|
|
rlm@10
|
49
|
|
rlm@10
|
50 (deftest seq-maybe-monad
|
|
rlm@10
|
51 (with-monad (maybe-t sequence-m)
|
|
rlm@10
|
52 (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))]
|
|
rlm@10
|
53 (are [a b] (= a b)
|
|
rlm@10
|
54 ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n)))
|
|
rlm@10
|
55 '(nil 2 nil 4 nil 6 nil 8 nil 10)
|
|
rlm@10
|
56 (pairs (for [n (range 5)] (when (odd? n) n)))
|
|
rlm@10
|
57 '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil)))))
|
|
rlm@10
|
58
|
|
rlm@10
|
59 (deftest state-maybe-monad
|
|
rlm@10
|
60 (with-monad (maybe-t state-m)
|
|
rlm@10
|
61 (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4]
|
|
rlm@10
|
62 [nil nil 3 4] [1 2 nil nil])]
|
|
rlm@10
|
63 (let [f (domonad
|
|
rlm@10
|
64 [x (m-plus (m-result a) (m-result b))
|
|
rlm@10
|
65 y (m-plus (m-result c) (m-result d))]
|
|
rlm@10
|
66 (+ x y))]
|
|
rlm@10
|
67 (f :state)))
|
|
rlm@10
|
68 (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state])))))
|
|
rlm@10
|
69
|
|
rlm@10
|
70 (deftest state-seq-monad
|
|
rlm@10
|
71 (with-monad (sequence-t state-m)
|
|
rlm@10
|
72 (is (= (let [[a b c d] [1 2 10 20]
|
|
rlm@10
|
73 f (domonad
|
|
rlm@10
|
74 [x (m-plus (m-result a) (m-result b))
|
|
rlm@10
|
75 y (m-plus (m-result c) (m-result d))]
|
|
rlm@10
|
76 (+ x y))]
|
|
rlm@10
|
77 (f :state)))
|
|
rlm@10
|
78 (list [(list 11 21 12 22) :state]))))
|
