Source file `ocamlformat_rpc_lib.ml`

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