blob: cd99c9a3b249e0938b2a68845fbdc47d385e3ab2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
type command = [ `Roundtrip ]
let command_of_yojson = function
| `String "Roundtrip" -> Ok `Roundtrip
| _ -> Error "invalid command"
type request = { expr : string; command : command }
[@@deriving of_yojson { exn = true }]
type response_expr = { expr : string } [@@deriving to_yojson { exn = true }]
type response = [ `Error of string | `Expr of response_expr ]
[@@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" }));
[%expect {| ["Expr",{"expr":"foo"}] |}]
(*
type position = [%import: Lexing.position] [@@deriving show]
type location = [%import: (Location.t[@with Lexing.position := position])]
[@@deriving show]
type constant = [%import: Parsetree.constant] [@@deriving show]
type expression_desc = [%import: Parsetree.expression_desc] [@@deriving show]
type expression = [%import: Parsetree.expression] [@@deriving show]
type structure_item_desc = [%import: Parsetree.structure_item_desc]
[@@deriving show]
type structure_item = [%import: Parsetree.structure_item] [@@deriving show]
type structure = [%import: Parsetree.structure] [@@deriving show]
type toplevel_phrase = [%import: Parsetree.toplevel_phrase] [@@deriving show]
let parse ~path (src : string) =
let buf = Lexing.from_string src in
buf.lex_start_p <- { buf.lex_start_p with pos_fname = path };
buf.lex_curr_p <- { buf.lex_curr_p with pos_fname = path };
Parse.expression buf
let () =
parse ~path:"main.ml" " print_endline ((\"Hello, world!\") )"
|> Format.fprintf Format.std_formatter "\n%a\n" Pprintast.expression
*)
let handle_request { expr; command } : response =
try
let buf = Lexing.from_string expr in
let expr = Parse.expression buf in
match command with
| `Roundtrip ->
let buf = Buffer.create 16 in
(let fmt = Format.formatter_of_buffer buf in
Pprintast.expression fmt expr;
Format.pp_print_flush fmt ());
`Expr { expr = Buffer.contents buf }
with
| Failure msg -> `Error msg
| exn -> `Error ("uncaught exception: " ^ Printexc.to_string exn)
|
