forked from
futur.blue/pegasus
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
60let is_reserved name = List.mem (String.lowercase_ascii name) reserved_keywords
61
62(* convert camelCase to snake_case *)
63let camel_to_snake s =
64 let buf = Buffer.create (String.length s * 2) in
65 String.iteri
66 (fun i c ->
67 if Char.uppercase_ascii c = c && c <> Char.lowercase_ascii c then begin
68 if i > 0 then Buffer.add_char buf '_' ;
69 Buffer.add_char buf (Char.lowercase_ascii c)
70 end
71 else Buffer.add_char buf c )
72 s ;
73 Buffer.contents buf
74
75let escape_keyword name = if is_reserved name then name ^ "_" else name
76
77let field_name name = escape_keyword (camel_to_snake name)
78
79let module_name_of_segment segment =
80 if String.length segment = 0 then segment else String.capitalize_ascii segment
81
82let module_path_of_nsid nsid =
83 String.split_on_char '.' nsid |> List.map module_name_of_segment
84
85let type_name_of_nsid nsid =
86 let segments = String.split_on_char '.' nsid in
87 match List.rev segments with
88 | last :: _ ->
89 camel_to_snake last
90 | [] ->
91 "unknown"
92
93let type_name name = escape_keyword (camel_to_snake name)
94
95let def_module_name name = String.capitalize_ascii name
96
97(* generate variant constructor name from ref *)
98let variant_name_of_ref ref_str =
99 (* "#localDef" -> "LocalDef", "com.example.defs#someDef" -> "SomeDef" *)
100 let name =
101 match String.split_on_char '#' ref_str with
102 | [_; def] ->
103 def
104 | [def] -> (
105 (* just nsid, use last segment *)
106 match List.rev (String.split_on_char '.' def) with
107 | last :: _ ->
108 last
109 | [] ->
110 "Unknown" )
111 | _ ->
112 "Unknown"
113 in
114 String.capitalize_ascii name
115
116(* generate qualified variant name including last nsid segment to avoid conflicts *)
117(* "app.bsky.embed.images#view" -> "ImagesView" *)
118(* "app.bsky.embed.images" (no #) -> "Images" (refers to main) *)
119(* "#localDef" -> "LocalDef" (no qualifier for local refs) *)
120let qualified_variant_name_of_ref ref_str =
121 match String.split_on_char '#' ref_str with
122 | [nsid; def] ->
123 (* external ref with def: use last segment of nsid as qualifier *)
124 let segments = String.split_on_char '.' nsid in
125 let qualifier =
126 match List.rev segments with
127 | last :: _ ->
128 String.capitalize_ascii last
129 | [] ->
130 ""
131 in
132 qualifier ^ String.capitalize_ascii def
133 | [nsid] when not (String.contains nsid '#') -> (
134 (* just nsid, no # - refers to main def, use last segment *)
135 let segments = String.split_on_char '.' nsid in
136 match List.rev segments with
137 | last :: _ ->
138 String.capitalize_ascii last
139 | [] ->
140 "Unknown" )
141 | _ ->
142 (* local ref like "#foo" *)
143 if String.length ref_str > 0 && ref_str.[0] = '#' then
144 String.capitalize_ascii
145 (String.sub ref_str 1 (String.length ref_str - 1))
146 else String.capitalize_ascii ref_str
147
148let union_type_name refs =
149 match refs with
150 | [] ->
151 "unknown_union"
152 | [r] ->
153 type_name (variant_name_of_ref r)
154 | _ -> (
155 (* use first two refs to generate a name *)
156 let names = List.map variant_name_of_ref refs in
157 let sorted = List.sort String.compare names in
158 match sorted with
159 | a :: b :: _ ->
160 camel_to_snake a ^ "_or_" ^ camel_to_snake b
161 | [a] ->
162 camel_to_snake a
163 | [] ->
164 "unknown_union" )
165
166(* convert nsid to flat file path and module name *)
167let flat_name_of_nsid nsid = String.split_on_char '.' nsid |> String.concat "_"
168
169let file_path_of_nsid nsid = flat_name_of_nsid nsid ^ ".ml"
170
171let flat_module_name_of_nsid nsid =
172 String.capitalize_ascii (flat_name_of_nsid nsid)
173
174let needs_key_annotation original_name ocaml_name = original_name <> ocaml_name
175
176let key_annotation original_name ocaml_name =
177 if needs_key_annotation original_name ocaml_name then
178 Printf.sprintf " [@key \"%s\"]" original_name
179 else ""
180
181(** find common prefix segments from a list of NSIDs
182 e.g. ["app.bsky.actor.defs"; "app.bsky.feed.defs"; "app.bsky.graph.defs"]
183 -> ["app"; "bsky"] *)
184let common_prefix_of_nsids nsids =
185 match nsids with
186 | [] ->
187 []
188 | first :: rest ->
189 let first_segments = String.split_on_char '.' first in
190 List.fold_left
191 (fun prefix nsid ->
192 let segments = String.split_on_char '.' nsid in
193 let rec common acc l1 l2 =
194 match (l1, l2) with
195 | h1 :: t1, h2 :: t2 when h1 = h2 ->
196 common (h1 :: acc) t1 t2
197 | _ ->
198 List.rev acc
199 in
200 common [] prefix segments )
201 first_segments rest
202
203(** generate shared module file name from NSIDs
204 e.g. ["app.bsky.actor.defs"; "app.bsky.feed.defs"] with index 1
205 -> "app_bsky_shared_1.ml" *)
206let shared_file_name nsids index =
207 let prefix = common_prefix_of_nsids nsids in
208 let prefix_str = String.concat "_" prefix in
209 prefix_str ^ "_shared_" ^ string_of_int index ^ ".ml"
210
211(** generate shared module name from NSIDs
212 e.g. ["app.bsky.actor.defs"; "app.bsky.feed.defs"] with index 1
213 -> "App_bsky_shared_1" *)
214let shared_module_name nsids index =
215 let prefix = common_prefix_of_nsids nsids in
216 let prefix_str = String.concat "_" prefix in
217 String.capitalize_ascii (prefix_str ^ "_shared_" ^ string_of_int index)
218
219(** generate a short type name for use in shared modules
220 uses the last segment of the nsid as context
221 e.g. nsid="app.bsky.actor.defs", def_name="viewerState"
222 -> "actor_viewer_state" *)
223let shared_type_name nsid def_name =
224 let segments = String.split_on_char '.' nsid in
225 let context =
226 match List.rev segments with
227 (* use second-last segment if last is "defs" *)
228 | "defs" :: second :: _ ->
229 second
230 | last :: _ ->
231 last
232 | [] ->
233 "unknown"
234 in
235 type_name (context ^ "_" ^ def_name)