Parser.ml

(*
 * Work-in-progress implementation of a simple parser combinator library.
 *)


type input = char list
(** Parser input is a list of characters. *)


module type Parser = sig
  (** This interface implements a basic monadic parser. *)

  type 'a t = input -> ('a * input, string) result
  (** Parser is a function from input to an intermediate value and the leftover
     of input, or an error if parsing fails. *)

  val run : 'a t -> input -> 'a
  (** [run p input] is the result of running the parser [p] with [input].
      @raises an exception with an error message if the parsing fails. *)

  val empty : 'a t
  (** [empty] is a parser that always fails regardless of the input. *)

  val unit : 'a -> 'a t
  (* [unit x] puts [x] into the parser structure. Also known as `return` or
     `pure` in the Monad interface. *)

  val and_then : ('a -> 'b t) -> 'a t -> 'b t
  (** [and_then handler p] runs the parser [p] and feeds its result into the
      [handler] producing a new parser. *)
end


(* Implementation of the Parser interface. *)
module Parser : Parser = struct
  type 'a t = input -> ('a * input, string) result

  let run parser input =
    match parser input with
    | Ok (x, _rest) -> x
    | Error msg -> failwith msg

  let unit x =
    fun input -> Ok (x, input)

  let empty =
    fun input -> Error "empty"

  let and_then handler p1 =
    fun input ->
      match p1 input with
      | Ok (x, rest) ->
        let p2 = handler x in
        p2 rest
      | Error msg -> Error msg
end


(* Tests *)

open Parser

(* Regardless of the input this parser will fail and don't run the handler. *)
let test_empty_parser () =
  let parser =
    empty |> and_then (fun x -> print_endline "No!"; unit x) in
  assert (parser ['2'; '+'; '2'] = Error "empty")


(* Regardless of the input this parser will succeed parsing 42. *)
let test_unit_parser () =
  let parser =
    unit 42 |> and_then (fun x -> print_endline "Yes!"; unit x) in
  assert (run parser ['2'; '+'; '2'] = 42)

let () =
  test_empty_parser ();
  test_unit_parser ()