🦀 Functional Rust

Choice Profunctor — Optionally Applied

See `example.ml` for OCaml source.
/// Choice Profunctor — enables prisms.
///
/// A Choice profunctor P<A,B> can be applied to ONE SIDE of a sum type:
///
///   left  :: P A B -> P (Either<A,C>) (Either<B,C>)
///   right :: P A B -> P (Either<C,A>) (Either<C,B>)
///
/// While Strong carries context through a PRODUCT (tuple),
/// Choice carries context through a COPRODUCT (sum type).
///
/// Choice profunctors enable prisms:
///   Prism s a = ∀ p. Choice p => p a a -> p s s
///
/// A prism focuses on ONE CONSTRUCTOR of a sum type.
/// It requires `Choice` because we need to "route around" non-matching variants.

/// Mapper<A,B> as the canonical Choice Profunctor
pub struct Mapper<A, B> {
    f: Box<dyn Fn(A) -> B>,
}

impl<A: 'static, B: 'static> Mapper<A, B> {
    pub fn new(f: impl Fn(A) -> B + 'static) -> Self {
        Mapper { f: Box::new(f) }
    }

    pub fn apply(&self, a: A) -> B {
        (self.f)(a)
    }

    /// left: apply only to the Left variant; pass Right through unchanged.
    pub fn left<C: 'static>(self) -> Mapper<Result<A, C>, Result<B, C>> {
        let f = self.f;
        Mapper::new(move |e| match e {
            Ok(a) => Ok(f(a)),
            Err(c) => Err(c),
        })
    }

    /// right: apply only to the Right (Err) variant; pass Left (Ok) through.
    pub fn right<C: 'static>(self) -> Mapper<Result<C, A>, Result<C, B>> {
        let f = self.f;
        Mapper::new(move |e| match e {
            Ok(c) => Ok(c),
            Err(a) => Err(f(a)),
        })
    }

    /// dimap for completeness
    pub fn dimap<C: 'static, D: 'static>(
        self,
        pre: impl Fn(C) -> A + 'static,
        post: impl Fn(B) -> D + 'static,
    ) -> Mapper<C, D> {
        let f = self.f;
        Mapper::new(move |c| post(f(pre(c))))
    }
}

// ── Prism ─────────────────────────────────────────────────────────────────────

/// A concrete prism: focuses on one constructor of sum type S.
///
///   preview :: S -> Option<A>   (try to extract the focused value)
///   review  :: A -> S           (construct S from A)
pub struct Prism<S, A> {
    pub preview: Box<dyn Fn(&S) -> Option<A>>,
    pub review: Box<dyn Fn(A) -> S>,
}

impl<S: Clone + 'static, A: Clone + 'static> Prism<S, A> {
    pub fn new(
        preview: impl Fn(&S) -> Option<A> + 'static,
        review: impl Fn(A) -> S + 'static,
    ) -> Self {
        Prism {
            preview: Box::new(preview),
            review: Box::new(review),
        }
    }

    /// preview: try to extract the focused value
    pub fn preview(&self, s: &S) -> Option<A> {
        (self.preview)(s)
    }

    /// review: construct S from A
    pub fn review(&self, a: A) -> S {
        (self.review)(a)
    }

    /// over: modify if the prism matches, leave unchanged otherwise
    pub fn over(&self, s: S, f: impl Fn(A) -> A) -> S {
        match (self.preview)(&s) {
            Some(a) => (self.review)(f(a)),
            None => s,
        }
    }

    /// set: replace if the prism matches
    pub fn set(&self, s: S, a: A) -> S {
        self.over(s, move |_| a.clone())
    }

    /// is: check if the prism matches
    pub fn is(&self, s: &S) -> bool {
        (self.preview)(s).is_some()
    }
}

// ── Example: JSON value with prisms ──────────────────────────────────────────

#[derive(Debug, Clone, PartialEq)]
enum Json {
    Null,
    Bool(bool),
    Int(i64),
    Float(f64),
    Str(String),
    Array(Vec<Json>),
}

fn int_prism() -> Prism<Json, i64> {
    Prism::new(
        |j| match j { Json::Int(n) => Some(*n), _ => None },
        |n| Json::Int(n),
    )
}

fn bool_prism() -> Prism<Json, bool> {
    Prism::new(
        |j| match j { Json::Bool(b) => Some(*b), _ => None },
        |b| Json::Bool(b),
    )
}

fn str_prism() -> Prism<Json, String> {
    Prism::new(
        |j| match j { Json::Str(s) => Some(s.clone()), _ => None },
        |s| Json::Str(s),
    )
}

fn array_prism() -> Prism<Json, Vec<Json>> {
    Prism::new(
        |j| match j { Json::Array(v) => Some(v.clone()), _ => None },
        |v| Json::Array(v),
    )
}

fn main() {
    println!("=== Choice Profunctor + Prisms ===\n");
    println!("Choice: left :: P A B -> P (A+C) (B+C)");
    println!("Enables prisms: focus on one constructor of a sum type.\n");

    // Choice profunctor: left and right
    let double = Mapper::new(|n: i32| n * 2);
    let double_left = double.left::<String>();
    println!("left (double) on Ok(5):    {:?}", double_left.apply(Ok(5)));
    println!("left (double) on Err(\"x\"): {:?}", double_left.apply(Err("x".to_string())));

    let inc = Mapper::new(|n: i32| n + 100);
    let inc_right = inc.right::<&str>();
    println!("right (inc) on Ok(\"y\"):   {:?}", inc_right.apply(Ok("y")));
    println!("right (inc) on Err(5):    {:?}", inc_right.apply(Err(5)));

    // Prisms on JSON
    println!();
    let int_p = int_prism();
    let bool_p = bool_prism();
    let str_p = str_prism();

    let j_int = Json::Int(42);
    let j_str = Json::Str("hello".to_string());
    let j_bool = Json::Bool(true);

    println!("preview int  on Int(42):   {:?}", int_p.preview(&j_int));
    println!("preview int  on Str(hi):   {:?}", int_p.preview(&j_str));
    println!("preview bool on Bool(true):{:?}", bool_p.preview(&j_bool));

    // over: double integers, leave others unchanged
    let doubled = int_p.over(j_int.clone(), |n| n * 2);
    let unchanged = int_p.over(j_str.clone(), |n| n * 2);
    println!("\nover int (*2) on Int(42):  {:?}", doubled);
    println!("over int (*2) on Str(hi):  {:?}", unchanged);

    // review: construct from focused value
    let j_new = int_p.review(99);
    println!("\nreview int 99: {:?}", j_new);

    // is: test membership
    println!("is_int Int(42): {}", int_p.is(&j_int));
    println!("is_int Str(hi): {}", int_p.is(&j_str));

    // Map over an array of JSON values, doubling all integers
    let arr = Json::Array(vec![
        Json::Int(1), Json::Str("skip".to_string()), Json::Int(3), Json::Bool(false)
    ]);
    let arr_p = array_prism();
    let doubled_arr = arr_p.over(arr, |items| {
        items.into_iter().map(|item| {
            int_p.over(item, |n| n * 2)
        }).collect()
    });
    println!("\nDouble ints in array: {:?}", doubled_arr);

    println!();
    println!("Prism vs Lens:");
    println!("  Lens: always succeeds (product type, getter never fails)");
    println!("  Prism: may fail (sum type, preview returns Option)");
    println!("  Lens = Strong profunctor; Prism = Choice profunctor");
}

#[cfg(test)]
mod tests {
    use super::*;

    #[test]
    fn test_left() {
        let double = Mapper::new(|n: i32| n * 2);
        let d_left = double.left::<String>();
        assert_eq!(d_left.apply(Ok(5)), Ok(10));
        assert_eq!(d_left.apply(Err("x".to_string())), Err("x".to_string()));
    }

    #[test]
    fn test_right() {
        let double = Mapper::new(|n: i32| n * 2);
        let d_right = double.right::<String>();
        assert_eq!(d_right.apply(Ok("x".to_string())), Ok("x".to_string()));
        assert_eq!(d_right.apply(Err(5)), Err(10));
    }

    #[test]
    fn test_prism_preview_match() {
        let p = int_prism();
        assert_eq!(p.preview(&Json::Int(42)), Some(42));
        assert_eq!(p.preview(&Json::Str("hi".to_string())), None);
    }

    #[test]
    fn test_prism_review() {
        let p = int_prism();
        assert_eq!(p.review(7), Json::Int(7));
    }

    #[test]
    fn test_prism_over() {
        let p = int_prism();
        let j = Json::Int(10);
        let j2 = p.over(j, |n| n + 5);
        assert_eq!(j2, Json::Int(15));

        // Non-matching: unchanged
        let j3 = Json::Bool(true);
        let j4 = p.over(j3.clone(), |n| n + 5);
        assert_eq!(j4, j3);
    }
}
(* Choice profunctor: can be applied to one side of a sum type.
   left  :: p a b -> p (a + c) (b + c)
   right :: p a b -> p (c + a) (c + b)
   Enables building prisms! *)

(* Functions form a choice profunctor *)
let left  f = function Left a  -> Left (f a)  | Right c -> Right c
let right f = function Right a -> Right (f (a)) | Left c -> Left c

(* Prism: focuses on one constructor of a sum type *)
type ('s, 'a) prism = {
  preview : 's -> 'a option;
  review  : 'a -> 's;
}

let preview prism s = prism.preview s
let review  prism a = prism.review a

(* Transform matching elements *)
let over_prism prism f s =
  match prism.preview s with
  | None   -> s
  | Some a -> prism.review (f a)

type json =
  | JNull
  | JBool   of bool
  | JInt    of int
  | JString of string
  | JArray  of json list

let int_prism : (json, int) prism = {
  preview = (function JInt n -> Some n | _ -> None);
  review  = (fun n -> JInt n);
}

let () =
  let v = JInt 42 in
  Printf.printf "preview int: %s\n" (match preview int_prism v with Some n -> string_of_int n | None -> "none");
  Printf.printf "preview str: %s\n" (match preview int_prism (JString "hi") with Some n -> string_of_int n | None -> "none");

  let doubled = over_prism int_prism (fun n -> n * 2) v in
  Printf.printf "doubled: %s\n" (match preview int_prism doubled with Some n -> string_of_int n | None -> "?");

  Printf.printf "review: %s\n" (match review int_prism 99 with JInt n -> string_of_int n | _ -> "?")