Meikel Brandmeyer  committed 3a5c12f

Introduced super-tag ::monad and mzero/mplus

* monad.clj (::monad,::mzero): new tags
(bind): new default implementations for ::monad and ::mzero
(mplus): new multimethod with default implementations

* monad/error.clj (::success,::failure): derive from ::monad and ::mzero
(catch-error): cosmetic change of layout

* monad/maybe.clj (::nothing, ::just): derive from ::monad and ::mzero
(bind): remove implementation. Is equal to default

* monad/state.clj (::type): renamed to ::state and derived from ::monad

  • Participants
  • Parent commits 6bb3f72
  • Branches default

Comments (0)

Files changed (4)

File src/de/kotka/monad.clj

      [clojure.contrib.def :only (defstruct-)]))
+(derive ::mzero ::monad)
 (defstruct- monad-structure :type :monad)
 (defn return
-  "Bless an object with the given monad type."
+  "Bless an object with the given monad type. The monad type should
+  derive from :de.kotka.monad/monad."
   [t m]
   (struct monad-structure t m))
   Although this cannot be enforced in Clojure."}
   bind (fn [m _] (monad-type m)))
+(defmethod bind ::mzero [m _] m)
+(defmethod bind ::monad [m f] (f (monad m)))
+  #^{:doc
+  "If the first argument is not a ::mzero, return it. Otherwise return
+  the second value."}
+  mplus
+  (fn [m1 m2] #(vec (map monad-type [%1 %2]))))
+(defmethod mplus [::mzero ::monad] [_ m2] m2)
+(defmethod mplus [::monad ::monad] [m1 _] m1)
 (defmacro let-bind
   "let-bind binds the result of the given monads to the given variables
   and executes the body in an implicit do block. How this done exactly

File src/de/kotka/monad/error.clj

      [clojure.contrib.def :only (defvar)]))
-(derive ::success :de.kotka.monad.maybe/just)
-(derive ::failure :de.kotka.monad.maybe/nothing)
+(derive ::success :de.kotka.monad/monad)
+(derive ::failure :de.kotka.monad/mzero)
 (defn return-result
   (fn [m _] (monad-type m)))
-(defmethod catch-error ::success
-  [m _]
-  m)
-(defmethod catch-error ::failure
-  [m h]
-  (h (monad m)))
+(defmethod catch-error ::success [m _] m)
+(defmethod catch-error ::failure [m h] (h (monad m)))

File src/de/kotka/monad/maybe.clj

      [clojure.contrib.def :only (defvar)]))
+(derive ::nothing :de.kotka.monad/mzero)
+(derive ::just    :de.kotka.monad/monad)
   (return ::nothing `nothing)
    (throw (Exception. "Tried to retrieve a value from nothing")))
   ([_ default]
-(defmethod bind ::just
-  [m f]
-  (f (monad m)))
-(defmethod bind ::nothing
-  [m _]
-  m)

File src/de/kotka/monad/state.clj

      [clojure.contrib.def :only (defvar)]))
+(derive ::state :de.kotka.monad/monad)
 (defn put-value
   "Sets the value but leaves the state intact."
-  (return ::type #(vector x %)))
+  (return ::state #(vector x %)))
-  (return ::type #(vector % %))
+  (return ::state #(vector % %))
   "Returns the state as the value.")
 (defn put-state
   "Sets the state and a nil value."
-  (return ::type (fn [_] [nil s])))
+  (return ::state (fn [_] [nil s])))
 (defn run-state
   "Apply a state monad to the given initial state. Returns a vector
   "Run the given state monad and return its final state. Equivalent to
   run-state followed by second.")
-(defmethod bind ::type
+(defmethod bind ::state
   [m f]
-  (return ::type
+  (return ::state
           (fn [s0]
             (let [[a s1] (run-state m s0)]
               (run-state (f a) s1)))))