objective categorical abstract machine language personal data server
Run dune fmt
+43
-53
+7
-7
hermes-cli/bin/main.ml
+7
-7
hermes-cli/bin/main.ml
···
61
61
(* sort for consistent ordering *)
62
62
let sorted_docs =
63
63
List.sort
64
-
(fun a b ->
65
-
String.compare a.Lexicon_types.id b.Lexicon_types.id )
64
+
(fun a b -> String.compare a.Lexicon_types.id b.Lexicon_types.id)
66
65
docs
67
66
in
68
67
(* generate shared module with all types *)
69
-
let shared_module_name = Naming.shared_module_name nsids !shared_index in
68
+
let shared_module_name =
69
+
Naming.shared_module_name nsids !shared_index
70
+
in
70
71
let shared_file = Naming.shared_file_name nsids !shared_index in
71
72
let code = Codegen.gen_shared_module sorted_docs in
72
73
let full_path = Filename.concat output_dir shared_file in
···
86
87
let oc = open_out full_path in
87
88
output_string oc stub ;
88
89
close_out oc ;
89
-
Printf.printf " Generated: %s -> %s\n" rel_path shared_module_name )
90
+
Printf.printf " Generated: %s -> %s\n" rel_path
91
+
shared_module_name )
90
92
docs )
91
93
sccs ;
92
94
(* generate index file *)
···
115
117
Printf.printf "Done! Generated %d modules\n" (List.length lexicons)
116
118
117
119
let inputs =
118
-
let doc =
119
-
"lexicon files or directories to search recursively for JSON"
120
-
in
120
+
let doc = "lexicon files or directories to search recursively for JSON" in
121
121
Cmdliner.Arg.(non_empty & pos_all file [] & info [] ~docv:"INPUT" ~doc)
122
122
123
123
let output_dir =
+16
-29
hermes-cli/test/test_codegen.ml
+16
-29
hermes-cli/test/test_codegen.ml
···
261
261
let test_gen_inline_union () =
262
262
let union_type =
263
263
Lexicon_types.Union
264
-
{ refs= ["#typeA"; "#typeB"]
265
-
; closed= Some false
266
-
; description= None }
264
+
{refs= ["#typeA"; "#typeB"]; closed= Some false; description= None}
267
265
in
268
266
let obj_spec =
269
-
make_object_spec
270
-
[("status", make_property union_type)]
271
-
["status"]
267
+
make_object_spec [("status", make_property union_type)] ["status"]
272
268
in
273
269
let doc =
274
270
make_lexicon "com.example.inline"
···
286
282
let test_gen_inline_union_in_array () =
287
283
let union_type =
288
284
Lexicon_types.Union
289
-
{ refs= ["#typeA"; "#typeB"]
290
-
; closed= Some true
291
-
; description= None }
285
+
{refs= ["#typeA"; "#typeB"]; closed= Some true; description= None}
292
286
in
293
287
let array_type =
294
288
Lexicon_types.Array
295
-
{ items= union_type
296
-
; min_length= None
297
-
; max_length= None
298
-
; description= None }
289
+
{items= union_type; min_length= None; max_length= None; description= None}
299
290
in
300
291
let obj_spec =
301
-
make_object_spec
302
-
[("items", make_property array_type)]
303
-
["items"]
292
+
make_object_spec [("items", make_property array_type)] ["items"]
304
293
in
305
294
let doc =
306
295
make_lexicon "com.example.arrayunion"
···
356
345
let type_a_spec =
357
346
make_object_spec
358
347
[ ("name", make_property string_type)
359
-
; ("b", make_property (Lexicon_types.Ref {ref_= "#typeB"; description= None}))
360
-
]
348
+
; ( "b"
349
+
, make_property (Lexicon_types.Ref {ref_= "#typeB"; description= None})
350
+
) ]
361
351
["name"]
362
352
in
363
353
let type_b_spec =
364
354
make_object_spec
365
355
[ ("value", make_property int_type)
366
-
; ("a", make_property (Lexicon_types.Ref {ref_= "#typeA"; description= None}))
367
-
]
356
+
; ( "a"
357
+
, make_property (Lexicon_types.Ref {ref_= "#typeA"; description= None})
358
+
) ]
368
359
["value"]
369
360
in
370
361
let doc =
···
384
375
let test_gen_record () =
385
376
let record_spec : Lexicon_types.record_spec =
386
377
{ key= "tid"
387
-
; record=
388
-
make_object_spec
389
-
[("text", make_property string_type)]
390
-
["text"]
378
+
; record= make_object_spec [("text", make_property string_type)] ["text"]
391
379
; description= Some "A simple record" }
392
380
in
393
381
let doc =
···
414
402
in
415
403
let code = Codegen.gen_lexicon_module doc in
416
404
(* should generate qualified module reference *)
417
-
check bool "contains qualified ref" true
418
-
(contains code "Com_other_defs.user")
405
+
check bool "contains qualified ref" true (contains code "Com_other_defs.user")
419
406
420
407
(* test generating string type with known values *)
421
408
let test_gen_string_known_values () =
···
438
425
let code = Codegen.gen_lexicon_module doc in
439
426
check bool "contains type status = string" true
440
427
(contains code "type status = string") ;
441
-
check bool "contains status_of_yojson" true
442
-
(contains code "status_of_yojson")
428
+
check bool "contains status_of_yojson" true (contains code "status_of_yojson")
443
429
444
430
(* test generating query with bytes output (like getBlob) *)
445
431
let test_gen_query_bytes_output () =
···
525
511
526
512
let token_tests = [("token generation", `Quick, test_gen_token)]
527
513
528
-
let string_tests = [("string with known values", `Quick, test_gen_string_known_values)]
514
+
let string_tests =
515
+
[("string with known values", `Quick, test_gen_string_known_values)]
529
516
530
517
let () =
531
518
run "Codegen"
+2
-1
hermes_ppx/test/dune
+2
-1
hermes_ppx/test/dune
+6
-2
mist/lib/storage/cache_blockstore.ml
+6
-2
mist/lib/storage/cache_blockstore.ml
···
4
4
; mutable pending_writes: Block_map.t
5
5
; bs: 'bs }
6
6
7
-
module Make (Bs : Blockstore.Writable) : sig
7
+
module Make
8
+
(Bs : Blockstore.Writable) : sig
8
9
include Blockstore.Writable
9
10
10
11
val create : Bs.t -> t
···
21
22
type t = Bs.t data
22
23
23
24
let create bs =
24
-
{reads= Cid.Set.empty; cache= Block_map.empty; pending_writes= Block_map.empty; bs}
25
+
{ reads= Cid.Set.empty
26
+
; cache= Block_map.empty
27
+
; pending_writes= Block_map.empty
28
+
; bs }
25
29
26
30
let get_reads t = t.reads
27
31
+3
-2
pegasus/lib/api/admin/sendEmail.ml
+3
-2
pegasus/lib/api/admin/sendEmail.ml
···
21
21
in
22
22
let%lwt () =
23
23
Util.send_email_or_log ~recipients:[To recipient.email] ~subject
24
-
~body:(Emails.AdminEmail.make ~sender_handle:sender.handle
25
-
~recipient_handle:recipient.handle ~subject ~content)
24
+
~body:
25
+
(Emails.AdminEmail.make ~sender_handle:sender.handle
26
+
~recipient_handle:recipient.handle ~subject ~content )
26
27
in
27
28
Dream.json @@ Yojson.Safe.to_string @@ output_to_yojson {sent= true}
28
29
) )
+1
-2
pegasus/lib/api/repo/deleteRecord.ml
+1
-2
pegasus/lib/api/repo/deleteRecord.ml
···
35
35
match List.hd results with
36
36
| Delete _ ->
37
37
Dream.json @@ Yojson.Safe.to_string
38
-
@@ output_to_yojson
39
-
{commit= Some {cid= Cid.to_string commit_cid; rev}}
38
+
@@ output_to_yojson {commit= Some {cid= Cid.to_string commit_cid; rev}}
40
39
| _ ->
41
40
Errors.invalid_request "unexpected create or update result" )
+1
-3
pegasus/lib/api/server/createInviteCode.ml
+1
-3
pegasus/lib/api/server/createInviteCode.ml
···
13
13
14
14
let handler =
15
15
Xrpc.handler ~auth:Admin (fun {req; db; _} ->
16
-
let%lwt {use_count; for_account} =
17
-
Xrpc.parse_body req input_of_yojson
18
-
in
16
+
let%lwt {use_count; for_account} = Xrpc.parse_body req input_of_yojson in
19
17
let%lwt code =
20
18
create_invite_code ~db
21
19
~did:(Option.value for_account ~default:"admin")
+1
-1
pegasus/lib/api/server/getSession.ml
+1
-1
pegasus/lib/api/server/getSession.ml
+3
-1
pegasus/lib/api/server/requestEmailUpdate.ml
+3
-1
pegasus/lib/api/server/requestEmailUpdate.ml
···
28
28
in
29
29
Util.send_email_or_log ~recipients:[To to_email]
30
30
~subject:(Printf.sprintf "Confirm email change for %s" actor.handle)
31
-
~body:(Emails.EmailUpdate.make ~handle:actor.handle ~new_email:pending_email ~code)
31
+
~body:
32
+
(Emails.EmailUpdate.make ~handle:actor.handle ~new_email:pending_email
33
+
~code )
32
34
else Lwt.return_unit
33
35
in
34
36
Lwt.return token_required
+1
-4
pegasus/lib/api/sync/getRecord.ml
+1
-4
pegasus/lib/api/sync/getRecord.ml
···
1
1
module Mst = Mist.Mst.Make (User_store)
2
-
3
2
open Lexicons.Com_atproto_sync_getRecord.Main
4
3
5
4
let handler =
6
5
Xrpc.handler (fun ctx ->
7
-
let {did; collection; rkey} =
8
-
Xrpc.parse_query ctx.req params_of_yojson
9
-
in
6
+
let {did; collection; rkey} = Xrpc.parse_query ctx.req params_of_yojson in
10
7
let path = collection ^ "/" ^ rkey in
11
8
let%lwt repo = Repository.load did ~ensure_active:true in
12
9
match%lwt Repository.get_record repo path with
+2
-1
pegasus/test/test_sequencer.ml
+2
-1
pegasus/test/test_sequencer.ml
···
107
107
in
108
108
let stream =
109
109
Lwt.catch
110
-
(fun () -> Sequencer.Live.stream_with_backfill ~conn ~cursor:(Some 0) ~send)
110
+
(fun () ->
111
+
Sequencer.Live.stream_with_backfill ~conn ~cursor:(Some 0) ~send )
111
112
(fun _ -> Lwt.return_unit)
112
113
in
113
114
let _ = Lwt.async (fun () -> stream) in