X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=extra%2Fmonads%2Fmonads-tests.factor;h=ca02097401434e528b8b63a0f2713d3cee1cefaa;hp=0f1eb8edda53fcf203689f1d7640ecf212b4e903;hb=HEAD;hpb=b8c3894ad27ecaab2ad83812293aa30414b9b2ce

diff --git a/extra/monads/monads-tests.factor b/extra/monads/monads-tests.factor
index 0f1eb8edda..ca02097401 100644
--- a/extra/monads/monads-tests.factor
+++ b/extra/monads/monads-tests.factor
@@ -1,56 +1,57 @@
-USING: tools.test math kernel sequences lists promises monads ;
+USING: tools.test math math.functions kernel sequences lists
+promises monads ;
 FROM: monads => do ;
 IN: monads.tests
 
-[ 5 ] [ 1 identity-monad return [ 4 + ] fmap run-identity ] unit-test
+{ 5 } [ 1 identity-monad return [ 4 + ] fmap run-identity ] unit-test
 [ "OH HAI" identity-monad fail ] must-fail
 
-[ 666 ] [
-    111 just [ 6 * ] fmap [ ] [ "OOPS" throw ] if-maybe
+{ 666 } [
+    111 <just> [ 6 * ] fmap [ ] [ "OOPS" throw ] if-maybe
 ] unit-test
 
-[ nothing ] [
-    111 just [ maybe-monad fail ] bind
+{ nothing } [
+    111 <just> [ maybe-monad fail ] bind
 ] unit-test
 
-[ 100 ] [
+{ 100 } [
     5 either-monad return [ 10 * ] [ 20 * ] if-either
 ] unit-test
 
-[ T{ left f "OOPS" } ] [
+{ T{ left f "OOPS" } } [
     5 either-monad return >>= [ drop "OOPS" either-monad fail ] swap call
 ] unit-test
 
-[ { 10 20 30 } ] [
+{ { 10 20 30 } } [
     { 1 2 3 } [ 10 * ] fmap
 ] unit-test
 
-[ { } ] [
+{ { } } [
     { 1 2 3 } [ drop "OOPS" array-monad fail ] bind
 ] unit-test
 
-[ 5 ] [
+{ 5 } [
     5 state-monad return "initial state" run-st
 ] unit-test
 
-[ 8 ] [
+{ 8 } [
     5 state-monad return [ 3 + state-monad return ] bind
     "initial state" run-st
 ] unit-test
 
-[ 8 ] [
+{ 8 } [
     5 state-monad return >>=
     [ 3 + state-monad return ] swap call
     "initial state" run-st
 ] unit-test
 
-[ 11 ] [
+{ 11 } [
     f state-monad return >>=
     [ drop get-st ] swap call
     11 run-st
 ] unit-test
 
-[ 15 ] [
+{ 15 } [
     f state-monad return
     [ drop get-st ] bind
     [ 4 + put-st ] bind
@@ -58,7 +59,7 @@ IN: monads.tests
     11 run-st
 ] unit-test
 
-[ 15 ] [
+{ 15 } [
     {
         [ f return-st ]
         [ drop get-st ]
@@ -68,34 +69,34 @@ IN: monads.tests
     11 run-st
 ] unit-test
 
-[ nothing ] [
+{ nothing } [
     {
-        [ "hi" just ]
-        [ " bye" append just ]
+        [ "hi" <just> ]
+        [ " bye" append <just> ]
         [ drop nothing ]
-        [ reverse just ]
+        [ reverse <just> ]
     } do
 ] unit-test
 
 LAZY: nats-from ( n -- list )
-    dup 1+ nats-from cons ;
+    dup 1 + nats-from cons ;
 
 : nats ( -- list ) 0 nats-from ;
 
-[ 3 ] [
+{ 3 } [
     {
         [ nats ]
         [ dup 3 = [ list-monad return ] [ list-monad fail ] if ]
     } do car
 ] unit-test
 
-[ 9/11 ] [
+{ 9/11 } [
     {
         [ ask ]
     } do 9/11 run-reader
 ] unit-test
 
-[ 8 ] [
+{ 8 } [
     {
         [ ask ]
         [ 3 + reader-monad return ]
@@ -103,27 +104,43 @@ LAZY: nats-from ( n -- list )
     5 run-reader
 ] unit-test
 
-[ 6 ] [
+{ 6 } [
     f reader-monad return [ drop ask ] bind [ 1 + ] local 5 run-reader
 ] unit-test
 
-[ f { 1 2 3 } ] [
+{ f { 1 2 3 } } [
     5 writer-monad return
     [ drop { 1 2 3 } tell ] bind
     run-writer
 ] unit-test
 
-[ T{ identity f 7 } ]
+{
+    T{ writer
+        { value 1.618033988749895 }
+        { log
+            "Started with five, took square root, added one, divided by two."
+        }
+    }
+} [
+    {
+        [ 5 "Started with five, " <writer> ]
+        [ sqrt "took square root, " <writer> ]
+        [ 1 + "added one, " <writer> ]
+        [ 2 / "divided by two." <writer> ]
+    } do
+] unit-test
+
+{ T{ identity f 7 } }
 [
     4 identity-monad return
     [ 3 + ] identity-monad return
     identity-monad apply
 ] unit-test
 
-[ nothing ] [
-    5 just nothing maybe-monad apply
+{ nothing } [
+    5 <just> nothing maybe-monad apply
 ] unit-test
 
-[ T{ just f 15 } ] [
-    5 just [ 10 + ] just maybe-monad apply
+{ T{ just f 15 } } [
+    5 <just> [ 10 + ] <just> maybe-monad apply
 ] unit-test