HomeKit Accessory Protocol (HAP) for OCaml
hap: let open Json.Codec in cleanup
40 Json.Codec. prefixes removed across 5 codec defs. The Hap_json
submodule uses a top-level `open Json.Codec` since none of its
records (characteristic, service, accessory) have fields that
clash with `mem_map`. Top-level char_write_codec, char_write_request_codec,
and Pairing.stored use per-let `let open Json.Codec in`.
+49
-55
+49
-55
lib/hap.ml
+49
-55
lib/hap.ml
···
553
553
type char_write = { cw_aid : int; cw_iid : int; cw_value : Json.t }
554
554
555
555
let char_write_codec =
556
-
Json.Codec.Object.map ~kind:"char_write" (fun aid iid value ->
556
+
let open Json.Codec in
557
+
Object.map ~kind:"char_write" (fun aid iid value ->
557
558
{ cw_aid = aid; cw_iid = iid; cw_value = value })
558
-
|> Json.Codec.Object.mem "aid" Json.Codec.int ~enc:(fun c -> c.cw_aid)
559
-
|> Json.Codec.Object.mem "iid" Json.Codec.int ~enc:(fun c -> c.cw_iid)
560
-
|> Json.Codec.Object.mem "value" Json.Codec.Value.t ~enc:(fun c -> c.cw_value)
561
-
|> Json.Codec.Object.finish
559
+
|> Object.mem "aid" int ~enc:(fun c -> c.cw_aid)
560
+
|> Object.mem "iid" int ~enc:(fun c -> c.cw_iid)
561
+
|> Object.mem "value" Value.t ~enc:(fun c -> c.cw_value)
562
+
|> Object.finish
562
563
563
564
type char_write_request = { characteristics : char_write list }
564
565
565
566
let char_write_request_codec =
566
-
Json.Codec.Object.map ~kind:"char_write_request" (fun characteristics ->
567
+
let open Json.Codec in
568
+
Object.map ~kind:"char_write_request" (fun characteristics ->
567
569
{ characteristics })
568
-
|> Json.Codec.Object.mem "characteristics" (Json.Codec.list char_write_codec)
569
-
~enc:(fun r -> r.characteristics)
570
-
|> Json.Codec.Object.finish
570
+
|> Object.mem "characteristics" (list char_write_codec) ~enc:(fun r ->
571
+
r.characteristics)
572
+
|> Object.finish
571
573
572
574
(* Write a characteristic *)
573
575
let put_characteristic ~net ~sw session ~aid ~iid value =
···
628
630
}
629
631
630
632
let stored =
631
-
Json.Codec.Object.map ~kind:"hap.pairing"
633
+
let open Json.Codec in
634
+
Object.map ~kind:"hap.pairing"
632
635
(fun
633
636
accessory_id
634
637
accessory_ltpk
···
643
646
controller_ltsk;
644
647
controller_ltpk;
645
648
})
646
-
|> Json.Codec.Object.mem "accessory_id" Json.Codec.string ~enc:(fun p ->
647
-
p.accessory_id)
648
-
|> Json.Codec.Object.mem "accessory_ltpk" Json.Codec.string ~enc:(fun p ->
649
-
p.accessory_ltpk)
650
-
|> Json.Codec.Object.mem "controller_id" Json.Codec.string ~enc:(fun p ->
651
-
p.controller_id)
652
-
|> Json.Codec.Object.mem "controller_ltsk" Json.Codec.string ~enc:(fun p ->
653
-
p.controller_ltsk)
654
-
|> Json.Codec.Object.mem "controller_ltpk" Json.Codec.string ~enc:(fun p ->
655
-
p.controller_ltpk)
656
-
|> Json.Codec.Object.finish
649
+
|> Object.mem "accessory_id" string ~enc:(fun p -> p.accessory_id)
650
+
|> Object.mem "accessory_ltpk" string ~enc:(fun p -> p.accessory_ltpk)
651
+
|> Object.mem "controller_id" string ~enc:(fun p -> p.controller_id)
652
+
|> Object.mem "controller_ltsk" string ~enc:(fun p -> p.controller_ltsk)
653
+
|> Object.mem "controller_ltpk" string ~enc:(fun p -> p.controller_ltpk)
654
+
|> Object.finish
657
655
658
656
let of_pairing (p : pairing) : stored =
659
657
{
···
850
848
(** {1 HAP JSON Codecs} *)
851
849
852
850
module Hap_json = struct
851
+
open Json.Codec
852
+
853
853
type characteristic = { iid : int; type_ : string; value : Json.t option }
854
854
(** HAP characteristic *)
855
855
856
856
let characteristic =
857
-
Json.Codec.Object.map ~kind:"hap.characteristic" (fun iid type_ value ->
857
+
Object.map ~kind:"hap.characteristic" (fun iid type_ value ->
858
858
{ iid; type_; value })
859
-
|> Json.Codec.Object.mem "iid" Json.Codec.int ~enc:(fun c -> c.iid)
860
-
|> Json.Codec.Object.mem "type" Json.Codec.string ~enc:(fun c -> c.type_)
861
-
|> Json.Codec.Object.opt_mem "value" Json.Codec.Value.t ~enc:(fun c ->
862
-
c.value)
863
-
|> Json.Codec.Object.finish
859
+
|> Object.mem "iid" int ~enc:(fun c -> c.iid)
860
+
|> Object.mem "type" string ~enc:(fun c -> c.type_)
861
+
|> Object.opt_mem "value" Value.t ~enc:(fun c -> c.value)
862
+
|> Object.finish
864
863
865
864
type service = {
866
865
iid : int;
···
870
869
(** HAP service *)
871
870
872
871
let service =
873
-
Json.Codec.Object.map ~kind:"hap.service" (fun iid type_ characteristics ->
872
+
Object.map ~kind:"hap.service" (fun iid type_ characteristics ->
874
873
{ iid; type_; characteristics })
875
-
|> Json.Codec.Object.mem "iid" Json.Codec.int ~enc:(fun s -> s.iid)
876
-
|> Json.Codec.Object.mem "type" Json.Codec.string ~enc:(fun s -> s.type_)
877
-
|> Json.Codec.Object.mem "characteristics" (Json.Codec.list characteristic)
878
-
~enc:(fun s -> s.characteristics)
879
-
|> Json.Codec.Object.finish
874
+
|> Object.mem "iid" int ~enc:(fun s -> s.iid)
875
+
|> Object.mem "type" string ~enc:(fun s -> s.type_)
876
+
|> Object.mem "characteristics" (list characteristic) ~enc:(fun s ->
877
+
s.characteristics)
878
+
|> Object.finish
880
879
881
880
type accessory = { aid : int; services : service list }
882
881
(** HAP accessory *)
883
882
884
883
let accessory =
885
-
Json.Codec.Object.map ~kind:"hap.accessory" (fun aid services ->
886
-
{ aid; services })
887
-
|> Json.Codec.Object.mem "aid" Json.Codec.int ~enc:(fun a -> a.aid)
888
-
|> Json.Codec.Object.mem "services" (Json.Codec.list service) ~enc:(fun a ->
889
-
a.services)
890
-
|> Json.Codec.Object.finish
884
+
Object.map ~kind:"hap.accessory" (fun aid services -> { aid; services })
885
+
|> Object.mem "aid" int ~enc:(fun a -> a.aid)
886
+
|> Object.mem "services" (list service) ~enc:(fun a -> a.services)
887
+
|> Object.finish
891
888
892
889
type accessories_response = { accessories : accessory list }
893
890
(** HAP accessories response *)
894
891
895
892
let accessories_response =
896
-
Json.Codec.Object.map ~kind:"hap.accessories_response" (fun accessories ->
893
+
Object.map ~kind:"hap.accessories_response" (fun accessories ->
897
894
{ accessories })
898
-
|> Json.Codec.Object.mem "accessories" (Json.Codec.list accessory)
899
-
~enc:(fun r -> r.accessories)
900
-
|> Json.Codec.Object.finish
895
+
|> Object.mem "accessories" (list accessory) ~enc:(fun r -> r.accessories)
896
+
|> Object.finish
901
897
902
898
type char_value = { aid : int; iid : int; value : Json.t option }
903
899
(** HAP characteristics value *)
904
900
905
901
let char_value =
906
-
Json.Codec.Object.map ~kind:"hap.char_value" (fun aid iid value ->
907
-
{ aid; iid; value })
908
-
|> Json.Codec.Object.mem "aid" Json.Codec.int ~enc:(fun c -> c.aid)
909
-
|> Json.Codec.Object.mem "iid" Json.Codec.int ~enc:(fun c -> c.iid)
910
-
|> Json.Codec.Object.opt_mem "value" Json.Codec.Value.t ~enc:(fun c ->
911
-
c.value)
912
-
|> Json.Codec.Object.finish
902
+
Object.map ~kind:"hap.char_value" (fun aid iid value -> { aid; iid; value })
903
+
|> Object.mem "aid" int ~enc:(fun c -> c.aid)
904
+
|> Object.mem "iid" int ~enc:(fun c -> c.iid)
905
+
|> Object.opt_mem "value" Value.t ~enc:(fun c -> c.value)
906
+
|> Object.finish
913
907
914
908
type characteristics_response = { characteristics : char_value list }
915
909
916
910
let characteristics_response =
917
-
Json.Codec.Object.map ~kind:"hap.characteristics_response"
918
-
(fun characteristics -> { characteristics })
919
-
|> Json.Codec.Object.mem "characteristics" (Json.Codec.list char_value)
920
-
~enc:(fun r -> r.characteristics)
921
-
|> Json.Codec.Object.finish
911
+
Object.map ~kind:"hap.characteristics_response" (fun characteristics ->
912
+
{ characteristics })
913
+
|> Object.mem "characteristics" (list char_value) ~enc:(fun r ->
914
+
r.characteristics)
915
+
|> Object.finish
922
916
end
923
917
924
918
(** {1 High-level control} *)