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

impl<T: Functor, O: DeriveFunctor> Functor for OverloadInstance<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 OverloadInstance<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 OverloadInstance<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 OverloadInstance<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<'a, T: ApplicativeTuple<'a>, O: 'a + DeriveApplicative> ApplicativeTuple<'a>
    for OverloadInstance<T, O>
{
    fn tuple<A: 'a, B: 'a>(fab: (Self::F<'a, A>, Self::F<'a, B>)) -> Self::F<'a, (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, A>,
        fb: Self::F<'a, 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::F<'a, A>, fb: Self::F<'a, B>) -> Self::F<'a, B> {
        T::discard_first(fa, fb)
    }

    fn discard_second<A: 'a, B: 'a>(fa: Self::F<'a, A>, fb: Self::F<'a, B>) -> Self::F<'a, 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::F<'a, A>,
        f: impl 'a + FnOnce(A) -> Self::F<'a, B>,
    ) -> Self::F<'a, B> {
        T::bind(fa, f)
    }

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

    fn join<A: 'a>(ffa: Self::F<'a, Self::F<'a, A>>) -> Self::F<'a, 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::F<'a, 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<T: SharedFunctor, O: DeriveWeakFunctor> SharedFunctor for OverloadInstance<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 OverloadInstance<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> = OverloadInstance<T, DeriveFail<Ex>>;