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

use std::marker::PhantomData;

use crate::func::*;

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

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

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

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

impl<'a, T: Pure<'a>, O: 'a + DeriveApplicative> Pure<'a> for OverloadInstance<T, O> {
    fn pure<A: 'a>(a: A) -> Self::Fa<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::Fa<impl 'a + FnOnce(A) -> B>, fa: Self::Fa<A>) -> Self::Fa<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>(
        f: impl 'a + FnOnce(A, B) -> C,
        fa: Self::Fa<A>,
        fb: Self::Fa<B>,
    ) -> Self::Fa<C> {
        T::la2(f, fa, fb)
    }
}

impl<'a, T: ApplicativeTuple<'a>, O: 'a + DeriveApplicative> ApplicativeTuple<'a>
    for OverloadInstance<T, O>
{
    fn tuple<A: 'a, B: 'a>(fab: (Self::Fa<A>, Self::Fa<B>)) -> Self::Fa<(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::Fa<A>, fb: Self::Fa<B>) -> SelectedWrapped<'a, A, B, Self> {
        T::select_map(
            |selected| match selected {
                Selected::A(a, fb) => Selected::A(a, fb),
                Selected::B(fa, b) => Selected::B(fa, b),
            },
            fa,
            fb,
        )
    }
}

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

    fn discard_second<A: 'a, B: 'a>(fa: Self::Fa<A>, fb: Self::Fa<B>) -> Self::Fa<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(
            |state| match state {
                ControlFlow::Continue(next_f) => ControlFlow::Continue(Self::new(next_f)),
                ControlFlow::Break(b) => ControlFlow::Break(b),
            },
            self.0.next(),
        )
    }
}

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

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

    fn join<A: 'a>(ffa: Self::Fa<Self::Fa<A>>) -> Self::Fa<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 OverloadInstance<T, DeriveFail<Ex>>
{
    fn fail<A: 'a>(e: E) -> Self::Fa<A> {
        T::fail(Ok(e))
    }
}

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

impl<'a, Ex: 'a, Fallible: MonadFailAny<'a>> MonadFailAny<'a> for DeriveFailAny<Ex, Fallible> {
    type W<E: 'a> = OverloadInstance<Fallible::W<Result<E, Ex>>, DeriveFail<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(Ok, wa), |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: SharedFunctorA<'a>, O: 'a + DeriveWeakFunctor> SharedFunctorA<'a>
    for OverloadInstance<T, O>
{
    type SharedA<A: 'a + Clone> = T::SharedA<A>;

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

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

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