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)
5 #ifndef BOOST_HANA_TEST_LAWS_MONAD_HPP
6 #define BOOST_HANA_TEST_LAWS_MONAD_HPP
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>
25 #include <laws/base.hpp>
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;
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>
39 TestMonad(Xs xs, XXs xxs) {
40 hana::for_each(xs, [](auto m) {
41 static_assert(Monad<decltype(m)>{}, "");
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>{};
48 //////////////////////////////////////////////////////////////
49 // Laws formulated with `monadic_compose`
50 //////////////////////////////////////////////////////////////
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)
58 BOOST_HANA_CHECK(hana::equal(
59 hana::monadic_compose(lift<M>, f)(x),
64 BOOST_HANA_CHECK(hana::equal(
65 hana::monadic_compose(f, lift<M>)(x),
69 //////////////////////////////////////////////////////////////
70 // Laws formulated with `chain`
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),
80 BOOST_HANA_CHECK(hana::equal(
81 hana::chain(m, lift<M>),
85 BOOST_HANA_CHECK(hana::equal(
86 hana::chain(m, [f, g](auto x) {
87 return hana::chain(f(x), g);
89 hana::chain(hana::chain(m, f), g)
92 BOOST_HANA_CHECK(hana::equal(
93 hana::transform(m, f),
94 hana::chain(m, hana::compose(lift<M>, f))
97 //////////////////////////////////////////////////////////////
98 // Consistency of method definitions
99 //////////////////////////////////////////////////////////////
100 // consistency of `chain`
101 BOOST_HANA_CHECK(hana::equal(
103 hana::flatten(hana::transform(m, f))
106 // consistency of `monadic_compose`
107 BOOST_HANA_CHECK(hana::equal(
108 hana::monadic_compose(f, g)(x),
113 // consistency of `flatten`
114 hana::for_each(xxs, [](auto mm) {
115 BOOST_HANA_CHECK(hana::equal(
117 hana::chain(mm, hana::id)
123 template <typename S>
124 struct TestMonad<S, when<Sequence<S>::value>>
127 template <typename Xs, typename XXs>
128 TestMonad(Xs xs, XXs xxs)
129 : TestMonad<S, laws>{xs, xxs}
131 constexpr auto list = make<S>;
133 //////////////////////////////////////////////////////////////////
135 //////////////////////////////////////////////////////////////////
136 BOOST_HANA_CONSTANT_CHECK(hana::equal(
137 hana::flatten(list(list(), list())),
141 BOOST_HANA_CONSTANT_CHECK(hana::equal(
142 hana::flatten(list(list(ct_eq<0>{}), list())),
146 BOOST_HANA_CONSTANT_CHECK(hana::equal(
147 hana::flatten(list(list(), list(ct_eq<0>{}))),
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>{})
156 BOOST_HANA_CONSTANT_CHECK(hana::equal(
158 list(ct_eq<0>{}, ct_eq<1>{}),
160 list(ct_eq<2>{}, ct_eq<3>{}),
163 list(ct_eq<0>{}, ct_eq<1>{}, ct_eq<2>{}, ct_eq<3>{}, ct_eq<4>{})
166 // just make sure we don't double move; this happened in hana::tuple
167 hana::flatten(list(list(Tracked{1}, Tracked{2})));
169 //////////////////////////////////////////////////////////////////
171 //////////////////////////////////////////////////////////////////
173 test::_injection<0> f{};
174 auto g = hana::compose(list, f);
176 BOOST_HANA_CONSTANT_CHECK(hana::equal(
177 hana::chain(list(), g),
181 BOOST_HANA_CONSTANT_CHECK(hana::equal(
182 hana::chain(list(ct_eq<1>{}), g),
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>{}))
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>{}))
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>{}))
202 //////////////////////////////////////////////////////////////////
204 //////////////////////////////////////////////////////////////////
206 test::_injection<0> f{};
207 test::_injection<1> g{};
209 auto mf = [=](auto x) { return list(f(x), f(f(x))); };
210 auto mg = [=](auto x) { return list(g(x), g(g(x))); };
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)))))
220 }}} // end namespace boost::hana::test
222 #endif // !BOOST_HANA_TEST_LAWS_MONAD_HPP