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
open Core
module type Nvim_id = sig
type t = private int [@@deriving sexp_of]
include Comparable.S_plain with type t := t
include Hashable.S_plain with type t := t
include Msgpack.Msgpackable with type t := t
module Or_current : sig
type nonrec t =
| Current
| Id of t
[@@deriving sexp_of]
include Msgpack.Msgpackable with type t := t
end
end
let make_nvim_id ~type_id ~name =
(module struct
include Int
let rec of_msgpack =
let expected_type_id = type_id in
function
| Msgpack.Extension { type_id; data } when type_id = expected_type_id ->
let open Or_error in
Msgpack.t_of_string (Bytes.to_string data) >>= of_msgpack
| Integer i -> Ok i
| Int64 i | UInt64 i ->
(match Int64.to_int i with
| Some i -> Ok i
| None ->
Or_error.error_s
[%message (Printf.sprintf "too many %ss!" name) ~_:(i : Int64.t)])
| msg ->
Or_error.error_s
[%message (Printf.sprintf "not a %s message!" name) (msg : Msgpack.t)]
;;
let to_msgpack t = Msgpack.Integer t
module Or_current = struct
type nonrec t =
| Current
| Id of t
[@@deriving sexp_of]
let of_msgpack msgpack =
match%map.Or_error of_msgpack msgpack with
| 0 -> Current
| id -> Id id
;;
let to_msgpack t =
match t with
| Current -> to_msgpack 0
| Id id -> to_msgpack id
;;
end
end : Nvim_id)
;;