radn-rs/src/func/classes/overload.rs

use std::marker::PhantomData;

use crate::func::*;

pub struct OverloadClass<T, O>(T, O);

pub trait DeriveWeakFunctor {}
impl<O: DeriveFunctor> DeriveWeakFunctor for O {}
pub trait DeriveFunctor {}
impl<O: DeriveApplicative> DeriveFunctor for O {}
pub trait DeriveApplicative {}
impl<O: DeriveMonad> DeriveApplicative for O {}
pub trait DeriveMonad {}

impl<T: WeakFunctor, O: DeriveWeakFunctor> WeakFunctor for OverloadClass<T, O> {
    type F<'a, A: 'a> = T::F<'a, A>
    where
        Self: 'a;
}

impl<T: Functor, O: DeriveFunctor> Functor for OverloadClass<T, O> {
    fn fmap<'a, A: 'a, B: 'a>(f: impl 'a + FnOnce(A) -> B, fa: Self::F<'a, A>) -> Self::F<'a, B>
    where
        Self: 'a,
    {
        T::fmap(f, fa)
    }

    fn replace<'a, A: 'a, B: 'a>(fa: Self::F<'a, A>, b: B) -> Self::F<'a, B>
    where
        Self: 'a,
    {
        T::replace(fa, b)
    }

    fn void<'a, A: 'a>(fa: Self::F<'a, A>) -> Self::F<'a, ()>
    where
        Self: 'a,
    {
        T::void(fa)
    }
}

impl<T: Pure, O: DeriveApplicative> Pure for OverloadClass<T, O> {
    fn pure<'a, A: 'a>(a: A) -> Self::F<'a, A>
    where
        Self: 'a,
    {
        T::pure(a)
    }
}

impl<T: ApplicativeSeq, O: DeriveApplicative> ApplicativeSeq for OverloadClass<T, O> {
    fn seq<'a, A: 'a, B: 'a>(
        ff: Self::F<'a, impl 'a + FnOnce(A) -> B>,
        fa: Self::F<'a, A>,
    ) -> Self::F<'a, B>
    where
        Self: 'a,
    {
        T::seq(ff, fa)
    }
}

impl<T: ApplicativeLA2, O: DeriveApplicative> ApplicativeLA2 for OverloadClass<T, O> {
    fn la2<'a, A: 'a, B: 'a, C: 'a>(
        f: impl 'a + FnOnce(A, B) -> C,
        fa: Self::F<'a, A>,
        fb: Self::F<'a, B>,
    ) -> Self::F<'a, C>
    where
        Self: 'a,
    {
        T::la2(f, fa, fb)
    }
}

impl<T: ApplicativeTuple, O: DeriveApplicative> ApplicativeTuple for OverloadClass<T, O> {
    fn tuple<'a, A: 'a, B: 'a>(fab: (Self::F<'a, A>, Self::F<'a, B>)) -> Self::F<'a, (A, B)>
    where
        Self: 'a,
    {
        T::tuple(fab)
    }
}

impl<T: Applicative, O: DeriveApplicative> Applicative for OverloadClass<T, O> {
    fn discard_first<'a, A: 'a, B: 'a>(fa: Self::F<'a, A>, fb: Self::F<'a, B>) -> Self::F<'a, B>
    where
        Self: 'a,
    {
        T::discard_first(fa, fb)
    }

    fn discard_second<'a, A: 'a, B: 'a>(fa: Self::F<'a, A>, fb: Self::F<'a, B>) -> Self::F<'a, A>
    where
        Self: 'a,
    {
        T::discard_second(fa, fb)
    }
}

struct OverloadIterative<F, O>(F, PhantomData<O>);

impl<F, O> OverloadIterative<F, O> {
    fn new(f: F) -> Self {
        Self(f, PhantomData)
    }
}

impl<'a, T: 'a + Monad, O: 'a + DeriveMonad, F: AIterative<'a, T = OverloadClass<T, O>>>
    AIterative<'a> for OverloadIterative<F, O>
{
    type A = F::A;

    type B = F::B;

    type T = T;

    fn next(self, a: Self::A) -> AIterativeWrapped<'a, Self> {
        T::fmap(
            |state| match state {
                ControlFlow::Continue((next_a, next_f)) => {
                    ControlFlow::Continue((next_a, Self::new(next_f)))
                }
                ControlFlow::Break(b) => ControlFlow::Break(b),
            },
            self.0.next(a),
        )
    }
}

impl<'a, T: 'a + Monad, O: 'a + DeriveMonad, F: Iterative<'a, T = OverloadClass<T, O>>>
    Iterative<'a> for OverloadIterative<F, O>
{
    type B = F::B;

    type T = T;

    fn next(self) -> IterativeWrapped<'a, Self> {
        T::fmap(
            |state| match state {
                ControlFlow::Continue(next_f) => ControlFlow::Continue(Self::new(next_f)),
                ControlFlow::Break(b) => ControlFlow::Break(b),
            },
            self.0.next(),
        )
    }
}

impl<T: Monad, O: DeriveMonad> Monad for OverloadClass<T, O> {
    fn bind<'a, A: 'a, B: 'a>(
        fa: Self::F<'a, A>,
        f: impl 'a + FnOnce(A) -> Self::F<'a, B>,
    ) -> Self::F<'a, B>
    where
        Self: 'a,
    {
        T::bind(fa, f)
    }

    fn iterate_mut<'a, A: 'a, B: 'a>(
        a: A,
        f: impl 'a + FnMut(A) -> Self::F<'a, ControlFlow<B, A>>,
    ) -> Self::F<'a, B>
    where
        Self: 'a,
    {
        T::iterate_mut(a, f)
    }

    fn iterate_argument<'a, A: 'a, B: 'a>(
        a: A,
        f: impl AIterative<'a, T = Self, A = A, B = B>,
    ) -> Self::F<'a, B>
    where
        Self: 'a,
    {
        T::iterate_argument(a, OverloadIterative::new(f))
    }

    fn iterate<'a, B: 'a>(f: impl Iterative<'a, T = Self, B = B>) -> Self::F<'a, B>
    where
        Self: 'a,
    {
        T::iterate(OverloadIterative::new(f))
    }

    fn join<'a, A: 'a>(ffa: Self::F<'a, Self::F<'a, A>>) -> Self::F<'a, A>
    where
        Self::F<'a, A>: 'a,
        Self: 'a,
    {
        T::join(ffa)
    }
}

pub struct DeriveFail<Ex>(Ex);

impl<Ex> DeriveMonad for DeriveFail<Ex> {}

impl<E, Ex, T: MonadFail<Result<E, Ex>>> Fail<E> for OverloadClass<T, DeriveFail<Ex>> {
    fn fail<'a, A: 'a>(e: E) -> Self::F<'a, A>
    where
        Self: 'a,
        E: 'a,
    {
        T::fail(Ok(e))
    }
}

struct DeriveFailAny<Ex, Fallible>(Ex, Fallible);

impl<Ex, Fallible: MonadFailAny> MonadFailAny for DeriveFailAny<Ex, Fallible> {
    type W<E> = OverloadClass<Fallible::W<Result<E, Ex>>, DeriveFail<Ex>>;

    type T = Fallible::W<Ex>;

    fn map_err<'a, A: 'a, E0: 'a, E1: 'a>(
        wa: <Self::W<E0> as WeakFunctor>::F<'a, A>,
        f: impl 'a + FnOnce(E0) -> E1,
    ) -> <Self::W<E1> as WeakFunctor>::F<'a, A>
    where
        Self: 'a,
    {
        Fallible::map_err(wa, |err| err.map(f))
    }

    fn bind_err<'a, A: 'a, E0: 'a, E1: 'a>(
        wa: <Self::W<E0> as WeakFunctor>::F<'a, A>,
        f: impl 'a + FnOnce(E0) -> <Self::W<E1> as WeakFunctor>::F<'a, A>,
    ) -> <Self::W<E1> as WeakFunctor>::F<'a, A>
    where
        Self: 'a,
    {
        Fallible::bind_err(wa, |err| match err {
            Ok(e0) => f(e0),
            Err(ex) => Fallible::fail(Err(ex)),
        })
    }

    fn bind<'a, A: 'a, B: 'a, E0: 'a, E1: 'a>(
        wa: <Self::W<E0> as WeakFunctor>::F<'a, A>,
        f: impl 'a + FnOnce(Result<A, E0>) -> <Self::W<E1> as WeakFunctor>::F<'a, B>,
    ) -> <Self::W<E1> as WeakFunctor>::F<'a, B>
    where
        Self: 'a,
    {
        Fallible::bind(wa, |result| match result {
            Ok(a) => f(Ok(a)),
            Err(Ok(e0)) => f(Err(e0)),
            Err(Err(ex)) => Fallible::fail(Err(ex)),
        })
    }
    fn unstuff<'a, A: 'a, E: 'a>(
        wa: <Self::W<E> as WeakFunctor>::F<'a, A>,
    ) -> <Fallible::W<Ex> as WeakFunctor>::F<'a, Result<A, E>>
    where
        Self: 'a,
        Fallible::W<Ex>: 'a,
    {
        Fallible::bind_err(<Self::W<E> as Functor>::fmap(Ok, wa), |err| match err {
            Ok(e) => Fallible::pure(Err(e)),
            Err(ex) => Fallible::fail(ex),
        })
    }

    fn stuff<'a, A: 'a, E: 'a>(
        fa: <Fallible::W<Ex> as WeakFunctor>::F<'a, Result<A, E>>,
    ) -> <Self::W<E> as WeakFunctor>::F<'a, A>
    where
        Self: 'a,
        Fallible::W<Ex>: 'a,
    {
        Fallible::bind(fa, |result| match result {
            Ok(Ok(a)) => Fallible::pure(a),
            Ok(Err(e)) => Fallible::fail(Ok(e)),
            Err(ex) => Fallible::fail(Err(ex)),
        })
    }
}

impl<T: SharedFunctor, O: DeriveWeakFunctor> SharedFunctor for OverloadClass<T, O> {
    type Shared<'a, A: 'a + Clone> = T::Shared<'a, A>
    where
        Self: 'a;

    fn share<'a, A: 'a + Clone>(fa: Self::F<'a, A>) -> Self::Shared<'a, A>
    where
        Self: 'a,
    {
        T::share(fa)
    }

    fn unshare<'a, A: 'a + Clone>(sa: Self::Shared<'a, A>) -> Self::F<'a, A>
    where
        Self: 'a,
    {
        T::unshare(sa)
    }
}

impl<T: CovariantFunctor, O: DeriveWeakFunctor> CovariantFunctor for OverloadClass<T, O> {
    fn variate<'a: 'b, 'b, A: 'a>(fa: Self::F<'a, A>) -> Self::F<'b, A>
    where
        Self: 'a,
    {
        T::variate(fa)
    }
}

pub type EmbedFail<T, Ex> = OverloadClass<T, DeriveFail<Ex>>;