Owntracks location tracking with MQTT and HTTPS (recorder) support
nox
+252
-258
+1
-2
bin/dune
+1
-2
bin/dune
+4
-4
bin/main.ml
+4
-4
bin/main.ml
···
332
332
(** Decode string list, trying results wrapper first then plain array. *)
333
333
let decode_string_list body =
334
334
match
335
-
Jsont_bytesrw.decode_string Owntracks.Recorder.string_list_results_jsont
335
+
Json.of_string Owntracks.Recorder.string_list_results_jsont
336
336
body
337
337
with
338
338
| Ok items -> items
339
339
| Error _ -> (
340
340
match
341
-
Jsont_bytesrw.decode_string Owntracks.Recorder.string_list_jsont body
341
+
Json.of_string Owntracks.Recorder.string_list_jsont body
342
342
with
343
343
| Ok items -> items
344
344
| Error _ -> [])
···
346
346
(** Decode locations, trying array first then data wrapper. *)
347
347
let decode_locations body =
348
348
match
349
-
Jsont_bytesrw.decode_string Owntracks.Recorder.locations_jsont body
349
+
Json.of_string Owntracks.Recorder.locations_jsont body
350
350
with
351
351
| Ok locs -> locs
352
352
| Error _ -> (
353
353
match
354
-
Jsont_bytesrw.decode_string Owntracks.Recorder.locations_data_jsont
354
+
Json.of_string Owntracks.Recorder.locations_data_jsont
355
355
body
356
356
with
357
357
| Ok locs -> locs
+2
-2
dune-project
+2
-2
dune-project
···
12
12
(name owntracks)
13
13
(synopsis "OwnTracks message types and JSON codecs")
14
14
(description
15
-
"Types and jsont codecs for parsing OwnTracks MQTT location messages.
15
+
"Types and JSON codecs for parsing OwnTracks MQTT location messages.
16
16
OwnTracks is an open-source location tracking application that publishes
17
17
GPS coordinates, accuracy, speed, battery, and other device state over MQTT.
18
18
This library provides type-safe parsing and serialization of all OwnTracks
19
19
message types including locations, transitions, waypoints, and cards.")
20
20
(depends
21
21
(ocaml (>= 5.1))
22
-
(jsont (>= 0.1.0))
22
+
nox-json
23
23
(bytesrw (>= 0.1))
24
24
geojson
25
25
(odoc :with-doc)))
+1
-1
lib/dune
+1
-1
lib/dune
+66
-71
lib/geojson.ml
+66
-71
lib/geojson.ml
···
11
11
12
12
type float_array = float array
13
13
14
-
let float_array_jsont ~kind = Jsont.array ~kind Jsont.number
14
+
let float_array_jsont ~kind = Json.Codec.array ~kind Json.Codec.number
15
15
16
16
type 'a garray = 'a array
17
17
18
-
let garray = Jsont.array
18
+
let garray = Json.Codec.array
19
19
20
20
(** Bounding box. *)
21
21
module Bbox = struct
···
43
43
44
44
(** Internal wrapper for GeoJSON objects with bbox and unknown fields. *)
45
45
module Geojson_object = struct
46
-
type 'a t = { type' : 'a; bbox : Bbox.t option; unknown : Jsont.json }
46
+
type 'a t = { type' : 'a; bbox : Bbox.t option; unknown : Json.t }
47
47
48
48
let make type' bbox unknown = { type'; bbox; unknown }
49
49
let type' o = o.type'
···
52
52
53
53
let finish_jsont map =
54
54
map
55
-
|> Jsont.Object.opt_mem "bbox" Bbox.jsont ~enc:bbox
56
-
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
57
-
|> Jsont.Object.finish
55
+
|> Json.Codec.Object.opt_member "bbox" Bbox.jsont ~enc:bbox
56
+
|> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown
57
+
|> Json.Codec.Object.seal
58
58
59
59
let geometry ~kind coordinates =
60
-
Jsont.Object.map ~kind make
61
-
|> Jsont.Object.mem "coordinates" coordinates ~enc:type'
60
+
Json.Codec.Object.map ~kind make
61
+
|> Json.Codec.Object.member "coordinates" coordinates ~enc:type'
62
62
|> finish_jsont
63
63
end
64
64
···
67
67
type t = Position.t
68
68
69
69
let jsont = Geojson_object.geometry ~kind:"Point" Position.jsont
70
-
let v pos = Geojson_object.make pos None (Jsont.Json.object' [])
70
+
let v pos = Geojson_object.make pos None (Json.Value.object' [])
71
71
end
72
72
73
73
(** MultiPoint geometry. *)
···
82
82
type t = Position.t garray
83
83
84
84
let jsont = Geojson_object.geometry ~kind:"LineString" (garray Position.jsont)
85
-
let v positions = Geojson_object.make positions None (Jsont.Json.object' [])
85
+
let v positions = Geojson_object.make positions None (Json.Value.object' [])
86
86
end
87
87
88
88
(** MultiLineString geometry. *)
···
132
132
type t = {
133
133
id : id option;
134
134
geometry : geometry option;
135
-
properties : Jsont.json option;
135
+
properties : Json.t option;
136
136
}
137
137
138
138
let make id geometry properties = { id; geometry; properties }
···
148
148
149
149
let v ?properties geometry =
150
150
let obj = { id = None; geometry = Some geometry; properties } in
151
-
Geojson_object.make obj None (Jsont.Json.object' [])
151
+
Geojson_object.make obj None (Json.Value.object' [])
152
152
end
153
153
154
154
type t =
···
168
168
169
169
let feature_id_jsont =
170
170
let number =
171
-
let dec = Jsont.Base.dec (fun n -> `Number n) in
172
-
let enc =
173
-
Jsont.Base.enc (function `Number n -> n | _ -> assert false)
174
-
in
175
-
Jsont.Base.number (Jsont.Base.map ~enc ~dec ())
171
+
Json.Codec.map
172
+
~dec:(fun n -> `Number n)
173
+
~enc:(function `Number n -> n | _ -> assert false)
174
+
Json.Codec.number
176
175
in
177
176
let string =
178
-
let dec = Jsont.Base.dec (fun n -> `String n) in
179
-
let enc =
180
-
Jsont.Base.enc (function `String n -> n | _ -> assert false)
181
-
in
182
-
Jsont.Base.string (Jsont.Base.map ~enc ~dec ())
177
+
Json.Codec.map
178
+
~dec:(fun n -> `String n)
179
+
~enc:(function `String n -> n | _ -> assert false)
180
+
Json.Codec.string
183
181
in
184
182
let enc = function `Number _ -> number | `String _ -> string in
185
-
Jsont.any ~kind:"id" ~dec_number:number ~dec_string:string ~enc ()
183
+
Json.Codec.any ~kind:"id" ~dec_number:number ~dec_string:string ~enc ()
186
184
187
-
let case_map obj dec = Jsont.Object.Case.map (Jsont.kind obj) obj ~dec
185
+
let case_map obj dec = Json.Codec.Object.Case.map (Json.Codec.kind obj) obj ~dec
188
186
189
187
let rec geometry_jsont =
190
188
lazy begin
···
200
198
case_map (Lazy.force geometry_collection_jsont) geometry_collection
201
199
in
202
200
let enc_case = function
203
-
| `Point v -> Jsont.Object.Case.value case_point v
204
-
| `Multi_point v -> Jsont.Object.Case.value case_multi_point v
205
-
| `Line_string v -> Jsont.Object.Case.value case_line_string v
201
+
| `Point v -> Json.Codec.Object.Case.value case_point v
202
+
| `Multi_point v -> Json.Codec.Object.Case.value case_multi_point v
203
+
| `Line_string v -> Json.Codec.Object.Case.value case_line_string v
206
204
| `Multi_line_string v ->
207
-
Jsont.Object.Case.value case_multi_line_string v
208
-
| `Polygon v -> Jsont.Object.Case.value case_polygon v
209
-
| `Multi_polygon v -> Jsont.Object.Case.value case_multi_polygon v
205
+
Json.Codec.Object.Case.value case_multi_line_string v
206
+
| `Polygon v -> Json.Codec.Object.Case.value case_polygon v
207
+
| `Multi_polygon v -> Json.Codec.Object.Case.value case_multi_polygon v
210
208
| `Geometry_collection v ->
211
-
Jsont.Object.Case.value case_geometry_collection v
209
+
Json.Codec.Object.Case.value case_geometry_collection v
212
210
in
213
211
let cases =
214
-
Jsont.Object.Case.
212
+
Json.Codec.Object.Case.
215
213
[
216
214
make case_point;
217
215
make case_multi_point;
···
222
220
make case_geometry_collection;
223
221
]
224
222
in
225
-
Jsont.Object.map ~kind:"Geometry object" Fun.id
226
-
|> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
223
+
Json.Codec.Object.map ~kind:"Geometry object" Fun.id
224
+
|> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id ~enc_case cases
227
225
~tag_to_string:Fun.id ~tag_compare:String.compare
228
-
|> Jsont.Object.finish
226
+
|> Json.Codec.Object.seal
229
227
end
230
228
231
-
and feature_jsont : Feature.t object' Jsont.t Lazy.t =
229
+
and feature_jsont : Feature.t object' Json.Codec.t Lazy.t =
232
230
lazy begin
233
231
let case_feature = case_map (Lazy.force case_feature_jsont) Fun.id in
234
-
let enc_case v = Jsont.Object.Case.value case_feature v in
235
-
let cases = Jsont.Object.Case.[ make case_feature ] in
236
-
Jsont.Object.map ~kind:"Feature" Fun.id
237
-
|> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
232
+
let enc_case v = Json.Codec.Object.Case.value case_feature v in
233
+
let cases = Json.Codec.Object.Case.[ make case_feature ] in
234
+
Json.Codec.Object.map ~kind:"Feature" Fun.id
235
+
|> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id ~enc_case cases
238
236
~tag_to_string:Fun.id ~tag_compare:String.compare
239
-
|> Jsont.Object.finish
237
+
|> Json.Codec.Object.seal
240
238
end
241
239
242
-
and case_feature_jsont : Feature.t object' Jsont.t Lazy.t =
240
+
and case_feature_jsont : Feature.t object' Json.Codec.t Lazy.t =
243
241
lazy begin
244
-
Jsont.Object.map ~kind:"Feature" Feature.make_geojson_object
245
-
|> Jsont.Object.opt_mem "id" feature_id_jsont ~enc:(fun o ->
242
+
Json.Codec.Object.map ~kind:"Feature" Feature.make_geojson_object
243
+
|> Json.Codec.Object.opt_member "id" feature_id_jsont ~enc:(fun o ->
246
244
Feature.id (Geojson_object.type' o))
247
-
|> Jsont.Object.mem "geometry"
248
-
(Jsont.option (Jsont.rec' geometry_jsont))
245
+
|> Json.Codec.Object.member "geometry"
246
+
(Json.Codec.option (Json.Codec.fix geometry_jsont))
249
247
~enc:(fun o -> Feature.geometry (Geojson_object.type' o))
250
-
|> Jsont.Object.mem "properties" (Jsont.option Jsont.json_object)
248
+
|> Json.Codec.Object.member "properties" (Json.Codec.option Json.Codec.Value.object')
251
249
~enc:(fun o -> Feature.properties (Geojson_object.type' o))
252
250
|> Geojson_object.finish_jsont
253
251
end
254
252
255
253
and geometry_collection_jsont =
256
254
lazy begin
257
-
Jsont.Object.map ~kind:"GeometryCollection" Geojson_object.make
258
-
|> Jsont.Object.mem "geometries"
259
-
(Jsont.list (Jsont.rec' geometry_jsont))
255
+
Json.Codec.Object.map ~kind:"GeometryCollection" Geojson_object.make
256
+
|> Json.Codec.Object.member "geometries"
257
+
(Json.Codec.list (Json.Codec.fix geometry_jsont))
260
258
~enc:Geojson_object.type'
261
259
|> Geojson_object.finish_jsont
262
260
end
263
261
264
262
and feature_collection_json =
265
263
lazy begin
266
-
Jsont.Object.map ~kind:"FeatureCollection" Geojson_object.make
267
-
|> Jsont.Object.mem "features"
268
-
Jsont.(list (Jsont.rec' feature_jsont))
264
+
Json.Codec.Object.map ~kind:"FeatureCollection" Geojson_object.make
265
+
|> Json.Codec.Object.member "features"
266
+
Json.Codec.(list (fix feature_jsont))
269
267
~enc:Geojson_object.type'
270
268
|> Geojson_object.finish_jsont
271
269
end
272
270
273
-
and jsont : t Jsont.t Lazy.t =
271
+
and jsont : t Json.Codec.t Lazy.t =
274
272
lazy begin
275
273
let case_point = case_map Point.jsont point in
276
274
let case_multi_point = case_map Multi_point.jsont multi_point in
···
288
286
case_map (Lazy.force feature_collection_json) feature_collection
289
287
in
290
288
let enc_case = function
291
-
| `Point v -> Jsont.Object.Case.value case_point v
292
-
| `Multi_point v -> Jsont.Object.Case.value case_multi_point v
293
-
| `Line_string v -> Jsont.Object.Case.value case_line_string v
289
+
| `Point v -> Json.Codec.Object.Case.value case_point v
290
+
| `Multi_point v -> Json.Codec.Object.Case.value case_multi_point v
291
+
| `Line_string v -> Json.Codec.Object.Case.value case_line_string v
294
292
| `Multi_line_string v ->
295
-
Jsont.Object.Case.value case_multi_line_string v
296
-
| `Polygon v -> Jsont.Object.Case.value case_polygon v
297
-
| `Multi_polygon v -> Jsont.Object.Case.value case_multi_polygon v
293
+
Json.Codec.Object.Case.value case_multi_line_string v
294
+
| `Polygon v -> Json.Codec.Object.Case.value case_polygon v
295
+
| `Multi_polygon v -> Json.Codec.Object.Case.value case_multi_polygon v
298
296
| `Geometry_collection v ->
299
-
Jsont.Object.Case.value case_geometry_collection v
300
-
| `Feature v -> Jsont.Object.Case.value case_feature v
297
+
Json.Codec.Object.Case.value case_geometry_collection v
298
+
| `Feature v -> Json.Codec.Object.Case.value case_feature v
301
299
| `Feature_collection v ->
302
-
Jsont.Object.Case.value case_feature_collection v
300
+
Json.Codec.Object.Case.value case_feature_collection v
303
301
in
304
302
let cases =
305
-
Jsont.Object.Case.
303
+
Json.Codec.Object.Case.
306
304
[
307
305
make case_point;
308
306
make case_multi_point;
···
315
313
make case_feature_collection;
316
314
]
317
315
in
318
-
Jsont.Object.map ~kind:"GeoJSON" Fun.id
319
-
|> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
316
+
Json.Codec.Object.map ~kind:"GeoJSON" Fun.id
317
+
|> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id ~enc_case cases
320
318
~tag_to_string:Fun.id ~tag_compare:String.compare
321
-
|> Jsont.Object.finish
319
+
|> Json.Codec.Object.seal
322
320
end
323
321
324
322
let jsont = Lazy.force jsont
325
323
326
-
let to_string t =
327
-
match Jsont_bytesrw.encode_string jsont t with
328
-
| Ok s -> s
329
-
| Error e -> failwith e
324
+
let to_string t = Json.to_string jsont t
330
325
end
331
326
332
327
(** Convenience module for working with GeoJSON geometry types. *)
+11
-11
lib/geojson.mli
+11
-11
lib/geojson.mli
···
44
44
type t = float array
45
45
(** The type for bounding boxes. *)
46
46
47
-
val jsont : t Jsont.t
47
+
val jsont : t Json.Codec.t
48
48
(** [jsont] is a JSON codec for bounding boxes. *)
49
49
end
50
50
···
60
60
type t = float array
61
61
(** The type for positions. *)
62
62
63
-
val jsont : t Jsont.t
63
+
val jsont : t Json.Codec.t
64
64
(** [jsont] is a JSON codec for positions. *)
65
65
66
66
val v : ?altitude:float -> lng:float -> lat:float -> unit -> t
···
104
104
type t = Position.t
105
105
(** The type for point coordinates. *)
106
106
107
-
val jsont : t Geojson_object.t Jsont.t
107
+
val jsont : t Geojson_object.t Json.Codec.t
108
108
(** [jsont] is a JSON codec for Point geometry objects. *)
109
109
110
110
val v : Position.t -> t Geojson_object.t
···
118
118
type t = Position.t array
119
119
(** The type for multipoint coordinates. *)
120
120
121
-
val jsont : t Geojson_object.t Jsont.t
121
+
val jsont : t Geojson_object.t Json.Codec.t
122
122
(** [jsont] is a JSON codec for MultiPoint geometry objects. *)
123
123
end
124
124
···
130
130
type t = Position.t array
131
131
(** The type for linestring coordinates. *)
132
132
133
-
val jsont : t Geojson_object.t Jsont.t
133
+
val jsont : t Geojson_object.t Json.Codec.t
134
134
(** [jsont] is a JSON codec for LineString geometry objects. *)
135
135
136
136
val v : Position.t array -> t Geojson_object.t
···
144
144
type t = Line_string.t array
145
145
(** The type for multilinestring coordinates. *)
146
146
147
-
val jsont : t Geojson_object.t Jsont.t
147
+
val jsont : t Geojson_object.t Json.Codec.t
148
148
(** [jsont] is a JSON codec for MultiLineString geometry objects. *)
149
149
end
150
150
···
157
157
type t = Line_string.t array
158
158
(** The type for polygon coordinates (array of linear rings). *)
159
159
160
-
val jsont : t Geojson_object.t Jsont.t
160
+
val jsont : t Geojson_object.t Json.Codec.t
161
161
(** [jsont] is a JSON codec for Polygon geometry objects. *)
162
162
end
163
163
···
168
168
type t = Polygon.t array
169
169
(** The type for multipolygon coordinates. *)
170
170
171
-
val jsont : t Geojson_object.t Jsont.t
171
+
val jsont : t Geojson_object.t Json.Codec.t
172
172
(** [jsont] is a JSON codec for MultiPolygon geometry objects. *)
173
173
end
174
174
···
215
215
(** [geometry f] returns the optional geometry. A feature may have null
216
216
geometry. *)
217
217
218
-
val properties : t -> Jsont.json option
218
+
val properties : t -> Json.t option
219
219
(** [properties f] returns the optional properties JSON object. Properties
220
220
can be any JSON object. *)
221
221
222
222
type collection = t object' list
223
223
(** A FeatureCollection is a list of features. *)
224
224
225
-
val v : ?properties:Jsont.json -> geometry -> t object'
225
+
val v : ?properties:Json.t -> geometry -> t object'
226
226
(** [v ?properties geometry] creates a Feature with the given geometry and
227
227
optional properties JSON object. *)
228
228
end
···
271
271
272
272
(** {1:codec Encoding and Decoding} *)
273
273
274
-
val jsont : t Jsont.t
274
+
val jsont : t Json.Codec.t
275
275
(** [jsont] is a JSON codec for GeoJSON objects. Handles all GeoJSON types
276
276
including features, feature collections, and all geometry types. *)
277
277
+4
-4
lib/owntracks.mli
+4
-4
lib/owntracks.mli
···
5
5
6
6
(** OwnTracks message types and JSON codecs.
7
7
8
-
This module provides types and {{:https://erratique.ch/software/jsont}jsont}
8
+
This module provides types and {{:https://tangled.org/@anil.recoil.org/nox-json}nox-json}
9
9
codecs for parsing {{:https://owntracks.org/}OwnTracks} MQTT messages.
10
10
OwnTracks is an open-source location tracking application that publishes
11
11
location data over MQTT.
···
23
23
24
24
{1:example Example}
25
25
26
-
Decoding a location message using jsont_bytesrw:
26
+
Decoding a location message:
27
27
{[
28
28
let json =
29
29
{|{"_type":"location","lat":51.5,"lon":-0.1,"tst":1234567890}|}
30
30
in
31
-
match Jsont_bytesrw.decode_string Owntracks.Message.jsont json with
31
+
match Json.of_string Owntracks.Message.jsont json with
32
32
| Ok (Location loc) ->
33
33
Printf.printf "Location: %.4f, %.4f\n"
34
34
(Owntracks.Location.lat loc)
35
35
(Owntracks.Location.lon loc)
36
36
| Ok _ -> print_endline "Other message type"
37
-
| Error e -> Printf.printf "Error: %s\n" e
37
+
| Error e -> Printf.printf "Error: %s\n" (Json.Error.to_string e)
38
38
]}
39
39
40
40
See {{:https://owntracks.org/booklet/tech/json/}OwnTracks JSON format} for
+13
-13
lib/owntracks_card.ml
+13
-13
lib/owntracks_card.ml
···
10
10
let face t = t.face
11
11
let tid t = t.tid
12
12
13
-
let jsont_bare : t Jsont.t =
13
+
let jsont_bare : t Json.Codec.t =
14
14
let make name face tid = { name; face; tid } in
15
-
Jsont.Object.map ~kind:"card" make
16
-
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun c -> c.name)
17
-
|> Jsont.Object.opt_mem "face" Jsont.string ~enc:(fun c -> c.face)
18
-
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun c -> c.tid)
19
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
15
+
Json.Codec.Object.map ~kind:"card" make
16
+
|> Json.Codec.Object.opt_member "name" Json.Codec.string ~enc:(fun c -> c.name)
17
+
|> Json.Codec.Object.opt_member "face" Json.Codec.string ~enc:(fun c -> c.face)
18
+
|> Json.Codec.Object.opt_member "tid" Json.Codec.string ~enc:(fun c -> c.tid)
19
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
20
20
21
-
let jsont : t Jsont.t =
21
+
let jsont : t Json.Codec.t =
22
22
let make _type name face tid =
23
23
ignore _type;
24
24
{ name; face; tid }
25
25
in
26
-
Jsont.Object.map ~kind:"card" make
27
-
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "card")
28
-
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun c -> c.name)
29
-
|> Jsont.Object.opt_mem "face" Jsont.string ~enc:(fun c -> c.face)
30
-
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun c -> c.tid)
31
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
26
+
Json.Codec.Object.map ~kind:"card" make
27
+
|> Json.Codec.Object.member "_type" Json.Codec.string ~enc:(fun _ -> "card")
28
+
|> Json.Codec.Object.opt_member "name" Json.Codec.string ~enc:(fun c -> c.name)
29
+
|> Json.Codec.Object.opt_member "face" Json.Codec.string ~enc:(fun c -> c.face)
30
+
|> Json.Codec.Object.opt_member "tid" Json.Codec.string ~enc:(fun c -> c.tid)
31
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
32
32
33
33
let pp ppf card =
34
34
Format.fprintf ppf "Card: %s" (Option.value ~default:"(no name)" card.name)
+2
-2
lib/owntracks_card.mli
+2
-2
lib/owntracks_card.mli
···
34
34
35
35
(** {1 JSON Codec} *)
36
36
37
-
val jsont : t Jsont.t
37
+
val jsont : t Json.Codec.t
38
38
(** [jsont] is a JSON codec for card messages. Expects the ["_type"] field to be
39
39
["card"]. *)
40
40
41
-
val jsont_bare : t Jsont.t
41
+
val jsont_bare : t Json.Codec.t
42
42
(** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. *)
43
43
44
44
(** {1 Pretty Printing} *)
+14
-14
lib/owntracks_geojson_output.ml
+14
-14
lib/owntracks_geojson_output.ml
···
14
14
15
15
let props ~device_name ~timestamp ~time ?accuracy ?speed ?battery ?tracker_id ()
16
16
=
17
-
let open Jsont.Json in
17
+
let open Json.Value in
18
18
let add n f opt acc =
19
19
match opt with Some v -> (n, f v) :: acc | None -> acc
20
20
in
···
27
27
|> add "speed" number speed |> add "battery" int battery
28
28
|> add "tracker_id" string tracker_id
29
29
|> fun mems ->
30
-
Jsont.Json.object'
31
-
(List.map (fun (n, v) -> Jsont.Json.mem (Jsont.Json.name n) v) mems)
30
+
Json.Value.object'
31
+
(List.map (fun (n, v) -> Json.Value.member (Json.Value.name n) v) mems)
32
32
33
33
let point_feature ~device_name loc : Geojson.t =
34
34
let point = Geometry.Point.v (pos_of_loc loc) in
···
65
65
in
66
66
let properties =
67
67
Some
68
-
(Jsont.Json.object'
68
+
(Json.Value.object'
69
69
[
70
-
Jsont.Json.mem (Jsont.Json.name "name")
71
-
(Jsont.Json.string device_name);
72
-
Jsont.Json.mem (Jsont.Json.name "points")
73
-
(Jsont.Json.int (List.length sorted));
74
-
Jsont.Json.mem
75
-
(Jsont.Json.name "start_time")
76
-
(Jsont.Json.string
70
+
Json.Value.member (Json.Value.name "name")
71
+
(Json.Value.string device_name);
72
+
Json.Value.member (Json.Value.name "points")
73
+
(Json.Value.int (List.length sorted));
74
+
Json.Value.member
75
+
(Json.Value.name "start_time")
76
+
(Json.Value.string
77
77
(Owntracks_location.format_timestamp start_time));
78
-
Jsont.Json.mem
79
-
(Jsont.Json.name "end_time")
80
-
(Jsont.Json.string (Owntracks_location.format_timestamp end_time));
78
+
Json.Value.member
79
+
(Json.Value.name "end_time")
80
+
(Json.Value.string (Owntracks_location.format_timestamp end_time));
81
81
])
82
82
in
83
83
let feature = Geojson.Feature.v ?properties geom in
+41
-41
lib/owntracks_location.ml
+41
-41
lib/owntracks_location.ml
···
64
64
let topic t = t.topic
65
65
let with_topic topic t = { t with topic = Some topic }
66
66
67
-
let jsont : t Jsont.t =
67
+
let jsont : t Json.Codec.t =
68
68
let make _type tid tst lat lon alt acc vel cog batt bs conn t m poi inregions
69
69
addr topic =
70
70
ignore _type;
···
88
88
topic;
89
89
}
90
90
in
91
-
Jsont.Object.map ~kind:"location" make
92
-
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "location")
93
-
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun l -> l.tid)
94
-
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst)
95
-
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun l -> l.lat)
96
-
|> Jsont.Object.mem "lon" Jsont.number ~enc:(fun l -> l.lon)
97
-
|> Jsont.Object.opt_mem "alt" Jsont.number ~enc:(fun l -> l.alt)
98
-
|> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun l -> l.acc)
99
-
|> Jsont.Object.opt_mem "vel" Jsont.number ~enc:(fun l -> l.vel)
100
-
|> Jsont.Object.opt_mem "cog" Jsont.number ~enc:(fun l -> l.cog)
101
-
|> Jsont.Object.opt_mem "batt" Jsont.int ~enc:(fun l -> l.batt)
102
-
|> Jsont.Object.opt_mem "bs" Jsont.int ~enc:(fun l -> l.bs)
103
-
|> Jsont.Object.opt_mem "conn" Jsont.string ~enc:(fun l -> l.conn)
104
-
|> Jsont.Object.opt_mem "t" Jsont.string ~enc:(fun l -> l.t)
105
-
|> Jsont.Object.opt_mem "m" Jsont.int ~enc:(fun l -> l.m)
106
-
|> Jsont.Object.opt_mem "poi" Jsont.string ~enc:(fun l -> l.poi)
107
-
|> Jsont.Object.opt_mem "inregions" (Jsont.list Jsont.string) ~enc:(fun l ->
91
+
Json.Codec.Object.map ~kind:"location" make
92
+
|> Json.Codec.Object.member "_type" Json.Codec.string ~enc:(fun _ -> "location")
93
+
|> Json.Codec.Object.opt_member "tid" Json.Codec.string ~enc:(fun l -> l.tid)
94
+
|> Json.Codec.Object.member "tst" Json.Codec.int ~enc:(fun l -> l.tst)
95
+
|> Json.Codec.Object.member "lat" Json.Codec.number ~enc:(fun l -> l.lat)
96
+
|> Json.Codec.Object.member "lon" Json.Codec.number ~enc:(fun l -> l.lon)
97
+
|> Json.Codec.Object.opt_member "alt" Json.Codec.number ~enc:(fun l -> l.alt)
98
+
|> Json.Codec.Object.opt_member "acc" Json.Codec.number ~enc:(fun l -> l.acc)
99
+
|> Json.Codec.Object.opt_member "vel" Json.Codec.number ~enc:(fun l -> l.vel)
100
+
|> Json.Codec.Object.opt_member "cog" Json.Codec.number ~enc:(fun l -> l.cog)
101
+
|> Json.Codec.Object.opt_member "batt" Json.Codec.int ~enc:(fun l -> l.batt)
102
+
|> Json.Codec.Object.opt_member "bs" Json.Codec.int ~enc:(fun l -> l.bs)
103
+
|> Json.Codec.Object.opt_member "conn" Json.Codec.string ~enc:(fun l -> l.conn)
104
+
|> Json.Codec.Object.opt_member "t" Json.Codec.string ~enc:(fun l -> l.t)
105
+
|> Json.Codec.Object.opt_member "m" Json.Codec.int ~enc:(fun l -> l.m)
106
+
|> Json.Codec.Object.opt_member "poi" Json.Codec.string ~enc:(fun l -> l.poi)
107
+
|> Json.Codec.Object.opt_member "inregions" (Json.Codec.list Json.Codec.string) ~enc:(fun l ->
108
108
match l.inregions with [] -> None | xs -> Some xs)
109
-
|> Jsont.Object.opt_mem "addr" Jsont.string ~enc:(fun l -> l.addr)
110
-
|> Jsont.Object.opt_mem "topic" Jsont.string ~enc:(fun l -> l.topic)
111
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
109
+
|> Json.Codec.Object.opt_member "addr" Json.Codec.string ~enc:(fun l -> l.addr)
110
+
|> Json.Codec.Object.opt_member "topic" Json.Codec.string ~enc:(fun l -> l.topic)
111
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
112
112
113
-
let jsont_bare : t Jsont.t =
113
+
let jsont_bare : t Json.Codec.t =
114
114
let make tid tst lat lon alt acc vel cog batt bs conn t m poi inregions addr
115
115
topic =
116
116
{
···
133
133
topic;
134
134
}
135
135
in
136
-
Jsont.Object.map ~kind:"location" make
137
-
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun l -> l.tid)
138
-
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst)
139
-
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun l -> l.lat)
140
-
|> Jsont.Object.mem "lon" Jsont.number ~enc:(fun l -> l.lon)
141
-
|> Jsont.Object.opt_mem "alt" Jsont.number ~enc:(fun l -> l.alt)
142
-
|> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun l -> l.acc)
143
-
|> Jsont.Object.opt_mem "vel" Jsont.number ~enc:(fun l -> l.vel)
144
-
|> Jsont.Object.opt_mem "cog" Jsont.number ~enc:(fun l -> l.cog)
145
-
|> Jsont.Object.opt_mem "batt" Jsont.int ~enc:(fun l -> l.batt)
146
-
|> Jsont.Object.opt_mem "bs" Jsont.int ~enc:(fun l -> l.bs)
147
-
|> Jsont.Object.opt_mem "conn" Jsont.string ~enc:(fun l -> l.conn)
148
-
|> Jsont.Object.opt_mem "t" Jsont.string ~enc:(fun l -> l.t)
149
-
|> Jsont.Object.opt_mem "m" Jsont.int ~enc:(fun l -> l.m)
150
-
|> Jsont.Object.opt_mem "poi" Jsont.string ~enc:(fun l -> l.poi)
151
-
|> Jsont.Object.opt_mem "inregions" (Jsont.list Jsont.string) ~enc:(fun l ->
136
+
Json.Codec.Object.map ~kind:"location" make
137
+
|> Json.Codec.Object.opt_member "tid" Json.Codec.string ~enc:(fun l -> l.tid)
138
+
|> Json.Codec.Object.member "tst" Json.Codec.int ~enc:(fun l -> l.tst)
139
+
|> Json.Codec.Object.member "lat" Json.Codec.number ~enc:(fun l -> l.lat)
140
+
|> Json.Codec.Object.member "lon" Json.Codec.number ~enc:(fun l -> l.lon)
141
+
|> Json.Codec.Object.opt_member "alt" Json.Codec.number ~enc:(fun l -> l.alt)
142
+
|> Json.Codec.Object.opt_member "acc" Json.Codec.number ~enc:(fun l -> l.acc)
143
+
|> Json.Codec.Object.opt_member "vel" Json.Codec.number ~enc:(fun l -> l.vel)
144
+
|> Json.Codec.Object.opt_member "cog" Json.Codec.number ~enc:(fun l -> l.cog)
145
+
|> Json.Codec.Object.opt_member "batt" Json.Codec.int ~enc:(fun l -> l.batt)
146
+
|> Json.Codec.Object.opt_member "bs" Json.Codec.int ~enc:(fun l -> l.bs)
147
+
|> Json.Codec.Object.opt_member "conn" Json.Codec.string ~enc:(fun l -> l.conn)
148
+
|> Json.Codec.Object.opt_member "t" Json.Codec.string ~enc:(fun l -> l.t)
149
+
|> Json.Codec.Object.opt_member "m" Json.Codec.int ~enc:(fun l -> l.m)
150
+
|> Json.Codec.Object.opt_member "poi" Json.Codec.string ~enc:(fun l -> l.poi)
151
+
|> Json.Codec.Object.opt_member "inregions" (Json.Codec.list Json.Codec.string) ~enc:(fun l ->
152
152
match l.inregions with [] -> None | xs -> Some xs)
153
-
|> Jsont.Object.opt_mem "addr" Jsont.string ~enc:(fun l -> l.addr)
154
-
|> Jsont.Object.opt_mem "topic" Jsont.string ~enc:(fun l -> l.topic)
155
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
153
+
|> Json.Codec.Object.opt_member "addr" Json.Codec.string ~enc:(fun l -> l.addr)
154
+
|> Json.Codec.Object.opt_member "topic" Json.Codec.string ~enc:(fun l -> l.topic)
155
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
156
156
157
157
let format_timestamp tst =
158
158
let t = Unix.gmtime (float_of_int tst) in
+2
-2
lib/owntracks_location.mli
+2
-2
lib/owntracks_location.mli
···
128
128
129
129
(** {1 JSON Codec} *)
130
130
131
-
val jsont : t Jsont.t
131
+
val jsont : t Json.Codec.t
132
132
(** [jsont] is a JSON codec for location messages. Expects the ["_type"] field
133
133
to be ["location"]. *)
134
134
135
-
val jsont_bare : t Jsont.t
135
+
val jsont_bare : t Json.Codec.t
136
136
(** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. Use
137
137
this for parsing recorder API responses which omit the type field. *)
138
138
+9
-9
lib/owntracks_lwt.ml
+9
-9
lib/owntracks_lwt.ml
···
8
8
let v ~tst = { tst }
9
9
let tst t = t.tst
10
10
11
-
let jsont_bare : t Jsont.t =
11
+
let jsont_bare : t Json.Codec.t =
12
12
let make tst = { tst } in
13
-
Jsont.Object.map ~kind:"lwt" make
14
-
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst)
15
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
13
+
Json.Codec.Object.map ~kind:"lwt" make
14
+
|> Json.Codec.Object.member "tst" Json.Codec.int ~enc:(fun l -> l.tst)
15
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
16
16
17
-
let jsont : t Jsont.t =
17
+
let jsont : t Json.Codec.t =
18
18
let make _type tst =
19
19
ignore _type;
20
20
{ tst }
21
21
in
22
-
Jsont.Object.map ~kind:"lwt" make
23
-
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "lwt")
24
-
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst)
25
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
22
+
Json.Codec.Object.map ~kind:"lwt" make
23
+
|> Json.Codec.Object.member "_type" Json.Codec.string ~enc:(fun _ -> "lwt")
24
+
|> Json.Codec.Object.member "tst" Json.Codec.int ~enc:(fun l -> l.tst)
25
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
26
26
27
27
let pp ppf lwt =
28
28
Format.fprintf ppf "LWT: client disconnected at %s"
+2
-2
lib/owntracks_lwt.mli
+2
-2
lib/owntracks_lwt.mli
···
26
26
27
27
(** {1 JSON Codec} *)
28
28
29
-
val jsont : t Jsont.t
29
+
val jsont : t Json.Codec.t
30
30
(** [jsont] is a JSON codec for LWT messages. Expects the ["_type"] field to be
31
31
["lwt"]. *)
32
32
33
-
val jsont_bare : t Jsont.t
33
+
val jsont_bare : t Json.Codec.t
34
34
(** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. *)
35
35
36
36
(** {1 Pretty Printing} *)
+16
-16
lib/owntracks_message.ml
+16
-16
lib/owntracks_message.ml
···
17
17
let card c = Card c
18
18
let lwt l = Lwt l
19
19
20
-
let jsont : t Jsont.t =
20
+
let jsont : t Json.Codec.t =
21
21
let case_location =
22
-
Jsont.Object.Case.map "location" Owntracks_location.jsont_bare ~dec:location
22
+
Json.Codec.Object.Case.map "location" Owntracks_location.jsont_bare ~dec:location
23
23
in
24
24
let case_transition =
25
-
Jsont.Object.Case.map "transition" Owntracks_transition.jsont_bare
25
+
Json.Codec.Object.Case.map "transition" Owntracks_transition.jsont_bare
26
26
~dec:transition
27
27
in
28
28
let case_waypoint =
29
-
Jsont.Object.Case.map "waypoint" Owntracks_waypoint.jsont_bare ~dec:waypoint
29
+
Json.Codec.Object.Case.map "waypoint" Owntracks_waypoint.jsont_bare ~dec:waypoint
30
30
in
31
31
let case_waypoints =
32
-
Jsont.Object.Case.map "waypoints" Owntracks_waypoint.jsont_bare
32
+
Json.Codec.Object.Case.map "waypoints" Owntracks_waypoint.jsont_bare
33
33
~dec:waypoint
34
34
in
35
35
let case_card =
36
-
Jsont.Object.Case.map "card" Owntracks_card.jsont_bare ~dec:card
36
+
Json.Codec.Object.Case.map "card" Owntracks_card.jsont_bare ~dec:card
37
37
in
38
38
let case_lwt =
39
-
Jsont.Object.Case.map "lwt" Owntracks_lwt.jsont_bare ~dec:lwt
39
+
Json.Codec.Object.Case.map "lwt" Owntracks_lwt.jsont_bare ~dec:lwt
40
40
in
41
41
let enc_case = function
42
-
| Location l -> Jsont.Object.Case.value case_location l
43
-
| Transition t -> Jsont.Object.Case.value case_transition t
44
-
| Waypoint w -> Jsont.Object.Case.value case_waypoint w
45
-
| Card c -> Jsont.Object.Case.value case_card c
46
-
| Lwt l -> Jsont.Object.Case.value case_lwt l
42
+
| Location l -> Json.Codec.Object.Case.value case_location l
43
+
| Transition t -> Json.Codec.Object.Case.value case_transition t
44
+
| Waypoint w -> Json.Codec.Object.Case.value case_waypoint w
45
+
| Card c -> Json.Codec.Object.Case.value case_card c
46
+
| Lwt l -> Json.Codec.Object.Case.value case_lwt l
47
47
| Unknown _ -> assert false (* Cannot encode Unknown *)
48
48
in
49
49
let cases =
50
-
Jsont.Object.Case.
50
+
Json.Codec.Object.Case.
51
51
[
52
52
make case_location;
53
53
make case_transition;
···
57
57
make case_lwt;
58
58
]
59
59
in
60
-
Jsont.Object.map ~kind:"message" Fun.id
61
-
|> Jsont.Object.case_mem "_type" Jsont.string ~enc:Fun.id ~enc_case cases
62
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
60
+
Json.Codec.Object.map ~kind:"message" Fun.id
61
+
|> Json.Codec.Object.case_member "_type" Json.Codec.string ~enc:Fun.id ~enc_case cases
62
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
63
63
64
64
let pp ppf = function
65
65
| Location loc -> Owntracks_location.pp ppf loc
+1
-1
lib/owntracks_message.mli
+1
-1
lib/owntracks_message.mli
+2
-2
lib/owntracks_mqtt.ml
+2
-2
lib/owntracks_mqtt.ml
···
43
43
else payload
44
44
in
45
45
match
46
-
Jsont_bytesrw.decode_string Owntracks_message.jsont payload_with_topic
46
+
Json.of_string Owntracks_message.jsont payload_with_topic
47
47
with
48
48
| Ok message -> Ok { topic = msg.topic; user; device; message }
49
-
| Error e -> Error e
49
+
| Error e -> Error (Json.Error.to_string e)
50
50
51
51
let of_mqtt ~topic ~payload : (t, string) result =
52
52
of_mqtt_message
+11
-11
lib/owntracks_recorder.ml
+11
-11
lib/owntracks_recorder.ml
···
11
11
let password t = t.password
12
12
end
13
13
14
-
let locations_jsont : Owntracks_location.t list Jsont.t =
15
-
Jsont.list Owntracks_location.jsont_bare
14
+
let locations_jsont : Owntracks_location.t list Json.Codec.t =
15
+
Json.Codec.list Owntracks_location.jsont_bare
16
16
17
-
let locations_data_jsont : Owntracks_location.t list Jsont.t =
17
+
let locations_data_jsont : Owntracks_location.t list Json.Codec.t =
18
18
let make data = data in
19
-
Jsont.Object.map ~kind:"data_response" make
20
-
|> Jsont.Object.mem "data" locations_jsont ~enc:Fun.id
21
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
19
+
Json.Codec.Object.map ~kind:"data_response" make
20
+
|> Json.Codec.Object.member "data" locations_jsont ~enc:Fun.id
21
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
22
22
23
-
let string_list_jsont : string list Jsont.t = Jsont.list Jsont.string
23
+
let string_list_jsont : string list Json.Codec.t = Json.Codec.list Json.Codec.string
24
24
25
-
let string_list_results_jsont : string list Jsont.t =
25
+
let string_list_results_jsont : string list Json.Codec.t =
26
26
let make results = results in
27
-
Jsont.Object.map ~kind:"results_response" make
28
-
|> Jsont.Object.mem "results" string_list_jsont ~enc:Fun.id
29
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
27
+
Json.Codec.Object.map ~kind:"results_response" make
28
+
|> Json.Codec.Object.member "results" string_list_jsont ~enc:Fun.id
29
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
+4
-4
lib/owntracks_recorder.mli
+4
-4
lib/owntracks_recorder.mli
···
40
40
41
41
(** {1 JSON Codecs} *)
42
42
43
-
val locations_jsont : Owntracks_location.t list Jsont.t
43
+
val locations_jsont : Owntracks_location.t list Json.Codec.t
44
44
(** Codec for a JSON array of location objects (without ["_type"] field). Use
45
45
with the [/api/0/locations] endpoint when it returns an array. *)
46
46
47
-
val locations_data_jsont : Owntracks_location.t list Jsont.t
47
+
val locations_data_jsont : Owntracks_location.t list Json.Codec.t
48
48
(** Codec for [{data: [...]}] response format from some recorder endpoints. *)
49
49
50
-
val string_list_jsont : string list Jsont.t
50
+
val string_list_jsont : string list Json.Codec.t
51
51
(** Codec for a JSON array of strings (e.g., usernames or device names). *)
52
52
53
-
val string_list_results_jsont : string list Jsont.t
53
+
val string_list_results_jsont : string list Json.Codec.t
54
54
(** Codec for [{results: [...]}] response format from [/api/0/list]. *)
+23
-23
lib/owntracks_transition.ml
+23
-23
lib/owntracks_transition.ml
···
26
26
let desc t = t.desc
27
27
let wtst t = t.wtst
28
28
29
-
let jsont_bare : t Jsont.t =
29
+
let jsont_bare : t Json.Codec.t =
30
30
let make tid tst lat lon acc event desc wtst =
31
31
{ tid; tst; lat; lon; acc; event; desc; wtst }
32
32
in
33
-
Jsont.Object.map ~kind:"transition" make
34
-
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun t -> t.tid)
35
-
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun t -> t.tst)
36
-
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun t -> t.lat)
37
-
|> Jsont.Object.mem "lon" Jsont.number ~enc:(fun t -> t.lon)
38
-
|> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun t -> t.acc)
39
-
|> Jsont.Object.mem "event" Jsont.string ~enc:(fun t -> t.event)
40
-
|> Jsont.Object.opt_mem "desc" Jsont.string ~enc:(fun t -> t.desc)
41
-
|> Jsont.Object.opt_mem "wtst" Jsont.int ~enc:(fun t -> t.wtst)
42
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
33
+
Json.Codec.Object.map ~kind:"transition" make
34
+
|> Json.Codec.Object.opt_member "tid" Json.Codec.string ~enc:(fun t -> t.tid)
35
+
|> Json.Codec.Object.member "tst" Json.Codec.int ~enc:(fun t -> t.tst)
36
+
|> Json.Codec.Object.member "lat" Json.Codec.number ~enc:(fun t -> t.lat)
37
+
|> Json.Codec.Object.member "lon" Json.Codec.number ~enc:(fun t -> t.lon)
38
+
|> Json.Codec.Object.opt_member "acc" Json.Codec.number ~enc:(fun t -> t.acc)
39
+
|> Json.Codec.Object.member "event" Json.Codec.string ~enc:(fun t -> t.event)
40
+
|> Json.Codec.Object.opt_member "desc" Json.Codec.string ~enc:(fun t -> t.desc)
41
+
|> Json.Codec.Object.opt_member "wtst" Json.Codec.int ~enc:(fun t -> t.wtst)
42
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
43
43
44
-
let jsont : t Jsont.t =
44
+
let jsont : t Json.Codec.t =
45
45
let make _type tid tst lat lon acc event desc wtst =
46
46
ignore _type;
47
47
{ tid; tst; lat; lon; acc; event; desc; wtst }
48
48
in
49
-
Jsont.Object.map ~kind:"transition" make
50
-
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "transition")
51
-
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun t -> t.tid)
52
-
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun t -> t.tst)
53
-
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun t -> t.lat)
54
-
|> Jsont.Object.mem "lon" Jsont.number ~enc:(fun t -> t.lon)
55
-
|> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun t -> t.acc)
56
-
|> Jsont.Object.mem "event" Jsont.string ~enc:(fun t -> t.event)
57
-
|> Jsont.Object.opt_mem "desc" Jsont.string ~enc:(fun t -> t.desc)
58
-
|> Jsont.Object.opt_mem "wtst" Jsont.int ~enc:(fun t -> t.wtst)
59
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
49
+
Json.Codec.Object.map ~kind:"transition" make
50
+
|> Json.Codec.Object.member "_type" Json.Codec.string ~enc:(fun _ -> "transition")
51
+
|> Json.Codec.Object.opt_member "tid" Json.Codec.string ~enc:(fun t -> t.tid)
52
+
|> Json.Codec.Object.member "tst" Json.Codec.int ~enc:(fun t -> t.tst)
53
+
|> Json.Codec.Object.member "lat" Json.Codec.number ~enc:(fun t -> t.lat)
54
+
|> Json.Codec.Object.member "lon" Json.Codec.number ~enc:(fun t -> t.lon)
55
+
|> Json.Codec.Object.opt_member "acc" Json.Codec.number ~enc:(fun t -> t.acc)
56
+
|> Json.Codec.Object.member "event" Json.Codec.string ~enc:(fun t -> t.event)
57
+
|> Json.Codec.Object.opt_member "desc" Json.Codec.string ~enc:(fun t -> t.desc)
58
+
|> Json.Codec.Object.opt_member "wtst" Json.Codec.int ~enc:(fun t -> t.wtst)
59
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
60
60
61
61
let pp ppf tr =
62
62
Format.fprintf ppf "@[<v 0>";
+2
-2
lib/owntracks_transition.mli
+2
-2
lib/owntracks_transition.mli
···
59
59
60
60
(** {1 JSON Codec} *)
61
61
62
-
val jsont : t Jsont.t
62
+
val jsont : t Json.Codec.t
63
63
(** [jsont] is a JSON codec for transition messages. Expects the ["_type"] field
64
64
to be ["transition"]. *)
65
65
66
-
val jsont_bare : t Jsont.t
66
+
val jsont_bare : t Json.Codec.t
67
67
(** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. *)
68
68
69
69
(** {1 Pretty Printing} *)
+17
-17
lib/owntracks_waypoint.ml
+17
-17
lib/owntracks_waypoint.ml
···
12
12
let rad t = t.rad
13
13
let desc t = t.desc
14
14
15
-
let jsont_bare : t Jsont.t =
15
+
let jsont_bare : t Json.Codec.t =
16
16
let make tst lat lon rad desc = { tst; lat; lon; rad; desc } in
17
-
Jsont.Object.map ~kind:"waypoint" make
18
-
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun w -> w.tst)
19
-
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun w -> w.lat)
20
-
|> Jsont.Object.mem "lon" Jsont.number ~enc:(fun w -> w.lon)
21
-
|> Jsont.Object.mem "rad" Jsont.int ~enc:(fun w -> w.rad)
22
-
|> Jsont.Object.mem "desc" Jsont.string ~enc:(fun w -> w.desc)
23
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
17
+
Json.Codec.Object.map ~kind:"waypoint" make
18
+
|> Json.Codec.Object.member "tst" Json.Codec.int ~enc:(fun w -> w.tst)
19
+
|> Json.Codec.Object.member "lat" Json.Codec.number ~enc:(fun w -> w.lat)
20
+
|> Json.Codec.Object.member "lon" Json.Codec.number ~enc:(fun w -> w.lon)
21
+
|> Json.Codec.Object.member "rad" Json.Codec.int ~enc:(fun w -> w.rad)
22
+
|> Json.Codec.Object.member "desc" Json.Codec.string ~enc:(fun w -> w.desc)
23
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
24
24
25
-
let jsont : t Jsont.t =
25
+
let jsont : t Json.Codec.t =
26
26
let make _type tst lat lon rad desc =
27
27
ignore _type;
28
28
{ tst; lat; lon; rad; desc }
29
29
in
30
-
Jsont.Object.map ~kind:"waypoint" make
31
-
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "waypoint")
32
-
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun w -> w.tst)
33
-
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun w -> w.lat)
34
-
|> Jsont.Object.mem "lon" Jsont.number ~enc:(fun w -> w.lon)
35
-
|> Jsont.Object.mem "rad" Jsont.int ~enc:(fun w -> w.rad)
36
-
|> Jsont.Object.mem "desc" Jsont.string ~enc:(fun w -> w.desc)
37
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
30
+
Json.Codec.Object.map ~kind:"waypoint" make
31
+
|> Json.Codec.Object.member "_type" Json.Codec.string ~enc:(fun _ -> "waypoint")
32
+
|> Json.Codec.Object.member "tst" Json.Codec.int ~enc:(fun w -> w.tst)
33
+
|> Json.Codec.Object.member "lat" Json.Codec.number ~enc:(fun w -> w.lat)
34
+
|> Json.Codec.Object.member "lon" Json.Codec.number ~enc:(fun w -> w.lon)
35
+
|> Json.Codec.Object.member "rad" Json.Codec.int ~enc:(fun w -> w.rad)
36
+
|> Json.Codec.Object.member "desc" Json.Codec.string ~enc:(fun w -> w.desc)
37
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
38
38
39
39
let pp ppf wp =
40
40
Format.fprintf ppf "Waypoint: %s at (%.6f, %.6f) radius %dm" wp.desc wp.lat
+2
-2
lib/owntracks_waypoint.mli
+2
-2
lib/owntracks_waypoint.mli
···
38
38
39
39
(** {1 JSON Codec} *)
40
40
41
-
val jsont : t Jsont.t
41
+
val jsont : t Json.Codec.t
42
42
(** [jsont] is a JSON codec for waypoint messages. Expects the ["_type"] field
43
43
to be ["waypoint"]. *)
44
44
45
-
val jsont_bare : t Jsont.t
45
+
val jsont_bare : t Json.Codec.t
46
46
(** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. *)
47
47
48
48
(** {1 Pretty Printing} *)
+2
-2
owntracks.opam
+2
-2
owntracks.opam
···
2
2
opam-version: "2.0"
3
3
synopsis: "OwnTracks message types and JSON codecs"
4
4
description: """
5
-
Types and jsont codecs for parsing OwnTracks MQTT location messages.
5
+
Types and JSON codecs for parsing OwnTracks MQTT location messages.
6
6
OwnTracks is an open-source location tracking application that publishes
7
7
GPS coordinates, accuracy, speed, battery, and other device state over MQTT.
8
8
This library provides type-safe parsing and serialization of all OwnTracks
···
15
15
depends: [
16
16
"dune" {>= "3.21"}
17
17
"ocaml" {>= "5.1"}
18
-
"jsont" {>= "0.1.0"}
18
+
"nox-json"
19
19
"bytesrw" {>= "0.1"}
20
20
"geojson"
21
21
"odoc" {with-doc}