clojure.algo.monads用のerror monadとそのテスト

error_monad.clj

(ns testmonad.amonad-test
  (:use [clojure.test]
        [clojure.algo.monads]))

(defprotocol Either
  (either-call [obj on-left on-right]))
(defrecord Left [v]
  Either (either-call [obj on-left on-right] (on-left v)))
(defrecord Right [v]
  Either (either-call [obj on-left on-right] (on-right v)))
(defmacro either [obj left-sym left-expr right-sym right-expr]
  `(either-call ~obj (fn [~left-sym] ~left-expr) (fn [~right-sym] ~right-expr)))

(defmonad error-m
  [m-result (fn m-result-error [v]
              (->Right v))
   m-bind (fn m-bind-error [mv f]
            (either mv
              e (->Left e)
              v (f v)))])

(defn ok [v] (->Right v))
(defn ng [e] (->Left e))

(defmethod clojure.core/print-method Left [v ^java.io.Writer w]
  (.write w (str "#ng " (pr-str (:v v)))))
(defmethod clojure.core/print-method Right [v ^java.io.Writer w]
  (.write w (str "#ok " (pr-str (:v v)))))


(deftest hoge
  (testing ""
    (let [s (domonad state-m
              [_ (set-state {:x 1})]
              nil)]
      (is (= [nil {:x 1}]
             (s {})))))
  (testing ""
    (let [s (domonad (state-t maybe-m)
              [_ (set-state {:x 1})]
              nil)]
      (is (= [nil {:x 1}]
             (s {})))))
  (testing ""
    (is (= (ng :hoge) (domonad error-m [_ (ng :hoge)] :piyo))))
    (is (= (ok :piyo) (domonad error-m [_ (ok :hoge)] :piyo))) 
  (testing ""
    (let [set-statex (fn [s] (fn [_] (ok [nil s])))
          fail (fn [msg] (fn [_] (ng msg)))
          s (domonad (state-t error-m)
              [_ (set-statex {:x 1})]
              :hoge)]
      (is (= (ok [:hoge {:x 1}])
             (s {})))))
  )