185 Expert

Console DSL with Free Monad

Functional Programming

Tutorial

The Problem

Building on the free monad introduction, this example defines a richer Console DSL with Print, ReadLine, and Exit operations. The key insight is that the DSL operations are pure data — print_line("Hello") does not print anything, it constructs a value describing the print operation. This makes programs inspectable, serializable, and interpretable in multiple contexts: unit tests simulate I/O without touching the console.

🎯 Learning Outcomes

• Define a domain-specific language as a free monad over Console operations

• Implement bind (sequencing) for the free monad DSL

• See how DSL programs are constructed compositionally and interpreted separately

• Understand the "program as data" metaphor: a free monad program is a tree you can traverse

Code Example

#![allow(clippy::all)]
// Example 185: Console DSL with Free Monad
// Print, ReadLine, Exit operations as a domain-specific language

// === Approach 1: Console DSL enum ===

enum Console<A> {
    Pure(A),
    Print(String, Box<dyn FnOnce() -> Console<A>>),
    ReadLine(Box<dyn FnOnce(String) -> Console<A>>),
    Exit(i32),
}

fn pure<A>(a: A) -> Console<A> {
    Console::Pure(a)
}

fn print_line(msg: &str) -> Console<()> {
    let msg = msg.to_string();
    Console::Print(msg, Box::new(|| Console::Pure(())))
}

fn read_line_dsl() -> Console<String> {
    Console::ReadLine(Box::new(|s| Console::Pure(s)))
}

fn exit_prog<A>(code: i32) -> Console<A> {
    Console::Exit(code)
}

fn bind<A: 'static, B: 'static>(
    ma: Console<A>,
    f: impl FnOnce(A) -> Console<B> + 'static,
) -> Console<B> {
    match ma {
        Console::Pure(a) => f(a),
        Console::Print(msg, k) => Console::Print(msg, Box::new(move || bind(k(), f))),
        Console::ReadLine(k) => Console::ReadLine(Box::new(move |s| bind(k(s), f))),
        Console::Exit(code) => Console::Exit(code),
    }
}

// === Approach 2: Menu program ===

fn menu_program() -> Console<String> {
    bind(print_line("=== Menu ==="), move |()| {
        bind(print_line("1. Greet"), move |()| {
            bind(print_line("2. Exit"), move |()| {
                bind(print_line("Choose: "), move |()| {
                    bind(read_line_dsl(), move |choice: String| {
                        match choice.as_str() {
                            "1" => bind(print_line("Enter name: "), move |()| {
                                bind(read_line_dsl(), move |name: String| {
                                    bind(print_line(&format!("Hello, {}!", name)), move |()| {
                                        pure(format!("greeted {}", name))
                                    })
                                })
                            }),
                            "2" => exit_prog(0),
                            _ => bind(print_line("Invalid choice"), |()| pure("error".to_string())),
                        }
                    })
                })
            })
        })
    })
}

// === Approach 3: Pure test interpreter ===

#[derive(Debug, PartialEq)]
enum ProgramResult<A> {
    Ok(A),
    Exited(i32),
}

fn interpret_pure(inputs: &[&str], prog: Console<String>) -> (Vec<String>, ProgramResult<String>) {
    let mut outputs = Vec::new();
    let mut idx = 0;
    let mut current = prog;

    loop {
        match current {
            Console::Pure(a) => return (outputs, ProgramResult::Ok(a)),
            Console::Print(msg, k) => {
                outputs.push(msg);
                current = k();
            }
            Console::ReadLine(k) => {
                let input = inputs.get(idx).unwrap_or(&"").to_string();
                idx += 1;
                current = k(input);
            }
            Console::Exit(code) => return (outputs, ProgramResult::Exited(code)),
        }
    }
}

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

    #[test]
    fn test_greet_path() {
        let (out, result) = interpret_pure(&["1", "Alice"], menu_program());
        assert_eq!(
            out,
            vec![
                "=== Menu ===",
                "1. Greet",
                "2. Exit",
                "Choose: ",
                "Enter name: ",
                "Hello, Alice!"
            ]
        );
        assert_eq!(result, ProgramResult::Ok("greeted Alice".to_string()));
    }

    #[test]
    fn test_exit_path() {
        let (out, result) = interpret_pure(&["2"], menu_program());
        assert_eq!(out.len(), 4);
        assert_eq!(result, ProgramResult::Exited(0));
    }

    #[test]
    fn test_invalid_path() {
        let (out, result) = interpret_pure(&["x"], menu_program());
        assert!(out.contains(&"Invalid choice".to_string()));
        assert_eq!(result, ProgramResult::Ok("error".to_string()));
    }

    #[test]
    fn test_simple_print() {
        let prog = bind(print_line("hi"), |()| pure("done".to_string()));
        let (out, result) = interpret_pure(&[], prog);
        assert_eq!(out, vec!["hi"]);
        assert_eq!(result, ProgramResult::Ok("done".to_string()));
    }

    #[test]
    fn test_simple_read() {
        let prog = bind(read_line_dsl(), |s: String| pure(s));
        let (_, result) = interpret_pure(&["test"], prog);
        assert_eq!(result, ProgramResult::Ok("test".to_string()));
    }
}

(* Example 185: Console DSL with Free Monad *)
(* Print, ReadLine, Exit operations as a domain-specific language *)

(* Approach 1: Full console DSL *)
type 'a console =
  | Pure of 'a
  | Print of string * (unit -> 'a console)
  | ReadLine of (string -> 'a console)
  | Exit of int  (* exit code, no continuation *)

let pure x = Pure x
let print_line msg = Print (msg, fun () -> Pure ())
let read_line () = ReadLine (fun s -> Pure s)
let exit_prog code = Exit code

let rec bind : type a b. a console -> (a -> b console) -> b console =
  fun m f -> match m with
  | Pure a -> f a
  | Print (msg, k) -> Print (msg, fun () -> bind (k ()) f)
  | ReadLine k -> ReadLine (fun s -> bind (k s) f)
  | Exit code -> Exit code

let (>>=) = bind

(* Approach 2: Interactive menu program *)
let menu_program =
  print_line "=== Menu ===" >>= fun () ->
  print_line "1. Greet" >>= fun () ->
  print_line "2. Exit" >>= fun () ->
  print_line "Choose: " >>= fun () ->
  read_line () >>= fun choice ->
  match choice with
  | "1" ->
    print_line "Enter name: " >>= fun () ->
    read_line () >>= fun name ->
    print_line ("Hello, " ^ name ^ "!") >>= fun () ->
    pure ("greeted " ^ name)
  | "2" -> exit_prog 0
  | _ ->
    print_line "Invalid choice" >>= fun () ->
    pure "error"

(* Approach 3: Pure test interpreter *)
let interpret_pure inputs prog =
  let outputs = ref [] in
  let input_idx = ref 0 in
  let rec go : type a. a console -> (a, int) result = function
    | Pure a -> Ok a
    | Print (msg, k) ->
      outputs := msg :: !outputs;
      go (k ())
    | ReadLine k ->
      let s = List.nth inputs !input_idx in
      incr input_idx;
      go (k s)
    | Exit code -> Error code
  in
  let result = go prog in
  (List.rev !outputs, result)

let () =
  (* Test menu with greet *)
  let (out, result) = interpret_pure ["1"; "Alice"] menu_program in
  assert (out = ["=== Menu ==="; "1. Greet"; "2. Exit"; "Choose: "; "Enter name: "; "Hello, Alice!"]);
  assert (result = Ok "greeted Alice");

  (* Test menu with exit *)
  let (out2, result2) = interpret_pure ["2"] menu_program in
  assert (List.length out2 = 4);
  assert (result2 = Error 0);

  (* Test menu with invalid *)
  let (out3, result3) = interpret_pure ["x"] menu_program in
  assert (List.mem "Invalid choice" out3);
  assert (result3 = Ok "error");

  print_endline "✓ All tests passed"

Key Differences

Bind implementation: Both implement monadic bind by substituting Pure(a) with f(a) recursively; this is O(n) for each bind — tree re-traversal.

**Exit handling**: The Exit(i32) operation terminates the interpreter loop; both languages handle this as a special case that skips the continuation.

Continuation boxing: Rust uses Box<dyn FnOnce> for continuations; OCaml uses plain function values (heap-allocated, GC-managed).

Syntactic sugar: OCaml's let* requires a binding_op declaration; Rust's equivalent would require proc macros or manual bind chaining.

OCaml Approach

OCaml's let* desugaring makes DSL programs natural:

let program =
  let* () = print_line "Enter name:" in
  let* name = read_line () in
  print_line (Printf.sprintf "Hello, %s!" name)

This is syntactically cleaner than Rust's closure-based chaining. OCaml's type inference handles the Console<unit> / Console<string> types without annotation.

Full Source

#![allow(clippy::all)]
// Example 185: Console DSL with Free Monad
// Print, ReadLine, Exit operations as a domain-specific language

// === Approach 1: Console DSL enum ===

enum Console<A> {
    Pure(A),
    Print(String, Box<dyn FnOnce() -> Console<A>>),
    ReadLine(Box<dyn FnOnce(String) -> Console<A>>),
    Exit(i32),
}

fn pure<A>(a: A) -> Console<A> {
    Console::Pure(a)
}

fn print_line(msg: &str) -> Console<()> {
    let msg = msg.to_string();
    Console::Print(msg, Box::new(|| Console::Pure(())))
}

fn read_line_dsl() -> Console<String> {
    Console::ReadLine(Box::new(|s| Console::Pure(s)))
}

fn exit_prog<A>(code: i32) -> Console<A> {
    Console::Exit(code)
}

fn bind<A: 'static, B: 'static>(
    ma: Console<A>,
    f: impl FnOnce(A) -> Console<B> + 'static,
) -> Console<B> {
    match ma {
        Console::Pure(a) => f(a),
        Console::Print(msg, k) => Console::Print(msg, Box::new(move || bind(k(), f))),
        Console::ReadLine(k) => Console::ReadLine(Box::new(move |s| bind(k(s), f))),
        Console::Exit(code) => Console::Exit(code),
    }
}

// === Approach 2: Menu program ===

fn menu_program() -> Console<String> {
    bind(print_line("=== Menu ==="), move |()| {
        bind(print_line("1. Greet"), move |()| {
            bind(print_line("2. Exit"), move |()| {
                bind(print_line("Choose: "), move |()| {
                    bind(read_line_dsl(), move |choice: String| {
                        match choice.as_str() {
                            "1" => bind(print_line("Enter name: "), move |()| {
                                bind(read_line_dsl(), move |name: String| {
                                    bind(print_line(&format!("Hello, {}!", name)), move |()| {
                                        pure(format!("greeted {}", name))
                                    })
                                })
                            }),
                            "2" => exit_prog(0),
                            _ => bind(print_line("Invalid choice"), |()| pure("error".to_string())),
                        }
                    })
                })
            })
        })
    })
}

// === Approach 3: Pure test interpreter ===

#[derive(Debug, PartialEq)]
enum ProgramResult<A> {
    Ok(A),
    Exited(i32),
}

fn interpret_pure(inputs: &[&str], prog: Console<String>) -> (Vec<String>, ProgramResult<String>) {
    let mut outputs = Vec::new();
    let mut idx = 0;
    let mut current = prog;

    loop {
        match current {
            Console::Pure(a) => return (outputs, ProgramResult::Ok(a)),
            Console::Print(msg, k) => {
                outputs.push(msg);
                current = k();
            }
            Console::ReadLine(k) => {
                let input = inputs.get(idx).unwrap_or(&"").to_string();
                idx += 1;
                current = k(input);
            }
            Console::Exit(code) => return (outputs, ProgramResult::Exited(code)),
        }
    }
}

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

    #[test]
    fn test_greet_path() {
        let (out, result) = interpret_pure(&["1", "Alice"], menu_program());
        assert_eq!(
            out,
            vec![
                "=== Menu ===",
                "1. Greet",
                "2. Exit",
                "Choose: ",
                "Enter name: ",
                "Hello, Alice!"
            ]
        );
        assert_eq!(result, ProgramResult::Ok("greeted Alice".to_string()));
    }

    #[test]
    fn test_exit_path() {
        let (out, result) = interpret_pure(&["2"], menu_program());
        assert_eq!(out.len(), 4);
        assert_eq!(result, ProgramResult::Exited(0));
    }

    #[test]
    fn test_invalid_path() {
        let (out, result) = interpret_pure(&["x"], menu_program());
        assert!(out.contains(&"Invalid choice".to_string()));
        assert_eq!(result, ProgramResult::Ok("error".to_string()));
    }

    #[test]
    fn test_simple_print() {
        let prog = bind(print_line("hi"), |()| pure("done".to_string()));
        let (out, result) = interpret_pure(&[], prog);
        assert_eq!(out, vec!["hi"]);
        assert_eq!(result, ProgramResult::Ok("done".to_string()));
    }

    #[test]
    fn test_simple_read() {
        let prog = bind(read_line_dsl(), |s: String| pure(s));
        let (_, result) = interpret_pure(&["test"], prog);
        assert_eq!(result, ProgramResult::Ok("test".to_string()));
    }
}

(* Example 185: Console DSL with Free Monad *)
(* Print, ReadLine, Exit operations as a domain-specific language *)

(* Approach 1: Full console DSL *)
type 'a console =
  | Pure of 'a
  | Print of string * (unit -> 'a console)
  | ReadLine of (string -> 'a console)
  | Exit of int  (* exit code, no continuation *)

let pure x = Pure x
let print_line msg = Print (msg, fun () -> Pure ())
let read_line () = ReadLine (fun s -> Pure s)
let exit_prog code = Exit code

let rec bind : type a b. a console -> (a -> b console) -> b console =
  fun m f -> match m with
  | Pure a -> f a
  | Print (msg, k) -> Print (msg, fun () -> bind (k ()) f)
  | ReadLine k -> ReadLine (fun s -> bind (k s) f)
  | Exit code -> Exit code

let (>>=) = bind

(* Approach 2: Interactive menu program *)
let menu_program =
  print_line "=== Menu ===" >>= fun () ->
  print_line "1. Greet" >>= fun () ->
  print_line "2. Exit" >>= fun () ->
  print_line "Choose: " >>= fun () ->
  read_line () >>= fun choice ->
  match choice with
  | "1" ->
    print_line "Enter name: " >>= fun () ->
    read_line () >>= fun name ->
    print_line ("Hello, " ^ name ^ "!") >>= fun () ->
    pure ("greeted " ^ name)
  | "2" -> exit_prog 0
  | _ ->
    print_line "Invalid choice" >>= fun () ->
    pure "error"

(* Approach 3: Pure test interpreter *)
let interpret_pure inputs prog =
  let outputs = ref [] in
  let input_idx = ref 0 in
  let rec go : type a. a console -> (a, int) result = function
    | Pure a -> Ok a
    | Print (msg, k) ->
      outputs := msg :: !outputs;
      go (k ())
    | ReadLine k ->
      let s = List.nth inputs !input_idx in
      incr input_idx;
      go (k s)
    | Exit code -> Error code
  in
  let result = go prog in
  (List.rev !outputs, result)

let () =
  (* Test menu with greet *)
  let (out, result) = interpret_pure ["1"; "Alice"] menu_program in
  assert (out = ["=== Menu ==="; "1. Greet"; "2. Exit"; "Choose: "; "Enter name: "; "Hello, Alice!"]);
  assert (result = Ok "greeted Alice");

  (* Test menu with exit *)
  let (out2, result2) = interpret_pure ["2"] menu_program in
  assert (List.length out2 = 4);
  assert (result2 = Error 0);

  (* Test menu with invalid *)
  let (out3, result3) = interpret_pure ["x"] menu_program in
  assert (List.mem "Invalid choice" out3);
  assert (result3 = Ok "error");

  print_endline "✓ All tests passed"

✓ Tests Rust test suite

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

    #[test]
    fn test_greet_path() {
        let (out, result) = interpret_pure(&["1", "Alice"], menu_program());
        assert_eq!(
            out,
            vec![
                "=== Menu ===",
                "1. Greet",
                "2. Exit",
                "Choose: ",
                "Enter name: ",
                "Hello, Alice!"
            ]
        );
        assert_eq!(result, ProgramResult::Ok("greeted Alice".to_string()));
    }

    #[test]
    fn test_exit_path() {
        let (out, result) = interpret_pure(&["2"], menu_program());
        assert_eq!(out.len(), 4);
        assert_eq!(result, ProgramResult::Exited(0));
    }

    #[test]
    fn test_invalid_path() {
        let (out, result) = interpret_pure(&["x"], menu_program());
        assert!(out.contains(&"Invalid choice".to_string()));
        assert_eq!(result, ProgramResult::Ok("error".to_string()));
    }

    #[test]
    fn test_simple_print() {
        let prog = bind(print_line("hi"), |()| pure("done".to_string()));
        let (out, result) = interpret_pure(&[], prog);
        assert_eq!(out, vec!["hi"]);
        assert_eq!(result, ProgramResult::Ok("done".to_string()));
    }

    #[test]
    fn test_simple_read() {
        let prog = bind(read_line_dsl(), |s: String| pure(s));
        let (_, result) = interpret_pure(&["test"], prog);
        assert_eq!(result, ProgramResult::Ok("test".to_string()));
    }
}

Exercises

Add a Prompt(question: String, continuation: Box<dyn FnOnce(String) -> Console<A>>) operation that prints the question and reads the answer.

Implement a pure test runner that takes Vec<String> as simulated input and returns Vec<String> as captured output.

Write a dry_run interpreter that lists all operations the program would perform without executing any I/O.

Open Source Repos

functional-rust

View the source for this example on GitHub — OCaml and Rust side by side in the repo.

Rust