#[cfg(feature = "std")]
use std::boxed::Box;
#[cfg(all(not(feature = "std"), feature = "alloc"))]
use alloc::boxed::Box;
use core::marker::PhantomData;
use karpal_core::applicative::Applicative;
use karpal_core::chain::Chain;
use karpal_core::hkt::HKT;
trait CodensityInner<F: HKT + 'static, A: 'static> {
fn to_monad(self: Box<Self>) -> F::Of<A>
where
F: Applicative + Chain;
}
struct CodensityPure<F: HKT + 'static, A: 'static> {
value: A,
_marker: PhantomData<F>,
}
impl<F: HKT + 'static, A: 'static> CodensityInner<F, A> for CodensityPure<F, A> {
fn to_monad(self: Box<Self>) -> F::Of<A>
where
F: Applicative + Chain,
{
F::pure(self.value)
}
}
struct CodensityMap<F: HKT + 'static, Src: 'static, A: 'static> {
inner: Box<dyn CodensityInner<F, Src>>,
transform: Box<dyn Fn(Src) -> A>,
}
impl<F: HKT + 'static, Src: 'static, A: 'static> CodensityInner<F, A> for CodensityMap<F, Src, A> {
fn to_monad(self: Box<Self>) -> F::Of<A>
where
F: Applicative + Chain,
{
let f_src: F::Of<Src> = self.inner.to_monad();
F::fmap(f_src, self.transform)
}
}
struct CodensityBind<F: HKT + 'static, Src: 'static, A: 'static> {
inner: Box<dyn CodensityInner<F, Src>>,
bind_fn: Box<dyn Fn(Src) -> Codensity<F, A>>,
}
impl<F: HKT + 'static, Src: 'static, A: 'static> CodensityInner<F, A> for CodensityBind<F, Src, A> {
fn to_monad(self: Box<Self>) -> F::Of<A>
where
F: Applicative + Chain,
{
let f_src: F::Of<Src> = self.inner.to_monad();
let bind_fn = self.bind_fn;
F::chain(f_src, move |src| (bind_fn)(src).inner.to_monad())
}
}
pub struct Codensity<F: HKT + 'static, A: 'static> {
inner: Box<dyn CodensityInner<F, A>>,
}
impl<F: HKT + 'static, A: 'static> Codensity<F, A> {
pub fn pure(a: A) -> Self {
Codensity {
inner: Box::new(CodensityPure {
value: a,
_marker: PhantomData,
}),
}
}
pub fn fmap<B: 'static>(self, f: impl Fn(A) -> B + 'static) -> Codensity<F, B> {
Codensity {
inner: Box::new(CodensityMap {
inner: self.inner,
transform: Box::new(f),
}),
}
}
pub fn chain<B: 'static>(self, f: impl Fn(A) -> Codensity<F, B> + 'static) -> Codensity<F, B> {
Codensity {
inner: Box::new(CodensityBind {
inner: self.inner,
bind_fn: Box::new(f),
}),
}
}
pub fn to_monad(self) -> F::Of<A>
where
F: Applicative + Chain,
{
self.inner.to_monad()
}
}
pub struct CodensityF<F: HKT + 'static>(PhantomData<F>);
#[cfg(test)]
mod tests {
use super::*;
use karpal_core::hkt::OptionF;
#[test]
fn pure_to_monad() {
let c = Codensity::<OptionF, i32>::pure(42);
let result = c.to_monad();
assert_eq!(result, Some(42));
}
#[test]
fn fmap_to_monad() {
let c = Codensity::<OptionF, i32>::pure(5).fmap(|x| x * 3);
let result = c.to_monad();
assert_eq!(result, Some(15));
}
#[test]
fn chain_to_monad() {
let c = Codensity::<OptionF, i32>::pure(10).chain(|x| Codensity::pure(x + 1));
let result = c.to_monad();
assert_eq!(result, Some(11));
}
#[test]
fn chain_multiple() {
let c = Codensity::<OptionF, i32>::pure(1)
.chain(|x| Codensity::pure(x + 1))
.chain(|x| Codensity::pure(x * 10))
.chain(|x| Codensity::pure(x + 5));
let result = c.to_monad();
assert_eq!(result, Some(25));
}
#[test]
fn fmap_then_chain() {
let c = Codensity::<OptionF, i32>::pure(3)
.fmap(|x| x * 2)
.chain(|x| Codensity::pure(x + 100));
let result = c.to_monad();
assert_eq!(result, Some(106));
}
#[test]
fn chain_associativity() {
let left = Codensity::<OptionF, i32>::pure(5)
.chain(|x| Codensity::pure(x + 1))
.chain(|x| Codensity::pure(x * 2));
let right = Codensity::<OptionF, i32>::pure(5)
.chain(|x| Codensity::<OptionF, i32>::pure(x + 1).chain(|y| Codensity::pure(y * 2)));
assert_eq!(left.to_monad(), right.to_monad());
}
#[test]
fn monad_left_identity() {
let left = Codensity::<OptionF, i32>::pure(4).chain(|x| Codensity::pure(x * 3));
assert_eq!(left.to_monad(), Some(12));
}
#[test]
fn monad_right_identity() {
let m = Codensity::<OptionF, i32>::pure(42);
let result = m.chain(Codensity::pure);
assert_eq!(result.to_monad(), Some(42));
}
#[test]
fn fmap_changes_type() {
let c = Codensity::<OptionF, i32>::pure(42).fmap(|x| format!("val={x}"));
assert_eq!(c.to_monad(), Some("val=42".to_string()));
}
}
#[cfg(test)]
mod law_tests {
use super::*;
use karpal_core::hkt::OptionF;
use proptest::prelude::*;
proptest! {
#[test]
fn functor_identity(x in any::<i32>()) {
let result = Codensity::<OptionF, i32>::pure(x)
.fmap(|a| a)
.to_monad();
prop_assert_eq!(result, Some(x));
}
#[test]
fn functor_composition(x in any::<i32>()) {
let f = |a: i32| a.wrapping_add(1);
let g = |a: i32| a.wrapping_mul(2);
let left = Codensity::<OptionF, i32>::pure(x)
.fmap(move |a| g(f(a)))
.to_monad();
let right = Codensity::<OptionF, i32>::pure(x)
.fmap(f)
.fmap(g)
.to_monad();
prop_assert_eq!(left, right);
}
#[test]
fn monad_left_identity(x in any::<i32>()) {
let left = Codensity::<OptionF, i32>::pure(x)
.chain(|a| Codensity::pure(a.wrapping_mul(2)))
.to_monad();
let right = Codensity::<OptionF, i32>::pure(x.wrapping_mul(2)).to_monad();
prop_assert_eq!(left, right);
}
#[test]
fn monad_right_identity(x in any::<i32>()) {
let result = Codensity::<OptionF, i32>::pure(x)
.chain(Codensity::pure)
.to_monad();
prop_assert_eq!(result, Some(x));
}
#[test]
fn monad_associativity(x in any::<i32>()) {
let left = Codensity::<OptionF, i32>::pure(x)
.chain(|a| Codensity::pure(a.wrapping_add(1)))
.chain(|a| Codensity::pure(a.wrapping_mul(2)))
.to_monad();
let right = Codensity::<OptionF, i32>::pure(x)
.chain(|a| {
Codensity::<OptionF, i32>::pure(a.wrapping_add(1))
.chain(|b| Codensity::pure(b.wrapping_mul(2)))
})
.to_monad();
prop_assert_eq!(left, right);
}
}
}