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 __anona981b7c40402boost::hana::test::TestMonad209 auto mf = [=](auto x) { return list(f(x), f(f(x))); }; __anona981b7c40502boost::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