objective categorical abstract machine language personal data server
1(* ocaml reserved keywords that need escaping *)
2let reserved_keywords =
3 [ "and"
4 ; "as"
5 ; "assert"
6 ; "asr"
7 ; "begin"
8 ; "class"
9 ; "constraint"
10 ; "do"
11 ; "done"
12 ; "downto"
13 ; "else"
14 ; "end"
15 ; "exception"
16 ; "external"
17 ; "false"
18 ; "for"
19 ; "fun"
20 ; "function"
21 ; "functor"
22 ; "if"
23 ; "in"
24 ; "include"
25 ; "inherit"
26 ; "initializer"
27 ; "land"
28 ; "lazy"
29 ; "let"
30 ; "lor"
31 ; "lsl"
32 ; "lsr"
33 ; "lxor"
34 ; "match"
35 ; "method"
36 ; "mod"
37 ; "module"
38 ; "mutable"
39 ; "new"
40 ; "nonrec"
41 ; "object"
42 ; "of"
43 ; "open"
44 ; "or"
45 ; "private"
46 ; "rec"
47 ; "sig"
48 ; "struct"
49 ; "then"
50 ; "to"
51 ; "true"
52 ; "try"
53 ; "type"
54 ; "val"
55 ; "virtual"
56 ; "when"
57 ; "while"
58 ; "with"
59 ; "option"
60 ; "list"
61 ; "result"
62 ; "unit"
63 ; "int"
64 ; "string"
65 ; "bool"
66 ; "float"
67 ; "char"
68 ; "bytes"
69 ; "array"
70 ; "ref" ]
71
72let is_reserved name = List.mem (String.lowercase_ascii name) reserved_keywords
73
74(* convert camelCase to snake_case *)
75let camel_to_snake s =
76 let buf = Buffer.create (String.length s * 2) in
77 String.iteri
78 (fun i c ->
79 if Char.uppercase_ascii c = c && c <> Char.lowercase_ascii c then begin
80 if i > 0 then Buffer.add_char buf '_' ;
81 Buffer.add_char buf (Char.lowercase_ascii c)
82 end
83 else Buffer.add_char buf c )
84 s ;
85 Buffer.contents buf
86
87let escape_keyword name = if is_reserved name then name ^ "_" else name
88
89let field_name name = escape_keyword (camel_to_snake name)
90
91let module_name_of_segment segment =
92 if String.length segment = 0 then segment else String.capitalize_ascii segment
93
94let module_path_of_nsid nsid =
95 String.split_on_char '.' nsid |> List.map module_name_of_segment
96
97let type_name_of_nsid nsid =
98 let segments = String.split_on_char '.' nsid in
99 match List.rev segments with
100 | last :: _ ->
101 camel_to_snake last
102 | [] ->
103 "unknown"
104
105let type_name name = escape_keyword (camel_to_snake name)
106
107let def_module_name name = String.capitalize_ascii name
108
109(* generate variant constructor name from ref *)
110let variant_name_of_ref ref_str =
111 (* "#localDef" -> "LocalDef", "com.example.defs#someDef" -> "SomeDef" *)
112 let name =
113 match String.split_on_char '#' ref_str with
114 | [_; def] ->
115 def
116 | [def] -> (
117 (* just nsid, use last segment *)
118 match List.rev (String.split_on_char '.' def) with
119 | last :: _ ->
120 last
121 | [] ->
122 "Unknown" )
123 | _ ->
124 "Unknown"
125 in
126 String.capitalize_ascii name
127
128(* generate qualified variant name including last nsid segment to avoid conflicts *)
129(* "app.bsky.embed.images#view" -> "ImagesView" *)
130(* "app.bsky.embed.images" (no #) -> "Images" (refers to main) *)
131(* "#localDef" -> "LocalDef" (no qualifier for local refs) *)
132let qualified_variant_name_of_ref ref_str =
133 match String.split_on_char '#' ref_str with
134 | [nsid; def] ->
135 (* external ref with def: use last segment of nsid as qualifier *)
136 let segments = String.split_on_char '.' nsid in
137 let qualifier =
138 match List.rev segments with
139 | last :: _ ->
140 String.capitalize_ascii last
141 | [] ->
142 ""
143 in
144 qualifier ^ String.capitalize_ascii def
145 | [nsid] when not (String.contains nsid '#') -> (
146 (* just nsid, no # - refers to main def, use last segment *)
147 let segments = String.split_on_char '.' nsid in
148 match List.rev segments with
149 | last :: _ ->
150 String.capitalize_ascii last
151 | [] ->
152 "Unknown" )
153 | _ ->
154 (* local ref like "#foo" *)
155 if String.length ref_str > 0 && ref_str.[0] = '#' then
156 String.capitalize_ascii
157 (String.sub ref_str 1 (String.length ref_str - 1))
158 else String.capitalize_ascii ref_str
159
160let union_type_name refs =
161 match refs with
162 | [] ->
163 "unknown_union"
164 | [r] ->
165 type_name (variant_name_of_ref r)
166 | _ -> (
167 (* use first two refs to generate a name *)
168 let names = List.map variant_name_of_ref refs in
169 let sorted = List.sort String.compare names in
170 match sorted with
171 | a :: b :: _ ->
172 camel_to_snake a ^ "_or_" ^ camel_to_snake b
173 | [a] ->
174 camel_to_snake a
175 | [] ->
176 "unknown_union" )
177
178(* convert nsid to flat file path and module name *)
179let flat_name_of_nsid nsid = String.split_on_char '.' nsid |> String.concat "_"
180
181let file_path_of_nsid nsid = flat_name_of_nsid nsid ^ ".ml"
182
183let flat_module_name_of_nsid nsid =
184 String.capitalize_ascii (flat_name_of_nsid nsid)
185
186let needs_key_annotation original_name ocaml_name = original_name <> ocaml_name
187
188let key_annotation original_name ocaml_name =
189 if needs_key_annotation original_name ocaml_name then
190 Printf.sprintf " [@key \"%s\"]" original_name
191 else ""
192
193(** find common prefix segments from a list of NSIDs
194 e.g. ["app.bsky.actor.defs"; "app.bsky.feed.defs"; "app.bsky.graph.defs"]
195 -> ["app"; "bsky"] *)
196let common_prefix_of_nsids nsids =
197 match nsids with
198 | [] ->
199 []
200 | first :: rest ->
201 let first_segments = String.split_on_char '.' first in
202 List.fold_left
203 (fun prefix nsid ->
204 let segments = String.split_on_char '.' nsid in
205 let rec common acc l1 l2 =
206 match (l1, l2) with
207 | h1 :: t1, h2 :: t2 when h1 = h2 ->
208 common (h1 :: acc) t1 t2
209 | _ ->
210 List.rev acc
211 in
212 common [] prefix segments )
213 first_segments rest
214
215(** generate shared module file name from NSIDs
216 e.g. ["app.bsky.actor.defs"; "app.bsky.feed.defs"] with index 1
217 -> "app_bsky_shared_1.ml" *)
218let shared_file_name nsids index =
219 let prefix = common_prefix_of_nsids nsids in
220 let prefix_str = String.concat "_" prefix in
221 prefix_str ^ "_shared_" ^ string_of_int index ^ ".ml"
222
223(** generate shared module name from NSIDs
224 e.g. ["app.bsky.actor.defs"; "app.bsky.feed.defs"] with index 1
225 -> "App_bsky_shared_1" *)
226let shared_module_name nsids index =
227 let prefix = common_prefix_of_nsids nsids in
228 let prefix_str = String.concat "_" prefix in
229 String.capitalize_ascii (prefix_str ^ "_shared_" ^ string_of_int index)
230
231(** generate a short type name for use in shared modules
232 uses the last segment of the nsid as context
233 e.g. nsid="app.bsky.actor.defs", def_name="viewerState"
234 -> "actor_viewer_state" *)
235let shared_type_name nsid def_name =
236 let segments = String.split_on_char '.' nsid in
237 let context =
238 match List.rev segments with
239 (* use second-last segment if last is "defs" *)
240 | "defs" :: second :: _ ->
241 second
242 | last :: _ ->
243 last
244 | [] ->
245 "unknown"
246 in
247 type_name (context ^ "_" ^ def_name)
248
249(** group NSIDs by shared prefixes
250 e.g. ["app.bsky.actor.defs"; "app.bsky.actor.getProfile"; "app.bsky.graph.defs"; "com.atproto.sync.getRepo"]
251 -> [("app", Node [("bsky", Node [("actor", Node [("defs", Module "app.bsky.actor.defs"); ("getProfile", Module "app.bsky.actor.getProfile")]);
252 ("graph", Node [("defs", Module "app.bsky.graph.defs")])])]);
253 ("com", [("atproto", [("sync", [("getRepo", Module "com.atproto.sync.getRepo")])])])] *)
254type trie = Node of (string * trie) list | Module of string
255
256let group_nsids_by_prefix nsids =
257 let rec insert_segments trie nsid segments =
258 match segments with
259 | [] ->
260 Module nsid
261 | seg :: rest ->
262 let children =
263 match trie with Node node_children -> node_children | Module _ -> []
264 in
265 let existing =
266 match List.assoc_opt seg children with
267 | Some child ->
268 child
269 | None ->
270 Node []
271 in
272 let updated = insert_segments existing nsid rest in
273 let trie_without_seg = List.remove_assoc seg children in
274 Node ((seg, updated) :: trie_without_seg)
275 in
276 match
277 List.fold_left
278 (fun trie nsid ->
279 let segments = String.split_on_char '.' nsid in
280 insert_segments trie nsid segments )
281 (Node []) nsids
282 with
283 | Node result ->
284 result
285 | _ ->
286 failwith "unexpected trie type"