510 lines
11 KiB
Rust
510 lines
11 KiB
Rust
use std::{
|
|
fmt::Debug,
|
|
ops::{Add, AddAssign},
|
|
};
|
|
|
|
use local::LocalFunctor;
|
|
|
|
use super::applicative_select::*;
|
|
use super::controlflow::*;
|
|
use super::fail::*;
|
|
use super::shared::*;
|
|
use super::*;
|
|
|
|
pub struct TestResults {
|
|
success: usize,
|
|
total: usize,
|
|
result: Result<(), String>,
|
|
}
|
|
|
|
pub type R = TestResults;
|
|
|
|
impl R {
|
|
pub fn unwrap(self) {
|
|
if let Self {
|
|
success,
|
|
total,
|
|
result: Err(e),
|
|
} = self
|
|
{
|
|
panic!("failed:\n{success}/{total}\n{e}\n")
|
|
}
|
|
}
|
|
}
|
|
|
|
pub trait Eqr<'a>: WeakFunctor<'a> {
|
|
fn eqr<A: 'a + Send + PartialEq + Debug>(
|
|
name: &'a str,
|
|
left: Self::F<A>,
|
|
right: Self::F<A>,
|
|
) -> R;
|
|
}
|
|
|
|
pub fn eqr<T: PartialEq + Debug>(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(el), Err(er)) => Err(el + "\n" + er.as_str()),
|
|
(e, Ok(_)) => e,
|
|
(Ok(_), e) => e,
|
|
},
|
|
}
|
|
}
|
|
}
|
|
|
|
impl AddAssign<R> 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 el), Err(er)) => {
|
|
*el += "\n";
|
|
*el += er.as_str()
|
|
}
|
|
(_, Ok(_)) => {}
|
|
(rl, Err(er)) => *rl = Err(er),
|
|
}
|
|
}
|
|
}
|
|
|
|
#[cfg(test)]
|
|
mod eqr_tests {
|
|
use super::{eqr, R};
|
|
|
|
#[test]
|
|
fn eqr_ok() {
|
|
eqr("test", 0, 0).unwrap();
|
|
}
|
|
|
|
#[test]
|
|
#[should_panic(expected = "test: 1 != 2")]
|
|
fn eqr_panic() {
|
|
eqr("test", 1, 2).unwrap();
|
|
}
|
|
|
|
#[test]
|
|
#[should_panic]
|
|
fn eqr_err_add() {
|
|
(R::default() + eqr("test", 1, 2) + eqr("test", 3, 4)).unwrap();
|
|
}
|
|
|
|
#[test]
|
|
#[should_panic]
|
|
fn eqr_err_add_assign() {
|
|
let mut r = R::default();
|
|
r += eqr("test", 1, 2);
|
|
r += eqr("test", 3, 4);
|
|
r.unwrap();
|
|
}
|
|
}
|
|
|
|
pub fn fmap_respects_identity<'a, T: Functor<'a> + Eqr<'a>, A: 'a + Send + Debug + PartialEq>(
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr("identity: fmap id == id", T::fmap(fa0(), |a| a), fa0())
|
|
}
|
|
|
|
pub fn fmap_respects_composition<
|
|
'a,
|
|
T: Functor<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send,
|
|
C: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
f: impl 'a + Send + Copy + Fn(B) -> C,
|
|
g: impl 'a + Send + Copy + Fn(A) -> B,
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"composition: fmap (f . g) == fmap f . fmap g",
|
|
T::fmap(fa0(), move |a| f(g(a))),
|
|
T::fmap(T::fmap(fa0(), g), f),
|
|
)
|
|
}
|
|
|
|
pub fn seq_respects_identity<'a, T: Applicative<'a> + Eqr<'a>, A: 'a + Send + Debug + PartialEq>(
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"identity: pure id <*> v = v",
|
|
T::seq(T::pure(|a| a), fa0()),
|
|
fa0(),
|
|
)
|
|
}
|
|
|
|
pub fn seq_respects_composition<
|
|
'a,
|
|
T: Applicative<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send,
|
|
C: 'a + Send + Debug + PartialEq,
|
|
F: 'a + Send + Fn(B) -> C,
|
|
G: 'a + Send + Fn(A) -> B,
|
|
>(
|
|
ff0: impl Fn() -> T::F<F>,
|
|
fg0: impl Fn() -> T::F<G>,
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> 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: Applicative<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
f: impl 'a + Send + Fn(A) -> B,
|
|
a0: impl Fn() -> A,
|
|
) -> 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: Applicative<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
F: 'a + Send + Fn(A) -> B,
|
|
>(
|
|
ff0: impl Fn() -> T::F<F>,
|
|
a0: impl 'a + Send + Fn() -> A,
|
|
) -> 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: Applicative<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
F: 'a + Send + Fn(A) -> B,
|
|
>(
|
|
ff0: impl Fn() -> T::F<F>,
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"seq via la2: (<*>) = liftA2 id",
|
|
T::seq(ff0(), fa0()),
|
|
T::la2(ff0(), fa0(), |f, a| f(a)),
|
|
)
|
|
}
|
|
|
|
pub fn fmap_can_be_expressed_via_seq<
|
|
'a,
|
|
T: Applicative<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
f: impl 'a + Send + Copy + Fn(A) -> B,
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"fmap via seq: fmap f x = pure f <*> x",
|
|
T::fmap(fa0(), f),
|
|
T::seq(T::pure(f), fa0()),
|
|
)
|
|
}
|
|
|
|
pub fn discard_can_be_expressed_via_seq_or_la2<
|
|
'a,
|
|
T: Applicative<'a> + Eqr<'a>,
|
|
A: 'a + Send + Debug + PartialEq,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
fa0: impl 'a + Fn() -> T::F<A>,
|
|
fb0: impl 'a + Fn() -> T::F<B>,
|
|
) -> 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(fa0(), fb0()),
|
|
T::la2(fa0(), fb0(), |a, _| a),
|
|
)
|
|
}
|
|
|
|
pub fn bind_respects_left_identity<
|
|
'a,
|
|
T: Monad<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
f: impl 'a + Send + Fn(A) -> T::F<B>,
|
|
a0: impl Fn() -> A,
|
|
) -> 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: Monad<'a> + Eqr<'a>,
|
|
A: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"right identity: m >>= bind = m",
|
|
T::bind(fa0(), T::pure),
|
|
fa0(),
|
|
)
|
|
}
|
|
|
|
pub fn bind_is_associative<
|
|
'a,
|
|
T: Monad<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send,
|
|
C: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
f: impl 'a + Send + Clone + Fn(B) -> T::F<C>,
|
|
g: impl 'a + Send + Clone + Fn(A) -> T::F<B>,
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> 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: Monad<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
F: 'a + Send + Fn(A) -> B,
|
|
>(
|
|
ff0: impl Fn() -> T::F<F>,
|
|
fa0: impl 'a + Send + Fn() -> T::F<A>,
|
|
) -> 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: Monad<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
f: impl 'a + Send + Copy + Fn(A) -> B,
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"fmap via bind: fmap f xs = xs >>= return . f",
|
|
T::fmap(fa0(), f),
|
|
T::bind(fa0(), move |a| T::pure(f(a))),
|
|
)
|
|
}
|
|
|
|
pub fn void_can_be_exressed_via_replace<
|
|
'a,
|
|
T: Functor<'a> + Eqr<'a>,
|
|
A: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
fa0: impl Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"void via bind: void x = () <$ x",
|
|
T::void(fa0()),
|
|
T::replace(fa0(), ()),
|
|
)
|
|
}
|
|
|
|
pub fn tuple_can_be_expressed_via_la2<
|
|
'a,
|
|
T: Applicative<'a> + Eqr<'a>,
|
|
A: 'a + Send + Debug + PartialEq,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
fa0: impl Fn() -> T::F<A>,
|
|
fb0: impl Fn() -> T::F<B>,
|
|
) -> R {
|
|
T::eqr(
|
|
"tuple via la2",
|
|
T::tuple((fa0(), fb0())),
|
|
T::la2(fa0(), fb0(), |a, b| (a, b)),
|
|
)
|
|
}
|
|
|
|
pub fn join_can_be_expressed_via_bind<
|
|
'a,
|
|
T: Monad<'a> + Eqr<'a>,
|
|
A: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
ffa0: impl Fn() -> T::F<T::F<A>>,
|
|
) -> R {
|
|
T::eqr(
|
|
"join via bind: join x = x >>= id",
|
|
T::join(ffa0()),
|
|
T::bind(ffa0(), |fa| fa),
|
|
)
|
|
}
|
|
|
|
enum TestIterative<'a, T: Monad<'a>, A: 'a + Send, B: 'a + Send, F: 'a + FnOnce(A) -> T::F<B>> {
|
|
Pre(T::F<A>, F),
|
|
Post(T::F<B>),
|
|
}
|
|
|
|
impl<'a, T: Monad<'a>, A: 'a + Send, B: 'a + Send, F: 'a + Send + FnOnce(A) -> T::F<B>>
|
|
Iterative<'a> for TestIterative<'a, T, A, B, F>
|
|
{
|
|
type B = B;
|
|
|
|
type T = T;
|
|
|
|
fn next(self) -> IterativeWrapped<'a, Self> {
|
|
match self {
|
|
Self::Pre(fa, f) => T::fmap(fa, |a| ControlFlow::Continue(Self::Post(f(a)))),
|
|
Self::Post(fb) => T::fmap(fb, ControlFlow::Break),
|
|
}
|
|
}
|
|
}
|
|
|
|
pub fn iterate_can_be_expressed_via_bind<
|
|
'a,
|
|
T: Monad<'a> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
F: 'a + Send + Fn(A) -> T::F<B>,
|
|
>(
|
|
fa0: impl 'a + Fn() -> T::F<A>,
|
|
f0: impl 'a + Fn() -> F,
|
|
) -> R {
|
|
T::eqr(
|
|
"iterate via bind",
|
|
T::iterate(TestIterative::Pre(fa0(), f0())),
|
|
T::bind(fa0(), f0()),
|
|
)
|
|
}
|
|
|
|
pub fn select_of_equal_is_same<
|
|
'a,
|
|
T: Applicative<'a> + Eqr<'a>,
|
|
A: 'a + Send + Debug + PartialEq,
|
|
>(
|
|
fa0: impl 'a + Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"select of equal",
|
|
T::fmap(T::select(fa0(), fa0()), |selected| match selected {
|
|
Selected::A(a, _) | Selected::B(_, a) => a,
|
|
}),
|
|
fa0(),
|
|
)
|
|
}
|
|
|
|
pub fn shared_is_same_as_original<
|
|
'a,
|
|
T: SharedFunctor<'a> + Eqr<'a>,
|
|
A: 'a + Send + Sync + Clone + Debug + PartialEq,
|
|
>(
|
|
fa0: impl 'a + Fn() -> T::F<A>,
|
|
) -> R {
|
|
T::eqr(
|
|
"shared same as original",
|
|
T::unshare(T::share(fa0())),
|
|
fa0(),
|
|
)
|
|
}
|
|
|
|
pub fn shared_is_same_after_clone<
|
|
'a,
|
|
T: SharedFunctor<'a> + Eqr<'a>,
|
|
A: 'a + Send + Sync + Clone + Debug + PartialEq,
|
|
>(
|
|
fa0: impl 'a + Fn() -> T::F<A>,
|
|
) -> R {
|
|
let sa = T::share(fa0());
|
|
T::eqr(
|
|
"shared same as original",
|
|
T::unshare(sa.clone()),
|
|
T::unshare(sa),
|
|
)
|
|
}
|
|
|
|
pub fn fmap_keeps_fail<
|
|
'a,
|
|
T: Functor<'a> + Fail<'a, E> + Eqr<'a>,
|
|
A: 'a + Send,
|
|
B: 'a + Send + Debug + PartialEq,
|
|
E: 'a + Send,
|
|
>(
|
|
e0: impl 'a + Send + Fn() -> E,
|
|
f: impl 'a + Send + Fn(A) -> B,
|
|
) -> R {
|
|
T::eqr("fmap fail", T::fmap(T::fail(e0()), f), T::fail(e0()))
|
|
}
|
|
|
|
pub fn local_self_composes<
|
|
'a,
|
|
T: LocalFunctor<'a> + Monad<'a> + Eqr<'a>,
|
|
A: 'a + Send + Debug + PartialOrd,
|
|
>(
|
|
ffa0: impl Fn() -> T::F<T::F<A>>,
|
|
) -> R {
|
|
T::eqr(
|
|
"local self",
|
|
T::join(T::stuff::<_, T>(T::stuff::<_, T>(ffa0()))),
|
|
T::join(ffa0()),
|
|
)
|
|
}
|