Skip to main content

karpal_core/
comonad.rs

1// Copyright (C) 2026 Industrial Algebra
2// SPDX-License-Identifier: Apache-2.0
3
4use crate::extend::Extend;
5use crate::hkt::{EnvF, IdentityF, OptionF};
6#[cfg(any(feature = "std", feature = "alloc"))]
7use crate::hkt::{NonEmptyVec, NonEmptyVecF};
8
9/// Comonad: the categorical dual of Monad.
10///
11/// A Comonad can `extract` a value from a context, and `extend` a
12/// context-aware function over the entire structure.
13///
14/// Laws:
15/// - Left identity: `extract(&extend(w, f)) == f(&w)`
16/// - Right identity: `extend(w, |w| extract(w)) == w`
17/// - Associativity (inherited from Extend)
18pub trait Comonad: Extend {
19    fn extract<A: Clone>(wa: &Self::Of<A>) -> A;
20}
21
22impl Comonad for IdentityF {
23    fn extract<A: Clone>(wa: &A) -> A {
24        wa.clone()
25    }
26}
27
28impl Comonad for OptionF {
29    fn extract<A: Clone>(wa: &Option<A>) -> A {
30        wa.as_ref()
31            .expect("Comonad::extract called on None")
32            .clone()
33    }
34}
35
36#[cfg(any(feature = "std", feature = "alloc"))]
37impl Comonad for NonEmptyVecF {
38    fn extract<A: Clone>(wa: &NonEmptyVec<A>) -> A {
39        wa.head.clone()
40    }
41}
42
43impl<E> Comonad for EnvF<E> {
44    fn extract<A: Clone>(wa: &(E, A)) -> A {
45        wa.1.clone()
46    }
47}
48
49#[cfg(test)]
50mod tests {
51    use super::*;
52
53    #[test]
54    fn identity_extract() {
55        assert_eq!(IdentityF::extract(&42), 42);
56    }
57
58    #[test]
59    fn option_extract() {
60        assert_eq!(OptionF::extract(&Some(42)), 42);
61    }
62
63    #[test]
64    #[should_panic(expected = "Comonad::extract called on None")]
65    fn option_extract_none_panics() {
66        OptionF::extract(&None::<i32>);
67    }
68
69    #[test]
70    fn nonemptyvec_extract() {
71        let nev = NonEmptyVec::new(1, vec![2, 3]);
72        assert_eq!(NonEmptyVecF::extract(&nev), 1);
73    }
74
75    #[test]
76    fn env_extract() {
77        assert_eq!(EnvF::<&str>::extract(&("hello", 42)), 42);
78    }
79}
80
81#[cfg(test)]
82mod law_tests {
83    use super::*;
84    use proptest::prelude::*;
85
86    fn nonemptyvec_strategy<T: core::fmt::Debug + Clone + 'static>(
87        elem: impl Strategy<Value = T> + Clone + 'static,
88    ) -> impl Strategy<Value = NonEmptyVec<T>> {
89        (elem.clone(), prop::collection::vec(elem, 0..5))
90            .prop_map(|(head, tail)| NonEmptyVec::new(head, tail))
91    }
92
93    proptest! {
94        // Left identity: extract(&extend(w, f)) == f(&w)
95        #[test]
96        fn identity_left_identity(x in any::<i32>()) {
97            let f = |w: &i32| w.wrapping_add(1);
98            let left = IdentityF::extract(&IdentityF::extend(x, f));
99            let right = f(&x);
100            prop_assert_eq!(left, right);
101        }
102
103        // Right identity: extend(w, |w| extract(w)) == w
104        #[test]
105        fn identity_right_identity(x in any::<i32>()) {
106            let result = IdentityF::extend(x, |w| IdentityF::extract(w));
107            prop_assert_eq!(result, x);
108        }
109
110        #[test]
111        fn nonemptyvec_left_identity(w in nonemptyvec_strategy(any::<i16>())) {
112            let f = |nev: &NonEmptyVec<i16>| nev.head.wrapping_add(1);
113            let left = NonEmptyVecF::extract(&NonEmptyVecF::extend(w.clone(), f));
114            let right = f(&w);
115            prop_assert_eq!(left, right);
116        }
117
118        #[test]
119        fn nonemptyvec_right_identity(w in nonemptyvec_strategy(any::<i16>())) {
120            let result = NonEmptyVecF::extend(w.clone(), |w| NonEmptyVecF::extract(w));
121            prop_assert_eq!(result, w);
122        }
123
124        #[test]
125        fn env_left_identity(e in any::<i8>(), a in any::<i16>()) {
126            let w = (e, a);
127            let f = |wa: &(i8, i16)| wa.1.wrapping_add(1);
128            let left = EnvF::<i8>::extract(&EnvF::<i8>::extend(w, f));
129            let right = f(&(e, a));
130            prop_assert_eq!(left, right);
131        }
132
133        #[test]
134        fn env_right_identity(e in any::<i8>(), a in any::<i16>()) {
135            let w = (e, a);
136            let result = EnvF::<i8>::extend(w, |w| EnvF::<i8>::extract(w));
137            prop_assert_eq!(result, (e, a));
138        }
139    }
140}