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

//! Add extra behaviour on top of an existing instance.
//!
//! Initially made as [`EmbedFail`] implementation detail.
//!
//! For combining existing [instances], see [`composition`].
//!
//! [`composition`]: super::composition

use std::marker::PhantomData;

use crate::func::class_prelude::*;

pub struct OverloadInstance<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<'a, T: WeakFunctor<'a>, O: 'a + DeriveWeakFunctor> WeakFunctor<'a> for OverloadInstance<T, O> {
    type F<A: 'a> = T::F<A>;
}

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

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

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

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

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

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

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

impl<'a, T: ApplicativeSelect<'a>, O: 'a + DeriveApplicative> ApplicativeSelect<'a>
    for OverloadInstance<T, O>
{
    fn select<A: 'a, B: 'a>(fa: Self::F<A>, fb: Self::F<B>) -> SelectedWrapped<'a, A, B, Self> {
        T::select_map(fa, fb, |selected| match selected {
            Selected::A(a, fb) => Selected::A(a, fb),
            Selected::B(fa, b) => Selected::B(fa, b),
        })
    }
}

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

    fn discard_second<A: 'a, B: 'a>(fa: Self::F<A>, fb: Self::F<B>) -> Self::F<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: Monad<'a>, O: 'a + DeriveMonad, F: Iterative<'a, T = OverloadInstance<T, O>>>
    Iterative<'a> for OverloadIterative<F, O>
{
    type B = F::B;

    type T = T;

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

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

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

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

pub struct DeriveFail<Ex>(Ex);

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

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

/// Instance of [`MonadFailAny`] for [`EmbedFail`].
pub struct DeriveFailAny<Ex, Fallible>(Ex, Fallible);

impl<'a, Ex: 'a, Fallible: MonadFailAny<'a>> MonadFailAny<'a> for DeriveFailAny<Ex, Fallible> {
    type W<E: 'a> = EmbedFail<Fallible::W<Result<E, Ex>>, Ex>;

    type T = Fallible::W<Ex>;

    fn unstuff<A: 'a, E: 'a>(wa: WrapE<'a, A, E, Self>) -> Wrap<'a, Result<A, E>, Self::T> {
        Fallible::bind_err(<Self::W<E> as Functor>::fmap(wa, Ok), |err| match err {
            Ok(e) => Fallible::pure(Err(e)),
            Err(ex) => Fallible::fail(ex),
        })
    }

    fn stuff<A: 'a, E: 'a>(fa: Wrap<'a, Result<A, E>, Self::T>) -> WrapE<'a, A, E, Self> {
        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)),
        })
    }

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

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

    fn bind<A: 'a, B: 'a, E0: 'a, E1: 'a>(
        wa: WrapE<'a, A, E0, Self>,
        f: impl 'a + FnOnce(Result<A, E0>) -> WrapE<'a, B, E1, Self>,
    ) -> WrapE<'a, B, E1, Self> {
        Fallible::bind(wa, |result| match result {
            Ok(a) => f(Ok(a)),
            Err(Ok(e0)) => f(Err(e0)),
            Err(Err(ex)) => Fallible::fail(Err(ex)),
        })
    }
}

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

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

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

/// [`MonadFail`] based on embedding the error into some other [`MonadFailAny`].
pub type EmbedFail<T, Ex> = OverloadInstance<T, DeriveFail<Ex>>;