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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
(**************************************************************************)
(* *)
(* OCamlFormat *)
(* *)
(* Copyright (c) Facebook, Inc. and its affiliates. *)
(* *)
(* This source code is licensed under the MIT license found in *)
(* the LICENSE file in the root directory of this source tree. *)
(* *)
(**************************************************************************)
type format_args = Protocol.format_args =
{path: string option; config: (string * string) list option}
let empty_args = Protocol.empty_args
module Version = Protocol.Version
module type IO = IO.S
module Protocol = Protocol
module Make (IO : IO) = struct
module Protocol = Protocol.Make (IO)
module V1 = struct
module Client = struct
type t = {pid: int; input: IO.ic; output: IO.oc}
let pid t = t.pid
let mk ~pid input output = {pid; input; output}
let query command t =
let open IO in
Protocol.V1.output t.output command
>>= fun () -> Protocol.V1.read_input t.input
let halt t =
let open IO in
match Protocol.V1.output t.output `Halt with
| exception _ ->
return (Error (`Msg "failing to close connection to server"))
| (_ : unit IO.t) -> return (Ok ())
let config c t =
let open IO in
query (`Config c) t
>>= function
| `Config _ -> return (Ok ())
| `Error msg -> return (Error (`Msg msg))
| _ ->
return
(Error (`Msg "failing to set configuration: unknown error"))
let format x t =
let open IO in
query (`Format x) t
>>= function
| `Format x -> return (Ok x)
| `Error msg -> return (Error (`Msg msg))
| _ -> return (Error (`Msg "failing to format input: unknown error"))
end
end
module V2 = struct
module Client = struct
type t = {pid: int; input: IO.ic; output: IO.oc}
let pid t = t.pid
let mk ~pid input output = {pid; input; output}
let query command t =
let open IO in
Protocol.V2.output t.output command
>>= fun () -> Protocol.V2.read_input t.input
let halt t =
let open IO in
match Protocol.V2.output t.output `Halt with
| exception _ ->
return (Error (`Msg "failing to close connection to server"))
| (_ : unit IO.t) -> return (Ok ())
let format ~format_args x t =
let open IO in
query (`Format (x, format_args)) t
>>= function
| `Format (x, _args) -> return (Ok x)
| `Error msg -> return (Error (`Msg msg))
| _ -> return (Error (`Msg "failing to format input: unknown error"))
end
end
type client = [`V1 of V1.Client.t | `V2 of V2.Client.t]
let get_client ~pid input output x =
match Version.of_string x with
| Some V1 -> Ok (`V1 (V1.Client.mk ~pid input output))
| Some V2 -> Ok (`V2 (V2.Client.mk ~pid input output))
| None -> Error (`Msg "invalid client version")
let pick_client ~pid ic oc versions =
let open IO in
let rec aux = function
| [] -> return (Error (`Msg "Version negociation failed"))
| latest :: others -> (
Protocol.Init.output oc (`Version latest)
>>= fun () ->
Protocol.Init.read_input ic
>>= function
| `Version v when v = latest -> return (get_client ~pid ic oc v)
| `Version v -> (
match others with
| h :: _ when v = h -> return (get_client ~pid ic oc v)
| _ -> aux others )
| `Unknown -> aux others
| `Halt ->
return
(Error
(`Msg
"OCamlFormat-RPC did not respond. Check that a \
compatible version of the OCamlFormat RPC server \
(ocamlformat-rpc >= 0.18.0) is installed." ) ) )
in
aux versions
let pid = function
| `V1 cl -> V1.Client.pid cl
| `V2 cl -> V2.Client.pid cl
let halt = function
| `V1 cl -> V1.Client.halt cl
| `V2 cl -> V2.Client.halt cl
let config c = function
| `V1 cl -> V1.Client.config c cl
| `V2 _ ->
IO.return
(Error
(`Msg "'Config' command not implemented in ocamlformat-rpc V2")
)
let format ?(format_args = empty_args) x = function
| `V1 cl -> V1.Client.format x cl
| `V2 cl -> V2.Client.format ~format_args x cl
end
|
