1 // Copyright Louis Dionne 2013-2017
2 // Distributed under the Boost Software License, Version 1.0.
3 // (See accompanying file LICENSE.md or copy at http://boost.org/LICENSE_1_0.txt)
4 
5 #ifndef BOOST_HANA_TEST_LAWS_MONAD_HPP
6 #define BOOST_HANA_TEST_LAWS_MONAD_HPP
7 
8 #include <boost/hana/assert.hpp>
9 #include <boost/hana/bool.hpp>
10 #include <boost/hana/chain.hpp>
11 #include <boost/hana/concept/comparable.hpp>
12 #include <boost/hana/concept/monad.hpp>
13 #include <boost/hana/concept/sequence.hpp>
14 #include <boost/hana/core/make.hpp>
15 #include <boost/hana/core/when.hpp>
16 #include <boost/hana/equal.hpp>
17 #include <boost/hana/flatten.hpp>
18 #include <boost/hana/for_each.hpp>
19 #include <boost/hana/functional/compose.hpp>
20 #include <boost/hana/functional/id.hpp>
21 #include <boost/hana/lift.hpp>
22 #include <boost/hana/monadic_compose.hpp>
23 #include <boost/hana/transform.hpp>
24 
25 #include <laws/base.hpp>
26 
27 
28 namespace boost { namespace hana { namespace test {
29     template <typename M, typename = when<true>>
30     struct TestMonad : TestMonad<M, laws> {
31         using TestMonad<M, laws>::TestMonad;
32     };
33 
34     template <typename M>
35     struct TestMonad<M, laws> {
36         // Xs are Monads over something
37         // XXs are Monads over Monads over something
38         template <typename Xs, typename XXs>
TestMonadboost::hana::test::TestMonad39         TestMonad(Xs xs, XXs xxs) {
40             hana::for_each(xs, [](auto m) {
41                 static_assert(Monad<decltype(m)>{}, "");
42 
43                 auto f = hana::compose(lift<M>, test::_injection<0>{});
44                 auto g = hana::compose(lift<M>, test::_injection<1>{});
45                 auto h = hana::compose(lift<M>, test::_injection<2>{});
46                 auto x = test::ct_eq<0>{};
47 
48                 //////////////////////////////////////////////////////////////
49                 // Laws formulated with `monadic_compose`
50                 //////////////////////////////////////////////////////////////
51                 // associativity
52                 BOOST_HANA_CHECK(hana::equal(
53                     hana::monadic_compose(h, hana::monadic_compose(g, f))(x),
54                     hana::monadic_compose(hana::monadic_compose(h, g), f)(x)
55                 ));
56 
57                 // left identity
58                 BOOST_HANA_CHECK(hana::equal(
59                     hana::monadic_compose(lift<M>, f)(x),
60                     f(x)
61                 ));
62 
63                 // right identity
64                 BOOST_HANA_CHECK(hana::equal(
65                     hana::monadic_compose(f, lift<M>)(x),
66                     f(x)
67                 ));
68 
69                 //////////////////////////////////////////////////////////////
70                 // Laws formulated with `chain`
71                 //
72                 // This just provides us with some additional cross-checking,
73                 // but the documentation does not mention those.
74                 //////////////////////////////////////////////////////////////
75                 BOOST_HANA_CHECK(hana::equal(
76                     hana::chain(hana::lift<M>(x), f),
77                     f(x)
78                 ));
79 
80                 BOOST_HANA_CHECK(hana::equal(
81                     hana::chain(m, lift<M>),
82                     m
83                 ));
84 
85                 BOOST_HANA_CHECK(hana::equal(
86                     hana::chain(m, [f, g](auto x) {
87                         return hana::chain(f(x), g);
88                     }),
89                     hana::chain(hana::chain(m, f), g)
90                 ));
91 
92                 BOOST_HANA_CHECK(hana::equal(
93                     hana::transform(m, f),
94                     hana::chain(m, hana::compose(lift<M>, f))
95                 ));
96 
97                 //////////////////////////////////////////////////////////////
98                 // Consistency of method definitions
99                 //////////////////////////////////////////////////////////////
100                 // consistency of `chain`
101                 BOOST_HANA_CHECK(hana::equal(
102                     hana::chain(m, f),
103                     hana::flatten(hana::transform(m, f))
104                 ));
105 
106                 // consistency of `monadic_compose`
107                 BOOST_HANA_CHECK(hana::equal(
108                     hana::monadic_compose(f, g)(x),
109                     hana::chain(g(x), f)
110                 ));
111             });
112 
113             // consistency of `flatten`
114             hana::for_each(xxs, [](auto mm) {
115                 BOOST_HANA_CHECK(hana::equal(
116                     hana::flatten(mm),
117                     hana::chain(mm, hana::id)
118                 ));
119             });
120         }
121     };
122 
123     template <typename S>
124     struct TestMonad<S, when<Sequence<S>::value>>
125         : TestMonad<S, laws>
126     {
127         template <typename Xs, typename XXs>
TestMonadboost::hana::test::TestMonad128         TestMonad(Xs xs, XXs xxs)
129             : TestMonad<S, laws>{xs, xxs}
130         {
131             constexpr auto list = make<S>;
132 
133             //////////////////////////////////////////////////////////////////
134             // flatten
135             //////////////////////////////////////////////////////////////////
136             BOOST_HANA_CONSTANT_CHECK(hana::equal(
137                 hana::flatten(list(list(), list())),
138                 list()
139             ));
140 
141             BOOST_HANA_CONSTANT_CHECK(hana::equal(
142                 hana::flatten(list(list(ct_eq<0>{}), list())),
143                 list(ct_eq<0>{})
144             ));
145 
146             BOOST_HANA_CONSTANT_CHECK(hana::equal(
147                 hana::flatten(list(list(), list(ct_eq<0>{}))),
148                 list(ct_eq<0>{})
149             ));
150 
151             BOOST_HANA_CONSTANT_CHECK(hana::equal(
152                 hana::flatten(list(list(ct_eq<0>{}), list(ct_eq<1>{}))),
153                 list(ct_eq<0>{}, ct_eq<1>{})
154             ));
155 
156             BOOST_HANA_CONSTANT_CHECK(hana::equal(
157                 hana::flatten(list(
158                     list(ct_eq<0>{}, ct_eq<1>{}),
159                     list(),
160                     list(ct_eq<2>{}, ct_eq<3>{}),
161                     list(ct_eq<4>{})
162                 )),
163                 list(ct_eq<0>{}, ct_eq<1>{}, ct_eq<2>{}, ct_eq<3>{}, ct_eq<4>{})
164             ));
165 
166             // just make sure we don't double move; this happened in hana::tuple
167             hana::flatten(list(list(Tracked{1}, Tracked{2})));
168 
169             //////////////////////////////////////////////////////////////////
170             // chain
171             //////////////////////////////////////////////////////////////////
172             {
173                 test::_injection<0> f{};
174                 auto g = hana::compose(list, f);
175 
176                 BOOST_HANA_CONSTANT_CHECK(hana::equal(
177                     hana::chain(list(), g),
178                     list()
179                 ));
180 
181                 BOOST_HANA_CONSTANT_CHECK(hana::equal(
182                     hana::chain(list(ct_eq<1>{}), g),
183                     list(f(ct_eq<1>{}))
184                 ));
185 
186                 BOOST_HANA_CONSTANT_CHECK(hana::equal(
187                     hana::chain(list(ct_eq<1>{}, ct_eq<2>{}), g),
188                     list(f(ct_eq<1>{}), f(ct_eq<2>{}))
189                 ));
190 
191                 BOOST_HANA_CONSTANT_CHECK(hana::equal(
192                     hana::chain(list(ct_eq<1>{}, ct_eq<2>{}, ct_eq<3>{}), g),
193                     list(f(ct_eq<1>{}), f(ct_eq<2>{}), f(ct_eq<3>{}))
194                 ));
195 
196                 BOOST_HANA_CONSTANT_CHECK(hana::equal(
197                     hana::chain(list(ct_eq<1>{}, ct_eq<2>{}, ct_eq<3>{}, ct_eq<4>{}), g),
198                     list(f(ct_eq<1>{}), f(ct_eq<2>{}), f(ct_eq<3>{}), f(ct_eq<4>{}))
199                 ));
200             }
201 
202             //////////////////////////////////////////////////////////////////
203             // monadic_compose
204             //////////////////////////////////////////////////////////////////
205             {
206                 test::_injection<0> f{};
207                 test::_injection<1> g{};
208 
__anon3f7b7c8e0402boost::hana::test::TestMonad209                 auto mf = [=](auto x) { return list(f(x), f(f(x))); };
__anon3f7b7c8e0502boost::hana::test::TestMonad210                 auto mg = [=](auto x) { return list(g(x), g(g(x))); };
211 
212                 auto x = test::ct_eq<0>{};
213                 BOOST_HANA_CHECK(hana::equal(
214                     hana::monadic_compose(mf, mg)(x),
215                     list(f(g(x)), f(f(g(x))), f(g(g(x))), f(f(g(g(x)))))
216                 ));
217             }
218         }
219     };
220 }}} // end namespace boost::hana::test
221 
222 #endif // !BOOST_HANA_TEST_LAWS_MONAD_HPP
223