Permalink
Browse files

Add the reader monad

  • Loading branch information...
1 parent bfeafd6 commit 3055d0dc19d0e497556b5d6dc86c77a112d2dcd2 @leonardoborges leonardoborges committed with khinsen Feb 5, 2014
Showing with 73 additions and 3 deletions.
  1. +28 −1 src/main/clojure/clojure/algo/monads.clj
  2. +45 −2 src/test/clojure/clojure/algo/test_monads.clj
@@ -517,8 +517,35 @@
(defn censor [f mv]
(let [[v a] mv] [v (f a)]))
-; Continuation monad
+; Reader monad
+(defmonad reader-m
+ "Monad describing computations which read values from a shared environment.
+ Also known as the environment monad."
+ [m-result (fn [a]
+ (fn [_] a))
+ m-bind (fn [m k]
+ (fn [r]
+ ((k (m r)) r)))
+ ])
+
+(defn ask
+ "Returns the environment."
+ []
+ identity)
+(defn asks
+ "Returns a function of the current environment."
+ [f]
+ (fn [env]
+ (f env)))
+
+(defn local
+ "Runs reader g in the context of an environment modified by f"
+ [f g]
+ (fn [env]
+ (g (f env))))
+
+; Continuation monad
(defmonad cont-m
"Monad describing computations in continuation-passing style. The monadic
values are functions that are called with a single argument representing
@@ -12,7 +12,8 @@
(:use [clojure.test :only (deftest is are run-tests)]
[clojure.algo.monads
:only (with-monad domonad m-lift m-seq m-chain writer-m write
- sequence-m maybe-m state-m maybe-t sequence-t)]))
+ sequence-m maybe-m state-m maybe-t sequence-t
+ reader-m ask asks local)]))
(deftest domonad-if-then
@@ -140,6 +141,49 @@
(+ a b))
[3 #{:a}])))
+(deftest reader-monad
+ (let [monad-value (domonad reader-m
+ [x (asks :number)]
+ (* x 2))]
+ (is (= (monad-value {:number 3})
+ 6)))
+
+ (let [monad-value (domonad reader-m
+ [env (ask)]
+ env)]
+ (is (= (monad-value "env")
+ "env")))
+
+ (let [monad-value (domonad reader-m
+ [numbers (ask)
+ sum (m-result (reduce + numbers))
+ mean (m-result (/ sum (count numbers)))]
+ mean)]
+ (is (= (monad-value (range 1 10))
+ 5)))
+
+ (let [monad-value (domonad reader-m
+ [a (ask)
+ b (local inc (ask))]
+ (* a b))]
+ (is (= (monad-value 10)
+ 110)))
+
+
+ (let [mult-a-b (fn []
+ (domonad reader-m
+ [a (asks :a)
+ b (asks :b)]
+ (* a b)))
+ monad-value (domonad reader-m
+ [a (asks :a)
+ b (asks :b)
+ a' (local #(update-in % [:a] inc) (asks :a))
+ c (local #(assoc % :b 5) (mult-a-b))]
+ [a b a' c])]
+ (= (monad-value {:a 10})
+ [10 nil 11 50])))
+
(deftest seq-maybe-monad
(with-monad (maybe-t sequence-m)
(letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))]
@@ -169,4 +213,3 @@
(+ x y))]
(f :state)))
(list [(list 11 21 12 22) :state]))))
-

0 comments on commit 3055d0d

Please sign in to comment.