use super::*; use core::fmt::Debug; use std::ops::{Add, AddAssign}; pub struct TestResults { success: usize, total: usize, result: Result<(), String>, } pub type R = TestResults; impl R { pub fn unwrap(self) { match self { TestResults { success, total, result: Err(e), } => panic!("failed:\n{success}/{total}\n{e}\n"), _ => (), }; } } pub trait Eqr: WeakFunctor { fn eqr<'a, A: PartialEq + Debug>( name: &'a str, left: Self::F<'a, A>, right: Self::F<'a, A>, ) -> R; } pub fn eqr(name: &str, left: T, right: T) -> R { if left == right { TestResults { success: 1, total: 1, result: Ok(()), } } else { TestResults { success: 0, total: 1, result: Err(format!("{name}: {:?} != {:?}", left, right)), } } } impl Default for R { fn default() -> Self { Self { success: 0, total: 0, result: Ok(()), } } } impl Add for R { type Output = R; fn add(self, rhs: Self) -> Self::Output { Self { success: self.success + rhs.success, total: self.total + rhs.total, result: match (self.result, rhs.result) { (Err(le), Err(re)) => Err(le + "\n" + re.as_str()), (e, Ok(_)) => e, (Ok(_), e) => e, }, } } } impl AddAssign for R { fn add_assign(&mut self, rhs: R) { self.success += rhs.success; self.total += rhs.total; match (&mut self.result, rhs.result) { (Err(ref mut le), Err(re)) => { *le += "\n"; *le += re.as_str() } (_, Ok(_)) => {} (lr, Err(re)) => *lr = Err(re), } } } pub fn fmap_respects_identity< 'a, T: 'a + Functor + Eqr, A: 'a + Debug + PartialEq, FA0: Fn() -> T::F<'a, A>, >( fa0: FA0, ) -> R { T::eqr("identity: fmap id == id", T::fmap(|a| a, fa0()), fa0()) } pub fn fmap_respects_composition< 'a, T: 'a + Functor + Eqr, A: 'a, B: 'a, C: 'a + Debug + PartialEq, F: 'a + Copy + Fn(B) -> C, G: 'a + Copy + Fn(A) -> B, FA0: Fn() -> T::F<'a, A>, >( f: F, g: G, fa0: FA0, ) -> R { T::eqr( "composition: fmap (f . g) == fmap f . fmap g", T::fmap(move |a| f(g(a)), fa0()), T::fmap(f, T::fmap(g, fa0())), ) } pub fn seq_respects_identity< 'a, T: 'a + Applicative + Eqr, A: 'a + Debug + PartialEq, FA0: Fn() -> T::F<'a, A>, >( fa0: FA0, ) -> R { T::eqr( "identity: pure id <*> v = v", T::seq(T::pure(|a| a), fa0()), fa0(), ) } pub fn seq_respects_composition< 'a, T: 'a + Applicative + Eqr, A: 'a, B: 'a, C: 'a + Debug + PartialEq, F: 'a + Fn(B) -> C, G: 'a + Fn(A) -> B, FF0: Fn() -> T::F<'a, F>, FG0: Fn() -> T::F<'a, G>, FA0: Fn() -> T::F<'a, A>, >( ff0: FF0, fg0: FG0, fa0: FA0, ) -> R { T::eqr( "composition: pure (.) <*> u <*> v <*> w = u <*> (v <*> w)", T::seq( T::seq( T::seq(T::pure(|f: F| move |g: G| move |a| f(g(a))), ff0()), fg0(), ), fa0(), ), T::seq(ff0(), T::seq(fg0(), fa0())), ) } pub fn seq_is_homomorphic< 'a, T: 'a + Applicative + Eqr, A: 'a, B: 'a + Debug + PartialEq, A0: Fn() -> A, F: 'a + Fn(A) -> B, >( f: F, a0: A0, ) -> R { T::eqr( "homomorphism: pure f <*> pure x = pure (f x)", T::pure(f(a0())), T::seq(T::pure(f), T::pure(a0())), ) } pub fn seq_respects_interchange< 'a, T: 'a + Applicative + Eqr, A: 'a, B: 'a + Debug + PartialEq, F: 'a + Fn(A) -> B, A0: 'a + Fn() -> A, FF0: Fn() -> T::F<'a, F>, >( ff0: FF0, a0: A0, ) -> R { T::eqr( "interchange: u <*> pure y = pure ($ y) <*> u", T::seq(ff0(), T::pure(a0())), T::seq(T::pure(move |f: F| f(a0())), ff0()), ) } pub fn seq_can_be_expressed_via_la2< 'a, T: 'a + Applicative + Eqr, A: 'a, B: 'a + Debug + PartialEq, F: 'a + Fn(A) -> B, FA0: Fn() -> T::F<'a, A>, FF0: Fn() -> T::F<'a, F>, >( ff0: FF0, fa0: FA0, ) -> R { T::eqr( "seq via la2: (<*>) = liftA2 id", T::seq(ff0(), fa0()), T::la2(|f, a| f(a), ff0(), fa0()), ) } pub fn fmap_can_be_expressed_via_seq< 'a, T: 'a + Applicative + Eqr, A: 'a, B: 'a + Debug + PartialEq, F: 'a + Copy + Fn(A) -> B, FA0: Fn() -> T::F<'a, A>, >( f: F, fa0: FA0, ) -> R { T::eqr( "fmap via seq: fmap f x = pure f <*> x", T::fmap(f, fa0()), T::seq(T::pure(f), fa0()), ) } pub fn discard_can_be_expressed_via_seq_or_la2< 'a, T: 'a + Applicative + Eqr, A: 'a, B: 'a + Debug + PartialEq, FA0: 'a + Fn() -> T::F<'a, A>, FB0: 'a + Fn() -> T::F<'a, B>, >( fa0: FA0, fb0: FB0, ) -> R { T::eqr( "discard via seq: u *> v = (id <$ u) <*> v", T::discard_first(fa0(), fb0()), T::seq(T::replace(fa0(), |b| b), fb0()), ) + T::eqr( "discard via la2: u <* v = liftA2 const u v", T::discard_second(fb0(), fa0()), T::la2(|b, _| b, fb0(), fa0()), ) } pub fn bind_respects_left_identity< 'a, T: 'a + Monad + Eqr, A: 'a, B: 'a + Debug + PartialEq, F: 'a + Fn(A) -> T::F<'a, B>, A0: Fn() -> A, >( f: F, a0: A0, ) -> R { T::eqr( "left identity: pure a >>= k = k a", f(a0()), T::bind(T::pure(a0()), f), ) } pub fn bind_respects_right_identity< 'a, T: 'a + Monad + Eqr, A: 'a + Debug + PartialEq, FA0: Fn() -> T::F<'a, A>, >( fa0: FA0, ) -> R { T::eqr( "right identity: m >>= bind = m", T::bind(fa0(), T::pure), fa0(), ) } pub fn bind_is_associative< 'a, T: 'a + Monad + Eqr, A: 'a, B: 'a, C: 'a + Debug + PartialEq, F: 'a + Clone + Fn(B) -> T::F<'a, C>, G: 'a + Clone + Fn(A) -> T::F<'a, B>, FA0: 'a + Fn() -> T::F<'a, A>, >( f: F, g: G, fa0: FA0, ) -> R { T::eqr( r"associativity: m >>= (\x -> k x >>= h) = (m >>= k) >>= h", T::bind(T::bind(fa0(), g.clone()), f.clone()), T::bind(fa0(), move |a| T::bind(g(a), f)), ) } pub fn seq_can_be_expressed_via_bind< 'a, T: 'a + Monad + Eqr, A: 'a, B: 'a + Debug + PartialEq, F: 'a + Fn(A) -> B, FA0: 'a + Fn() -> T::F<'a, A>, FF0: Fn() -> T::F<'a, F>, >( ff0: FF0, fa0: FA0, ) -> R { T::eqr( r"seq via bind: m1 <*> m2 = m1 >>= (\x1 -> m2 >>= (\x2 -> pure (x1 x2)))", T::seq(ff0(), fa0()), T::bind(ff0(), move |f| T::bind(fa0(), move |a| T::pure(f(a)))), ) } pub fn fmap_can_be_expressed_via_bind< 'a, T: 'a + Monad + Eqr, A: 'a, B: 'a + Debug + PartialEq, F: 'a + Copy + Fn(A) -> B, FA0: 'a + Fn() -> T::F<'a, A>, >( f: F, fa0: FA0, ) -> R { T::eqr( "fmap via bind: fmap f xs = xs >>= return . f", T::fmap(f, fa0()), T::bind(fa0(), move |a| T::pure(f(a))), ) }