simpler_monad.clj

(defprotocol Monad
  (return [m v])
  (bind [m mv f]))

(defprotocol MonadPlus
  (mzero [m])
  (mplus [m mv mw]))


;; identity monad

(def identity-m
  (reify
    Monad
    (return [_ v] v)
    (bind [_ mv f] (f mv))))


;; maybe monad
;;  nil, false means Nothing
;;  all the other value v means Just v 

(def maybe-m
  (reify
    Monad
    (return [_ v] v)
    (bind [_ mv f] (and mv (f mv)))
    MonadPlus
    (mzero [_] nil)
    (mplus [_ mv mw] (or mv mw))))


;; list monad

(def list-m
  (reify
    Monad
    (return [_ v] (list v))
    (bind [_ mv f] (for [v mv r (f v)] r))
    MonadPlus
    (mzero [_] (list))
    (mplus [_ mv mw] (concat mv mw))))


;; state monad
;;   state => [v s] : s is state, v is retval

(def state-m
  (reify
    Monad
    (return [_ v] (fn [s] [v s]))
    (bind [_ mv f] (fn [s] (let [[v ss] (mv s)] ((f v) ss))))))

(defn state-t
  [m]
  (letfn [(ret [v] (fn [s] (return m [v s])))
          (>>= [mv f] (fn [s] (bind m (mv s) (fn [[v ss]] ((f v) ss)))))]
    (if (extends? MonadPlus (class m))
      (reify
        Monad
        (return [_ v] (ret v))
        (bind [_ mv f] (>>= mv f))  
        MonadPlus
        (mzero [_] (fn [s] (mzero m)))
        (mplus [_ mv mw] (fn [s] (mplus m mv mw))))
      (reify
        Monad
        (return [_ v] (ret v))
        (bind [_ mv f] (>>= mv f))))))


;; error monad
;;   instance of java.lang.Exception means error,
;;   all the other values mean ok.

(def error-m
  (reify
    Monad
    (return [_ v] v)
    (bind [_ mv f] (if (instance? Exception mv) mv (f mv)))
    MonadPlus
    (mzero [_] (Exception.))
    (mplus [_ mv mw] (if (instance? Exception mv) mw mv))))