Source file hidapi_lwt.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
open Lwt.Syntax
type device_info = Hidapi.device_info = {
path : string;
vendor_id : int;
product_id : int;
serial_number : string option;
release_number : int;
manufacturer_string : string option;
product_string : string option;
usage_page : int;
usage : int;
interface_number : int;
}
type t = Hidapi.t
type info
external hid_enumerate : int -> int -> info option Lwt_unix.job
= "hid_enumerate_job"
external hid_enumerate_next : info -> Hidapi.device_info * info option
= "stub_hid_enumerate_next"
external hid_free_enumeration : info -> unit = "stub_hid_free_enumeration"
[@@noalloc]
external hid_open_job : int -> int -> Hidapi.t option Lwt_unix.job
= "hid_open_job"
external hid_open_path_job : string -> Hidapi.t option Lwt_unix.job
= "hid_open_path_job"
external hid_close_job : Hidapi.t -> unit Lwt_unix.job = "hid_close_job"
external hid_read_timeout_job :
Hidapi.t -> Bigstring.t -> int -> int -> int Lwt_unix.job
= "hid_read_timeout_job"
external hid_write_job : Hidapi.t -> Bigstring.t -> int -> int Lwt_unix.job
= "hid_write_job"
external hid_error : Hidapi.t -> string option = "stub_hid_error"
let init = Hidapi.init
let deinit = Hidapi.deinit
let enumerate ?(vendor_id = 0) ?(product_id = 0) () =
let* result = Lwt_unix.run_job (hid_enumerate vendor_id product_id) in
match result with
| None -> Lwt.return_nil
| Some info ->
let rec inner acc i =
match hid_enumerate_next i with
| di, None -> di :: acc
| di, Some next -> inner (di :: acc) next
in
let res = inner [] info in
hid_free_enumeration info ;
Lwt.return res
let open_id ~vendor_id ~product_id =
Lwt_unix.run_job (hid_open_job vendor_id product_id)
let open_id_exn ~vendor_id ~product_id =
let* result = open_id ~vendor_id ~product_id in
match result with None -> failwith "open_id_exn" | Some t -> Lwt.return t
let open_path path = Lwt_unix.run_job (hid_open_path_job path)
let open_path_exn path =
let* result = open_path path in
match result with None -> failwith "open_path_exn" | Some t -> Lwt.return t
let close t = Lwt_unix.run_job (hid_close_job t)
let write t ?len buf =
let buflen = Bigstring.length buf in
let* len =
match len with
| None -> Lwt.return buflen
| Some l when l < 0 ->
Lwt.fail_invalid_arg
(Printf.sprintf "write: len = %d must be positive" l)
| Some l when l > buflen ->
Lwt.fail_invalid_arg
(Printf.sprintf "write: len is too big (%d > %d)" l buflen)
| Some l -> Lwt.return l
in
let* result = Lwt_unix.run_job (hid_write_job t buf len) in
match result with
| -1 ->
Lwt.return_error (match hid_error t with None -> "" | Some msg -> msg)
| nb_written -> Lwt.return_ok nb_written
let read ?(timeout = -1) t buf len =
let* result = Lwt_unix.run_job (hid_read_timeout_job t buf len timeout) in
match result with
| -1 ->
Lwt.return_error (match hid_error t with None -> "" | Some msg -> msg)
| nb_read -> Lwt.return_ok nb_read
let set_nonblocking = Hidapi.set_nonblocking
let set_nonblocking_exn = Hidapi.set_nonblocking_exn