···7777 in
7878 aux [] path
79798080+let generate_index lexicons =
8181+ let nsids = List.map (fun lexicon -> lexicon.Lexicon_types.id) lexicons in
8282+ let trie = Naming.group_nsids_by_prefix nsids in
8383+ let rec build_index (trie : Naming.trie) index indent =
8484+ match trie with
8585+ | Node children ->
8686+ List.fold_left
8787+ (fun acc (key, child) ->
8888+ match (child : Naming.trie) with
8989+ | Module nsid ->
9090+ let module_name = Naming.flat_module_name_of_nsid nsid in
9191+ acc ^ indent
9292+ ^ Printf.sprintf "module %s = %s\n"
9393+ (String.capitalize_ascii key)
9494+ module_name
9595+ | Node _ ->
9696+ acc ^ indent
9797+ ^ Printf.sprintf "module %s = struct\n"
9898+ (String.capitalize_ascii key)
9999+ ^ build_index child index (indent ^ " ")
100100+ ^ indent ^ "end\n" )
101101+ index children
102102+ | _ ->
103103+ failwith "build_index called with invalid trie"
104104+ in
105105+ build_index (Node trie) "" ""
106106+80107(* generate module structure from lexicons *)
81108let generate ~inputs ~output_dir ~module_name =
82109 (* create output directory *)
···163190 let oc = open_out index_path in
164191 Printf.fprintf oc "(* %s - generated from atproto lexicons *)\n\n" module_name ;
165192 (* export each lexicon as a module alias *)
166166- List.iter
167167- (fun doc ->
168168- let flat_module = Naming.flat_module_name_of_nsid doc.Lexicon_types.id in
169169- Printf.fprintf oc "module %s = %s\n" flat_module flat_module )
170170- lexicons ;
193193+ Out_channel.output_string oc (generate_index lexicons) ;
171194 close_out oc ;
172195 Printf.printf "Generated index: %s\n" index_path ;
173196 (* generate dune file *)
+39
hermes-cli/lib/naming.ml
···245245 "unknown"
246246 in
247247 type_name (context ^ "_" ^ def_name)
248248+249249+(** group NSIDs by shared prefixes
250250+ e.g. ["app.bsky.actor.defs"; "app.bsky.actor.getProfile"; "app.bsky.graph.defs"; "com.atproto.sync.getRepo"]
251251+ -> [("app", Node [("bsky", Node [("actor", Node [("defs", Module "app.bsky.actor.defs"); ("getProfile", Module "app.bsky.actor.getProfile")]);
252252+ ("graph", Node [("defs", Module "app.bsky.graph.defs")])])]);
253253+ ("com", [("atproto", [("sync", [("getRepo", Module "com.atproto.sync.getRepo")])])])] *)
254254+type trie = Node of (string * trie) list | Module of string
255255+256256+let group_nsids_by_prefix nsids =
257257+ let rec insert_segments trie nsid segments =
258258+ match segments with
259259+ | [] ->
260260+ Module nsid
261261+ | seg :: rest ->
262262+ let children =
263263+ match trie with Node node_children -> node_children | Module _ -> []
264264+ in
265265+ let existing =
266266+ match List.assoc_opt seg children with
267267+ | Some child ->
268268+ child
269269+ | None ->
270270+ Node []
271271+ in
272272+ let updated = insert_segments existing nsid rest in
273273+ let trie_without_seg = List.remove_assoc seg children in
274274+ Node ((seg, updated) :: trie_without_seg)
275275+ in
276276+ match
277277+ List.fold_left
278278+ (fun trie nsid ->
279279+ let segments = String.split_on_char '.' nsid in
280280+ insert_segments trie nsid segments )
281281+ (Node []) nsids
282282+ with
283283+ | Node result ->
284284+ result
285285+ | _ ->
286286+ failwith "unexpected trie type"
+1-1
hermes/README.md
···3939 let client = Hermes.make_client ~service:"https://public.api.bsky.app" () in
40404141 (* Make a query using the generated module *)
4242- let* profile = App_bsky_actor_getProfile.call ~actor:"bsky.app" client in
4242+ let* profile = App.Bsky.Actor.Profile.call ~actor:"bsky.app" client in
4343 print_endline profile.display_name;
4444 Lwt.return_unit
4545end
+14-31
hermes_ppx/lib/hermes_ppx.ml
···44let nsid_to_module_path nsid =
55 String.split_on_char '.' nsid |> List.map String.capitalize_ascii
6677-(* convert nsid to flat module name: "com.atproto.identity.resolveHandle" -> "Com_atproto_identity_resolveHandle" *)
88-let nsid_to_flat_module_name nsid =
99- let flat = String.concat "_" (String.split_on_char '.' nsid) in
1010- String.capitalize_ascii flat
1111-1212-(* build module access expression from path: ["App"; "Bsky"] -> App.Bsky *)
1313-let build_module_path ~loc path =
1414- match path with
1515- | [] ->
1616- Location.raise_errorf ~loc "Empty module path"
1717- | first :: rest ->
1818- List.fold_left
1919- (fun acc part ->
2020- let lid = Loc.make ~loc (Longident.Ldot (acc.txt, part)) in
2121- lid )
2222- (Loc.make ~loc (Longident.Lident first))
2323- rest
2424-2525-(* build full expression for flat module structure: Module_name.Main.call *)
2626-let build_call_expr_flat ~loc nsid =
2727- let module_name = nsid_to_flat_module_name nsid in
2828- (* Build: Module_name.Main.call *)
2929- let lid = Longident.(Ldot (Ldot (Lident module_name, "Main"), "call")) in
77+(* build full expression: Module.Name.Main.call *)
88+let build_call_expr ~loc nsid =
99+ let module_path = nsid_to_module_path nsid in
1010+ let module_lid =
1111+ match module_path with
1212+ | [] ->
1313+ Location.raise_errorf ~loc "Expected non-empty nsid"
1414+ | hd :: tl ->
1515+ List.fold_left
1616+ (fun acc part -> Longident.Ldot (acc, part))
1717+ (Longident.Lident hd) tl
1818+ in
1919+ let lid = Longident.(Ldot (Ldot (module_lid, "Main"), "call")) in
3020 Ast_builder.Default.pexp_ident ~loc (Loc.make ~loc lid)
3131-3232-(* build full expression: Module.Path.call (nested style, kept for compatibility) *)
3333-let build_call_expr ~loc nsid =
3434- let parts = nsid_to_module_path nsid in
3535- let module_lid = build_module_path ~loc parts in
3636- let call_lid = Loc.make ~loc (Longident.Ldot (module_lid.txt, "call")) in
3737- Ast_builder.Default.pexp_ident ~loc call_lid
38213922(* parse method and nsid from structure items *)
4023let parse_method_and_nsid ~loc str =
···6548let expand ~ctxt str =
6649 let loc = Expansion_context.Extension.extension_point_loc ctxt in
6750 let _method, nsid = parse_method_and_nsid ~loc str in
6868- build_call_expr_flat ~loc nsid
5151+ build_call_expr ~loc nsid
69527053let xrpc_extension =
7154 Extension.V3.declare "xrpc" Extension.Context.expression
-11
hermes_ppx/test/test_ppx.ml
···1818 let result = Hermes_ppx.nsid_to_module_path "test" in
1919 check (list string) "single segment" ["Test"] result
20202121-let test_build_module_path_single () =
2222- let result = Hermes_ppx.build_module_path ~loc ["App"] in
2323- check string "single module" "App" (Ppxlib.Longident.name result.txt)
2424-2525-let test_build_module_path_nested () =
2626- let result = Hermes_ppx.build_module_path ~loc ["App"; "Bsky"; "Graph"] in
2727- check string "nested module" "App.Bsky.Graph"
2828- (Ppxlib.Longident.name result.txt)
2929-3021let test_build_call_expr () =
3122 let result = Hermes_ppx.build_call_expr ~loc "app.bsky.graph.getProfile" in
3223 let expected_str = "App.Bsky.Graph.GetProfile.call" in
···7263 , `Quick
7364 , test_nsid_to_module_path_camel_case )
7465 ; ("nsid_to_module_path single", `Quick, test_nsid_to_module_path_single)
7575- ; ("build_module_path single", `Quick, test_build_module_path_single)
7676- ; ("build_module_path nested", `Quick, test_build_module_path_nested)
7766 ; ("build_call_expr", `Quick, test_build_call_expr) ]
78677968let expansion_tests =
···11-open Lexicons.Com_atproto_server_deactivateAccount.Main
11+open Lexicons.Com.Atproto.Server.DeactivateAccount.Main
2233let deactivate_account ~did db =
44 let%lwt () = Data_store.deactivate_actor did db in
+1-1
pegasus/lib/api/server/deleteAccount.ml
···11-open Lexicons.Com_atproto_server_deleteAccount.Main
11+open Lexicons.Com.Atproto.Server.DeleteAccount.Main
2233let rec rm_rf path =
44 if Sys.is_directory path then (
···11-open Lexicons.Com_atproto_server_requestEmailUpdate.Main
11+open Lexicons.Com.Atproto.Server.RequestEmailUpdate.Main
2233let request_email_update ?pending_email (actor : Data_store.Types.actor) db =
44 let token_required =
+1-1
pegasus/lib/api/server/requestPasswordReset.ml
···11-open Lexicons.Com_atproto_server_requestPasswordReset.Main
11+open Lexicons.Com.Atproto.Server.RequestPasswordReset.Main
2233let request_password_reset (actor : Data_store.Types.actor) db =
44 let did = actor.did in