factor/extra/monads/monads-tests.factor

130 lines
2.3 KiB
Factor

USING: tools.test math kernel sequences lists promises monads ;
FROM: monads => do ;
IN: monads.tests
[ 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
] unit-test
[ nothing ] [
111 just [ maybe-monad fail ] bind
] unit-test
[ 100 ] [
5 either-monad return [ 10 * ] [ 20 * ] if-either
] unit-test
[ T{ left f "OOPS" } ] [
5 either-monad return >>= [ drop "OOPS" either-monad fail ] swap call
] unit-test
[ { 10 20 30 } ] [
{ 1 2 3 } [ 10 * ] fmap
] unit-test
[ { } ] [
{ 1 2 3 } [ drop "OOPS" array-monad fail ] bind
] unit-test
[ 5 ] [
5 state-monad return "initial state" run-st
] unit-test
[ 8 ] [
5 state-monad return [ 3 + state-monad return ] bind
"initial state" run-st
] unit-test
[ 8 ] [
5 state-monad return >>=
[ 3 + state-monad return ] swap call
"initial state" run-st
] unit-test
[ 11 ] [
f state-monad return >>=
[ drop get-st ] swap call
11 run-st
] unit-test
[ 15 ] [
f state-monad return
[ drop get-st ] bind
[ 4 + put-st ] bind
[ drop get-st ] bind
11 run-st
] unit-test
[ 15 ] [
{
[ f return-st ]
[ drop get-st ]
[ 4 + put-st ]
[ drop get-st ]
} do
11 run-st
] unit-test
[ nothing ] [
{
[ "hi" just ]
[ " bye" append just ]
[ drop nothing ]
[ reverse just ]
} do
] unit-test
LAZY: nats-from ( n -- list )
dup 1 + nats-from cons ;
: nats ( -- list ) 0 nats-from ;
[ 3 ] [
{
[ nats ]
[ dup 3 = [ list-monad return ] [ list-monad fail ] if ]
} do car
] unit-test
[ 9/11 ] [
{
[ ask ]
} do 9/11 run-reader
] unit-test
[ 8 ] [
{
[ ask ]
[ 3 + reader-monad return ]
} do
5 run-reader
] unit-test
[ 6 ] [
f reader-monad return [ drop ask ] bind [ 1 + ] local 5 run-reader
] unit-test
[ f { 1 2 3 } ] [
5 writer-monad return
[ drop { 1 2 3 } tell ] bind
run-writer
] 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
] unit-test
[ T{ just f 15 } ] [
5 just [ 10 + ] just maybe-monad apply
] unit-test