1212import static com .jnape .palatable .lambda .adt .Maybe .nothing ;
1313import static com .jnape .palatable .lambda .functions .builtin .fn1 .Constantly .constantly ;
1414import static com .jnape .palatable .lambda .functions .builtin .fn1 .Id .id ;
15+ import static com .jnape .palatable .lambda .functions .builtin .fn1 .Upcast .upcast ;
16+ import static com .jnape .palatable .lambda .monad .Monad .join ;
1517import static java .util .Arrays .asList ;
1618
1719public class MonadLaws <M extends Monad > implements Trait <Monad <?, M >> {
@@ -22,7 +24,8 @@ public void test(Monad<?, M> m) {
2224 .<Function <Monad <?, M >, Maybe <String >>>foldMap (f -> f .apply (m ), asList (
2325 this ::testLeftIdentity ,
2426 this ::testRightIdentity ,
25- this ::testAssociativity ))
27+ this ::testAssociativity ,
28+ this ::testJoin ))
2629 .peek (s -> {
2730 throw new AssertionError ("The following Monad laws did not hold for instance of " + m .getClass () + ": \n \t - " + s );
2831 });
@@ -32,21 +35,29 @@ private Maybe<String> testLeftIdentity(Monad<?, M> m) {
3235 Object a = new Object ();
3336 Fn1 <Object , Monad <Object , M >> fn = id ().andThen (m ::pure );
3437 return m .pure (a ).flatMap (fn ).equals (fn .apply (a ))
35- ? nothing ()
36- : just ("left identity (m.pure(a).flatMap(fn).equals(fn.apply(a)))" );
38+ ? nothing ()
39+ : just ("left identity (m.pure(a).flatMap(fn).equals(fn.apply(a)))" );
3740 }
3841
3942 private Maybe <String > testRightIdentity (Monad <?, M > m ) {
4043 return m .flatMap (m ::pure ).equals (m )
41- ? nothing ()
42- : just ("right identity: (m.flatMap(m::pure).equals(m))" );
44+ ? nothing ()
45+ : just ("right identity: (m.flatMap(m::pure).equals(m))" );
4346 }
4447
4548 private Maybe <String > testAssociativity (Monad <?, M > m ) {
4649 Fn1 <Object , Monad <Object , M >> f = constantly (m .pure (new Object ()));
4750 Function <Object , Monad <Object , M >> g = constantly (m .pure (new Object ()));
4851 return m .flatMap (f ).flatMap (g ).equals (m .flatMap (a -> f .apply (a ).flatMap (g )))
49- ? nothing ()
50- : just ("associativity: (m.flatMap(f).flatMap(g).equals(m.flatMap(a -> f.apply(a).flatMap(g))))" );
52+ ? nothing ()
53+ : just ("associativity: (m.flatMap(f).flatMap(g).equals(m.flatMap(a -> f.apply(a).flatMap(g))))" );
54+ }
55+
56+ private Maybe <String > testJoin (Monad <?, M > m ) {
57+ Monad <Monad <Object , M >, M > mma = m .pure (m .fmap (upcast ()));
58+ boolean equals = mma .flatMap (id ()).equals (join (mma ));
59+ return equals
60+ ? nothing ()
61+ : just ("join: (m.pure(m).flatMap(id())).equals(Monad.join(m.pure(m)))" );
5162 }
5263}
0 commit comments