anil.recoil.org
Pure OCaml xxhash implementation
Squashed 'ocaml-openapi/' content from commit affe4bed
git-subtree-dir: ocaml-openapi
git-subtree-split: affe4bedbc4a00bed8da9037f8ad5e6a96f1aa94
+70
CLAUDE.md
+70
CLAUDE.md
···
1
+
# OCaml OpenAPI
2
+
3
+
OpenAPI code generator for OCaml, specialized for:
4
+
- **requests** HTTP library (Eio-based)
5
+
- **jsont** for JSON codecs
6
+
- Stdlib-first approach (avoiding Base/Core)
7
+
- OCamldoc comments from OpenAPI descriptions
8
+
9
+
## Quick Start
10
+
11
+
```bash
12
+
# Generate client from OpenAPI spec
13
+
opam exec -- dune exec -- openapi-gen generate spec.json -o ./generated -n my_api
14
+
15
+
# Include dune regeneration rules
16
+
opam exec -- dune exec -- openapi-gen generate spec.json -o ./generated -n my_api --regen
17
+
```
18
+
19
+
## Generated Code Structure
20
+
21
+
```
22
+
output/
23
+
├── dune # Build configuration (wrapped library)
24
+
├── dune.inc # Regeneration rules (if --regen used)
25
+
├── types.ml # Type definitions with jsont codecs
26
+
├── types.mli # Type interfaces
27
+
├── client.ml # API client functions using requests
28
+
├── client.mli # Client interface
29
+
├── <api_name>.ml # Wrapped main module
30
+
└── <api_name>.mli # Main module interface
31
+
```
32
+
33
+
## Usage
34
+
35
+
After generation, you can use the API like:
36
+
37
+
```ocaml
38
+
(* Access types through the wrapped module *)
39
+
let album : Immich.Types.AlbumResponseDto.t = ...
40
+
41
+
(* Create a client and make requests *)
42
+
Eio_main.run @@ fun env ->
43
+
Eio.Switch.run @@ fun sw ->
44
+
let client = Immich.Client.create ~sw env ~base_url:"http://localhost:2283/api" in
45
+
let json = Immich.Client.get_activities ~album_id:"..." client () in
46
+
...
47
+
```
48
+
49
+
## Regeneration with Dune
50
+
51
+
When using `--regen`, the generated `dune.inc` contains rules for:
52
+
53
+
```bash
54
+
# Regenerate and promote changes
55
+
dune build @gen --auto-promote
56
+
```
57
+
58
+
## Architecture
59
+
60
+
- `lib/openapi_spec.ml` - OpenAPI 3.x specification types with jsont codecs
61
+
- `lib/openapi_codegen.ml` - Code generation from spec to OCaml
62
+
- `lib/openapi_runtime.ml` - Runtime utilities for generated clients
63
+
- `bin/openapi_cli.ml` - CLI tool
64
+
65
+
## Build & Test
66
+
67
+
```bash
68
+
opam exec -- dune build
69
+
opam exec -- dune test
70
+
```
+4
bin/dune
+4
bin/dune
+141
bin/openapi_cli.ml
+141
bin/openapi_cli.ml
···
1
+
(** OpenAPI code generator CLI. *)
2
+
3
+
let setup_logging style_renderer level =
4
+
Fmt_tty.setup_std_outputs ?style_renderer ();
5
+
Logs.set_level level;
6
+
Logs.set_reporter (Logs_fmt.reporter ())
7
+
8
+
let read_file path =
9
+
let ic = open_in path in
10
+
let n = in_channel_length ic in
11
+
let s = really_input_string ic n in
12
+
close_in ic;
13
+
s
14
+
15
+
(** Parse spec file and run action, handling errors uniformly *)
16
+
let with_spec spec_path f =
17
+
let spec_content = read_file spec_path in
18
+
match Openapi.Spec.of_string spec_content with
19
+
| Error e ->
20
+
Logs.err (fun m -> m "Failed to parse OpenAPI spec: %s" e);
21
+
1
22
+
| Ok spec -> f spec
23
+
24
+
let generate_cmd spec_path output_dir package_name include_regen_rule =
25
+
setup_logging None (Some Logs.Info);
26
+
Logs.info (fun m -> m "Reading OpenAPI spec from %s" spec_path);
27
+
with_spec spec_path (fun spec ->
28
+
Logs.info (fun m -> m "Parsed OpenAPI spec: %s v%s"
29
+
spec.info.title spec.info.version);
30
+
31
+
let package_name = Option.value package_name
32
+
~default:(Openapi.Codegen.Name.to_snake_case spec.info.title) in
33
+
34
+
(* Use spec_path for dune.inc regeneration rule if requested *)
35
+
let spec_path_for_dune = if include_regen_rule then Some spec_path else None in
36
+
let config = Openapi.Codegen.{ output_dir; package_name; spec_path = spec_path_for_dune } in
37
+
let files = Openapi.Codegen.generate ~config spec in
38
+
39
+
(try Unix.mkdir output_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
40
+
Openapi.Codegen.write_files ~output_dir files;
41
+
42
+
Logs.info (fun m -> m "Generated %d files in %s" (List.length files) output_dir);
43
+
List.iter (fun (name, _) -> Logs.info (fun m -> m " - %s" name)) files;
44
+
0)
45
+
46
+
let inspect_cmd spec_path =
47
+
setup_logging None (Some Logs.Info);
48
+
with_spec spec_path (fun spec ->
49
+
Fmt.pr "@[<v>";
50
+
Fmt.pr "OpenAPI Specification@,";
51
+
Fmt.pr "====================@,@,";
52
+
Fmt.pr "Title: %s@," spec.info.title;
53
+
Fmt.pr "Version: %s@," spec.info.version;
54
+
Option.iter (fun d -> Fmt.pr "Description: %s@," d) spec.info.description;
55
+
Fmt.pr "@,";
56
+
57
+
Fmt.pr "Servers:@,";
58
+
List.iter (fun (s : Openapi.Spec.server) ->
59
+
Fmt.pr " - %s@," s.url
60
+
) spec.servers;
61
+
Fmt.pr "@,";
62
+
63
+
Fmt.pr "Paths (%d):@," (List.length spec.paths);
64
+
List.iter (fun (path, _item) ->
65
+
Fmt.pr " - %s@," path
66
+
) spec.paths;
67
+
Fmt.pr "@,";
68
+
69
+
(match spec.components with
70
+
| Some c ->
71
+
Fmt.pr "Schemas (%d):@," (List.length c.schemas);
72
+
List.iter (fun (name, _) ->
73
+
Fmt.pr " - %s@," name
74
+
) c.schemas
75
+
| None -> ());
76
+
77
+
Fmt.pr "@]";
78
+
0)
79
+
80
+
(* Cmdliner setup *)
81
+
open Cmdliner
82
+
83
+
let spec_path =
84
+
let doc = "Path to the OpenAPI specification file (JSON)." in
85
+
Arg.(required & pos 0 (some file) None & info [] ~docv:"SPEC" ~doc)
86
+
87
+
let output_dir =
88
+
let doc = "Output directory for generated code." in
89
+
Arg.(required & opt (some string) None & info ["o"; "output"] ~docv:"DIR" ~doc)
90
+
91
+
let package_name =
92
+
let doc = "Package name for generated code (defaults to API title)." in
93
+
Arg.(value & opt (some string) None & info ["n"; "name"] ~docv:"NAME" ~doc)
94
+
95
+
let include_regen_rule =
96
+
let doc = "Include dune.inc regeneration rule with spec path." in
97
+
Arg.(value & flag & info ["regen"; "include-regen-rule"] ~doc)
98
+
99
+
let generate_term =
100
+
Term.(const generate_cmd $ spec_path $ output_dir $ package_name $ include_regen_rule)
101
+
102
+
let generate_info =
103
+
let doc = "Generate OCaml code from an OpenAPI specification." in
104
+
let man = [
105
+
`S Manpage.s_description;
106
+
`P "Generates OCaml types and client code from an OpenAPI 3.x specification.";
107
+
`P "The generated code uses:";
108
+
`I ("$(b,jsont)", "for JSON encoding/decoding");
109
+
`I ("$(b,requests)", "for HTTP client (Eio-based)");
110
+
`I ("$(b,ptime)", "for date-time handling");
111
+
`S Manpage.s_examples;
112
+
`P "Generate client from local spec:";
113
+
`Pre " openapi generate spec.json -o ./client -n my_api";
114
+
`P "Generate with regeneration rule for dune:";
115
+
`Pre " openapi generate spec.json -o ./client -n my_api --regen";
116
+
] in
117
+
Cmd.info "generate" ~doc ~man
118
+
119
+
let inspect_term =
120
+
Term.(const inspect_cmd $ spec_path)
121
+
122
+
let inspect_info =
123
+
let doc = "Inspect an OpenAPI specification." in
124
+
Cmd.info "inspect" ~doc
125
+
126
+
let main_info =
127
+
let doc = "OpenAPI code generator for OCaml." in
128
+
let man = [
129
+
`S Manpage.s_description;
130
+
`P "Generate OCaml API clients from OpenAPI 3.x specifications.";
131
+
`P "Use $(b,generate) to create client code, or $(b,inspect) to view spec details.";
132
+
] in
133
+
Cmd.info "openapi" ~version:"0.1.0" ~doc ~man
134
+
135
+
let main_cmd =
136
+
Cmd.group main_info [
137
+
Cmd.v generate_info generate_term;
138
+
Cmd.v inspect_info inspect_term;
139
+
]
140
+
141
+
let () = exit (Cmd.eval' main_cmd)
+29
dune-project
+29
dune-project
···
1
+
(lang dune 3.21)
2
+
3
+
(name openapi)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
(authors "Anil Madhavapeddy")
9
+
(homepage "https://tangled.org/@anil.recoil.org/ocaml-openapi")
10
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
11
+
(maintenance_intent "(latest)")
12
+
(source (tangled anil.recoil.org/ocaml-openapi))
13
+
14
+
(package
15
+
(name openapi)
16
+
(synopsis "OpenAPI code generator for OCaml with requests and jsont")
17
+
(description
18
+
"Generate type-safe OCaml API clients from OpenAPI 3.x specifications.
19
+
Uses the requests HTTP library and jsont for JSON codecs.")
20
+
(depends
21
+
(ocaml (>= 5.1.0))
22
+
jsont
23
+
bytesrw
24
+
fmt
25
+
logs
26
+
ptime
27
+
(cmdliner (>= 1.2.0))
28
+
(odoc :with-doc)
29
+
(alcotest :with-test)))
+7
lib/dune
+7
lib/dune
+254
lib/index.mld
+254
lib/index.mld
···
1
+
{0 OCaml OpenAPI}
2
+
3
+
{1 Overview}
4
+
5
+
[openapi] generates type-safe OCaml API clients from OpenAPI 3.x
6
+
specifications. The generated code uses:
7
+
8
+
- {b jsont} for JSON encoding/decoding
9
+
- {b requests} for HTTP client (Eio-based)
10
+
- {b ptime} for date-time handling
11
+
12
+
{1 Installation}
13
+
14
+
{[
15
+
opam install openapi
16
+
]}
17
+
18
+
{1 Generating a Client}
19
+
20
+
Use the [openapi-gen] CLI tool to generate OCaml code from an OpenAPI spec:
21
+
22
+
{[
23
+
# Basic generation
24
+
openapi-gen generate spec.json -o ./my_api -n my_api
25
+
26
+
# With dune regeneration rules
27
+
openapi-gen generate spec.json -o ./my_api -n my_api --regen
28
+
]}
29
+
30
+
{2 CLI Options}
31
+
32
+
{ul
33
+
{- [-o], [--output] — Output directory for generated code (required)}
34
+
{- [-n], [--name] — Package name for generated library (defaults to API title)}
35
+
{- [--regen] — Include dune.inc rules for [dune build @gen --auto-promote]}}
36
+
37
+
{1 Generated Code Structure}
38
+
39
+
The generator produces a complete dune library:
40
+
41
+
{[
42
+
my_api/
43
+
├── dune # Library configuration (wrapped)
44
+
├── dune.inc # Regeneration rules (if --regen used)
45
+
├── types.ml # Type definitions with jsont codecs
46
+
├── types.mli # Type interfaces
47
+
├── client.ml # API client functions
48
+
├── client.mli # Client interface
49
+
├── my_api.ml # Main wrapped module
50
+
└── my_api.mli # Main module interface
51
+
]}
52
+
53
+
{1 Using Generated Code}
54
+
55
+
{2 Accessing Types}
56
+
57
+
All schema types are generated as modules within [Types]:
58
+
59
+
{[
60
+
(* Access a type *)
61
+
let user : My_api.Types.User.t = {
62
+
id = 123;
63
+
name = "Alice";
64
+
email = Some "alice@example.com";
65
+
}
66
+
67
+
(* Encode to JSON *)
68
+
let json = Jsont.encode My_api.Types.User.t_jsont user
69
+
70
+
(* Decode from JSON *)
71
+
let user' = Jsont.decode My_api.Types.User.t_jsont json
72
+
]}
73
+
74
+
{2 Making API Requests}
75
+
76
+
Create a client and call API operations:
77
+
78
+
{[
79
+
let () =
80
+
Eio_main.run @@ fun env ->
81
+
Eio.Switch.run @@ fun sw ->
82
+
83
+
(* Create the client *)
84
+
let client = My_api.Client.create ~sw env
85
+
~base_url:"https://api.example.com" in
86
+
87
+
(* Make a request - returns typed value *)
88
+
let user = My_api.Client.get_user ~id:"123" client () in
89
+
Printf.printf "User: %s\n" user.name
90
+
91
+
(* List endpoints return typed lists *)
92
+
let users = My_api.Client.list_users client () in
93
+
List.iter (fun u -> Printf.printf "- %s\n" u.name) users
94
+
]}
95
+
96
+
{2 Request Bodies}
97
+
98
+
For POST/PUT/PATCH requests, pass the typed value directly:
99
+
100
+
{[
101
+
(* Create typed request body *)
102
+
let new_user : My_api.Types.CreateUserDto.t = {
103
+
name = "Bob";
104
+
email = "bob@example.com";
105
+
} in
106
+
107
+
(* Pass as the body parameter - encoding is automatic *)
108
+
let created = My_api.Client.create_user ~body:new_user client ()
109
+
]}
110
+
111
+
{1 Keeping Generated Code Updated}
112
+
113
+
If you used [--regen], the generated [dune.inc] includes rules to regenerate
114
+
the client when the spec changes:
115
+
116
+
{[
117
+
# Regenerate and promote changes
118
+
dune build @gen --auto-promote
119
+
]}
120
+
121
+
This is useful for CI pipelines to ensure generated code stays in sync with
122
+
the OpenAPI specification.
123
+
124
+
{1 Library Modules}
125
+
126
+
{2 Core Modules}
127
+
128
+
{ul
129
+
{- {!module:Openapi.Spec} — OpenAPI 3.x specification types with jsont codecs}
130
+
{- {!module:Openapi.Codegen} — Code generation from spec to OCaml}
131
+
{- {!module:Openapi.Runtime} — Runtime utilities for generated clients}}
132
+
133
+
{2 Runtime Utilities}
134
+
135
+
The {!module:Openapi.Runtime} module provides helpers used by generated code:
136
+
137
+
{[
138
+
(* Path template rendering *)
139
+
Openapi.Runtime.Path.render
140
+
~params:[("userId", "123"); ("postId", "456")]
141
+
"/users/{userId}/posts/{postId}"
142
+
(* => "/users/123/posts/456" *)
143
+
144
+
(* Query string encoding *)
145
+
Openapi.Runtime.Query.encode [("page", "1"); ("limit", "10")]
146
+
(* => "?page=1&limit=10" *)
147
+
]}
148
+
149
+
{1 Example: Immich API}
150
+
151
+
Here's a complete example generating a client for the Immich photo server:
152
+
153
+
{[
154
+
# Generate the client
155
+
openapi-gen generate immich-openapi-specs.json -o ./immich -n immich
156
+
157
+
# In your code:
158
+
let () =
159
+
Eio_main.run @@ fun env ->
160
+
Eio.Switch.run @@ fun sw ->
161
+
let client = Immich.Client.create ~sw env
162
+
~base_url:"http://localhost:2283/api" in
163
+
164
+
(* List albums *)
165
+
let albums_json = Immich.Client.get_all_albums client () in
166
+
167
+
(* Get server info *)
168
+
let info = Immich.Client.get_server_info client () in
169
+
...
170
+
]}
171
+
172
+
{1 Limitations}
173
+
174
+
{2 Schema Generation}
175
+
176
+
{ul
177
+
{- {b oneOf/anyOf} — Union types are mapped to [Jsont.json]. Proper
178
+
implementation would generate OCaml variant types with discriminator-based
179
+
decoding. See {{:#union-types}Union Types} below for details.}
180
+
{- {b allOf} — Composition schemas are mapped to [Jsont.json]. Proper
181
+
implementation would merge all referenced schemas into a single record type.}
182
+
{- {b additionalProperties} — Dynamic object properties are parsed but not
183
+
used in code generation. Objects with [additionalProperties: true] become
184
+
[Jsont.json].}
185
+
{- {b Recursive schemas} — Schemas that reference themselves are not fully
186
+
supported and may cause infinite loops during generation.}
187
+
{- {b Nested $ref} — References to references are not resolved; only direct
188
+
schema references work.}}
189
+
190
+
{2 Client Generation}
191
+
192
+
{ul
193
+
{- {b Error responses} — Error schemas (4xx, 5xx) are not generated. Errors
194
+
are raised as exceptions with the HTTP status code and body text.}
195
+
{- {b Authentication} — Security schemes (apiKey, http, oauth2) are parsed
196
+
but not applied to requests. Add headers manually via the requests session.}
197
+
{- {b Header parameters} — Header parameters are parsed but not included in
198
+
generated function signatures.}
199
+
{- {b Cookie parameters} — Cookie parameters are parsed but not included in
200
+
generated functions.}
201
+
{- {b Parameter references} — [$ref] in parameters are skipped; only inline
202
+
parameters are used.}}
203
+
204
+
{2 Content Types}
205
+
206
+
{ul
207
+
{- {b File uploads} — [multipart/form-data] is not supported. Binary file
208
+
uploads require special handling not yet implemented.}
209
+
{- {b XML} — Only [application/json] content types are supported.}
210
+
{- {b Form encoding} — [application/x-www-form-urlencoded] is not supported.}}
211
+
212
+
{2 Advanced Features}
213
+
214
+
{ul
215
+
{- {b Callbacks} — Webhook callbacks are parsed but no server code is
216
+
generated.}
217
+
{- {b Links} — Response links are parsed but not used in code generation.}
218
+
{- {b External references} — Only internal [$ref] pointers starting with
219
+
[#/] are supported. External file references are not resolved.}}
220
+
221
+
{1:union-types Implementing Union Types}
222
+
223
+
To properly support [oneOf]/[anyOf], the generator would need to:
224
+
225
+
{ol
226
+
{- Analyze schemas in the union to determine variant names}
227
+
{- Use the [discriminator] property if present to determine the tag field}
228
+
{- Generate an OCaml variant type with one constructor per schema}
229
+
{- Generate a decoder that:
230
+
{ul
231
+
{- Reads the discriminator field if present}
232
+
{- Pattern matches to select the appropriate decoder}
233
+
{- Falls back to trying each decoder in order for anyOf}}}
234
+
{- Generate an encoder that pattern matches on the variant}}
235
+
236
+
Example of what generated code might look like:
237
+
238
+
{[
239
+
(* For oneOf with discriminator *)
240
+
type pet =
241
+
| Dog of Dog.t
242
+
| Cat of Cat.t
243
+
244
+
let pet_jsont : pet Jsont.t =
245
+
(* Read discriminator field "petType" to determine variant *)
246
+
...
247
+
]}
248
+
249
+
{1 See Also}
250
+
251
+
{ul
252
+
{- {{:https://spec.openapis.org/oas/v3.0.3} OpenAPI 3.0 Specification}}
253
+
{- {{:https://erratique.ch/software/jsont} jsont documentation}}
254
+
{- {{:https://github.com/tarides/requests} requests library}}}
+13
lib/openapi.ml
+13
lib/openapi.ml
···
1
+
(** OCaml OpenAPI - Code generator for OpenAPI specifications.
2
+
3
+
This library provides:
4
+
- {!module:Spec} - OpenAPI 3.x specification types with jsont codecs
5
+
- {!module:Codegen} - Code generation from spec to OCaml
6
+
- {!module:Runtime} - Runtime utilities for generated clients
7
+
- {!module:Nestjs} - NestJS/Express error handling (optional)
8
+
*)
9
+
10
+
module Spec = Openapi_spec
11
+
module Codegen = Openapi_codegen
12
+
module Runtime = Openapi_runtime
13
+
module Nestjs = Openapi_nestjs
+1069
lib/openapi_codegen.ml
+1069
lib/openapi_codegen.ml
···
1
+
(** Code generation from OpenAPI specifications.
2
+
3
+
This module generates OCaml code from parsed OpenAPI specs:
4
+
- Nested module structure grouped by common schema prefixes
5
+
- Abstract types with accessor and constructor functions
6
+
- Client functions placed in relevant type modules
7
+
- Proper Eio error handling with context
8
+
*)
9
+
10
+
module Spec = Openapi_spec
11
+
12
+
(** {1 Name Conversion} *)
13
+
14
+
module Name = struct
15
+
module StringSet = Set.Make(String)
16
+
17
+
let ocaml_keywords = StringSet.of_list [
18
+
"and"; "as"; "assert"; "asr"; "begin"; "class"; "constraint"; "do"; "done";
19
+
"downto"; "else"; "end"; "exception"; "external"; "false"; "for"; "fun";
20
+
"function"; "functor"; "if"; "in"; "include"; "inherit"; "initializer";
21
+
"land"; "lazy"; "let"; "lor"; "lsl"; "lsr"; "lxor"; "match"; "method";
22
+
"mod"; "module"; "mutable"; "new"; "nonrec"; "object"; "of"; "open"; "or";
23
+
"private"; "rec"; "sig"; "struct"; "then"; "to"; "true"; "try"; "type";
24
+
"val"; "virtual"; "when"; "while"; "with"
25
+
]
26
+
27
+
let escape_keyword s =
28
+
if StringSet.mem s ocaml_keywords then s ^ "_" else s
29
+
30
+
let to_snake_case s =
31
+
let buf = Buffer.create (String.length s) in
32
+
let prev_upper = ref false in
33
+
String.iteri (fun i c ->
34
+
match c with
35
+
| 'A'..'Z' ->
36
+
if i > 0 && not !prev_upper then Buffer.add_char buf '_';
37
+
Buffer.add_char buf (Char.lowercase_ascii c);
38
+
prev_upper := true
39
+
| 'a'..'z' | '0'..'9' | '_' ->
40
+
Buffer.add_char buf c;
41
+
prev_upper := false
42
+
| '-' | ' ' | '.' | '/' ->
43
+
Buffer.add_char buf '_';
44
+
prev_upper := false
45
+
| _ ->
46
+
prev_upper := false
47
+
) s;
48
+
escape_keyword (Buffer.contents buf)
49
+
50
+
let to_module_name s =
51
+
let snake = to_snake_case s in
52
+
let parts = String.split_on_char '_' snake in
53
+
String.concat "" (List.map String.capitalize_ascii parts)
54
+
55
+
let to_type_name s = String.lowercase_ascii (to_snake_case s)
56
+
57
+
let to_variant_name s = String.capitalize_ascii (to_snake_case s)
58
+
59
+
(** Split a schema name into prefix and suffix for nested modules.
60
+
E.g., "AlbumResponseDto" -> ("Album", "ResponseDto") *)
61
+
let split_schema_name (name : string) : string * string =
62
+
(* Common suffixes to look for *)
63
+
let suffixes = [
64
+
"ResponseDto"; "RequestDto"; "CreateDto"; "UpdateDto"; "Dto";
65
+
"Response"; "Request"; "Create"; "Update"; "Config"; "Info";
66
+
"Status"; "Type"; "Entity"; "Item"; "Entry"; "Data"; "Result"
67
+
] in
68
+
let found = List.find_opt (fun suffix ->
69
+
String.length name > String.length suffix &&
70
+
String.ends_with ~suffix name
71
+
) suffixes in
72
+
match found with
73
+
| Some suffix ->
74
+
let prefix_len = String.length name - String.length suffix in
75
+
let prefix = String.sub name 0 prefix_len in
76
+
if prefix = "" then (name, "T")
77
+
else (prefix, suffix)
78
+
| None ->
79
+
(* No known suffix, use as-is with submodule T *)
80
+
(name, "T")
81
+
82
+
let operation_name ~(method_ : string) ~(path : string) ~(operation_id : string option) =
83
+
match operation_id with
84
+
| Some id -> to_snake_case id
85
+
| None ->
86
+
let method_name = String.lowercase_ascii method_ in
87
+
let path_parts = String.split_on_char '/' path
88
+
|> List.filter (fun s -> s <> "" && not (String.length s > 0 && s.[0] = '{'))
89
+
in
90
+
let path_name = String.concat "_" (List.map to_snake_case path_parts) in
91
+
method_name ^ "_" ^ path_name
92
+
end
93
+
94
+
(** {1 OCamldoc Helpers} *)
95
+
96
+
let escape_doc s =
97
+
let s = String.concat "\\}" (String.split_on_char '}' s) in
98
+
String.concat "\\{" (String.split_on_char '{' s)
99
+
100
+
let format_doc ?(indent=0) description =
101
+
let prefix = String.make indent ' ' in
102
+
match description with
103
+
| None | Some "" -> ""
104
+
| Some desc -> Printf.sprintf "%s(** %s *)\n" prefix (escape_doc desc)
105
+
106
+
let format_doc_block ?(indent=0) ~summary ?description () =
107
+
let prefix = String.make indent ' ' in
108
+
match summary, description with
109
+
| None, None -> ""
110
+
| Some s, None -> Printf.sprintf "%s(** %s *)\n" prefix (escape_doc s)
111
+
| None, Some d -> Printf.sprintf "%s(** %s *)\n" prefix (escape_doc d)
112
+
| Some s, Some d ->
113
+
Printf.sprintf "%s(** %s\n\n%s %s *)\n" prefix (escape_doc s) prefix (escape_doc d)
114
+
115
+
let format_param_doc name description =
116
+
match description with
117
+
| None | Some "" -> ""
118
+
| Some d -> Printf.sprintf " @param %s %s\n" name (escape_doc d)
119
+
120
+
(** {1 JSON Helpers} *)
121
+
122
+
let json_string = function
123
+
| Jsont.String (s, _) -> Some s
124
+
| _ -> None
125
+
126
+
let json_object = function
127
+
| Jsont.Object (mems, _) -> Some mems
128
+
| _ -> None
129
+
130
+
let get_ref json =
131
+
Option.bind (json_object json) (fun mems ->
132
+
List.find_map (fun ((n, _), v) ->
133
+
if n = "$ref" then json_string v else None
134
+
) mems)
135
+
136
+
let get_member name json =
137
+
Option.bind (json_object json) (fun mems ->
138
+
List.find_map (fun ((n, _), v) ->
139
+
if n = name then Some v else None
140
+
) mems)
141
+
142
+
let get_string_member name json =
143
+
Option.bind (get_member name json) json_string
144
+
145
+
(** {1 Schema Analysis} *)
146
+
147
+
let schema_name_from_ref (ref_ : string) : string option =
148
+
match String.split_on_char '/' ref_ with
149
+
| ["#"; "components"; "schemas"; name] -> Some name
150
+
| _ -> None
151
+
152
+
let rec find_refs_in_json (json : Jsont.json) : string list =
153
+
match json with
154
+
| Jsont.Object (mems, _) ->
155
+
(match List.find_map (fun ((n, _), v) ->
156
+
if n = "$ref" then json_string v else None) mems with
157
+
| Some ref_ -> Option.to_list (schema_name_from_ref ref_)
158
+
| None -> List.concat_map (fun (_, v) -> find_refs_in_json v) mems)
159
+
| Jsont.Array (items, _) -> List.concat_map find_refs_in_json items
160
+
| _ -> []
161
+
162
+
let find_schema_dependencies (schema : Spec.schema) : string list =
163
+
let from_properties = List.concat_map (fun (_, json) -> find_refs_in_json json) schema.properties in
164
+
let refs_from_list = Option.fold ~none:[] ~some:(List.concat_map find_refs_in_json) in
165
+
let from_items = Option.fold ~none:[] ~some:find_refs_in_json schema.items in
166
+
List.sort_uniq String.compare
167
+
(from_properties @ from_items @ refs_from_list schema.all_of
168
+
@ refs_from_list schema.one_of @ refs_from_list schema.any_of)
169
+
170
+
(** {1 Module Tree Structure} *)
171
+
172
+
module StringMap = Map.Make(String)
173
+
module StringSet = Set.Make(String)
174
+
175
+
(** {1 Topological Sort} *)
176
+
177
+
(** Kahn's algorithm for topological sorting.
178
+
Returns nodes in dependency order (dependencies first). *)
179
+
let topological_sort (nodes : string list) (deps : string -> string list) : string list =
180
+
(* Build adjacency list and in-degree map *)
181
+
let nodes_set = StringSet.of_list nodes in
182
+
let in_degree = List.fold_left (fun m node ->
183
+
StringMap.add node 0 m
184
+
) StringMap.empty nodes in
185
+
let adj = List.fold_left (fun m node ->
186
+
StringMap.add node [] m
187
+
) StringMap.empty nodes in
188
+
(* Add edges: if A depends on B, add edge B -> A *)
189
+
let (in_degree, adj) = List.fold_left (fun (in_degree, adj) node ->
190
+
let node_deps = deps node |> List.filter (fun d -> StringSet.mem d nodes_set) in
191
+
let in_degree = StringMap.add node (List.length node_deps) in_degree in
192
+
let adj = List.fold_left (fun adj dep ->
193
+
let existing = Option.value ~default:[] (StringMap.find_opt dep adj) in
194
+
StringMap.add dep (node :: existing) adj
195
+
) adj node_deps in
196
+
(in_degree, adj)
197
+
) (in_degree, adj) nodes in
198
+
(* Start with nodes that have no dependencies *)
199
+
let queue = List.filter (fun n ->
200
+
StringMap.find n in_degree = 0
201
+
) nodes in
202
+
let rec process queue in_degree result =
203
+
match queue with
204
+
| [] -> List.rev result
205
+
| node :: rest ->
206
+
let result = node :: result in
207
+
let dependents = Option.value ~default:[] (StringMap.find_opt node adj) in
208
+
let (queue', in_degree) = List.fold_left (fun (q, deg) dep ->
209
+
let new_deg = StringMap.find dep deg - 1 in
210
+
let deg = StringMap.add dep new_deg deg in
211
+
if new_deg = 0 then (dep :: q, deg) else (q, deg)
212
+
) (rest, in_degree) dependents in
213
+
process queue' in_degree result
214
+
in
215
+
process queue in_degree []
216
+
217
+
type field_info = {
218
+
ocaml_name : string;
219
+
json_name : string;
220
+
ocaml_type : string;
221
+
base_type : string;
222
+
is_optional : bool;
223
+
is_required : bool;
224
+
description : string option;
225
+
}
226
+
227
+
type schema_info = {
228
+
original_name : string;
229
+
prefix : string;
230
+
suffix : string;
231
+
schema : Spec.schema;
232
+
fields : field_info list;
233
+
is_enum : bool;
234
+
enum_variants : (string * string) list; (* ocaml_name, json_value *)
235
+
description : string option;
236
+
}
237
+
238
+
type operation_info = {
239
+
func_name : string;
240
+
operation_id : string option;
241
+
summary : string option;
242
+
description : string option;
243
+
tags : string list;
244
+
path : string;
245
+
method_ : string;
246
+
path_params : (string * string * string option * bool) list; (* ocaml, json, desc, required *)
247
+
query_params : (string * string * string option * bool) list;
248
+
body_schema_ref : string option;
249
+
response_schema_ref : string option;
250
+
}
251
+
252
+
type module_node = {
253
+
name : string;
254
+
schemas : schema_info list;
255
+
operations : operation_info list;
256
+
dependencies : StringSet.t; (* Other prefix modules this depends on *)
257
+
children : module_node StringMap.t;
258
+
}
259
+
260
+
let empty_node name = { name; schemas = []; operations = []; dependencies = StringSet.empty; children = StringMap.empty }
261
+
262
+
(** {1 Type Resolution} *)
263
+
264
+
let rec type_of_json_schema (json : Jsont.json) : string * bool =
265
+
(* Check if the schema is nullable *)
266
+
let is_nullable = match get_member "nullable" json with
267
+
| Some (Jsont.Bool (b, _)) -> b
268
+
| _ -> false
269
+
in
270
+
match get_ref json with
271
+
| Some ref_ ->
272
+
(match schema_name_from_ref ref_ with
273
+
| Some name ->
274
+
let prefix, suffix = Name.split_schema_name name in
275
+
(Printf.sprintf "%s.%s.t" (Name.to_module_name prefix) (Name.to_module_name suffix), is_nullable)
276
+
| None -> ("Jsont.json", is_nullable))
277
+
| None ->
278
+
match get_string_member "type" json with
279
+
| Some "string" ->
280
+
(match get_string_member "format" json with
281
+
| Some "date-time" -> ("Ptime.t", is_nullable)
282
+
| _ -> ("string", is_nullable))
283
+
| Some "integer" ->
284
+
(match get_string_member "format" json with
285
+
| Some "int64" -> ("int64", is_nullable)
286
+
| Some "int32" -> ("int32", is_nullable)
287
+
| _ -> ("int", is_nullable))
288
+
| Some "number" -> ("float", is_nullable)
289
+
| Some "boolean" -> ("bool", is_nullable)
290
+
| Some "array" ->
291
+
(match get_member "items" json with
292
+
| Some items ->
293
+
let (elem_type, _) = type_of_json_schema items in
294
+
(elem_type ^ " list", is_nullable)
295
+
| None -> ("Jsont.json list", is_nullable))
296
+
| Some "object" -> ("Jsont.json", is_nullable)
297
+
| _ -> ("Jsont.json", is_nullable)
298
+
299
+
let rec jsont_of_base_type = function
300
+
| "string" -> "Jsont.string"
301
+
| "int" -> "Jsont.int"
302
+
| "int32" -> "Jsont.int32"
303
+
| "int64" -> "Jsont.int64"
304
+
| "float" -> "Jsont.number"
305
+
| "bool" -> "Jsont.bool"
306
+
| "Ptime.t" -> "Openapi.Runtime.ptime_jsont"
307
+
| "Jsont.json" -> "Jsont.json"
308
+
| s when String.ends_with ~suffix:" list" s ->
309
+
let elem = String.sub s 0 (String.length s - 5) in
310
+
Printf.sprintf "(Jsont.list %s)" (jsont_of_base_type elem)
311
+
| s when String.ends_with ~suffix:".t" s ->
312
+
let module_path = String.sub s 0 (String.length s - 2) in
313
+
module_path ^ ".jsont"
314
+
| _ -> "Jsont.json"
315
+
316
+
(** {1 Schema Processing} *)
317
+
318
+
let analyze_schema (name : string) (schema : Spec.schema) : schema_info =
319
+
let prefix, suffix = Name.split_schema_name name in
320
+
let is_enum = Option.is_some schema.enum in
321
+
let enum_variants = match schema.enum with
322
+
| Some values ->
323
+
List.filter_map (fun json ->
324
+
match json with
325
+
| Jsont.String (s, _) -> Some (Name.to_variant_name s, s)
326
+
| _ -> None
327
+
) values
328
+
| None -> []
329
+
in
330
+
let fields = List.map (fun (field_name, field_json) ->
331
+
let ocaml_name = Name.to_snake_case field_name in
332
+
let is_required = List.mem field_name schema.required in
333
+
let (base_type, json_nullable) = type_of_json_schema field_json in
334
+
let is_optional = json_nullable || not is_required in
335
+
let ocaml_type = if is_optional then base_type ^ " option" else base_type in
336
+
let description = get_string_member "description" field_json in
337
+
{ ocaml_name; json_name = field_name; ocaml_type; base_type; is_optional; is_required; description }
338
+
) schema.properties in
339
+
{ original_name = name; prefix; suffix; schema; fields; is_enum; enum_variants;
340
+
description = schema.description }
341
+
342
+
(** {1 Operation Processing} *)
343
+
344
+
let analyze_operation ~path ~method_ (op : Spec.operation) : operation_info =
345
+
let func_name = Name.operation_name ~method_ ~path ~operation_id:op.operation_id in
346
+
let params = List.filter_map (fun (p : Spec.parameter Spec.or_ref) ->
347
+
match p with Spec.Value p -> Some p | Spec.Ref _ -> None
348
+
) op.parameters in
349
+
350
+
let path_params = List.filter_map (fun (p : Spec.parameter) ->
351
+
if p.in_ = Spec.Path then
352
+
Some (Name.to_snake_case p.name, p.name, p.description, p.required)
353
+
else None
354
+
) params in
355
+
356
+
let query_params = List.filter_map (fun (p : Spec.parameter) ->
357
+
if p.in_ = Spec.Query then
358
+
Some (Name.to_snake_case p.name, p.name, p.description, p.required)
359
+
else None
360
+
) params in
361
+
362
+
let body_schema_ref = match op.request_body with
363
+
| Some (Spec.Value (rb : Spec.request_body)) ->
364
+
List.find_map (fun (ct, (media : Spec.media_type)) ->
365
+
if String.length ct >= 16 && String.sub ct 0 16 = "application/json" then
366
+
match media.schema with
367
+
| Some (Spec.Ref r) -> schema_name_from_ref r
368
+
| _ -> None
369
+
else None
370
+
) rb.content
371
+
| _ -> None
372
+
in
373
+
374
+
let response_schema_ref =
375
+
let find_in_content content =
376
+
List.find_map (fun (ct, (media : Spec.media_type)) ->
377
+
if String.length ct >= 16 && String.sub ct 0 16 = "application/json" then
378
+
match media.schema with
379
+
| Some (Spec.Ref r) -> schema_name_from_ref r
380
+
| Some (Spec.Value s) when s.type_ = Some "array" ->
381
+
Option.bind s.items (fun items -> Option.bind (get_ref items) schema_name_from_ref)
382
+
| _ -> None
383
+
else None
384
+
) content
385
+
in
386
+
let try_status status =
387
+
List.find_map (fun (code, resp) ->
388
+
if code = status then
389
+
match resp with
390
+
| Spec.Value (r : Spec.response) -> find_in_content r.content
391
+
| _ -> None
392
+
else None
393
+
) op.responses.responses
394
+
in
395
+
match try_status "200" with
396
+
| Some r -> Some r
397
+
| None -> match try_status "201" with
398
+
| Some r -> Some r
399
+
| None -> match op.responses.default with
400
+
| Some (Spec.Value (r : Spec.response)) -> find_in_content r.content
401
+
| _ -> None
402
+
in
403
+
404
+
{ func_name; operation_id = op.operation_id; summary = op.summary;
405
+
description = op.description; tags = op.tags; path; method_;
406
+
path_params; query_params; body_schema_ref; response_schema_ref }
407
+
408
+
(** {1 Module Tree Building} *)
409
+
410
+
(** Extract prefix module dependencies from a schema's fields *)
411
+
let schema_prefix_deps (schema : schema_info) : StringSet.t =
412
+
let deps = List.filter_map (fun (f : field_info) ->
413
+
(* Check if the type references another module *)
414
+
if String.contains f.base_type '.' then
415
+
(* Extract first component before the dot *)
416
+
match String.split_on_char '.' f.base_type with
417
+
| prefix :: _ when prefix <> "Jsont" && prefix <> "Ptime" && prefix <> "Openapi" ->
418
+
Some prefix
419
+
| _ -> None
420
+
else None
421
+
) schema.fields in
422
+
StringSet.of_list deps
423
+
424
+
(** Extract prefix module dependencies from an operation's types *)
425
+
let operation_prefix_deps (op : operation_info) : StringSet.t =
426
+
let body_dep = match op.body_schema_ref with
427
+
| Some name ->
428
+
let prefix, _ = Name.split_schema_name name in
429
+
Some (Name.to_module_name prefix)
430
+
| None -> None
431
+
in
432
+
let response_dep = match op.response_schema_ref with
433
+
| Some name ->
434
+
let prefix, _ = Name.split_schema_name name in
435
+
Some (Name.to_module_name prefix)
436
+
| None -> None
437
+
in
438
+
StringSet.of_list (List.filter_map Fun.id [body_dep; response_dep])
439
+
440
+
let build_module_tree (schemas : schema_info list) (operations : operation_info list) : module_node * string list =
441
+
let root = empty_node "Root" in
442
+
443
+
(* Add schemas to tree and track dependencies *)
444
+
let root = List.fold_left (fun root schema ->
445
+
let prefix_mod = Name.to_module_name schema.prefix in
446
+
let child = match StringMap.find_opt prefix_mod root.children with
447
+
| Some c -> c
448
+
| None -> empty_node prefix_mod
449
+
in
450
+
let schema_deps = schema_prefix_deps schema in
451
+
(* Remove self-dependency *)
452
+
let schema_deps = StringSet.remove prefix_mod schema_deps in
453
+
let child = { child with
454
+
schemas = schema :: child.schemas;
455
+
dependencies = StringSet.union child.dependencies schema_deps
456
+
} in
457
+
{ root with children = StringMap.add prefix_mod child root.children }
458
+
) root schemas in
459
+
460
+
(* Add operations to tree based on response type, and track operation dependencies *)
461
+
let root = List.fold_left (fun root op ->
462
+
match op.response_schema_ref with
463
+
| Some ref_name ->
464
+
let prefix, _ = Name.split_schema_name ref_name in
465
+
let prefix_mod = Name.to_module_name prefix in
466
+
let child = match StringMap.find_opt prefix_mod root.children with
467
+
| Some c -> c
468
+
| None -> empty_node prefix_mod
469
+
in
470
+
let op_deps = operation_prefix_deps op in
471
+
(* Remove self-dependency *)
472
+
let op_deps = StringSet.remove prefix_mod op_deps in
473
+
let child = { child with
474
+
operations = op :: child.operations;
475
+
dependencies = StringSet.union child.dependencies op_deps
476
+
} in
477
+
{ root with children = StringMap.add prefix_mod child root.children }
478
+
| None ->
479
+
(* Put in Client module for operations without typed response *)
480
+
let child = match StringMap.find_opt "Client" root.children with
481
+
| Some c -> c
482
+
| None -> empty_node "Client"
483
+
in
484
+
let op_deps = operation_prefix_deps op in
485
+
let op_deps = StringSet.remove "Client" op_deps in
486
+
let child = { child with
487
+
operations = op :: child.operations;
488
+
dependencies = StringSet.union child.dependencies op_deps
489
+
} in
490
+
{ root with children = StringMap.add "Client" child root.children }
491
+
) root operations in
492
+
493
+
(* Get sorted list of module names (dependencies first) *)
494
+
let module_names = StringMap.fold (fun name _ acc -> name :: acc) root.children [] in
495
+
let deps_of name =
496
+
match StringMap.find_opt name root.children with
497
+
| Some node -> StringSet.elements node.dependencies
498
+
| None -> []
499
+
in
500
+
let sorted = topological_sort module_names deps_of in
501
+
502
+
(root, sorted)
503
+
504
+
(** {1 Code Generation} *)
505
+
506
+
let gen_enum_impl (schema : schema_info) : string =
507
+
let doc = format_doc schema.description in
508
+
if schema.enum_variants = [] then
509
+
Printf.sprintf "%stype t = string\n\nlet jsont = Jsont.string" doc
510
+
else
511
+
let type_def = Printf.sprintf "%stype t = [\n%s\n]" doc
512
+
(String.concat "\n" (List.map (fun (v, _) -> " | `" ^ v) schema.enum_variants))
513
+
in
514
+
let dec_cases = String.concat "\n" (List.map (fun (v, raw) ->
515
+
Printf.sprintf " | %S -> `%s" raw v
516
+
) schema.enum_variants) in
517
+
let enc_cases = String.concat "\n" (List.map (fun (v, raw) ->
518
+
Printf.sprintf " | `%s -> %S" v raw
519
+
) schema.enum_variants) in
520
+
Printf.sprintf {|%s
521
+
522
+
let jsont : t Jsont.t =
523
+
Jsont.map Jsont.string ~kind:%S
524
+
~dec:(function
525
+
%s
526
+
| s -> Jsont.Error.msgf Jsont.Meta.none "Unknown value: %%s" s)
527
+
~enc:(function
528
+
%s)|} type_def schema.original_name dec_cases enc_cases
529
+
530
+
let gen_enum_intf (schema : schema_info) : string =
531
+
let doc = format_doc schema.description in
532
+
if schema.enum_variants = [] then
533
+
Printf.sprintf "%stype t = string\n\nval jsont : t Jsont.t" doc
534
+
else
535
+
let type_def = Printf.sprintf "%stype t = [\n%s\n]" doc
536
+
(String.concat "\n" (List.map (fun (v, _) -> " | `" ^ v) schema.enum_variants))
537
+
in
538
+
Printf.sprintf "%s\n\nval jsont : t Jsont.t" type_def
539
+
540
+
(** Localize an OCaml type string by stripping the current_prefix module *)
541
+
let localize_type ~current_prefix (type_str : string) : string =
542
+
(* Handle patterns like "User.ResponseDto.t" -> "ResponseDto.t" if current_prefix = "User" *)
543
+
let prefix_dot = current_prefix ^ "." in
544
+
let strip_prefix s =
545
+
if String.length s >= String.length prefix_dot &&
546
+
String.sub s 0 (String.length prefix_dot) = prefix_dot then
547
+
String.sub s (String.length prefix_dot) (String.length s - String.length prefix_dot)
548
+
else s
549
+
in
550
+
(* Handle "X list", "X option", and nested combinations *)
551
+
let rec localize s =
552
+
if String.ends_with ~suffix:" list" s then
553
+
let elem = String.sub s 0 (String.length s - 5) in
554
+
(localize elem) ^ " list"
555
+
else if String.ends_with ~suffix:" option" s then
556
+
let elem = String.sub s 0 (String.length s - 7) in
557
+
(localize elem) ^ " option"
558
+
else
559
+
strip_prefix s
560
+
in
561
+
localize type_str
562
+
563
+
(** Localize a jsont codec string by stripping the current_prefix module *)
564
+
let rec localize_jsont ~current_prefix (jsont_str : string) : string =
565
+
let prefix_dot = current_prefix ^ "." in
566
+
(* Handle patterns like "User.ResponseDto.jsont" -> "ResponseDto.jsont" *)
567
+
(* Also handle "(Jsont.list User.ResponseDto.jsont)" *)
568
+
if String.length jsont_str >= String.length prefix_dot then
569
+
if String.sub jsont_str 0 (String.length prefix_dot) = prefix_dot then
570
+
String.sub jsont_str (String.length prefix_dot) (String.length jsont_str - String.length prefix_dot)
571
+
else if String.length jsont_str > 12 && String.sub jsont_str 0 12 = "(Jsont.list " then
572
+
let inner = String.sub jsont_str 12 (String.length jsont_str - 13) in
573
+
"(Jsont.list " ^ localize_jsont ~current_prefix inner ^ ")"
574
+
else
575
+
jsont_str
576
+
else
577
+
jsont_str
578
+
579
+
let gen_record_impl ~current_prefix (schema : schema_info) : string =
580
+
let loc_type = localize_type ~current_prefix in
581
+
let loc_jsont = localize_jsont ~current_prefix in
582
+
let doc = format_doc schema.description in
583
+
if schema.fields = [] then
584
+
Printf.sprintf "%stype t = Jsont.json\n\nlet jsont = Jsont.json\n\nlet v () = Jsont.Null ((), Jsont.Meta.none)" doc
585
+
else
586
+
(* Private type definition *)
587
+
let type_fields = String.concat "\n" (List.map (fun (f : field_info) ->
588
+
let field_doc = match f.description with
589
+
| Some d -> Printf.sprintf " (** %s *)" (escape_doc d)
590
+
| None -> ""
591
+
in
592
+
Printf.sprintf " %s : %s;%s" f.ocaml_name (loc_type f.ocaml_type) field_doc
593
+
) schema.fields) in
594
+
595
+
let type_def = Printf.sprintf "%stype t = {\n%s\n}" doc type_fields in
596
+
597
+
(* Constructor function v *)
598
+
let required_fields = List.filter (fun (f : field_info) -> not f.is_optional) schema.fields in
599
+
let optional_fields = List.filter (fun (f : field_info) -> f.is_optional) schema.fields in
600
+
let v_params =
601
+
(List.map (fun (f : field_info) -> Printf.sprintf "~%s" f.ocaml_name) required_fields) @
602
+
(List.map (fun (f : field_info) -> Printf.sprintf "?%s" f.ocaml_name) optional_fields) @
603
+
["()"]
604
+
in
605
+
let v_body = String.concat "; " (List.map (fun (f : field_info) -> f.ocaml_name) schema.fields) in
606
+
let v_func = Printf.sprintf "let v %s = { %s }" (String.concat " " v_params) v_body in
607
+
608
+
(* Accessor functions *)
609
+
let accessors = String.concat "\n" (List.map (fun (f : field_info) ->
610
+
Printf.sprintf "let %s t = t.%s" f.ocaml_name f.ocaml_name
611
+
) schema.fields) in
612
+
613
+
(* Jsont codec *)
614
+
let make_params = String.concat " " (List.map (fun (f : field_info) -> f.ocaml_name) schema.fields) in
615
+
let jsont_members = String.concat "\n" (List.map (fun (f : field_info) ->
616
+
let codec = loc_jsont (jsont_of_base_type f.base_type) in
617
+
if f.is_optional then
618
+
if f.is_required then
619
+
Printf.sprintf " |> Jsont.Object.mem %S (Jsont.option %s)\n ~dec_absent:None ~enc_omit:Option.is_none ~enc:(fun r -> r.%s)"
620
+
f.json_name codec f.ocaml_name
621
+
else
622
+
Printf.sprintf " |> Jsont.Object.opt_mem %S %s ~enc:(fun r -> r.%s)"
623
+
f.json_name codec f.ocaml_name
624
+
else
625
+
Printf.sprintf " |> Jsont.Object.mem %S %s ~enc:(fun r -> r.%s)"
626
+
f.json_name codec f.ocaml_name
627
+
) schema.fields) in
628
+
629
+
Printf.sprintf {|%s
630
+
631
+
%s
632
+
633
+
%s
634
+
635
+
let jsont : t Jsont.t =
636
+
Jsont.Object.map ~kind:%S
637
+
(fun %s -> { %s })
638
+
%s
639
+
|> Jsont.Object.skip_unknown
640
+
|> Jsont.Object.finish|}
641
+
type_def v_func accessors schema.original_name make_params v_body jsont_members
642
+
643
+
let gen_record_intf ~current_prefix (schema : schema_info) : string =
644
+
let loc_type = localize_type ~current_prefix in
645
+
let doc = format_doc schema.description in
646
+
if schema.fields = [] then
647
+
Printf.sprintf "%stype t\n\nval jsont : t Jsont.t\n\nval v : unit -> t" doc
648
+
else
649
+
(* Abstract type *)
650
+
let type_decl = Printf.sprintf "%stype t" doc in
651
+
652
+
(* Constructor signature *)
653
+
let required_fields = List.filter (fun (f : field_info) -> not f.is_optional) schema.fields in
654
+
let optional_fields = List.filter (fun (f : field_info) -> f.is_optional) schema.fields in
655
+
let v_param_docs = String.concat ""
656
+
((List.map (fun (f : field_info) -> format_param_doc f.ocaml_name f.description) required_fields) @
657
+
(List.map (fun (f : field_info) -> format_param_doc f.ocaml_name f.description) optional_fields))
658
+
in
659
+
let v_params =
660
+
(List.map (fun (f : field_info) -> Printf.sprintf "%s:%s" f.ocaml_name (loc_type f.base_type)) required_fields) @
661
+
(List.map (fun (f : field_info) -> Printf.sprintf "?%s:%s" f.ocaml_name (loc_type f.base_type)) optional_fields) @
662
+
["unit"; "t"]
663
+
in
664
+
let v_doc = if v_param_docs = "" then "(** Construct a value *)\n"
665
+
else Printf.sprintf "(** Construct a value\n%s*)\n" v_param_docs in
666
+
let v_sig = Printf.sprintf "%sval v : %s" v_doc (String.concat " -> " v_params) in
667
+
668
+
(* Accessor signatures *)
669
+
let accessor_sigs = String.concat "\n\n" (List.map (fun (f : field_info) ->
670
+
let acc_doc = match f.description with
671
+
| Some d -> Printf.sprintf "(** %s *)\n" (escape_doc d)
672
+
| None -> ""
673
+
in
674
+
Printf.sprintf "%sval %s : t -> %s" acc_doc f.ocaml_name (loc_type f.ocaml_type)
675
+
) schema.fields) in
676
+
677
+
Printf.sprintf "%s\n\n%s\n\n%s\n\nval jsont : t Jsont.t"
678
+
type_decl v_sig accessor_sigs
679
+
680
+
(** Format a jsont codec reference, stripping the current_prefix if present *)
681
+
let format_jsont_ref ~current_prefix (schema_ref : string) : string =
682
+
let prefix, suffix = Name.split_schema_name schema_ref in
683
+
let prefix_mod = Name.to_module_name prefix in
684
+
let suffix_mod = Name.to_module_name suffix in
685
+
if prefix_mod = current_prefix then
686
+
Printf.sprintf "%s.jsont" suffix_mod
687
+
else
688
+
Printf.sprintf "%s.%s.jsont" prefix_mod suffix_mod
689
+
690
+
let gen_operation_impl ~current_prefix (op : operation_info) : string =
691
+
let doc = format_doc_block ~summary:op.summary ?description:op.description () in
692
+
let param_docs = String.concat ""
693
+
((List.map (fun (n, _, d, _) -> format_param_doc n d) op.path_params) @
694
+
(List.map (fun (n, _, d, _) -> format_param_doc n d) op.query_params)) in
695
+
let full_doc = if param_docs = "" then doc
696
+
else if doc = "" then Printf.sprintf "(**\n%s*)\n" param_docs
697
+
else String.sub doc 0 (String.length doc - 3) ^ param_docs ^ "*)\n" in
698
+
699
+
let path_args = List.map (fun (n, _, _, _) -> Printf.sprintf "~%s" n) op.path_params in
700
+
let query_args = List.map (fun (n, _, _, req) ->
701
+
if req then Printf.sprintf "~%s" n else Printf.sprintf "?%s" n
702
+
) op.query_params in
703
+
(* DELETE and HEAD don't support body in the requests library *)
704
+
let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in
705
+
let body_arg = match op.body_schema_ref, method_supports_body with
706
+
| Some _, true -> ["~body"]
707
+
| _ -> []
708
+
in
709
+
let all_args = path_args @ query_args @ body_arg @ ["client"; "()"] in
710
+
711
+
let path_render =
712
+
if op.path_params = [] then Printf.sprintf "%S" op.path
713
+
else
714
+
let bindings = List.map (fun (ocaml, json, _, _) ->
715
+
Printf.sprintf "(%S, %s)" json ocaml
716
+
) op.path_params in
717
+
Printf.sprintf "Openapi.Runtime.Path.render ~params:[%s] %S"
718
+
(String.concat "; " bindings) op.path
719
+
in
720
+
721
+
let query_build =
722
+
if op.query_params = [] then "\"\""
723
+
else
724
+
let parts = List.map (fun (ocaml, json, _, req) ->
725
+
if req then Printf.sprintf "Openapi.Runtime.Query.singleton ~key:%S ~value:%s" json ocaml
726
+
else Printf.sprintf "Openapi.Runtime.Query.optional ~key:%S ~value:%s" json ocaml
727
+
) op.query_params in
728
+
Printf.sprintf "Openapi.Runtime.Query.encode (List.concat [%s])" (String.concat "; " parts)
729
+
in
730
+
731
+
let method_lower = String.lowercase_ascii op.method_ in
732
+
let body_codec = match op.body_schema_ref with
733
+
| Some name -> format_jsont_ref ~current_prefix name
734
+
| None -> "Jsont.json"
735
+
in
736
+
(* DELETE and HEAD don't support body in the requests library *)
737
+
let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in
738
+
let http_call = match op.body_schema_ref, method_supports_body with
739
+
| Some _, true ->
740
+
Printf.sprintf "Requests.%s client.session ~body:(Requests.Body.json (Openapi.Runtime.Json.encode_json %s body)) url"
741
+
method_lower body_codec
742
+
| Some _, false ->
743
+
(* Method doesn't support body - ignore the body parameter *)
744
+
Printf.sprintf "Requests.%s client.session url" method_lower
745
+
| None, _ ->
746
+
Printf.sprintf "Requests.%s client.session url" method_lower
747
+
in
748
+
749
+
let response_codec = match op.response_schema_ref with
750
+
| Some name -> format_jsont_ref ~current_prefix name
751
+
| None -> "Jsont.json"
752
+
in
753
+
754
+
let decode = if response_codec = "Jsont.json" then
755
+
"Requests.Response.json response"
756
+
else
757
+
Printf.sprintf "Openapi.Runtime.Json.decode_json_exn %s (Requests.Response.json response)" response_codec
758
+
in
759
+
760
+
Printf.sprintf {|%slet %s %s =
761
+
let op_name = %S in
762
+
let url_path = %s in
763
+
let query = %s in
764
+
let url = client.base_url ^ url_path ^ query in
765
+
let response =
766
+
try %s
767
+
with Eio.Io _ as ex ->
768
+
let bt = Printexc.get_raw_backtrace () in
769
+
Eio.Exn.reraise_with_context ex bt "calling %%s %%s" %S url
770
+
in
771
+
if Requests.Response.ok response then
772
+
%s
773
+
else
774
+
raise (Openapi.Runtime.Api_error {
775
+
operation = op_name;
776
+
method_ = %S;
777
+
url;
778
+
status = Requests.Response.status_code response;
779
+
body = Requests.Response.text response;
780
+
})|}
781
+
full_doc op.func_name (String.concat " " all_args)
782
+
op.func_name path_render query_build http_call op.method_ decode op.method_
783
+
784
+
(** Format a type reference, stripping the current_prefix if present *)
785
+
let format_type_ref ~current_prefix (schema_ref : string) : string =
786
+
let prefix, suffix = Name.split_schema_name schema_ref in
787
+
let prefix_mod = Name.to_module_name prefix in
788
+
let suffix_mod = Name.to_module_name suffix in
789
+
if prefix_mod = current_prefix then
790
+
(* Local reference - use unqualified name *)
791
+
Printf.sprintf "%s.t" suffix_mod
792
+
else
793
+
Printf.sprintf "%s.%s.t" prefix_mod suffix_mod
794
+
795
+
let gen_operation_intf ~current_prefix (op : operation_info) : string =
796
+
let doc = format_doc_block ~summary:op.summary ?description:op.description () in
797
+
let param_docs = String.concat ""
798
+
((List.map (fun (n, _, d, _) -> format_param_doc n d) op.path_params) @
799
+
(List.map (fun (n, _, d, _) -> format_param_doc n d) op.query_params)) in
800
+
let full_doc = if param_docs = "" then doc
801
+
else if doc = "" then Printf.sprintf "(**\n%s*)\n" param_docs
802
+
else String.sub doc 0 (String.length doc - 3) ^ param_docs ^ "*)\n" in
803
+
804
+
let path_args = List.map (fun (n, _, _, _) -> Printf.sprintf "%s:string" n) op.path_params in
805
+
let query_args = List.map (fun (n, _, _, req) ->
806
+
if req then Printf.sprintf "%s:string" n else Printf.sprintf "?%s:string" n
807
+
) op.query_params in
808
+
let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in
809
+
let body_arg = match op.body_schema_ref, method_supports_body with
810
+
| Some name, true -> [Printf.sprintf "body:%s" (format_type_ref ~current_prefix name)]
811
+
| _ -> []
812
+
in
813
+
let response_type = match op.response_schema_ref with
814
+
| Some name -> format_type_ref ~current_prefix name
815
+
| None -> "Jsont.json"
816
+
in
817
+
let all_args = path_args @ query_args @ body_arg @ ["t"; "unit"; response_type] in
818
+
819
+
Printf.sprintf "%sval %s : %s" full_doc op.func_name (String.concat " -> " all_args)
820
+
821
+
(** {1 Full Module Generation} *)
822
+
823
+
let gen_submodule_impl ~current_prefix (schema : schema_info) : string =
824
+
let suffix_mod = Name.to_module_name schema.suffix in
825
+
let content = if schema.is_enum then gen_enum_impl schema else gen_record_impl ~current_prefix schema in
826
+
let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in
827
+
Printf.sprintf "module %s = struct\n%s\nend" suffix_mod indented
828
+
829
+
let gen_submodule_intf ~current_prefix (schema : schema_info) : string =
830
+
let suffix_mod = Name.to_module_name schema.suffix in
831
+
let content = if schema.is_enum then gen_enum_intf schema else gen_record_intf ~current_prefix schema in
832
+
let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in
833
+
Printf.sprintf "module %s : sig\n%s\nend" suffix_mod indented
834
+
835
+
(** Extract suffix module dependencies within the same prefix *)
836
+
let schema_suffix_deps ~current_prefix (schema : schema_info) : string list =
837
+
List.filter_map (fun (f : field_info) ->
838
+
(* Check if the type references a sibling module (same prefix) *)
839
+
if String.contains f.base_type '.' then
840
+
match String.split_on_char '.' f.base_type with
841
+
| prefix :: suffix :: _ when prefix = current_prefix ->
842
+
Some (Name.to_module_name suffix)
843
+
| _ -> None
844
+
else None
845
+
) schema.fields
846
+
847
+
(** Sort schemas within a prefix module by their dependencies *)
848
+
let sort_schemas_by_deps ~current_prefix (schemas : schema_info list) : schema_info list =
849
+
let suffix_of schema = Name.to_module_name schema.suffix in
850
+
let suffix_names = List.map suffix_of schemas in
851
+
let deps_of suffix =
852
+
match List.find_opt (fun s -> suffix_of s = suffix) schemas with
853
+
| Some schema -> schema_suffix_deps ~current_prefix schema |> List.filter (fun d -> List.mem d suffix_names)
854
+
| None -> []
855
+
in
856
+
let sorted = topological_sort suffix_names deps_of in
857
+
List.filter_map (fun suffix ->
858
+
List.find_opt (fun s -> suffix_of s = suffix) schemas
859
+
) sorted
860
+
861
+
let gen_prefix_module_impl (node : module_node) : string =
862
+
let sorted_schemas = sort_schemas_by_deps ~current_prefix:node.name node.schemas in
863
+
let schema_mods = List.map (gen_submodule_impl ~current_prefix:node.name) sorted_schemas in
864
+
let op_impls = List.map (gen_operation_impl ~current_prefix:node.name) (List.rev node.operations) in
865
+
let content = String.concat "\n\n" (schema_mods @ op_impls) in
866
+
let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in
867
+
Printf.sprintf "module %s = struct\n%s\nend" node.name indented
868
+
869
+
let gen_prefix_module_intf (node : module_node) : string =
870
+
let sorted_schemas = sort_schemas_by_deps ~current_prefix:node.name node.schemas in
871
+
let schema_mods = List.map (gen_submodule_intf ~current_prefix:node.name) sorted_schemas in
872
+
let op_intfs = List.map (gen_operation_intf ~current_prefix:node.name) (List.rev node.operations) in
873
+
let content = String.concat "\n\n" (schema_mods @ op_intfs) in
874
+
let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in
875
+
Printf.sprintf "module %s : sig\n%s\nend" node.name indented
876
+
877
+
(** {1 Top-Level Generation} *)
878
+
879
+
type config = {
880
+
output_dir : string;
881
+
package_name : string;
882
+
spec_path : string option;
883
+
}
884
+
885
+
let generate_ml (spec : Spec.t) (package_name : string) : string =
886
+
let api_desc = Option.value ~default:"Generated API client." spec.info.description in
887
+
888
+
(* Collect schemas *)
889
+
let schemas = match spec.components with
890
+
| None -> []
891
+
| Some c -> List.filter_map (fun (name, sor) ->
892
+
match sor with
893
+
| Spec.Ref _ -> None
894
+
| Spec.Value s -> Some (analyze_schema name s)
895
+
) c.schemas
896
+
in
897
+
898
+
(* Collect operations *)
899
+
let operations = List.concat_map (fun (path, pi) ->
900
+
let ops = [
901
+
("GET", pi.Spec.get); ("POST", pi.post); ("PUT", pi.put);
902
+
("DELETE", pi.delete); ("PATCH", pi.patch);
903
+
("HEAD", pi.head); ("OPTIONS", pi.options);
904
+
] in
905
+
List.filter_map (fun (method_, op_opt) ->
906
+
Option.map (fun op -> analyze_operation ~path ~method_ op) op_opt
907
+
) ops
908
+
) spec.paths in
909
+
910
+
(* Build module tree *)
911
+
let (tree, sorted_modules) = build_module_tree schemas operations in
912
+
913
+
(* Generate top-level client type and functions *)
914
+
let client_impl = {|type t = {
915
+
session : Requests.t;
916
+
base_url : string;
917
+
}
918
+
919
+
let create ?session ~sw env ~base_url =
920
+
let session = match session with
921
+
| Some s -> s
922
+
| None -> Requests.create ~sw env
923
+
in
924
+
{ session; base_url }
925
+
926
+
let base_url t = t.base_url
927
+
let session t = t.session|} in
928
+
929
+
(* Generate prefix modules in dependency order *)
930
+
let prefix_mods = List.filter_map (fun name ->
931
+
match StringMap.find_opt name tree.children with
932
+
| None -> None
933
+
| Some node ->
934
+
if node.name = "Client" then
935
+
(* Generate Client operations inline *)
936
+
let ops = List.map (gen_operation_impl ~current_prefix:"Client") (List.rev node.operations) in
937
+
if ops = [] then None
938
+
else
939
+
let content = String.concat "\n\n" ops in
940
+
let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in
941
+
Some (Printf.sprintf "module Client = struct\n%s\nend" indented)
942
+
else
943
+
Some (gen_prefix_module_impl node)
944
+
) sorted_modules in
945
+
946
+
Printf.sprintf {|(** {1 %s}
947
+
948
+
%s
949
+
950
+
@version %s *)
951
+
952
+
%s
953
+
954
+
%s
955
+
|}
956
+
(Name.to_module_name package_name) (escape_doc api_desc) spec.info.version
957
+
client_impl (String.concat "\n\n" prefix_mods)
958
+
959
+
let generate_mli (spec : Spec.t) (package_name : string) : string =
960
+
let api_desc = Option.value ~default:"Generated API client." spec.info.description in
961
+
962
+
(* Collect schemas *)
963
+
let schemas = match spec.components with
964
+
| None -> []
965
+
| Some c -> List.filter_map (fun (name, sor) ->
966
+
match sor with
967
+
| Spec.Ref _ -> None
968
+
| Spec.Value s -> Some (analyze_schema name s)
969
+
) c.schemas
970
+
in
971
+
972
+
(* Collect operations *)
973
+
let operations = List.concat_map (fun (path, pi) ->
974
+
let ops = [
975
+
("GET", pi.Spec.get); ("POST", pi.post); ("PUT", pi.put);
976
+
("DELETE", pi.delete); ("PATCH", pi.patch);
977
+
("HEAD", pi.head); ("OPTIONS", pi.options);
978
+
] in
979
+
List.filter_map (fun (method_, op_opt) ->
980
+
Option.map (fun op -> analyze_operation ~path ~method_ op) op_opt
981
+
) ops
982
+
) spec.paths in
983
+
984
+
(* Build module tree *)
985
+
let (tree, sorted_modules) = build_module_tree schemas operations in
986
+
987
+
(* Generate top-level client type and function interfaces *)
988
+
let client_intf = {|type t
989
+
990
+
val create :
991
+
?session:Requests.t ->
992
+
sw:Eio.Switch.t ->
993
+
< net : _ Eio.Net.t ; fs : Eio.Fs.dir_ty Eio.Path.t ; clock : _ Eio.Time.clock ; .. > ->
994
+
base_url:string ->
995
+
t
996
+
997
+
val base_url : t -> string
998
+
val session : t -> Requests.t|} in
999
+
1000
+
(* Generate prefix modules in dependency order *)
1001
+
let prefix_mods = List.filter_map (fun name ->
1002
+
match StringMap.find_opt name tree.children with
1003
+
| None -> None
1004
+
| Some node ->
1005
+
if node.name = "Client" then
1006
+
let ops = List.map (gen_operation_intf ~current_prefix:"Client") (List.rev node.operations) in
1007
+
if ops = [] then None
1008
+
else
1009
+
let content = String.concat "\n\n" ops in
1010
+
let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in
1011
+
Some (Printf.sprintf "module Client : sig\n%s\nend" indented)
1012
+
else
1013
+
Some (gen_prefix_module_intf node)
1014
+
) sorted_modules in
1015
+
1016
+
Printf.sprintf {|(** {1 %s}
1017
+
1018
+
%s
1019
+
1020
+
@version %s *)
1021
+
1022
+
%s
1023
+
1024
+
%s
1025
+
|}
1026
+
(Name.to_module_name package_name) (escape_doc api_desc) spec.info.version
1027
+
client_intf (String.concat "\n\n" prefix_mods)
1028
+
1029
+
let generate_dune (package_name : string) : string =
1030
+
Printf.sprintf {|(library
1031
+
(name %s)
1032
+
(libraries openapi jsont jsont.bytesrw requests ptime eio)
1033
+
(wrapped true))
1034
+
1035
+
(include dune.inc)
1036
+
|} package_name
1037
+
1038
+
let generate_dune_inc ~(spec_path : string option) (package_name : string) : string =
1039
+
match spec_path with
1040
+
| None -> "; No spec path provided - regeneration rules not generated\n"
1041
+
| Some path ->
1042
+
Printf.sprintf {|; Generated rules for OpenAPI code regeneration
1043
+
; Run: dune build @gen --auto-promote
1044
+
1045
+
(rule
1046
+
(alias gen)
1047
+
(mode (promote (until-clean)))
1048
+
(targets %s.ml %s.mli)
1049
+
(deps %s)
1050
+
(action
1051
+
(run openapi-gen generate -o . -n %s %%{deps})))
1052
+
|} package_name package_name path package_name
1053
+
1054
+
let generate ~(config : config) (spec : Spec.t) : (string * string) list =
1055
+
let package_name = config.package_name in
1056
+
[
1057
+
("dune", generate_dune package_name);
1058
+
("dune.inc", generate_dune_inc ~spec_path:config.spec_path package_name);
1059
+
(package_name ^ ".ml", generate_ml spec package_name);
1060
+
(package_name ^ ".mli", generate_mli spec package_name);
1061
+
]
1062
+
1063
+
let write_files ~(output_dir : string) (files : (string * string) list) : unit =
1064
+
List.iter (fun (filename, content) ->
1065
+
let path = Filename.concat output_dir filename in
1066
+
let oc = open_out path in
1067
+
output_string oc content;
1068
+
close_out oc
1069
+
) files
+156
lib/openapi_nestjs.ml
+156
lib/openapi_nestjs.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** NestJS-style API error handling.
7
+
8
+
NestJS/Express applications return errors in a standard format:
9
+
{[
10
+
{
11
+
"message": "Missing required permission: person.read",
12
+
"error": "Forbidden",
13
+
"statusCode": 403,
14
+
"correlationId": "koskgk9d"
15
+
}
16
+
]}
17
+
18
+
This module provides types and utilities for parsing and handling
19
+
these errors in a structured way.
20
+
21
+
{2 Usage}
22
+
23
+
{[
24
+
match Immich.People.get_all_people client () with
25
+
| people -> ...
26
+
| exception Openapi.Runtime.Api_error e ->
27
+
match Openapi.Nestjs.of_api_error e with
28
+
| Some nestjs_error ->
29
+
Fmt.epr "Error: %s (correlation: %s)@."
30
+
nestjs_error.message
31
+
(Option.value ~default:"none" nestjs_error.correlation_id)
32
+
| None ->
33
+
(* Not a NestJS error, use raw body *)
34
+
Fmt.epr "Error: %s@." e.body
35
+
]}
36
+
*)
37
+
38
+
(** {1 Error Types} *)
39
+
40
+
(** A structured NestJS HTTP exception. *)
41
+
type t = {
42
+
status_code : int;
43
+
(** HTTP status code (e.g., 403, 404, 500). *)
44
+
45
+
error : string option;
46
+
(** Error category (e.g., "Forbidden", "Not Found", "Internal Server Error"). *)
47
+
48
+
message : string;
49
+
(** Human-readable error message. Can be a single string or concatenated
50
+
from an array of validation messages. *)
51
+
52
+
correlation_id : string option;
53
+
(** Request correlation ID for debugging/support. *)
54
+
}
55
+
56
+
(** {1 JSON Codec} *)
57
+
58
+
(** Jsont codec for NestJS errors.
59
+
60
+
Handles both string and array message formats:
61
+
- {[ "message": "error text" ]}
62
+
- {[ "message": ["validation error 1", "validation error 2"] ]} *)
63
+
let jsont : t Jsont.t =
64
+
(* Message can be string or array of strings *)
65
+
let message_jsont =
66
+
Jsont.map Jsont.json ~kind:"message"
67
+
~dec:(fun json ->
68
+
match json with
69
+
| Jsont.String (s, _) -> s
70
+
| Jsont.Array (items, _) ->
71
+
items
72
+
|> List.filter_map (function
73
+
| Jsont.String (s, _) -> Some s
74
+
| _ -> None)
75
+
|> String.concat "; "
76
+
| _ -> "Unknown error")
77
+
~enc:(fun s -> Jsont.String (s, Jsont.Meta.none))
78
+
in
79
+
Jsont.Object.map ~kind:"NestjsError"
80
+
(fun status_code error message correlation_id ->
81
+
{ status_code; error; message; correlation_id })
82
+
|> Jsont.Object.mem "statusCode" Jsont.int ~enc:(fun e -> e.status_code)
83
+
|> Jsont.Object.opt_mem "error" Jsont.string ~enc:(fun e -> e.error)
84
+
|> Jsont.Object.mem "message" message_jsont ~enc:(fun e -> e.message)
85
+
|> Jsont.Object.opt_mem "correlationId" Jsont.string ~enc:(fun e -> e.correlation_id)
86
+
|> Jsont.Object.skip_unknown
87
+
|> Jsont.Object.finish
88
+
89
+
(** {1 Parsing} *)
90
+
91
+
(** Parse a JSON string into a NestJS error.
92
+
Returns [None] if the string is not valid NestJS error JSON. *)
93
+
let of_string (s : string) : t option =
94
+
match Jsont_bytesrw.decode_string jsont s with
95
+
| Ok e -> Some e
96
+
| Error _ -> None
97
+
98
+
(** Parse an {!Openapi.Runtime.Api_error} into a structured NestJS error.
99
+
Returns [None] if the error body is not valid NestJS error JSON. *)
100
+
let of_api_error (e : Openapi_runtime.api_error) : t option =
101
+
of_string e.body
102
+
103
+
(** {1 Convenience Functions} *)
104
+
105
+
(** Check if this is a permission/authorization error (401 or 403). *)
106
+
let is_auth_error (e : t) : bool =
107
+
e.status_code = 401 || e.status_code = 403
108
+
109
+
(** Check if this is a "not found" error (404). *)
110
+
let is_not_found (e : t) : bool =
111
+
e.status_code = 404
112
+
113
+
(** Check if this is a validation error (400 with message array). *)
114
+
let is_validation_error (e : t) : bool =
115
+
e.status_code = 400
116
+
117
+
(** Check if this is a server error (5xx). *)
118
+
let is_server_error (e : t) : bool =
119
+
e.status_code >= 500 && e.status_code < 600
120
+
121
+
(** {1 Pretty Printing} *)
122
+
123
+
(** Pretty-print a NestJS error. *)
124
+
let pp ppf (e : t) =
125
+
match e.correlation_id with
126
+
| Some cid ->
127
+
Format.fprintf ppf "%s [%d] (correlationId: %s)"
128
+
e.message e.status_code cid
129
+
| None ->
130
+
Format.fprintf ppf "%s [%d]" e.message e.status_code
131
+
132
+
(** Convert to a human-readable string. *)
133
+
let to_string (e : t) : string =
134
+
Format.asprintf "%a" pp e
135
+
136
+
(** {1 Exception Handling} *)
137
+
138
+
(** Exception for NestJS-specific errors.
139
+
Use this when you want to distinguish NestJS errors from generic API errors. *)
140
+
exception Error of t
141
+
142
+
(** Register a pretty printer for the exception. *)
143
+
let () =
144
+
Printexc.register_printer (function
145
+
| Error e -> Some (Format.asprintf "Nestjs.Error: %a" pp e)
146
+
| _ -> None)
147
+
148
+
(** Handle an {!Openapi.Runtime.Api_error}, converting it to a NestJS error
149
+
if possible.
150
+
151
+
@raise Error if the error body parses as a NestJS error
152
+
@raise Openapi.Runtime.Api_error if parsing fails (re-raises original) *)
153
+
let raise_if_nestjs (e : Openapi_runtime.api_error) =
154
+
match of_api_error e with
155
+
| Some nestjs -> raise (Error nestjs)
156
+
| None -> raise (Openapi_runtime.Api_error e)
+104
lib/openapi_nestjs.mli
+104
lib/openapi_nestjs.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** NestJS-style API error handling.
7
+
8
+
NestJS/Express applications return errors in a standard format:
9
+
{[
10
+
{
11
+
"message": "Missing required permission: person.read",
12
+
"error": "Forbidden",
13
+
"statusCode": 403,
14
+
"correlationId": "koskgk9d"
15
+
}
16
+
]}
17
+
18
+
This module provides types and utilities for parsing and handling
19
+
these errors in a structured way.
20
+
21
+
{2 Usage}
22
+
23
+
{[
24
+
match Immich.People.get_all_people client () with
25
+
| people -> ...
26
+
| exception Openapi.Runtime.Api_error e ->
27
+
match Openapi.Nestjs.of_api_error e with
28
+
| Some nestjs_error ->
29
+
Fmt.epr "Error: %s (correlation: %s)@."
30
+
nestjs_error.message
31
+
(Option.value ~default:"none" nestjs_error.correlation_id)
32
+
| None ->
33
+
(* Not a NestJS error, use raw body *)
34
+
Fmt.epr "Error: %s@." e.body
35
+
]}
36
+
*)
37
+
38
+
(** {1 Error Types} *)
39
+
40
+
(** A structured NestJS HTTP exception. *)
41
+
type t = {
42
+
status_code : int;
43
+
(** HTTP status code (e.g., 403, 404, 500). *)
44
+
45
+
error : string option;
46
+
(** Error category (e.g., "Forbidden", "Not Found", "Internal Server Error"). *)
47
+
48
+
message : string;
49
+
(** Human-readable error message. Can be a single string or concatenated
50
+
from an array of validation messages. *)
51
+
52
+
correlation_id : string option;
53
+
(** Request correlation ID for debugging/support. *)
54
+
}
55
+
56
+
(** {1 JSON Codec} *)
57
+
58
+
val jsont : t Jsont.t
59
+
(** Jsont codec for NestJS errors. *)
60
+
61
+
(** {1 Parsing} *)
62
+
63
+
val of_string : string -> t option
64
+
(** Parse a JSON string into a NestJS error.
65
+
Returns [None] if the string is not valid NestJS error JSON. *)
66
+
67
+
val of_api_error : Openapi_runtime.api_error -> t option
68
+
(** Parse an {!Openapi_runtime.api_error} into a structured NestJS error.
69
+
Returns [None] if the error body is not valid NestJS error JSON. *)
70
+
71
+
(** {1 Convenience Functions} *)
72
+
73
+
val is_auth_error : t -> bool
74
+
(** Check if this is a permission/authorization error (401 or 403). *)
75
+
76
+
val is_not_found : t -> bool
77
+
(** Check if this is a "not found" error (404). *)
78
+
79
+
val is_validation_error : t -> bool
80
+
(** Check if this is a validation error (400 with message array). *)
81
+
82
+
val is_server_error : t -> bool
83
+
(** Check if this is a server error (5xx). *)
84
+
85
+
(** {1 Pretty Printing} *)
86
+
87
+
val pp : Format.formatter -> t -> unit
88
+
(** Pretty-print a NestJS error. *)
89
+
90
+
val to_string : t -> string
91
+
(** Convert to a human-readable string. *)
92
+
93
+
(** {1 Exception Handling} *)
94
+
95
+
exception Error of t
96
+
(** Exception for NestJS-specific errors.
97
+
Use this when you want to distinguish NestJS errors from generic API errors. *)
98
+
99
+
val raise_if_nestjs : Openapi_runtime.api_error -> 'a
100
+
(** Handle an {!Openapi_runtime.api_error}, converting it to a NestJS error
101
+
if possible.
102
+
103
+
@raise Error if the error body parses as a NestJS error
104
+
@raise Openapi_runtime.Api_error if parsing fails (re-raises original) *)
+200
lib/openapi_runtime.ml
+200
lib/openapi_runtime.ml
···
1
+
(** Runtime utilities for generated OpenAPI clients.
2
+
3
+
This module provides utilities used by generated client code:
4
+
- Path template rendering
5
+
- Query parameter building
6
+
- JSON encoding/decoding helpers
7
+
*)
8
+
9
+
(** {1 Path Templates} *)
10
+
11
+
module Path = struct
12
+
(** Render a path template like "/users/{id}/posts/{postId}" with parameters *)
13
+
let render ~(params : (string * string) list) (template : string) : string =
14
+
List.fold_left
15
+
(fun path (name, value) ->
16
+
match String.split_on_char '{' path with
17
+
| [only] -> only
18
+
| parts ->
19
+
String.concat "" (List.mapi (fun i part ->
20
+
if i = 0 then part
21
+
else
22
+
match String.split_on_char '}' part with
23
+
| [var; rest] when var = name -> value ^ rest
24
+
| _ -> "{" ^ part
25
+
) parts))
26
+
template params
27
+
28
+
(** Extract parameter names from a path template *)
29
+
let parameters (template : string) : string list =
30
+
let rec extract acc s =
31
+
match String.index_opt s '{' with
32
+
| None -> List.rev acc
33
+
| Some i ->
34
+
let rest = String.sub s (i + 1) (String.length s - i - 1) in
35
+
match String.index_opt rest '}' with
36
+
| None -> List.rev acc
37
+
| Some j ->
38
+
let name = String.sub rest 0 j in
39
+
let remaining = String.sub rest (j + 1) (String.length rest - j - 1) in
40
+
extract (name :: acc) remaining
41
+
in
42
+
extract [] template
43
+
end
44
+
45
+
(** {1 Query Parameters} *)
46
+
47
+
module Query = struct
48
+
type param = string * string
49
+
50
+
(** Helper for optional parameters with custom stringifier *)
51
+
let optional_with ~key ~value ~to_string : param list =
52
+
Option.fold ~none:[] ~some:(fun v -> [(key, to_string v)]) value
53
+
54
+
let singleton ~key ~value : param list = [(key, value)]
55
+
56
+
let optional ~key ~value : param list =
57
+
optional_with ~key ~value ~to_string:Fun.id
58
+
59
+
let list ~key ~values : param list =
60
+
List.map (fun v -> (key, v)) values
61
+
62
+
let int ~key ~value : param list = [(key, string_of_int value)]
63
+
64
+
let int_opt ~key ~value : param list =
65
+
optional_with ~key ~value ~to_string:string_of_int
66
+
67
+
let bool ~key ~value : param list =
68
+
[(key, if value then "true" else "false")]
69
+
70
+
let bool_opt ~key ~value : param list =
71
+
optional_with ~key ~value ~to_string:(fun b -> if b then "true" else "false")
72
+
73
+
let float ~key ~value : param list = [(key, string_of_float value)]
74
+
75
+
let float_opt ~key ~value : param list =
76
+
optional_with ~key ~value ~to_string:string_of_float
77
+
78
+
let encode (params : param list) : string =
79
+
if params = [] then ""
80
+
else
81
+
"?" ^
82
+
String.concat "&" (List.map (fun (k, v) ->
83
+
(* URL encode the value *)
84
+
let encode_char c =
85
+
match c with
86
+
| 'A'..'Z' | 'a'..'z' | '0'..'9' | '-' | '_' | '.' | '~' ->
87
+
String.make 1 c
88
+
| c ->
89
+
Printf.sprintf "%%%02X" (Char.code c)
90
+
in
91
+
let encoded_v = String.to_seq v
92
+
|> Seq.map encode_char
93
+
|> List.of_seq
94
+
|> String.concat ""
95
+
in
96
+
k ^ "=" ^ encoded_v
97
+
) params)
98
+
end
99
+
100
+
(** {1 JSON Helpers} *)
101
+
102
+
module Json = struct
103
+
let decode codec s =
104
+
Jsont_bytesrw.decode_string codec s
105
+
106
+
let decode' codec s =
107
+
Jsont_bytesrw.decode_string' codec s
108
+
109
+
let encode codec v =
110
+
Jsont_bytesrw.encode_string codec v
111
+
112
+
let encode' codec v =
113
+
Jsont_bytesrw.encode_string' codec v
114
+
115
+
let encode_compact codec v =
116
+
Jsont_bytesrw.encode_string ~format:Jsont.Minify codec v
117
+
118
+
(** Decode a Jsont.json value through a codec.
119
+
Encodes to string then decodes - not optimal but works. *)
120
+
let decode_json (codec : 'a Jsont.t) (json : Jsont.json) : ('a, string) result =
121
+
match Jsont_bytesrw.encode_string Jsont.json json with
122
+
| Ok s -> Jsont_bytesrw.decode_string codec s
123
+
| Error e -> Error e
124
+
125
+
(** Decode a Jsont.json value, raising on error *)
126
+
let decode_json_exn (codec : 'a Jsont.t) (json : Jsont.json) : 'a =
127
+
match decode_json codec json with
128
+
| Ok v -> v
129
+
| Error e -> failwith e
130
+
131
+
(** Encode a value to Jsont.json *)
132
+
let encode_json (codec : 'a Jsont.t) (v : 'a) : Jsont.json =
133
+
match Jsont_bytesrw.encode_string codec v with
134
+
| Ok s ->
135
+
(match Jsont_bytesrw.decode_string Jsont.json s with
136
+
| Ok json -> json
137
+
| Error _ -> Jsont.Null ((), Jsont.Meta.none))
138
+
| Error _ -> Jsont.Null ((), Jsont.Meta.none)
139
+
end
140
+
141
+
(** {1 HTTP Method} *)
142
+
143
+
type http_method = Get | Post | Put | Patch | Delete | Head | Options
144
+
145
+
let string_of_method = function
146
+
| Get -> "GET"
147
+
| Post -> "POST"
148
+
| Put -> "PUT"
149
+
| Patch -> "PATCH"
150
+
| Delete -> "DELETE"
151
+
| Head -> "HEAD"
152
+
| Options -> "OPTIONS"
153
+
154
+
(** {1 Common Types} *)
155
+
156
+
(** ISO 8601 date-time codec *)
157
+
let ptime_jsont : Ptime.t Jsont.t =
158
+
Jsont.map Jsont.string ~kind:"datetime"
159
+
~dec:(fun s ->
160
+
match Ptime.of_rfc3339 s with
161
+
| Ok (t, _, _) -> t
162
+
| Error _ -> Jsont.Error.msgf Jsont.Meta.none "Invalid datetime: %s" s)
163
+
~enc:(fun t -> Ptime.to_rfc3339 t)
164
+
165
+
(** UUID as string *)
166
+
let uuid_jsont : string Jsont.t = Jsont.string
167
+
168
+
(** Base64 encoded bytes *)
169
+
let base64_jsont : string Jsont.t = Jsont.string
170
+
171
+
(** {1 Nullable wrapper} *)
172
+
173
+
let nullable (codec : 'a Jsont.t) : 'a option Jsont.t =
174
+
Jsont.option codec
175
+
176
+
(** {1 Any JSON value wrapper} *)
177
+
178
+
type json = Jsont.json
179
+
180
+
let json_jsont : json Jsont.t = Jsont.json
181
+
182
+
(** {1 API Errors} *)
183
+
184
+
(** Error raised when an API call fails with a non-2xx status code *)
185
+
type api_error = {
186
+
operation : string;
187
+
method_ : string;
188
+
url : string;
189
+
status : int;
190
+
body : string;
191
+
}
192
+
193
+
exception Api_error of api_error
194
+
195
+
let () =
196
+
Printexc.register_printer (function
197
+
| Api_error e ->
198
+
Some (Printf.sprintf "Api_error: %s %s returned %d: %s"
199
+
e.method_ e.url e.status e.body)
200
+
| _ -> None)
+876
lib/openapi_spec.ml
+876
lib/openapi_spec.ml
···
1
+
(** OpenAPI 3.x specification types with jsont codecs.
2
+
3
+
This module defines types that mirror the OpenAPI 3.0/3.1 specification,
4
+
with bidirectional JSON codecs using jsont. *)
5
+
6
+
(** {1 Reference handling} *)
7
+
8
+
type 'a or_ref =
9
+
| Ref of string (** A $ref pointer like "#/components/schemas/Pet" *)
10
+
| Value of 'a (** An inline value *)
11
+
12
+
(** Find a member by name in an object's member list *)
13
+
let find_member name (mems : Jsont.mem list) : Jsont.json option =
14
+
List.find_map (fun ((n, _meta), v) ->
15
+
if n = name then Some v else None
16
+
) mems
17
+
18
+
(** Create an or_ref codec that handles $ref pointers.
19
+
Uses JSON as intermediate to detect $ref field. *)
20
+
let or_ref_jsont (value_jsont : 'a Jsont.t) : 'a or_ref Jsont.t =
21
+
Jsont.map Jsont.json ~kind:"or_ref"
22
+
~dec:(fun json ->
23
+
match json with
24
+
| Jsont.Object (mems, _meta) ->
25
+
(match find_member "$ref" mems with
26
+
| Some (Jsont.String (ref_str, _)) -> Ref ref_str
27
+
| _ ->
28
+
(* Not a $ref, decode as value using bytesrw *)
29
+
match Jsont_bytesrw.decode_string value_jsont
30
+
(Result.get_ok (Jsont_bytesrw.encode_string Jsont.json json)) with
31
+
| Ok v -> Value v
32
+
| Error e -> Jsont.Error.msg Jsont.Meta.none e)
33
+
| _ ->
34
+
(* Non-object, decode as value *)
35
+
match Jsont_bytesrw.decode_string value_jsont
36
+
(Result.get_ok (Jsont_bytesrw.encode_string Jsont.json json)) with
37
+
| Ok v -> Value v
38
+
| Error e -> Jsont.Error.msg Jsont.Meta.none e)
39
+
~enc:(function
40
+
| Ref r -> Jsont.Object ([(("$ref", Jsont.Meta.none), Jsont.String (r, Jsont.Meta.none))], Jsont.Meta.none)
41
+
| Value v ->
42
+
match Jsont_bytesrw.encode_string value_jsont v with
43
+
| Ok s ->
44
+
(match Jsont_bytesrw.decode_string Jsont.json s with
45
+
| Ok json -> json
46
+
| Error _ -> Jsont.Null ((), Jsont.Meta.none))
47
+
| Error _ -> Jsont.Null ((), Jsont.Meta.none))
48
+
49
+
(** {1 String Map} *)
50
+
51
+
module StringMap = Map.Make(String)
52
+
53
+
let string_map_jsont (value_jsont : 'a Jsont.t) : (string * 'a) list Jsont.t =
54
+
let map_jsont = Jsont.Object.as_string_map value_jsont in
55
+
Jsont.map ~kind:"string_map"
56
+
~dec:(fun m -> StringMap.bindings m)
57
+
~enc:(fun pairs -> List.fold_left (fun m (k, v) -> StringMap.add k v m) StringMap.empty pairs)
58
+
map_jsont
59
+
60
+
(** {1 Contact} *)
61
+
62
+
type contact = {
63
+
name : string option;
64
+
url : string option;
65
+
email : string option;
66
+
}
67
+
68
+
let contact_jsont : contact Jsont.t =
69
+
Jsont.Object.map ~kind:"Contact"
70
+
(fun name url email -> { name; url; email })
71
+
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun c -> c.name)
72
+
|> Jsont.Object.opt_mem "url" Jsont.string ~enc:(fun c -> c.url)
73
+
|> Jsont.Object.opt_mem "email" Jsont.string ~enc:(fun c -> c.email)
74
+
|> Jsont.Object.skip_unknown
75
+
|> Jsont.Object.finish
76
+
77
+
(** {1 License} *)
78
+
79
+
type license = {
80
+
name : string;
81
+
url : string option;
82
+
}
83
+
84
+
let license_jsont : license Jsont.t =
85
+
Jsont.Object.map ~kind:"License"
86
+
(fun name url -> { name; url })
87
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun l -> l.name)
88
+
|> Jsont.Object.opt_mem "url" Jsont.string ~enc:(fun l -> l.url)
89
+
|> Jsont.Object.skip_unknown
90
+
|> Jsont.Object.finish
91
+
92
+
(** {1 Info} *)
93
+
94
+
type info = {
95
+
title : string;
96
+
description : string option;
97
+
terms_of_service : string option;
98
+
contact : contact option;
99
+
license : license option;
100
+
version : string;
101
+
}
102
+
103
+
let info_jsont : info Jsont.t =
104
+
Jsont.Object.map ~kind:"Info"
105
+
(fun title description terms_of_service contact license version ->
106
+
{ title; description; terms_of_service; contact; license; version })
107
+
|> Jsont.Object.mem "title" Jsont.string ~enc:(fun i -> i.title)
108
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun i -> i.description)
109
+
|> Jsont.Object.opt_mem "termsOfService" Jsont.string ~enc:(fun i -> i.terms_of_service)
110
+
|> Jsont.Object.opt_mem "contact" contact_jsont ~enc:(fun i -> i.contact)
111
+
|> Jsont.Object.opt_mem "license" license_jsont ~enc:(fun i -> i.license)
112
+
|> Jsont.Object.mem "version" Jsont.string ~enc:(fun i -> i.version)
113
+
|> Jsont.Object.skip_unknown
114
+
|> Jsont.Object.finish
115
+
116
+
(** {1 Server} *)
117
+
118
+
type server_variable = {
119
+
enum : string list option;
120
+
default : string;
121
+
description : string option;
122
+
}
123
+
124
+
let server_variable_jsont : server_variable Jsont.t =
125
+
Jsont.Object.map ~kind:"ServerVariable"
126
+
(fun enum default description -> { enum; default; description })
127
+
|> Jsont.Object.opt_mem "enum" Jsont.(list string) ~enc:(fun sv -> sv.enum)
128
+
|> Jsont.Object.mem "default" Jsont.string ~enc:(fun sv -> sv.default)
129
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun sv -> sv.description)
130
+
|> Jsont.Object.skip_unknown
131
+
|> Jsont.Object.finish
132
+
133
+
type server = {
134
+
url : string;
135
+
description : string option;
136
+
variables : (string * server_variable) list;
137
+
}
138
+
139
+
let server_jsont : server Jsont.t =
140
+
Jsont.Object.map ~kind:"Server"
141
+
(fun url description variables -> { url; description; variables })
142
+
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun s -> s.url)
143
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun s -> s.description)
144
+
|> Jsont.Object.mem "variables" (string_map_jsont server_variable_jsont)
145
+
~dec_absent:[] ~enc:(fun s -> s.variables)
146
+
|> Jsont.Object.skip_unknown
147
+
|> Jsont.Object.finish
148
+
149
+
(** {1 External Documentation} *)
150
+
151
+
type external_docs = {
152
+
description : string option;
153
+
url : string;
154
+
}
155
+
156
+
let external_docs_jsont : external_docs Jsont.t =
157
+
Jsont.Object.map ~kind:"ExternalDocs"
158
+
(fun description url -> { description; url })
159
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun ed -> ed.description)
160
+
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun ed -> ed.url)
161
+
|> Jsont.Object.skip_unknown
162
+
|> Jsont.Object.finish
163
+
164
+
(** {1 Tag} *)
165
+
166
+
type tag = {
167
+
name : string;
168
+
description : string option;
169
+
external_docs : external_docs option;
170
+
}
171
+
172
+
let tag_jsont : tag Jsont.t =
173
+
Jsont.Object.map ~kind:"Tag"
174
+
(fun name description external_docs -> { name; description; external_docs })
175
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun t -> t.name)
176
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun t -> t.description)
177
+
|> Jsont.Object.opt_mem "externalDocs" external_docs_jsont ~enc:(fun t -> t.external_docs)
178
+
|> Jsont.Object.skip_unknown
179
+
|> Jsont.Object.finish
180
+
181
+
(** {1 Discriminator} *)
182
+
183
+
type discriminator = {
184
+
property_name : string;
185
+
mapping : (string * string) list;
186
+
}
187
+
188
+
let discriminator_jsont : discriminator Jsont.t =
189
+
Jsont.Object.map ~kind:"Discriminator"
190
+
(fun property_name mapping -> { property_name; mapping })
191
+
|> Jsont.Object.mem "propertyName" Jsont.string ~enc:(fun d -> d.property_name)
192
+
|> Jsont.Object.mem "mapping" (string_map_jsont Jsont.string)
193
+
~dec_absent:[] ~enc:(fun d -> d.mapping)
194
+
|> Jsont.Object.skip_unknown
195
+
|> Jsont.Object.finish
196
+
197
+
(** {1 Schema}
198
+
199
+
JSON Schema with OpenAPI extensions. We use a simplified approach
200
+
where references are stored as schema or_ref. *)
201
+
202
+
type schema = {
203
+
title : string option;
204
+
description : string option;
205
+
type_ : string option;
206
+
format : string option;
207
+
default : Jsont.json option;
208
+
nullable : bool;
209
+
read_only : bool;
210
+
write_only : bool;
211
+
deprecated : bool;
212
+
(* Validation *)
213
+
enum : Jsont.json list option;
214
+
const : Jsont.json option;
215
+
minimum : float option;
216
+
maximum : float option;
217
+
exclusive_minimum : float option;
218
+
exclusive_maximum : float option;
219
+
multiple_of : float option;
220
+
min_length : int option;
221
+
max_length : int option;
222
+
pattern : string option;
223
+
min_items : int option;
224
+
max_items : int option;
225
+
unique_items : bool;
226
+
min_properties : int option;
227
+
max_properties : int option;
228
+
(* Composition - stored as JSON for simplicity *)
229
+
all_of : Jsont.json list option;
230
+
one_of : Jsont.json list option;
231
+
any_of : Jsont.json list option;
232
+
not_ : Jsont.json option;
233
+
(* Object - stored as JSON for simplicity *)
234
+
properties : (string * Jsont.json) list;
235
+
required : string list;
236
+
additional_properties : Jsont.json option;
237
+
(* Array *)
238
+
items : Jsont.json option;
239
+
(* Discriminator *)
240
+
discriminator : discriminator option;
241
+
(* Examples *)
242
+
example : Jsont.json option;
243
+
}
244
+
245
+
let empty_schema = {
246
+
title = None; description = None; type_ = None; format = None; default = None;
247
+
nullable = false; read_only = false; write_only = false; deprecated = false;
248
+
enum = None; const = None; minimum = None; maximum = None;
249
+
exclusive_minimum = None; exclusive_maximum = None; multiple_of = None;
250
+
min_length = None; max_length = None; pattern = None;
251
+
min_items = None; max_items = None; unique_items = false;
252
+
min_properties = None; max_properties = None;
253
+
all_of = None; one_of = None; any_of = None; not_ = None;
254
+
properties = []; required = []; additional_properties = None;
255
+
items = None; discriminator = None; example = None;
256
+
}
257
+
258
+
let schema_jsont : schema Jsont.t =
259
+
Jsont.Object.map ~kind:"Schema"
260
+
(fun title description type_ format default nullable read_only write_only
261
+
deprecated enum const minimum maximum exclusive_minimum exclusive_maximum
262
+
multiple_of min_length max_length pattern min_items max_items unique_items
263
+
min_properties max_properties all_of one_of any_of not_ properties required
264
+
additional_properties items discriminator example ->
265
+
{ title; description; type_; format; default; nullable; read_only; write_only;
266
+
deprecated; enum; const; minimum; maximum; exclusive_minimum; exclusive_maximum;
267
+
multiple_of; min_length; max_length; pattern; min_items; max_items; unique_items;
268
+
min_properties; max_properties; all_of; one_of; any_of; not_; properties; required;
269
+
additional_properties; items; discriminator; example })
270
+
|> Jsont.Object.opt_mem "title" Jsont.string ~enc:(fun s -> s.title)
271
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun s -> s.description)
272
+
|> Jsont.Object.opt_mem "type" Jsont.string ~enc:(fun s -> s.type_)
273
+
|> Jsont.Object.opt_mem "format" Jsont.string ~enc:(fun s -> s.format)
274
+
|> Jsont.Object.opt_mem "default" Jsont.json ~enc:(fun s -> s.default)
275
+
|> Jsont.Object.mem "nullable" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.nullable)
276
+
|> Jsont.Object.mem "readOnly" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.read_only)
277
+
|> Jsont.Object.mem "writeOnly" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.write_only)
278
+
|> Jsont.Object.mem "deprecated" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.deprecated)
279
+
|> Jsont.Object.opt_mem "enum" Jsont.(list json) ~enc:(fun s -> s.enum)
280
+
|> Jsont.Object.opt_mem "const" Jsont.json ~enc:(fun s -> s.const)
281
+
|> Jsont.Object.opt_mem "minimum" Jsont.number ~enc:(fun s -> s.minimum)
282
+
|> Jsont.Object.opt_mem "maximum" Jsont.number ~enc:(fun s -> s.maximum)
283
+
|> Jsont.Object.opt_mem "exclusiveMinimum" Jsont.number ~enc:(fun s -> s.exclusive_minimum)
284
+
|> Jsont.Object.opt_mem "exclusiveMaximum" Jsont.number ~enc:(fun s -> s.exclusive_maximum)
285
+
|> Jsont.Object.opt_mem "multipleOf" Jsont.number ~enc:(fun s -> s.multiple_of)
286
+
|> Jsont.Object.opt_mem "minLength" Jsont.int ~enc:(fun s -> s.min_length)
287
+
|> Jsont.Object.opt_mem "maxLength" Jsont.int ~enc:(fun s -> s.max_length)
288
+
|> Jsont.Object.opt_mem "pattern" Jsont.string ~enc:(fun s -> s.pattern)
289
+
|> Jsont.Object.opt_mem "minItems" Jsont.int ~enc:(fun s -> s.min_items)
290
+
|> Jsont.Object.opt_mem "maxItems" Jsont.int ~enc:(fun s -> s.max_items)
291
+
|> Jsont.Object.mem "uniqueItems" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.unique_items)
292
+
|> Jsont.Object.opt_mem "minProperties" Jsont.int ~enc:(fun s -> s.min_properties)
293
+
|> Jsont.Object.opt_mem "maxProperties" Jsont.int ~enc:(fun s -> s.max_properties)
294
+
|> Jsont.Object.opt_mem "allOf" Jsont.(list json) ~enc:(fun s -> s.all_of)
295
+
|> Jsont.Object.opt_mem "oneOf" Jsont.(list json) ~enc:(fun s -> s.one_of)
296
+
|> Jsont.Object.opt_mem "anyOf" Jsont.(list json) ~enc:(fun s -> s.any_of)
297
+
|> Jsont.Object.opt_mem "not" Jsont.json ~enc:(fun s -> s.not_)
298
+
|> Jsont.Object.mem "properties" (string_map_jsont Jsont.json)
299
+
~dec_absent:[] ~enc:(fun s -> s.properties)
300
+
|> Jsont.Object.mem "required" Jsont.(list string)
301
+
~dec_absent:[] ~enc:(fun s -> s.required)
302
+
|> Jsont.Object.opt_mem "additionalProperties" Jsont.json
303
+
~enc:(fun s -> s.additional_properties)
304
+
|> Jsont.Object.opt_mem "items" Jsont.json ~enc:(fun s -> s.items)
305
+
|> Jsont.Object.opt_mem "discriminator" discriminator_jsont ~enc:(fun s -> s.discriminator)
306
+
|> Jsont.Object.opt_mem "example" Jsont.json ~enc:(fun s -> s.example)
307
+
|> Jsont.Object.skip_unknown
308
+
|> Jsont.Object.finish
309
+
310
+
let schema_or_ref_jsont = or_ref_jsont schema_jsont
311
+
312
+
(** {1 Parameter} *)
313
+
314
+
type parameter_location = Query | Header | Path | Cookie
315
+
316
+
let parameter_location_jsont : parameter_location Jsont.t =
317
+
Jsont.map Jsont.string ~kind:"parameter_location"
318
+
~dec:(function
319
+
| "query" -> Query
320
+
| "header" -> Header
321
+
| "path" -> Path
322
+
| "cookie" -> Cookie
323
+
| s -> Jsont.Error.msgf Jsont.Meta.none "Unknown parameter location: %s" s)
324
+
~enc:(function
325
+
| Query -> "query"
326
+
| Header -> "header"
327
+
| Path -> "path"
328
+
| Cookie -> "cookie")
329
+
330
+
type parameter_style =
331
+
| Matrix | Label | Form | Simple | SpaceDelimited
332
+
| PipeDelimited | DeepObject
333
+
334
+
let parameter_style_jsont : parameter_style Jsont.t =
335
+
Jsont.map Jsont.string ~kind:"parameter_style"
336
+
~dec:(function
337
+
| "matrix" -> Matrix
338
+
| "label" -> Label
339
+
| "form" -> Form
340
+
| "simple" -> Simple
341
+
| "spaceDelimited" -> SpaceDelimited
342
+
| "pipeDelimited" -> PipeDelimited
343
+
| "deepObject" -> DeepObject
344
+
| s -> Jsont.Error.msgf Jsont.Meta.none "Unknown parameter style: %s" s)
345
+
~enc:(function
346
+
| Matrix -> "matrix"
347
+
| Label -> "label"
348
+
| Form -> "form"
349
+
| Simple -> "simple"
350
+
| SpaceDelimited -> "spaceDelimited"
351
+
| PipeDelimited -> "pipeDelimited"
352
+
| DeepObject -> "deepObject")
353
+
354
+
(** {1 Example} *)
355
+
356
+
type example = {
357
+
summary : string option;
358
+
description : string option;
359
+
value : Jsont.json option;
360
+
external_value : string option;
361
+
}
362
+
363
+
let example_jsont : example Jsont.t =
364
+
Jsont.Object.map ~kind:"Example"
365
+
(fun summary description value external_value ->
366
+
{ summary; description; value; external_value })
367
+
|> Jsont.Object.opt_mem "summary" Jsont.string ~enc:(fun e -> e.summary)
368
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun e -> e.description)
369
+
|> Jsont.Object.opt_mem "value" Jsont.json ~enc:(fun e -> e.value)
370
+
|> Jsont.Object.opt_mem "externalValue" Jsont.string ~enc:(fun e -> e.external_value)
371
+
|> Jsont.Object.skip_unknown
372
+
|> Jsont.Object.finish
373
+
374
+
let example_or_ref_jsont = or_ref_jsont example_jsont
375
+
376
+
(** {1 Header} *)
377
+
378
+
type header = {
379
+
description : string option;
380
+
required : bool;
381
+
deprecated : bool;
382
+
schema : schema or_ref option;
383
+
}
384
+
385
+
let header_jsont : header Jsont.t =
386
+
Jsont.Object.map ~kind:"Header"
387
+
(fun description required deprecated schema ->
388
+
{ description; required; deprecated; schema })
389
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun h -> h.description)
390
+
|> Jsont.Object.mem "required" Jsont.bool ~dec_absent:false ~enc:(fun h -> h.required)
391
+
|> Jsont.Object.mem "deprecated" Jsont.bool ~dec_absent:false ~enc:(fun h -> h.deprecated)
392
+
|> Jsont.Object.opt_mem "schema" schema_or_ref_jsont ~enc:(fun h -> h.schema)
393
+
|> Jsont.Object.skip_unknown
394
+
|> Jsont.Object.finish
395
+
396
+
let header_or_ref_jsont = or_ref_jsont header_jsont
397
+
398
+
(** {1 Encoding} *)
399
+
400
+
type encoding = {
401
+
content_type : string option;
402
+
headers : (string * header or_ref) list;
403
+
style : parameter_style option;
404
+
explode : bool option;
405
+
allow_reserved : bool;
406
+
}
407
+
408
+
let encoding_jsont : encoding Jsont.t =
409
+
Jsont.Object.map ~kind:"Encoding"
410
+
(fun content_type headers style explode allow_reserved ->
411
+
{ content_type; headers; style; explode; allow_reserved })
412
+
|> Jsont.Object.opt_mem "contentType" Jsont.string ~enc:(fun e -> e.content_type)
413
+
|> Jsont.Object.mem "headers" (string_map_jsont header_or_ref_jsont)
414
+
~dec_absent:[] ~enc:(fun e -> e.headers)
415
+
|> Jsont.Object.opt_mem "style" parameter_style_jsont ~enc:(fun e -> e.style)
416
+
|> Jsont.Object.opt_mem "explode" Jsont.bool ~enc:(fun e -> e.explode)
417
+
|> Jsont.Object.mem "allowReserved" Jsont.bool ~dec_absent:false ~enc:(fun e -> e.allow_reserved)
418
+
|> Jsont.Object.skip_unknown
419
+
|> Jsont.Object.finish
420
+
421
+
(** {1 Media Type} *)
422
+
423
+
type media_type = {
424
+
schema : schema or_ref option;
425
+
example : Jsont.json option;
426
+
examples : (string * example or_ref) list;
427
+
encoding : (string * encoding) list;
428
+
}
429
+
430
+
let media_type_jsont : media_type Jsont.t =
431
+
Jsont.Object.map ~kind:"MediaType"
432
+
(fun schema example examples encoding ->
433
+
{ schema; example; examples; encoding })
434
+
|> Jsont.Object.opt_mem "schema" schema_or_ref_jsont ~enc:(fun mt -> mt.schema)
435
+
|> Jsont.Object.opt_mem "example" Jsont.json ~enc:(fun mt -> mt.example)
436
+
|> Jsont.Object.mem "examples" (string_map_jsont example_or_ref_jsont)
437
+
~dec_absent:[] ~enc:(fun mt -> mt.examples)
438
+
|> Jsont.Object.mem "encoding" (string_map_jsont encoding_jsont)
439
+
~dec_absent:[] ~enc:(fun mt -> mt.encoding)
440
+
|> Jsont.Object.skip_unknown
441
+
|> Jsont.Object.finish
442
+
443
+
(** {1 Parameter} *)
444
+
445
+
type parameter = {
446
+
name : string;
447
+
in_ : parameter_location;
448
+
description : string option;
449
+
required : bool;
450
+
deprecated : bool;
451
+
allow_empty_value : bool;
452
+
style : parameter_style option;
453
+
explode : bool option;
454
+
allow_reserved : bool;
455
+
schema : schema or_ref option;
456
+
example : Jsont.json option;
457
+
content : (string * media_type) list;
458
+
}
459
+
460
+
let parameter_jsont : parameter Jsont.t =
461
+
Jsont.Object.map ~kind:"Parameter"
462
+
(fun name in_ description required deprecated allow_empty_value style
463
+
explode allow_reserved schema example content ->
464
+
{ name; in_; description; required; deprecated; allow_empty_value;
465
+
style; explode; allow_reserved; schema; example; content })
466
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)
467
+
|> Jsont.Object.mem "in" parameter_location_jsont ~enc:(fun p -> p.in_)
468
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun p -> p.description)
469
+
|> Jsont.Object.mem "required" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.required)
470
+
|> Jsont.Object.mem "deprecated" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.deprecated)
471
+
|> Jsont.Object.mem "allowEmptyValue" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.allow_empty_value)
472
+
|> Jsont.Object.opt_mem "style" parameter_style_jsont ~enc:(fun p -> p.style)
473
+
|> Jsont.Object.opt_mem "explode" Jsont.bool ~enc:(fun p -> p.explode)
474
+
|> Jsont.Object.mem "allowReserved" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.allow_reserved)
475
+
|> Jsont.Object.opt_mem "schema" schema_or_ref_jsont ~enc:(fun p -> p.schema)
476
+
|> Jsont.Object.opt_mem "example" Jsont.json ~enc:(fun p -> p.example)
477
+
|> Jsont.Object.mem "content" (string_map_jsont media_type_jsont)
478
+
~dec_absent:[] ~enc:(fun p -> p.content)
479
+
|> Jsont.Object.skip_unknown
480
+
|> Jsont.Object.finish
481
+
482
+
let parameter_or_ref_jsont = or_ref_jsont parameter_jsont
483
+
484
+
(** {1 Request Body} *)
485
+
486
+
type request_body = {
487
+
description : string option;
488
+
content : (string * media_type) list;
489
+
required : bool;
490
+
}
491
+
492
+
let request_body_jsont : request_body Jsont.t =
493
+
Jsont.Object.map ~kind:"RequestBody"
494
+
(fun description content required -> { description; content; required })
495
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun rb -> rb.description)
496
+
|> Jsont.Object.mem "content" (string_map_jsont media_type_jsont)
497
+
~dec_absent:[] ~enc:(fun rb -> rb.content)
498
+
|> Jsont.Object.mem "required" Jsont.bool ~dec_absent:false ~enc:(fun rb -> rb.required)
499
+
|> Jsont.Object.skip_unknown
500
+
|> Jsont.Object.finish
501
+
502
+
let request_body_or_ref_jsont = or_ref_jsont request_body_jsont
503
+
504
+
(** {1 Link} *)
505
+
506
+
type link = {
507
+
operation_ref : string option;
508
+
operation_id : string option;
509
+
parameters : (string * Jsont.json) list;
510
+
request_body : Jsont.json option;
511
+
description : string option;
512
+
server : server option;
513
+
}
514
+
515
+
let link_jsont : link Jsont.t =
516
+
Jsont.Object.map ~kind:"Link"
517
+
(fun operation_ref operation_id parameters request_body description server ->
518
+
{ operation_ref; operation_id; parameters; request_body; description; server })
519
+
|> Jsont.Object.opt_mem "operationRef" Jsont.string ~enc:(fun l -> l.operation_ref)
520
+
|> Jsont.Object.opt_mem "operationId" Jsont.string ~enc:(fun l -> l.operation_id)
521
+
|> Jsont.Object.mem "parameters" (string_map_jsont Jsont.json)
522
+
~dec_absent:[] ~enc:(fun l -> l.parameters)
523
+
|> Jsont.Object.opt_mem "requestBody" Jsont.json ~enc:(fun l -> l.request_body)
524
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun l -> l.description)
525
+
|> Jsont.Object.opt_mem "server" server_jsont ~enc:(fun l -> l.server)
526
+
|> Jsont.Object.skip_unknown
527
+
|> Jsont.Object.finish
528
+
529
+
let link_or_ref_jsont = or_ref_jsont link_jsont
530
+
531
+
(** {1 Response} *)
532
+
533
+
type response = {
534
+
description : string;
535
+
headers : (string * header or_ref) list;
536
+
content : (string * media_type) list;
537
+
links : (string * link or_ref) list;
538
+
}
539
+
540
+
let response_jsont : response Jsont.t =
541
+
Jsont.Object.map ~kind:"Response"
542
+
(fun description headers content links ->
543
+
{ description; headers; content; links })
544
+
|> Jsont.Object.mem "description" Jsont.string ~dec_absent:"" ~enc:(fun r -> r.description)
545
+
|> Jsont.Object.mem "headers" (string_map_jsont header_or_ref_jsont)
546
+
~dec_absent:[] ~enc:(fun r -> r.headers)
547
+
|> Jsont.Object.mem "content" (string_map_jsont media_type_jsont)
548
+
~dec_absent:[] ~enc:(fun r -> r.content)
549
+
|> Jsont.Object.mem "links" (string_map_jsont link_or_ref_jsont)
550
+
~dec_absent:[] ~enc:(fun r -> r.links)
551
+
|> Jsont.Object.skip_unknown
552
+
|> Jsont.Object.finish
553
+
554
+
let response_or_ref_jsont = or_ref_jsont response_jsont
555
+
556
+
(** {1 Responses} *)
557
+
558
+
type responses = {
559
+
default : response or_ref option;
560
+
responses : (string * response or_ref) list; (* status code -> response *)
561
+
}
562
+
563
+
let responses_jsont : responses Jsont.t =
564
+
(* Responses is an object where keys are status codes or "default" *)
565
+
Jsont.map (Jsont.Object.as_string_map response_or_ref_jsont) ~kind:"Responses"
566
+
~dec:(fun m ->
567
+
let default = StringMap.find_opt "default" m in
568
+
let responses =
569
+
StringMap.bindings m
570
+
|> List.filter (fun (k, _) -> k <> "default")
571
+
in
572
+
{ default; responses })
573
+
~enc:(fun r ->
574
+
let m = List.fold_left (fun m (k, v) -> StringMap.add k v m) StringMap.empty r.responses in
575
+
match r.default with
576
+
| Some d -> StringMap.add "default" d m
577
+
| None -> m)
578
+
579
+
(** {1 Security Requirement} *)
580
+
581
+
type security_requirement = (string * string list) list
582
+
583
+
let security_requirement_jsont : security_requirement Jsont.t =
584
+
string_map_jsont Jsont.(list string)
585
+
586
+
(** {1 Callback - simplified to JSON} *)
587
+
588
+
type callback = Jsont.json
589
+
590
+
let callback_jsont : callback Jsont.t = Jsont.json
591
+
let callback_or_ref_jsont = or_ref_jsont callback_jsont
592
+
593
+
(** {1 Operation} *)
594
+
595
+
type operation = {
596
+
tags : string list;
597
+
summary : string option;
598
+
description : string option;
599
+
external_docs : external_docs option;
600
+
operation_id : string option;
601
+
parameters : parameter or_ref list;
602
+
request_body : request_body or_ref option;
603
+
responses : responses;
604
+
callbacks : (string * callback or_ref) list;
605
+
deprecated : bool;
606
+
security : security_requirement list option;
607
+
servers : server list;
608
+
}
609
+
610
+
let operation_jsont : operation Jsont.t =
611
+
Jsont.Object.map ~kind:"Operation"
612
+
(fun tags summary description external_docs operation_id parameters
613
+
request_body responses callbacks deprecated security servers ->
614
+
{ tags; summary; description; external_docs; operation_id; parameters;
615
+
request_body; responses; callbacks; deprecated; security; servers })
616
+
|> Jsont.Object.mem "tags" Jsont.(list string) ~dec_absent:[] ~enc:(fun o -> o.tags)
617
+
|> Jsont.Object.opt_mem "summary" Jsont.string ~enc:(fun o -> o.summary)
618
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun o -> o.description)
619
+
|> Jsont.Object.opt_mem "externalDocs" external_docs_jsont ~enc:(fun o -> o.external_docs)
620
+
|> Jsont.Object.opt_mem "operationId" Jsont.string ~enc:(fun o -> o.operation_id)
621
+
|> Jsont.Object.mem "parameters" Jsont.(list parameter_or_ref_jsont)
622
+
~dec_absent:[] ~enc:(fun o -> o.parameters)
623
+
|> Jsont.Object.opt_mem "requestBody" request_body_or_ref_jsont ~enc:(fun o -> o.request_body)
624
+
|> Jsont.Object.mem "responses" responses_jsont
625
+
~dec_absent:{ default = None; responses = [] } ~enc:(fun o -> o.responses)
626
+
|> Jsont.Object.mem "callbacks" (string_map_jsont callback_or_ref_jsont)
627
+
~dec_absent:[] ~enc:(fun o -> o.callbacks)
628
+
|> Jsont.Object.mem "deprecated" Jsont.bool ~dec_absent:false ~enc:(fun o -> o.deprecated)
629
+
|> Jsont.Object.opt_mem "security" Jsont.(list security_requirement_jsont)
630
+
~enc:(fun o -> o.security)
631
+
|> Jsont.Object.mem "servers" Jsont.(list server_jsont)
632
+
~dec_absent:[] ~enc:(fun o -> o.servers)
633
+
|> Jsont.Object.skip_unknown
634
+
|> Jsont.Object.finish
635
+
636
+
(** {1 Path Item} *)
637
+
638
+
type path_item = {
639
+
ref_ : string option;
640
+
summary : string option;
641
+
description : string option;
642
+
get : operation option;
643
+
put : operation option;
644
+
post : operation option;
645
+
delete : operation option;
646
+
options : operation option;
647
+
head : operation option;
648
+
patch : operation option;
649
+
trace : operation option;
650
+
servers : server list;
651
+
parameters : parameter or_ref list;
652
+
}
653
+
654
+
let path_item_jsont : path_item Jsont.t =
655
+
Jsont.Object.map ~kind:"PathItem"
656
+
(fun ref_ summary description get put post delete options head patch trace
657
+
servers parameters ->
658
+
{ ref_; summary; description; get; put; post; delete; options; head;
659
+
patch; trace; servers; parameters })
660
+
|> Jsont.Object.opt_mem "$ref" Jsont.string ~enc:(fun pi -> pi.ref_)
661
+
|> Jsont.Object.opt_mem "summary" Jsont.string ~enc:(fun pi -> pi.summary)
662
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun pi -> pi.description)
663
+
|> Jsont.Object.opt_mem "get" operation_jsont ~enc:(fun pi -> pi.get)
664
+
|> Jsont.Object.opt_mem "put" operation_jsont ~enc:(fun pi -> pi.put)
665
+
|> Jsont.Object.opt_mem "post" operation_jsont ~enc:(fun pi -> pi.post)
666
+
|> Jsont.Object.opt_mem "delete" operation_jsont ~enc:(fun pi -> pi.delete)
667
+
|> Jsont.Object.opt_mem "options" operation_jsont ~enc:(fun pi -> pi.options)
668
+
|> Jsont.Object.opt_mem "head" operation_jsont ~enc:(fun pi -> pi.head)
669
+
|> Jsont.Object.opt_mem "patch" operation_jsont ~enc:(fun pi -> pi.patch)
670
+
|> Jsont.Object.opt_mem "trace" operation_jsont ~enc:(fun pi -> pi.trace)
671
+
|> Jsont.Object.mem "servers" Jsont.(list server_jsont)
672
+
~dec_absent:[] ~enc:(fun pi -> pi.servers)
673
+
|> Jsont.Object.mem "parameters" Jsont.(list parameter_or_ref_jsont)
674
+
~dec_absent:[] ~enc:(fun pi -> pi.parameters)
675
+
|> Jsont.Object.skip_unknown
676
+
|> Jsont.Object.finish
677
+
678
+
let path_item_or_ref_jsont = or_ref_jsont path_item_jsont
679
+
680
+
(** {1 Security Scheme} *)
681
+
682
+
type security_scheme_type =
683
+
| ApiKey
684
+
| Http
685
+
| OAuth2
686
+
| OpenIdConnect
687
+
688
+
let security_scheme_type_jsont : security_scheme_type Jsont.t =
689
+
Jsont.map Jsont.string ~kind:"security_scheme_type"
690
+
~dec:(function
691
+
| "apiKey" -> ApiKey
692
+
| "http" -> Http
693
+
| "oauth2" -> OAuth2
694
+
| "openIdConnect" -> OpenIdConnect
695
+
| s -> Jsont.Error.msgf Jsont.Meta.none "Unknown security scheme type: %s" s)
696
+
~enc:(function
697
+
| ApiKey -> "apiKey"
698
+
| Http -> "http"
699
+
| OAuth2 -> "oauth2"
700
+
| OpenIdConnect -> "openIdConnect")
701
+
702
+
type oauth_flow = {
703
+
authorization_url : string option;
704
+
token_url : string option;
705
+
refresh_url : string option;
706
+
scopes : (string * string) list;
707
+
}
708
+
709
+
let oauth_flow_jsont : oauth_flow Jsont.t =
710
+
Jsont.Object.map ~kind:"OAuthFlow"
711
+
(fun authorization_url token_url refresh_url scopes ->
712
+
{ authorization_url; token_url; refresh_url; scopes })
713
+
|> Jsont.Object.opt_mem "authorizationUrl" Jsont.string ~enc:(fun f -> f.authorization_url)
714
+
|> Jsont.Object.opt_mem "tokenUrl" Jsont.string ~enc:(fun f -> f.token_url)
715
+
|> Jsont.Object.opt_mem "refreshUrl" Jsont.string ~enc:(fun f -> f.refresh_url)
716
+
|> Jsont.Object.mem "scopes" (string_map_jsont Jsont.string)
717
+
~dec_absent:[] ~enc:(fun f -> f.scopes)
718
+
|> Jsont.Object.skip_unknown
719
+
|> Jsont.Object.finish
720
+
721
+
type oauth_flows = {
722
+
implicit : oauth_flow option;
723
+
password : oauth_flow option;
724
+
client_credentials : oauth_flow option;
725
+
authorization_code : oauth_flow option;
726
+
}
727
+
728
+
let oauth_flows_jsont : oauth_flows Jsont.t =
729
+
Jsont.Object.map ~kind:"OAuthFlows"
730
+
(fun implicit password client_credentials authorization_code ->
731
+
{ implicit; password; client_credentials; authorization_code })
732
+
|> Jsont.Object.opt_mem "implicit" oauth_flow_jsont ~enc:(fun f -> f.implicit)
733
+
|> Jsont.Object.opt_mem "password" oauth_flow_jsont ~enc:(fun f -> f.password)
734
+
|> Jsont.Object.opt_mem "clientCredentials" oauth_flow_jsont ~enc:(fun f -> f.client_credentials)
735
+
|> Jsont.Object.opt_mem "authorizationCode" oauth_flow_jsont ~enc:(fun f -> f.authorization_code)
736
+
|> Jsont.Object.skip_unknown
737
+
|> Jsont.Object.finish
738
+
739
+
type security_scheme = {
740
+
type_ : security_scheme_type;
741
+
description : string option;
742
+
name : string option;
743
+
in_ : parameter_location option;
744
+
scheme : string option;
745
+
bearer_format : string option;
746
+
flows : oauth_flows option;
747
+
open_id_connect_url : string option;
748
+
}
749
+
750
+
let security_scheme_jsont : security_scheme Jsont.t =
751
+
Jsont.Object.map ~kind:"SecurityScheme"
752
+
(fun type_ description name in_ scheme bearer_format flows open_id_connect_url ->
753
+
{ type_; description; name; in_; scheme; bearer_format; flows; open_id_connect_url })
754
+
|> Jsont.Object.mem "type" security_scheme_type_jsont ~enc:(fun ss -> ss.type_)
755
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun ss -> ss.description)
756
+
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun ss -> ss.name)
757
+
|> Jsont.Object.opt_mem "in" parameter_location_jsont ~enc:(fun ss -> ss.in_)
758
+
|> Jsont.Object.opt_mem "scheme" Jsont.string ~enc:(fun ss -> ss.scheme)
759
+
|> Jsont.Object.opt_mem "bearerFormat" Jsont.string ~enc:(fun ss -> ss.bearer_format)
760
+
|> Jsont.Object.opt_mem "flows" oauth_flows_jsont ~enc:(fun ss -> ss.flows)
761
+
|> Jsont.Object.opt_mem "openIdConnectUrl" Jsont.string ~enc:(fun ss -> ss.open_id_connect_url)
762
+
|> Jsont.Object.skip_unknown
763
+
|> Jsont.Object.finish
764
+
765
+
let security_scheme_or_ref_jsont = or_ref_jsont security_scheme_jsont
766
+
767
+
(** {1 Components} *)
768
+
769
+
type components = {
770
+
schemas : (string * schema or_ref) list;
771
+
responses : (string * response or_ref) list;
772
+
parameters : (string * parameter or_ref) list;
773
+
examples : (string * example or_ref) list;
774
+
request_bodies : (string * request_body or_ref) list;
775
+
headers : (string * header or_ref) list;
776
+
security_schemes : (string * security_scheme or_ref) list;
777
+
links : (string * link or_ref) list;
778
+
callbacks : (string * callback or_ref) list;
779
+
path_items : (string * path_item or_ref) list;
780
+
}
781
+
782
+
let components_jsont : components Jsont.t =
783
+
Jsont.Object.map ~kind:"Components"
784
+
(fun schemas responses parameters examples request_bodies headers
785
+
security_schemes links callbacks path_items ->
786
+
{ schemas; responses; parameters; examples; request_bodies;
787
+
headers; security_schemes; links; callbacks; path_items })
788
+
|> Jsont.Object.mem "schemas" (string_map_jsont schema_or_ref_jsont)
789
+
~dec_absent:[] ~enc:(fun c -> c.schemas)
790
+
|> Jsont.Object.mem "responses" (string_map_jsont response_or_ref_jsont)
791
+
~dec_absent:[] ~enc:(fun c -> c.responses)
792
+
|> Jsont.Object.mem "parameters" (string_map_jsont parameter_or_ref_jsont)
793
+
~dec_absent:[] ~enc:(fun c -> c.parameters)
794
+
|> Jsont.Object.mem "examples" (string_map_jsont example_or_ref_jsont)
795
+
~dec_absent:[] ~enc:(fun c -> c.examples)
796
+
|> Jsont.Object.mem "requestBodies" (string_map_jsont request_body_or_ref_jsont)
797
+
~dec_absent:[] ~enc:(fun c -> c.request_bodies)
798
+
|> Jsont.Object.mem "headers" (string_map_jsont header_or_ref_jsont)
799
+
~dec_absent:[] ~enc:(fun c -> c.headers)
800
+
|> Jsont.Object.mem "securitySchemes" (string_map_jsont security_scheme_or_ref_jsont)
801
+
~dec_absent:[] ~enc:(fun c -> c.security_schemes)
802
+
|> Jsont.Object.mem "links" (string_map_jsont link_or_ref_jsont)
803
+
~dec_absent:[] ~enc:(fun c -> c.links)
804
+
|> Jsont.Object.mem "callbacks" (string_map_jsont callback_or_ref_jsont)
805
+
~dec_absent:[] ~enc:(fun c -> c.callbacks)
806
+
|> Jsont.Object.mem "pathItems" (string_map_jsont path_item_or_ref_jsont)
807
+
~dec_absent:[] ~enc:(fun c -> c.path_items)
808
+
|> Jsont.Object.skip_unknown
809
+
|> Jsont.Object.finish
810
+
811
+
(** {1 OpenAPI Document} *)
812
+
813
+
type t = {
814
+
openapi : string;
815
+
info : info;
816
+
servers : server list;
817
+
paths : (string * path_item) list;
818
+
webhooks : (string * path_item or_ref) list;
819
+
components : components option;
820
+
security : security_requirement list;
821
+
tags : tag list;
822
+
external_docs : external_docs option;
823
+
}
824
+
825
+
let jsont : t Jsont.t =
826
+
Jsont.Object.map ~kind:"OpenAPI"
827
+
(fun openapi info servers paths webhooks components security tags external_docs ->
828
+
{ openapi; info; servers; paths; webhooks; components; security; tags; external_docs })
829
+
|> Jsont.Object.mem "openapi" Jsont.string ~enc:(fun t -> t.openapi)
830
+
|> Jsont.Object.mem "info" info_jsont ~enc:(fun t -> t.info)
831
+
|> Jsont.Object.mem "servers" Jsont.(list server_jsont)
832
+
~dec_absent:[] ~enc:(fun t -> t.servers)
833
+
|> Jsont.Object.mem "paths" (string_map_jsont path_item_jsont)
834
+
~dec_absent:[] ~enc:(fun t -> t.paths)
835
+
|> Jsont.Object.mem "webhooks" (string_map_jsont path_item_or_ref_jsont)
836
+
~dec_absent:[] ~enc:(fun t -> t.webhooks)
837
+
|> Jsont.Object.opt_mem "components" components_jsont ~enc:(fun t -> t.components)
838
+
|> Jsont.Object.mem "security" Jsont.(list security_requirement_jsont)
839
+
~dec_absent:[] ~enc:(fun t -> t.security)
840
+
|> Jsont.Object.mem "tags" Jsont.(list tag_jsont)
841
+
~dec_absent:[] ~enc:(fun t -> t.tags)
842
+
|> Jsont.Object.opt_mem "externalDocs" external_docs_jsont ~enc:(fun t -> t.external_docs)
843
+
|> Jsont.Object.skip_unknown
844
+
|> Jsont.Object.finish
845
+
846
+
(** {1 Parsing} *)
847
+
848
+
let of_string s =
849
+
Jsont_bytesrw.decode_string jsont s
850
+
851
+
let of_string' s =
852
+
Jsont_bytesrw.decode_string' jsont s
853
+
854
+
let to_string t =
855
+
Jsont_bytesrw.encode_string ~format:Jsont.Indent jsont t
856
+
857
+
let to_string' t =
858
+
Jsont_bytesrw.encode_string' ~format:Jsont.Indent jsont t
859
+
860
+
(** {1 Reference Resolution} *)
861
+
862
+
let resolve_schema_ref (ref_str : string) (spec : t) : schema option =
863
+
(* Parse $ref like "#/components/schemas/Pet" *)
864
+
if not (String.length ref_str > 0 && ref_str.[0] = '#') then None
865
+
else
866
+
let parts = String.split_on_char '/' ref_str in
867
+
match parts with
868
+
| ["#"; "components"; "schemas"; name] ->
869
+
(match spec.components with
870
+
| None -> None
871
+
| Some c ->
872
+
match List.assoc_opt name c.schemas with
873
+
| Some (Value s) -> Some s
874
+
| Some (Ref _) -> None (* nested refs not supported yet *)
875
+
| None -> None)
876
+
| _ -> None
+39
openapi.opam
+39
openapi.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "OpenAPI code generator for OCaml with requests and jsont"
4
+
description: """
5
+
Generate type-safe OCaml API clients from OpenAPI 3.x specifications.
6
+
Uses the requests HTTP library and jsont for JSON codecs."""
7
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
8
+
authors: ["Anil Madhavapeddy"]
9
+
license: "ISC"
10
+
homepage: "https://tangled.org/@anil.recoil.org/ocaml-openapi"
11
+
bug-reports: "https://tangled.org/anil.recoil.org/ocaml-openapi/issues"
12
+
depends: [
13
+
"dune" {>= "3.21"}
14
+
"ocaml" {>= "5.1.0"}
15
+
"jsont"
16
+
"bytesrw"
17
+
"fmt"
18
+
"logs"
19
+
"ptime"
20
+
"cmdliner" {>= "1.2.0"}
21
+
"odoc" {with-doc}
22
+
"alcotest" {with-test}
23
+
]
24
+
build: [
25
+
["dune" "subst"] {dev}
26
+
[
27
+
"dune"
28
+
"build"
29
+
"-p"
30
+
name
31
+
"-j"
32
+
jobs
33
+
"@install"
34
+
"@runtest" {with-test}
35
+
"@doc" {with-doc}
36
+
]
37
+
]
38
+
dev-repo: "git+https://tangled.org/anil.recoil.org/ocaml-openapi"
39
+
x-maintenance-intent: ["(latest)"]
+341
test/test_openapi.ml
+341
test/test_openapi.ml
···
1
+
(** Tests for ocaml-openapi *)
2
+
3
+
module Spec = Openapi.Spec
4
+
module Codegen = Openapi.Codegen
5
+
module Runtime = Openapi.Runtime
6
+
7
+
(** {1 Path Template Tests} *)
8
+
9
+
let test_path_render_simple () =
10
+
let result = Runtime.Path.render ~params:[] "/users" in
11
+
Alcotest.(check string) "no params" "/users" result
12
+
13
+
let test_path_render_one_param () =
14
+
let result = Runtime.Path.render ~params:[("id", "123")] "/users/{id}" in
15
+
Alcotest.(check string) "one param" "/users/123" result
16
+
17
+
let test_path_render_multiple_params () =
18
+
let result = Runtime.Path.render
19
+
~params:[("userId", "42"); ("postId", "99")]
20
+
"/users/{userId}/posts/{postId}" in
21
+
Alcotest.(check string) "multiple params" "/users/42/posts/99" result
22
+
23
+
let test_path_parameters () =
24
+
let params = Runtime.Path.parameters "/users/{userId}/posts/{postId}" in
25
+
Alcotest.(check (list string)) "extract params" ["userId"; "postId"] params
26
+
27
+
(** {1 Query Parameter Tests} *)
28
+
29
+
let test_query_singleton () =
30
+
let params = Runtime.Query.singleton ~key:"name" ~value:"alice" in
31
+
Alcotest.(check (list (pair string string))) "singleton" [("name", "alice")] params
32
+
33
+
let test_query_optional_some () =
34
+
let params = Runtime.Query.optional ~key:"name" ~value:(Some "alice") in
35
+
Alcotest.(check (list (pair string string))) "optional some" [("name", "alice")] params
36
+
37
+
let test_query_optional_none () =
38
+
let params = Runtime.Query.optional ~key:"name" ~value:None in
39
+
Alcotest.(check (list (pair string string))) "optional none" [] params
40
+
41
+
let test_query_encode_empty () =
42
+
let result = Runtime.Query.encode [] in
43
+
Alcotest.(check string) "empty query" "" result
44
+
45
+
let test_query_encode_single () =
46
+
let result = Runtime.Query.encode [("name", "alice")] in
47
+
Alcotest.(check string) "single query" "?name=alice" result
48
+
49
+
let test_query_encode_multiple () =
50
+
let result = Runtime.Query.encode [("name", "alice"); ("age", "30")] in
51
+
Alcotest.(check string) "multiple query" "?name=alice&age=30" result
52
+
53
+
let test_query_encode_special_chars () =
54
+
let result = Runtime.Query.encode [("q", "hello world")] in
55
+
Alcotest.(check string) "special chars" "?q=hello%20world" result
56
+
57
+
(** {1 Name Conversion Tests} *)
58
+
59
+
let test_snake_case_simple () =
60
+
let result = Codegen.Name.to_snake_case "getUserById" in
61
+
Alcotest.(check string) "camel to snake" "get_user_by_id" result
62
+
63
+
let test_snake_case_with_dashes () =
64
+
let result = Codegen.Name.to_snake_case "user-name" in
65
+
Alcotest.(check string) "dashes to underscore" "user_name" result
66
+
67
+
let test_snake_case_reserved () =
68
+
let result = Codegen.Name.to_snake_case "type" in
69
+
Alcotest.(check string) "reserved word" "type_" result
70
+
71
+
let test_module_name () =
72
+
let result = Codegen.Name.to_module_name "user_profile" in
73
+
Alcotest.(check string) "module name" "UserProfile" result
74
+
75
+
let test_variant_name () =
76
+
let result = Codegen.Name.to_variant_name "active_user" in
77
+
Alcotest.(check string) "variant name" "Active_user" result
78
+
79
+
(** {1 Spec Parsing Tests} *)
80
+
81
+
let minimal_spec = {|{
82
+
"openapi": "3.0.0",
83
+
"info": {
84
+
"title": "Test API",
85
+
"version": "1.0.0"
86
+
},
87
+
"paths": {}
88
+
}|}
89
+
90
+
let test_parse_minimal_spec () =
91
+
match Spec.of_string minimal_spec with
92
+
| Error e -> Alcotest.fail e
93
+
| Ok spec ->
94
+
Alcotest.(check string) "openapi version" "3.0.0" spec.openapi;
95
+
Alcotest.(check string) "title" "Test API" spec.info.title;
96
+
Alcotest.(check string) "version" "1.0.0" spec.info.version
97
+
98
+
let spec_with_schema = {|{
99
+
"openapi": "3.0.0",
100
+
"info": {
101
+
"title": "Test API",
102
+
"version": "1.0.0"
103
+
},
104
+
"paths": {},
105
+
"components": {
106
+
"schemas": {
107
+
"User": {
108
+
"type": "object",
109
+
"properties": {
110
+
"id": { "type": "integer" },
111
+
"name": { "type": "string" },
112
+
"email": { "type": "string", "format": "email" }
113
+
},
114
+
"required": ["id", "name"]
115
+
}
116
+
}
117
+
}
118
+
}|}
119
+
120
+
let test_parse_schema () =
121
+
match Spec.of_string spec_with_schema with
122
+
| Error e -> Alcotest.fail e
123
+
| Ok spec ->
124
+
match spec.components with
125
+
| None -> Alcotest.fail "expected components"
126
+
| Some c ->
127
+
Alcotest.(check int) "schema count" 1 (List.length c.schemas);
128
+
match List.assoc_opt "User" c.schemas with
129
+
| None -> Alcotest.fail "expected User schema"
130
+
| Some (Spec.Ref _) -> Alcotest.fail "expected value not ref"
131
+
| Some (Spec.Value s) ->
132
+
Alcotest.(check (option string)) "type" (Some "object") s.type_;
133
+
Alcotest.(check int) "properties" 3 (List.length s.properties);
134
+
Alcotest.(check (list string)) "required" ["id"; "name"] s.required
135
+
136
+
let spec_with_enum = {|{
137
+
"openapi": "3.0.0",
138
+
"info": {
139
+
"title": "Test API",
140
+
"version": "1.0.0"
141
+
},
142
+
"paths": {},
143
+
"components": {
144
+
"schemas": {
145
+
"Status": {
146
+
"type": "string",
147
+
"enum": ["active", "inactive", "pending"]
148
+
}
149
+
}
150
+
}
151
+
}|}
152
+
153
+
let test_parse_enum () =
154
+
match Spec.of_string spec_with_enum with
155
+
| Error e -> Alcotest.fail e
156
+
| Ok spec ->
157
+
match spec.components with
158
+
| None -> Alcotest.fail "expected components"
159
+
| Some c ->
160
+
match List.assoc_opt "Status" c.schemas with
161
+
| None -> Alcotest.fail "expected Status schema"
162
+
| Some (Spec.Ref _) -> Alcotest.fail "expected value not ref"
163
+
| Some (Spec.Value s) ->
164
+
match s.enum with
165
+
| None -> Alcotest.fail "expected enum"
166
+
| Some values ->
167
+
Alcotest.(check int) "enum count" 3 (List.length values)
168
+
169
+
let spec_with_paths = {|{
170
+
"openapi": "3.0.0",
171
+
"info": {
172
+
"title": "Test API",
173
+
"version": "1.0.0"
174
+
},
175
+
"paths": {
176
+
"/users": {
177
+
"get": {
178
+
"operationId": "listUsers",
179
+
"summary": "List all users",
180
+
"responses": {
181
+
"200": {
182
+
"description": "Success"
183
+
}
184
+
}
185
+
},
186
+
"post": {
187
+
"operationId": "createUser",
188
+
"summary": "Create a user",
189
+
"responses": {
190
+
"201": {
191
+
"description": "Created"
192
+
}
193
+
}
194
+
}
195
+
},
196
+
"/users/{id}": {
197
+
"get": {
198
+
"operationId": "getUser",
199
+
"parameters": [
200
+
{
201
+
"name": "id",
202
+
"in": "path",
203
+
"required": true,
204
+
"schema": { "type": "integer" }
205
+
}
206
+
],
207
+
"responses": {
208
+
"200": {
209
+
"description": "Success"
210
+
}
211
+
}
212
+
}
213
+
}
214
+
}
215
+
}|}
216
+
217
+
let test_parse_paths () =
218
+
match Spec.of_string spec_with_paths with
219
+
| Error e -> Alcotest.fail e
220
+
| Ok spec ->
221
+
Alcotest.(check int) "path count" 2 (List.length spec.paths);
222
+
match List.assoc_opt "/users" spec.paths with
223
+
| None -> Alcotest.fail "expected /users path"
224
+
| Some path_item ->
225
+
(match path_item.get with
226
+
| None -> Alcotest.fail "expected GET"
227
+
| Some op ->
228
+
Alcotest.(check (option string)) "operation id" (Some "listUsers") op.operation_id);
229
+
(match path_item.post with
230
+
| None -> Alcotest.fail "expected POST"
231
+
| Some op ->
232
+
Alcotest.(check (option string)) "operation id" (Some "createUser") op.operation_id)
233
+
234
+
(** {1 Code Generation Tests} *)
235
+
236
+
let contains_substring s sub =
237
+
let len_s = String.length s in
238
+
let len_sub = String.length sub in
239
+
if len_sub > len_s then false
240
+
else
241
+
let rec check i =
242
+
if i > len_s - len_sub then false
243
+
else if String.sub s i len_sub = sub then true
244
+
else check (i + 1)
245
+
in
246
+
check 0
247
+
248
+
let test_split_schema_name () =
249
+
let p, s = Codegen.Name.split_schema_name "AlbumResponseDto" in
250
+
Alcotest.(check string) "prefix" "Album" p;
251
+
Alcotest.(check string) "suffix" "ResponseDto" s
252
+
253
+
let test_split_schema_name_no_suffix () =
254
+
let p, s = Codegen.Name.split_schema_name "User" in
255
+
Alcotest.(check string) "prefix" "User" p;
256
+
Alcotest.(check string) "suffix" "T" s
257
+
258
+
let test_generate_files () =
259
+
match Spec.of_string spec_with_schema with
260
+
| Error e -> Alcotest.fail e
261
+
| Ok spec ->
262
+
let config = Codegen.{
263
+
output_dir = ".";
264
+
package_name = "test_api";
265
+
spec_path = None;
266
+
} in
267
+
let files = Codegen.generate ~config spec in
268
+
Alcotest.(check int) "file count" 4 (List.length files);
269
+
let ml = List.assoc_opt "test_api.ml" files in
270
+
(match ml with
271
+
| None -> Alcotest.fail "missing .ml file"
272
+
| Some content ->
273
+
Alcotest.(check bool) "contains module User" true
274
+
(contains_substring content "module User"))
275
+
276
+
let test_generate_enum_schema () =
277
+
match Spec.of_string spec_with_enum with
278
+
| Error e -> Alcotest.fail e
279
+
| Ok spec ->
280
+
let config = Codegen.{
281
+
output_dir = ".";
282
+
package_name = "test_enum";
283
+
spec_path = None;
284
+
} in
285
+
let files = Codegen.generate ~config spec in
286
+
let ml = List.assoc_opt "test_enum.ml" files in
287
+
(match ml with
288
+
| None -> Alcotest.fail "missing .ml file"
289
+
| Some content ->
290
+
Alcotest.(check bool) "contains Active variant" true
291
+
(contains_substring content "Active"))
292
+
293
+
(** {1 Test Suites} *)
294
+
295
+
let path_tests = [
296
+
"render simple", `Quick, test_path_render_simple;
297
+
"render one param", `Quick, test_path_render_one_param;
298
+
"render multiple params", `Quick, test_path_render_multiple_params;
299
+
"extract parameters", `Quick, test_path_parameters;
300
+
]
301
+
302
+
let query_tests = [
303
+
"singleton", `Quick, test_query_singleton;
304
+
"optional some", `Quick, test_query_optional_some;
305
+
"optional none", `Quick, test_query_optional_none;
306
+
"encode empty", `Quick, test_query_encode_empty;
307
+
"encode single", `Quick, test_query_encode_single;
308
+
"encode multiple", `Quick, test_query_encode_multiple;
309
+
"encode special chars", `Quick, test_query_encode_special_chars;
310
+
]
311
+
312
+
let name_tests = [
313
+
"snake case simple", `Quick, test_snake_case_simple;
314
+
"snake case dashes", `Quick, test_snake_case_with_dashes;
315
+
"snake case reserved", `Quick, test_snake_case_reserved;
316
+
"module name", `Quick, test_module_name;
317
+
"variant name", `Quick, test_variant_name;
318
+
]
319
+
320
+
let spec_tests = [
321
+
"parse minimal", `Quick, test_parse_minimal_spec;
322
+
"parse schema", `Quick, test_parse_schema;
323
+
"parse enum", `Quick, test_parse_enum;
324
+
"parse paths", `Quick, test_parse_paths;
325
+
]
326
+
327
+
let codegen_tests = [
328
+
"split schema name", `Quick, test_split_schema_name;
329
+
"split schema name no suffix", `Quick, test_split_schema_name_no_suffix;
330
+
"generate files", `Quick, test_generate_files;
331
+
"generate enum schema", `Quick, test_generate_enum_schema;
332
+
]
333
+
334
+
let () =
335
+
Alcotest.run "openapi" [
336
+
"Path", path_tests;
337
+
"Query", query_tests;
338
+
"Name", name_tests;
339
+
"Spec", spec_tests;
340
+
"Codegen", codegen_tests;
341
+
]