123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222 |
- // Copyright Louis Dionne 2013-2017
- // Distributed under the Boost Software License, Version 1.0.
- // (See accompanying file LICENSE.md or copy at http://boost.org/LICENSE_1_0.txt)
- #ifndef BOOST_HANA_TEST_LAWS_MONAD_HPP
- #define BOOST_HANA_TEST_LAWS_MONAD_HPP
- #include <boost/hana/assert.hpp>
- #include <boost/hana/bool.hpp>
- #include <boost/hana/chain.hpp>
- #include <boost/hana/concept/comparable.hpp>
- #include <boost/hana/concept/monad.hpp>
- #include <boost/hana/concept/sequence.hpp>
- #include <boost/hana/core/make.hpp>
- #include <boost/hana/core/when.hpp>
- #include <boost/hana/equal.hpp>
- #include <boost/hana/flatten.hpp>
- #include <boost/hana/for_each.hpp>
- #include <boost/hana/functional/compose.hpp>
- #include <boost/hana/functional/id.hpp>
- #include <boost/hana/lift.hpp>
- #include <boost/hana/monadic_compose.hpp>
- #include <boost/hana/transform.hpp>
- #include <laws/base.hpp>
- namespace boost { namespace hana { namespace test {
- template <typename M, typename = when<true>>
- struct TestMonad : TestMonad<M, laws> {
- using TestMonad<M, laws>::TestMonad;
- };
- template <typename M>
- struct TestMonad<M, laws> {
- // Xs are Monads over something
- // XXs are Monads over Monads over something
- template <typename Xs, typename XXs>
- TestMonad(Xs xs, XXs xxs) {
- hana::for_each(xs, [](auto m) {
- static_assert(Monad<decltype(m)>{}, "");
- auto f = hana::compose(lift<M>, test::_injection<0>{});
- auto g = hana::compose(lift<M>, test::_injection<1>{});
- auto h = hana::compose(lift<M>, test::_injection<2>{});
- auto x = test::ct_eq<0>{};
- //////////////////////////////////////////////////////////////
- // Laws formulated with `monadic_compose`
- //////////////////////////////////////////////////////////////
- // associativity
- BOOST_HANA_CHECK(hana::equal(
- hana::monadic_compose(h, hana::monadic_compose(g, f))(x),
- hana::monadic_compose(hana::monadic_compose(h, g), f)(x)
- ));
- // left identity
- BOOST_HANA_CHECK(hana::equal(
- hana::monadic_compose(lift<M>, f)(x),
- f(x)
- ));
- // right identity
- BOOST_HANA_CHECK(hana::equal(
- hana::monadic_compose(f, lift<M>)(x),
- f(x)
- ));
- //////////////////////////////////////////////////////////////
- // Laws formulated with `chain`
- //
- // This just provides us with some additional cross-checking,
- // but the documentation does not mention those.
- //////////////////////////////////////////////////////////////
- BOOST_HANA_CHECK(hana::equal(
- hana::chain(hana::lift<M>(x), f),
- f(x)
- ));
- BOOST_HANA_CHECK(hana::equal(
- hana::chain(m, lift<M>),
- m
- ));
- BOOST_HANA_CHECK(hana::equal(
- hana::chain(m, [f, g](auto x) {
- return hana::chain(f(x), g);
- }),
- hana::chain(hana::chain(m, f), g)
- ));
- BOOST_HANA_CHECK(hana::equal(
- hana::transform(m, f),
- hana::chain(m, hana::compose(lift<M>, f))
- ));
- //////////////////////////////////////////////////////////////
- // Consistency of method definitions
- //////////////////////////////////////////////////////////////
- // consistency of `chain`
- BOOST_HANA_CHECK(hana::equal(
- hana::chain(m, f),
- hana::flatten(hana::transform(m, f))
- ));
- // consistency of `monadic_compose`
- BOOST_HANA_CHECK(hana::equal(
- hana::monadic_compose(f, g)(x),
- hana::chain(g(x), f)
- ));
- });
- // consistency of `flatten`
- hana::for_each(xxs, [](auto mm) {
- BOOST_HANA_CHECK(hana::equal(
- hana::flatten(mm),
- hana::chain(mm, hana::id)
- ));
- });
- }
- };
- template <typename S>
- struct TestMonad<S, when<Sequence<S>::value>>
- : TestMonad<S, laws>
- {
- template <typename Xs, typename XXs>
- TestMonad(Xs xs, XXs xxs)
- : TestMonad<S, laws>{xs, xxs}
- {
- constexpr auto list = make<S>;
- //////////////////////////////////////////////////////////////////
- // flatten
- //////////////////////////////////////////////////////////////////
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::flatten(list(list(), list())),
- list()
- ));
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::flatten(list(list(ct_eq<0>{}), list())),
- list(ct_eq<0>{})
- ));
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::flatten(list(list(), list(ct_eq<0>{}))),
- list(ct_eq<0>{})
- ));
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::flatten(list(list(ct_eq<0>{}), list(ct_eq<1>{}))),
- list(ct_eq<0>{}, ct_eq<1>{})
- ));
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::flatten(list(
- list(ct_eq<0>{}, ct_eq<1>{}),
- list(),
- list(ct_eq<2>{}, ct_eq<3>{}),
- list(ct_eq<4>{})
- )),
- list(ct_eq<0>{}, ct_eq<1>{}, ct_eq<2>{}, ct_eq<3>{}, ct_eq<4>{})
- ));
- // just make sure we don't double move; this happened in hana::tuple
- hana::flatten(list(list(Tracked{1}, Tracked{2})));
- //////////////////////////////////////////////////////////////////
- // chain
- //////////////////////////////////////////////////////////////////
- {
- test::_injection<0> f{};
- auto g = hana::compose(list, f);
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::chain(list(), g),
- list()
- ));
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::chain(list(ct_eq<1>{}), g),
- list(f(ct_eq<1>{}))
- ));
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::chain(list(ct_eq<1>{}, ct_eq<2>{}), g),
- list(f(ct_eq<1>{}), f(ct_eq<2>{}))
- ));
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::chain(list(ct_eq<1>{}, ct_eq<2>{}, ct_eq<3>{}), g),
- list(f(ct_eq<1>{}), f(ct_eq<2>{}), f(ct_eq<3>{}))
- ));
- BOOST_HANA_CONSTANT_CHECK(hana::equal(
- hana::chain(list(ct_eq<1>{}, ct_eq<2>{}, ct_eq<3>{}, ct_eq<4>{}), g),
- list(f(ct_eq<1>{}), f(ct_eq<2>{}), f(ct_eq<3>{}), f(ct_eq<4>{}))
- ));
- }
- //////////////////////////////////////////////////////////////////
- // monadic_compose
- //////////////////////////////////////////////////////////////////
- {
- test::_injection<0> f{};
- test::_injection<1> g{};
- auto mf = [=](auto x) { return list(f(x), f(f(x))); };
- auto mg = [=](auto x) { return list(g(x), g(g(x))); };
- auto x = test::ct_eq<0>{};
- BOOST_HANA_CHECK(hana::equal(
- hana::monadic_compose(mf, mg)(x),
- list(f(g(x)), f(f(g(x))), f(g(g(x))), f(f(g(g(x)))))
- ));
- }
- }
- };
- }}} // end namespace boost::hana::test
- #endif // !BOOST_HANA_TEST_LAWS_MONAD_HPP
|