open Ast

type command = [ `Parse | `DrawTree | `RunCBN | `RunCBV | `StepCBN | `StepCBV ]

let command_of_yojson = function
  | `String "Parse" -> Ok `Parse
  | `String "DrawTree" -> Ok `DrawTree
  | `String "RunCBN" -> Ok `RunCBN
  | `String "RunCBV" -> Ok `RunCBV
  | `String "StepCBN" -> Ok `StepCBN
  | `String "StepCBV" -> Ok `StepCBV
  | _ -> Error "invalid command"

type request = { expr : string; command : command }
[@@deriving of_yojson { exn = true }]

type response_expr = { expr : string; has_redex : bool }
[@@deriving to_yojson { exn = true }]

type response =
  [ `Error of string | `Expr of response_expr | `Graphviz of string ]
[@@deriving to_yojson { exn = true }]

let%expect_test _ =
  Yojson.Safe.to_channel stdout (response_to_yojson (`Error "foo"));
  [%expect {| ["Error","foo"] |}]

let%expect_test _ =
  Yojson.Safe.to_channel stdout
    (response_to_yojson (`Expr { expr = "foo"; has_redex = false }));
  [%expect {| ["Expr",{"expr":"foo","has_redex":false}] |}]

let handle_request { expr; command } : response =
  try
    let buf = Lexing.from_string expr in
    let expr = Parse.expression buf in
    let expr = expr_of_parsetree expr in

    let expr_response (expr : expr ast) : response =
      let buf = Buffer.create 16 in
      (let fmt = Format.formatter_of_buffer buf in
       Pprintast.expression fmt (parsetree_of_expr expr);
       Format.pp_print_flush fmt ());
      let has_redex = Option.is_some (Eval.find_redex_cbn expr) in
      `Expr { expr = Buffer.contents buf; has_redex }
    in

    let step_with (find_redex : expr ast -> expr index option) (expr : expr ast)
        : expr ast =
      match find_redex expr with
      | Some i -> Eval.reduce expr i
      | None -> failwith "no redex"
    in

    match command with
    | `Parse -> expr_response expr
    | `StepCBN -> expr_response (step_with Eval.find_redex_cbn expr)
    | `StepCBV -> expr_response (step_with Eval.find_redex_cbv expr)
    | `DrawTree -> `Graphviz (Draw_tree.draw_tree expr)
    | `RunCBN | `RunCBV -> failwith "not implemented"
  with
  | Failure msg -> `Error msg
  | exn -> `Error ("uncaught exception: " ^ Printexc.to_string exn)