composable_error_handling_in_ocaml.ml

(* https://keleshev.com/composable-error-handling-in-ocaml *)

open Printf

let (>>=) = Result.bind
let (let*) = Result.bind


module Exceptions_example (X: sig
  type tree

  module Parser : sig
    exception SyntaxError of int
    exception GrammarError of {line: int; message: string}

    (** Can raise [Parser.SyntaxError] or [Parser.GrammarError] *)
    val parse : string -> tree
  end

  module Validation : sig
    exception LengthError of int
    exception HeightError of int

    (** Can raise [Validation.LengthError] or [Validation.HeightError] *)
    val perform : tree -> tree
  end

  module Display : sig
    exception Error of string

    (** Can raise [Display.Error] *)
    val render : tree -> string
  end
end) = struct
  open X

  let main source =
    let tree = Parser.parse source in
    let tree = Validation.perform tree in
    Display.render tree

  open Printf

  let handle_errors source =
    try
      printf "%s" (main source)
    with
      | Parser.SyntaxError line ->
          eprintf "Syntax error at line %d" line
      | Parser.(GrammarError {line; message}) ->
          eprintf "Grammar error at line %d: %s" line message
      | Validation.LengthError length ->
          eprintf "Validation error: length %d is out of bounds" length
      | Validation.HeightError height ->
          eprintf "Validation error: height %d is out of bounds" height
      | Display.Error message ->
          eprintf "Display error: %s" message
end


module Result_with_strings_example (X: sig
  type tree

  module Parser : sig
    val parse : string -> (tree, string) result
  end

  module Validation : sig
    val perform : tree -> (tree, string) result
  end

  module Display : sig
    val render : tree -> (string, string) result
  end
end) = struct
  open X

  let main source =
    match Parser.parse source with
    | Error message ->
        eprintf "Parser error: %s" message
    | Ok tree ->
        match Validation.perform tree with
        | Error message ->
            eprintf "Validation error: %s" message
        | Ok tree ->
            match Display.render tree with
            | Error message ->
                eprintf "Display error: %s" message
            | Ok output ->
                printf "%s" output

  (* * *)

  let main source =
    Result.bind (Parser.parse source) (fun tree ->
      Result.bind (Validation.perform tree) (fun tree ->
        Display.render tree))

  let main2 source =
    Parser.parse source >>= fun tree ->
    Validation.perform tree >>= fun tree ->
    Display.render tree

  let main3 source =
    let* tree = Parser.parse source in
    let* tree = Validation.perform tree in
    Display.render tree

  (* * *)

  let handle_errors source =
    match main source with
    | Error message -> eprintf "Error: %s" message
    | Ok output -> printf "%s" output
end


module Result_with_variant_example (X: sig
  type tree

  module Parser : sig
    type error =
      | SyntaxError of int
      | GrammarError of {line: int; message: string}

    val parse : string -> (tree, error) result
  end

  module Validation : sig
    type error =
      | LengthError of int
      | HeightError of int

    val perform : tree -> (tree, error) result
  end

  module Display : sig
    val render : tree -> (string, string) result
  end
end) = struct
  open X

  let main source =
    match Parser.parse source with
    | Error Parser.(SyntaxError line) ->
        eprintf "Syntax error at line %d" line
    | Error Parser.(GrammarError {line; message}) ->
        eprintf "Grammar error at line %d: %s" line message
    | Ok tree ->
        match Validation.perform tree with
        | Error Parser.(LengthError length) ->
            eprintf "Validation error: Length %d is out of bounds" length
        | Error Parser.(HeightError height) ->
            eprintf "Validation error: Height %d is out of bounds" height
        | Ok tree ->
            match Display.render tree with
            | Error message -> eprintf "Display error: %s" message
            | Ok output -> printf "%s" output
end


module Result_with_polymorhpic_variants_example (X: sig
  type tree

  module Parser : sig
    type error = [
      | `ParserSyntaxError of int
      | `ParserGrammarError of int * string
    ]

    val parse : string -> (tree, [> error]) result
  end

  module Validation : sig
    type error = [
      | `ValidationLengthError of int
      | `ValidationHeightError of int
    ]

    val perform : tree -> (tree, [> error]) result
  end

  module Display : sig
    type error = [
      | `DisplayError of string
    ]

    val render : tree -> (string, [> error]) result
  end
end): sig
  open X

  val parse_and_validate : string -> (tree, [>
    | `ParserSyntaxError of int
    | `ParserGrammarError of int * string
    | `ValidationLengthError of int
    | `ValidationHeightError of int
  ]) result

  val main : string -> (string, [>
    | `ParserSyntaxError of int
    | `ParserGrammarError of int * string
    | `ValidationLengthError of int
    | `ValidationHeightError of int
    | `DisplayError of string
  ]) result
end = struct
  open X

  let parse_and_validate source =
    let* tree = Parser.parse source in
    Validation.perform tree

  let main source =
    let* tree = Parser.parse source in
    let* tree = Validation.perform tree in
    Display.render tree

  let handle_errors source =
    match main source with
    | Ok output ->
        printf "%s" output
    | Error (`ParserSyntaxError line) ->
        eprintf "Syntax error at line %d" line
    | Error (`ParserGrammarError (line, message)) ->
        eprintf "Grammar error at line %d: %s" line message
    | Error (`ValidationLengthError length) ->
        eprintf "Validation error: length %d is out of bounds" length
    | Error (`ValidationHeightError height) ->
        eprintf "Validation error: height %d is out of bounds" height
    | Error (`DisplayError message) ->
        eprintf "Display error: %s" message
end