use super::applicative::Applicative;
use super::functor::Functor;
use super::monad::Monad;
use super::*;
pub trait MonadTrans {
fn lift<M: Monad, A>(a: K1<M, A>) -> K2<Self, M, A>;
}
pub struct IdentityT;
impl<M, A> Kind2<M, A> for IdentityT {
type Inner = K1<M, A>;
}
impl MonadTrans for IdentityT {
fn lift<M: Monad, A>(a: K1<M, A>) -> K2<Self, M, A> {
Self::new(a)
}
}
impl<M: Functor> Functor for K2P1_1<IdentityT, M> {
fn fmap<A, B, F: Fn(A) -> B>(f: F, a: K1<Self, A>) -> K1<Self, B> {
let a: K1<M, A> = a.into_inner();
let b: K1<M, B> = M::fmap(f, a);
Self::new(b)
}
}
impl<M: Applicative> Applicative for K2P1_1<IdentityT, M> {
fn pure<T>(t: T) -> K1<Self, T> {
Self::new(M::pure(t))
}
fn app<A: Clone, B, F: Fn(A) -> B>(f: K1<Self, F>, a: K1<Self, A>) -> K1<Self, B> {
Self::new(M::app(f.into_inner(), a.into_inner()))
}
}
impl<M: Monad> Monad for K2P1_1<IdentityT, M> {
fn bind<A, B, F: Fn(A) -> K1<Self, B>>(a: K1<Self, A>, f: F) -> K1<Self, B> {
Self::new(M::bind(a.into_inner(), move |x| f(x).into_inner()))
}
}
pub struct OptionT;
impl<M, A> Kind2<M, A> for OptionT {
type Inner = K1<M, Option<A>>;
}
impl MonadTrans for OptionT {
fn lift<M: Monad, A>(a: K1<M, A>) -> K2<Self, M, A> {
Self::new(M::bind(a, |x| M::pure(Some(x))))
}
}
impl<M: Functor> Functor for K2P1_1<OptionT, M> {
fn fmap<A, B, F: Fn(A) -> B>(f: F, a: K1<Self, A>) -> K1<Self, B> {
let a: K1<M, Option<A>> = a.into_inner();
let b: K1<M, Option<B>> = M::fmap(move |maybe| maybe.map(&f), a);
Self::new(b)
}
}
impl<M: Applicative> Applicative for K2P1_1<OptionT, M> {
fn pure<T>(t: T) -> K1<Self, T> {
Self::new(M::pure(Some(t)))
}
fn app<A: Clone, B, F: Fn(A) -> B>(f: K1<Self, F>, a: K1<Self, A>) -> K1<Self, B> {
Self::new(M::app(
M::fmap(
|maybe| {
move |x: Option<A>| {
maybe.as_ref()
.and_then(move |f| x.map(&f))
}
},
f.into_inner()
),
a.into_inner()
))
}
}
impl<M: Monad> Monad for K2P1_1<OptionT, M> {
fn bind<A, B, F: Fn(A) -> K1<Self, B>>(a: K1<Self, A>, f: F) -> K1<Self, B> {
Self::new(M::bind(a.into_inner(), move |maybe| {
match maybe {
Some(value) => f(value).into_inner(),
None => M::pure(None),
}
}))
}
}
#[cfg(test)]
mod test {
use super::*;
fn check_law_return<M: Monad, T: MonadTrans, A>(a: A)
where
M: Kind1<A>,
K2<T, M, A>: PartialEq + core::fmt::Debug,
K2P1_1<T, M>: Monad + Kind1<A>,
T: Kind2<M, A>,
A: Clone,
{
let just_return = Applicative::pure(a.clone()).into();
let lift_return = MonadTrans::lift(Applicative::pure(a));
assert_eq!(lift_return, just_return);
}
fn check_law_bind<M: Monad, T: MonadTrans, A, B, F>(a: K1<M, A>, f: F)
where
M: Kind1<A>,
K1<M, A>: Clone,
K2<T, M, B>: PartialEq + core::fmt::Debug,
K2P1_1<T, M>: Monad,
T: Kind2<M, A> + Kind2<M, B>,
F: Fn(A) -> K1<M, B> + Clone,
{
let bind_first = MonadTrans::lift(Monad::bind(a.clone(), f.clone()));
let lift_first = Monad::bind(MonadTrans::lift(a).into(), |x| MonadTrans::lift(f(x)).into()).into();
assert_eq!(bind_first, lift_first);
}
#[test]
fn identityt_transformer_law_return() {
use crate::types::OptionC;
check_law_return::<OptionC, IdentityT, _>(42);
}
#[test]
fn identityt_transformer_law_bind() {
use crate::types::OptionC;
let f = |n| OptionC::new(Some(n + 1));
let g = |_| OptionC::new(None);
check_law_bind::<OptionC, IdentityT, i32, _, _>(OptionC::new(None), &f);
check_law_bind::<OptionC, IdentityT, _, _, _>(OptionC::new(Some(42)), &f);
check_law_bind::<OptionC, IdentityT, i32, i32, _>(OptionC::new(None), &g);
check_law_bind::<OptionC, IdentityT, _, i32, _>(OptionC::new(Some(42)), &g);
}
#[test]
fn optiont_transformer_law_return() {
use crate::types::OptionC;
check_law_return::<OptionC, OptionT, _>(42);
}
#[test]
fn optiont_transformer_law_bind() {
use crate::types::OptionC;
let f = |n| OptionC::new(Some(n + 1));
let g = |_| OptionC::new(None);
check_law_bind::<OptionC, OptionT, i32, _, _>(OptionC::new(None), &f);
check_law_bind::<OptionC, OptionT, _, _, _>(OptionC::new(Some(42)), &f);
check_law_bind::<OptionC, OptionT, i32, i32, _>(OptionC::new(None), &g);
check_law_bind::<OptionC, OptionT, _, i32, _>(OptionC::new(Some(42)), &g);
}
}