1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/test_monads.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,78 @@
     1.4 +;; Test routines for monads.clj
     1.5 +
     1.6 +;; by Konrad Hinsen
     1.7 +;; last updated March 28, 2009
     1.8 +
     1.9 +;; Copyright (c) Konrad Hinsen, 2008. All rights reserved.  The use
    1.10 +;; and distribution terms for this software are covered by the Eclipse
    1.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.12 +;; which can be found in the file epl-v10.html at the root of this
    1.13 +;; distribution.  By using this software in any fashion, you are
    1.14 +;; agreeing to be bound by the terms of this license.  You must not
    1.15 +;; remove this notice, or any other, from this software.
    1.16 +
    1.17 +(ns clojure.contrib.test-monads
    1.18 +  (:use [clojure.test :only (deftest is are run-tests)]
    1.19 +	[clojure.contrib.monads
    1.20 +	 :only (with-monad domonad m-lift m-seq m-chain
    1.21 +		sequence-m maybe-m state-m maybe-t sequence-t)]))
    1.22 +
    1.23 +(deftest sequence-monad
    1.24 +  (with-monad sequence-m
    1.25 +    (are [a b] (= a b)
    1.26 +      (domonad [x (range 3) y (range 2)] (+ x y))
    1.27 +        '(0 1 1 2 2 3)
    1.28 +      (domonad [x (range 5) y (range (+ 1 x)) :when  (= (+ x y) 2)] (list x y))
    1.29 +        '((1 1) (2 0))
    1.30 +      ((m-lift 2 #(list %1 %2)) (range 3) (range 2))
    1.31 +        '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1))
    1.32 +      (m-seq (replicate 3 (range 2)))
    1.33 +        '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
    1.34 +      ((m-chain (replicate 3 range)) 5)
    1.35 +        '(0 0 0 1 0 0 1 0 1 2)
    1.36 +      (m-plus (range 3) (range 2))
    1.37 +        '(0 1 2 0 1))))
    1.38 +
    1.39 +(deftest maybe-monad
    1.40 +  (with-monad maybe-m
    1.41 +    (let [m+ (m-lift 2 +)
    1.42 +          mdiv (fn [x y] (domonad [a x  b y  :when (not (zero? b))] (/ a b)))]
    1.43 +      (are [a b] (= a b)
    1.44 +        (m+ (m-result 1) (m-result 3))
    1.45 +	  (m-result 4)
    1.46 +        (mdiv (m-result 1) (m-result 3))
    1.47 +	  (m-result (/ 1 3))
    1.48 +        (m+ 1 (mdiv (m-result 1) (m-result 0)))
    1.49 +	  m-zero
    1.50 +	(m-plus m-zero (m-result 1) m-zero (m-result 2))
    1.51 +	  (m-result 1)))))
    1.52 +
    1.53 +(deftest seq-maybe-monad
    1.54 +  (with-monad (maybe-t sequence-m)
    1.55 +    (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))]
    1.56 +      (are [a b] (= a b)
    1.57 +        ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n)))
    1.58 +          '(nil 2 nil 4 nil 6 nil 8 nil 10)
    1.59 +        (pairs (for [n (range 5)] (when (odd? n) n)))
    1.60 +          '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil)))))
    1.61 +
    1.62 +(deftest state-maybe-monad
    1.63 +  (with-monad (maybe-t state-m)
    1.64 +    (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4]
    1.65 +				 [nil nil 3 4] [1 2 nil nil])]
    1.66 +	     (let [f (domonad
    1.67 +		       [x (m-plus (m-result a) (m-result b))
    1.68 +			y (m-plus (m-result c) (m-result d))]
    1.69 +		       (+ x y))]
    1.70 +	       (f :state)))
    1.71 +	   (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state])))))
    1.72 +
    1.73 +(deftest state-seq-monad
    1.74 +  (with-monad (sequence-t state-m)
    1.75 +    (is (= (let [[a b c d] [1 2 10 20]
    1.76 +		 f (domonad
    1.77 +		     [x (m-plus (m-result a) (m-result b))
    1.78 +		      y (m-plus (m-result c) (m-result d))]
    1.79 +		     (+ x y))]
    1.80 +	     (f :state)))
    1.81 +	(list [(list 11 21 12 22) :state]))))