-70

ocaml-openapi/CLAUDE.md

reviewed

··· 1 1 - # OCaml OpenAPI 2 2 - 3 3 - OpenAPI code generator for OCaml, specialized for: 4 4 - - **requests** HTTP library (Eio-based) 5 5 - - **jsont** for JSON codecs 6 6 - - Stdlib-first approach (avoiding Base/Core) 7 7 - - OCamldoc comments from OpenAPI descriptions 8 8 - 9 9 - ## Quick Start 10 10 - 11 11 - ```bash 12 12 - # Generate client from OpenAPI spec 13 13 - opam exec -- dune exec -- openapi-gen generate spec.json -o ./generated -n my_api 14 14 - 15 15 - # Include dune regeneration rules 16 16 - opam exec -- dune exec -- openapi-gen generate spec.json -o ./generated -n my_api --regen 17 17 - ``` 18 18 - 19 19 - ## Generated Code Structure 20 20 - 21 21 - ``` 22 22 - output/ 23 23 - ├── dune # Build configuration (wrapped library) 24 24 - ├── dune.inc # Regeneration rules (if --regen used) 25 25 - ├── types.ml # Type definitions with jsont codecs 26 26 - ├── types.mli # Type interfaces 27 27 - ├── client.ml # API client functions using requests 28 28 - ├── client.mli # Client interface 29 29 - ├── <api_name>.ml # Wrapped main module 30 30 - └── <api_name>.mli # Main module interface 31 31 - ``` 32 32 - 33 33 - ## Usage 34 34 - 35 35 - After generation, you can use the API like: 36 36 - 37 37 - ```ocaml 38 38 - (* Access types through the wrapped module *) 39 39 - let album : Immich.Types.AlbumResponseDto.t = ... 40 40 - 41 41 - (* Create a client and make requests *) 42 42 - Eio_main.run @@ fun env -> 43 43 - Eio.Switch.run @@ fun sw -> 44 44 - let client = Immich.Client.create ~sw env ~base_url:"http://localhost:2283/api" in 45 45 - let json = Immich.Client.get_activities ~album_id:"..." client () in 46 46 - ... 47 47 - ``` 48 48 - 49 49 - ## Regeneration with Dune 50 50 - 51 51 - When using `--regen`, the generated `dune.inc` contains rules for: 52 52 - 53 53 - ```bash 54 54 - # Regenerate and promote changes 55 55 - dune build @gen --auto-promote 56 56 - ``` 57 57 - 58 58 - ## Architecture 59 59 - 60 60 - - `lib/openapi_spec.ml` - OpenAPI 3.x specification types with jsont codecs 61 61 - - `lib/openapi_codegen.ml` - Code generation from spec to OCaml 62 62 - - `lib/openapi_runtime.ml` - Runtime utilities for generated clients 63 63 - - `bin/openapi_cli.ml` - CLI tool 64 64 - 65 65 - ## Build & Test 66 66 - 67 67 - ```bash 68 68 - opam exec -- dune build 69 69 - opam exec -- dune test 70 70 - ```

-4

ocaml-openapi/bin/dune

reviewed

··· 1 1 - (executable 2 2 - (name openapi_cli) 3 3 - (public_name openapi-gen) 4 4 - (libraries openapi cmdliner fmt logs logs.fmt fmt.tty unix))

-141

ocaml-openapi/bin/openapi_cli.ml

reviewed

··· 1 1 - (** OpenAPI code generator CLI. *) 2 2 - 3 3 - let setup_logging style_renderer level = 4 4 - Fmt_tty.setup_std_outputs ?style_renderer (); 5 5 - Logs.set_level level; 6 6 - Logs.set_reporter (Logs_fmt.reporter ()) 7 7 - 8 8 - let read_file path = 9 9 - let ic = open_in path in 10 10 - let n = in_channel_length ic in 11 11 - let s = really_input_string ic n in 12 12 - close_in ic; 13 13 - s 14 14 - 15 15 - (** Parse spec file and run action, handling errors uniformly *) 16 16 - let with_spec spec_path f = 17 17 - let spec_content = read_file spec_path in 18 18 - match Openapi.Spec.of_string spec_content with 19 19 - | Error e -> 20 20 - Logs.err (fun m -> m "Failed to parse OpenAPI spec: %s" e); 21 21 - 1 22 22 - | Ok spec -> f spec 23 23 - 24 24 - let generate_cmd spec_path output_dir package_name include_regen_rule = 25 25 - setup_logging None (Some Logs.Info); 26 26 - Logs.info (fun m -> m "Reading OpenAPI spec from %s" spec_path); 27 27 - with_spec spec_path (fun spec -> 28 28 - Logs.info (fun m -> m "Parsed OpenAPI spec: %s v%s" 29 29 - spec.info.title spec.info.version); 30 30 - 31 31 - let package_name = Option.value package_name 32 32 - ~default:(Openapi.Codegen.Name.to_snake_case spec.info.title) in 33 33 - 34 34 - (* Use spec_path for dune.inc regeneration rule if requested *) 35 35 - let spec_path_for_dune = if include_regen_rule then Some spec_path else None in 36 36 - let config = Openapi.Codegen.{ output_dir; package_name; spec_path = spec_path_for_dune } in 37 37 - let files = Openapi.Codegen.generate ~config spec in 38 38 - 39 39 - (try Unix.mkdir output_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); 40 40 - Openapi.Codegen.write_files ~output_dir files; 41 41 - 42 42 - Logs.info (fun m -> m "Generated %d files in %s" (List.length files) output_dir); 43 43 - List.iter (fun (name, _) -> Logs.info (fun m -> m " - %s" name)) files; 44 44 - 0) 45 45 - 46 46 - let inspect_cmd spec_path = 47 47 - setup_logging None (Some Logs.Info); 48 48 - with_spec spec_path (fun spec -> 49 49 - Fmt.pr "@[<v>"; 50 50 - Fmt.pr "OpenAPI Specification@,"; 51 51 - Fmt.pr "====================@,@,"; 52 52 - Fmt.pr "Title: %s@," spec.info.title; 53 53 - Fmt.pr "Version: %s@," spec.info.version; 54 54 - Option.iter (fun d -> Fmt.pr "Description: %s@," d) spec.info.description; 55 55 - Fmt.pr "@,"; 56 56 - 57 57 - Fmt.pr "Servers:@,"; 58 58 - List.iter (fun (s : Openapi.Spec.server) -> 59 59 - Fmt.pr " - %s@," s.url 60 60 - ) spec.servers; 61 61 - Fmt.pr "@,"; 62 62 - 63 63 - Fmt.pr "Paths (%d):@," (List.length spec.paths); 64 64 - List.iter (fun (path, _item) -> 65 65 - Fmt.pr " - %s@," path 66 66 - ) spec.paths; 67 67 - Fmt.pr "@,"; 68 68 - 69 69 - (match spec.components with 70 70 - | Some c -> 71 71 - Fmt.pr "Schemas (%d):@," (List.length c.schemas); 72 72 - List.iter (fun (name, _) -> 73 73 - Fmt.pr " - %s@," name 74 74 - ) c.schemas 75 75 - | None -> ()); 76 76 - 77 77 - Fmt.pr "@]"; 78 78 - 0) 79 79 - 80 80 - (* Cmdliner setup *) 81 81 - open Cmdliner 82 82 - 83 83 - let spec_path = 84 84 - let doc = "Path to the OpenAPI specification file (JSON)." in 85 85 - Arg.(required & pos 0 (some file) None & info [] ~docv:"SPEC" ~doc) 86 86 - 87 87 - let output_dir = 88 88 - let doc = "Output directory for generated code." in 89 89 - Arg.(required & opt (some string) None & info ["o"; "output"] ~docv:"DIR" ~doc) 90 90 - 91 91 - let package_name = 92 92 - let doc = "Package name for generated code (defaults to API title)." in 93 93 - Arg.(value & opt (some string) None & info ["n"; "name"] ~docv:"NAME" ~doc) 94 94 - 95 95 - let include_regen_rule = 96 96 - let doc = "Include dune.inc regeneration rule with spec path." in 97 97 - Arg.(value & flag & info ["regen"; "include-regen-rule"] ~doc) 98 98 - 99 99 - let generate_term = 100 100 - Term.(const generate_cmd $ spec_path $ output_dir $ package_name $ include_regen_rule) 101 101 - 102 102 - let generate_info = 103 103 - let doc = "Generate OCaml code from an OpenAPI specification." in 104 104 - let man = [ 105 105 - `S Manpage.s_description; 106 106 - `P "Generates OCaml types and client code from an OpenAPI 3.x specification."; 107 107 - `P "The generated code uses:"; 108 108 - `I ("$(b,jsont)", "for JSON encoding/decoding"); 109 109 - `I ("$(b,requests)", "for HTTP client (Eio-based)"); 110 110 - `I ("$(b,ptime)", "for date-time handling"); 111 111 - `S Manpage.s_examples; 112 112 - `P "Generate client from local spec:"; 113 113 - `Pre " openapi generate spec.json -o ./client -n my_api"; 114 114 - `P "Generate with regeneration rule for dune:"; 115 115 - `Pre " openapi generate spec.json -o ./client -n my_api --regen"; 116 116 - ] in 117 117 - Cmd.info "generate" ~doc ~man 118 118 - 119 119 - let inspect_term = 120 120 - Term.(const inspect_cmd $ spec_path) 121 121 - 122 122 - let inspect_info = 123 123 - let doc = "Inspect an OpenAPI specification." in 124 124 - Cmd.info "inspect" ~doc 125 125 - 126 126 - let main_info = 127 127 - let doc = "OpenAPI code generator for OCaml." in 128 128 - let man = [ 129 129 - `S Manpage.s_description; 130 130 - `P "Generate OCaml API clients from OpenAPI 3.x specifications."; 131 131 - `P "Use $(b,generate) to create client code, or $(b,inspect) to view spec details."; 132 132 - ] in 133 133 - Cmd.info "openapi" ~version:"0.1.0" ~doc ~man 134 134 - 135 135 - let main_cmd = 136 136 - Cmd.group main_info [ 137 137 - Cmd.v generate_info generate_term; 138 138 - Cmd.v inspect_info inspect_term; 139 139 - ] 140 140 - 141 141 - let () = exit (Cmd.eval' main_cmd)

-29

ocaml-openapi/dune-project

reviewed

··· 1 1 - (lang dune 3.21) 2 2 - 3 3 - (name openapi) 4 4 - 5 5 - (generate_opam_files true) 6 6 - 7 7 - (license ISC) 8 8 - (authors "Anil Madhavapeddy") 9 9 - (homepage "https://tangled.org/@anil.recoil.org/ocaml-openapi") 10 10 - (maintainers "Anil Madhavapeddy <anil@recoil.org>") 11 11 - (maintenance_intent "(latest)") 12 12 - (source (tangled anil.recoil.org/ocaml-openapi)) 13 13 - 14 14 - (package 15 15 - (name openapi) 16 16 - (synopsis "OpenAPI code generator for OCaml with requests and jsont") 17 17 - (description 18 18 - "Generate type-safe OCaml API clients from OpenAPI 3.x specifications. 19 19 - Uses the requests HTTP library and jsont for JSON codecs.") 20 20 - (depends 21 21 - (ocaml (>= 5.1.0)) 22 22 - jsont 23 23 - bytesrw 24 24 - fmt 25 25 - logs 26 26 - ptime 27 27 - (cmdliner (>= 1.2.0)) 28 28 - (odoc :with-doc) 29 29 - (alcotest :with-test)))

-7

ocaml-openapi/lib/dune

reviewed

··· 1 1 - (library 2 2 - (name openapi) 3 3 - (public_name openapi) 4 4 - (libraries jsont jsont.bytesrw fmt logs ptime)) 5 5 - 6 6 - (documentation 7 7 - (package openapi))

-254

ocaml-openapi/lib/index.mld

reviewed

··· 1 1 - {0 OCaml OpenAPI} 2 2 - 3 3 - {1 Overview} 4 4 - 5 5 - [openapi] generates type-safe OCaml API clients from OpenAPI 3.x 6 6 - specifications. The generated code uses: 7 7 - 8 8 - - {b jsont} for JSON encoding/decoding 9 9 - - {b requests} for HTTP client (Eio-based) 10 10 - - {b ptime} for date-time handling 11 11 - 12 12 - {1 Installation} 13 13 - 14 14 - {[ 15 15 - opam install openapi 16 16 - ]} 17 17 - 18 18 - {1 Generating a Client} 19 19 - 20 20 - Use the [openapi-gen] CLI tool to generate OCaml code from an OpenAPI spec: 21 21 - 22 22 - {[ 23 23 - # Basic generation 24 24 - openapi-gen generate spec.json -o ./my_api -n my_api 25 25 - 26 26 - # With dune regeneration rules 27 27 - openapi-gen generate spec.json -o ./my_api -n my_api --regen 28 28 - ]} 29 29 - 30 30 - {2 CLI Options} 31 31 - 32 32 - {ul 33 33 - {- [-o], [--output] — Output directory for generated code (required)} 34 34 - {- [-n], [--name] — Package name for generated library (defaults to API title)} 35 35 - {- [--regen] — Include dune.inc rules for [dune build @gen --auto-promote]}} 36 36 - 37 37 - {1 Generated Code Structure} 38 38 - 39 39 - The generator produces a complete dune library: 40 40 - 41 41 - {[ 42 42 - my_api/ 43 43 - ├── dune # Library configuration (wrapped) 44 44 - ├── dune.inc # Regeneration rules (if --regen used) 45 45 - ├── types.ml # Type definitions with jsont codecs 46 46 - ├── types.mli # Type interfaces 47 47 - ├── client.ml # API client functions 48 48 - ├── client.mli # Client interface 49 49 - ├── my_api.ml # Main wrapped module 50 50 - └── my_api.mli # Main module interface 51 51 - ]} 52 52 - 53 53 - {1 Using Generated Code} 54 54 - 55 55 - {2 Accessing Types} 56 56 - 57 57 - All schema types are generated as modules within [Types]: 58 58 - 59 59 - {[ 60 60 - (* Access a type *) 61 61 - let user : My_api.Types.User.t = { 62 62 - id = 123; 63 63 - name = "Alice"; 64 64 - email = Some "alice@example.com"; 65 65 - } 66 66 - 67 67 - (* Encode to JSON *) 68 68 - let json = Jsont.encode My_api.Types.User.t_jsont user 69 69 - 70 70 - (* Decode from JSON *) 71 71 - let user' = Jsont.decode My_api.Types.User.t_jsont json 72 72 - ]} 73 73 - 74 74 - {2 Making API Requests} 75 75 - 76 76 - Create a client and call API operations: 77 77 - 78 78 - {[ 79 79 - let () = 80 80 - Eio_main.run @@ fun env -> 81 81 - Eio.Switch.run @@ fun sw -> 82 82 - 83 83 - (* Create the client *) 84 84 - let client = My_api.Client.create ~sw env 85 85 - ~base_url:"https://api.example.com" in 86 86 - 87 87 - (* Make a request - returns typed value *) 88 88 - let user = My_api.Client.get_user ~id:"123" client () in 89 89 - Printf.printf "User: %s\n" user.name 90 90 - 91 91 - (* List endpoints return typed lists *) 92 92 - let users = My_api.Client.list_users client () in 93 93 - List.iter (fun u -> Printf.printf "- %s\n" u.name) users 94 94 - ]} 95 95 - 96 96 - {2 Request Bodies} 97 97 - 98 98 - For POST/PUT/PATCH requests, pass the typed value directly: 99 99 - 100 100 - {[ 101 101 - (* Create typed request body *) 102 102 - let new_user : My_api.Types.CreateUserDto.t = { 103 103 - name = "Bob"; 104 104 - email = "bob@example.com"; 105 105 - } in 106 106 - 107 107 - (* Pass as the body parameter - encoding is automatic *) 108 108 - let created = My_api.Client.create_user ~body:new_user client () 109 109 - ]} 110 110 - 111 111 - {1 Keeping Generated Code Updated} 112 112 - 113 113 - If you used [--regen], the generated [dune.inc] includes rules to regenerate 114 114 - the client when the spec changes: 115 115 - 116 116 - {[ 117 117 - # Regenerate and promote changes 118 118 - dune build @gen --auto-promote 119 119 - ]} 120 120 - 121 121 - This is useful for CI pipelines to ensure generated code stays in sync with 122 122 - the OpenAPI specification. 123 123 - 124 124 - {1 Library Modules} 125 125 - 126 126 - {2 Core Modules} 127 127 - 128 128 - {ul 129 129 - {- {!module:Openapi.Spec} — OpenAPI 3.x specification types with jsont codecs} 130 130 - {- {!module:Openapi.Codegen} — Code generation from spec to OCaml} 131 131 - {- {!module:Openapi.Runtime} — Runtime utilities for generated clients}} 132 132 - 133 133 - {2 Runtime Utilities} 134 134 - 135 135 - The {!module:Openapi.Runtime} module provides helpers used by generated code: 136 136 - 137 137 - {[ 138 138 - (* Path template rendering *) 139 139 - Openapi.Runtime.Path.render 140 140 - ~params:[("userId", "123"); ("postId", "456")] 141 141 - "/users/{userId}/posts/{postId}" 142 142 - (* => "/users/123/posts/456" *) 143 143 - 144 144 - (* Query string encoding *) 145 145 - Openapi.Runtime.Query.encode [("page", "1"); ("limit", "10")] 146 146 - (* => "?page=1&limit=10" *) 147 147 - ]} 148 148 - 149 149 - {1 Example: Immich API} 150 150 - 151 151 - Here's a complete example generating a client for the Immich photo server: 152 152 - 153 153 - {[ 154 154 - # Generate the client 155 155 - openapi-gen generate immich-openapi-specs.json -o ./immich -n immich 156 156 - 157 157 - # In your code: 158 158 - let () = 159 159 - Eio_main.run @@ fun env -> 160 160 - Eio.Switch.run @@ fun sw -> 161 161 - let client = Immich.Client.create ~sw env 162 162 - ~base_url:"http://localhost:2283/api" in 163 163 - 164 164 - (* List albums *) 165 165 - let albums_json = Immich.Client.get_all_albums client () in 166 166 - 167 167 - (* Get server info *) 168 168 - let info = Immich.Client.get_server_info client () in 169 169 - ... 170 170 - ]} 171 171 - 172 172 - {1 Limitations} 173 173 - 174 174 - {2 Schema Generation} 175 175 - 176 176 - {ul 177 177 - {- {b oneOf/anyOf} — Union types are mapped to [Jsont.json]. Proper 178 178 - implementation would generate OCaml variant types with discriminator-based 179 179 - decoding. See {{:#union-types}Union Types} below for details.} 180 180 - {- {b allOf} — Composition schemas are mapped to [Jsont.json]. Proper 181 181 - implementation would merge all referenced schemas into a single record type.} 182 182 - {- {b additionalProperties} — Dynamic object properties are parsed but not 183 183 - used in code generation. Objects with [additionalProperties: true] become 184 184 - [Jsont.json].} 185 185 - {- {b Recursive schemas} — Schemas that reference themselves are not fully 186 186 - supported and may cause infinite loops during generation.} 187 187 - {- {b Nested $ref} — References to references are not resolved; only direct 188 188 - schema references work.}} 189 189 - 190 190 - {2 Client Generation} 191 191 - 192 192 - {ul 193 193 - {- {b Error responses} — Error schemas (4xx, 5xx) are not generated. Errors 194 194 - are raised as exceptions with the HTTP status code and body text.} 195 195 - {- {b Authentication} — Security schemes (apiKey, http, oauth2) are parsed 196 196 - but not applied to requests. Add headers manually via the requests session.} 197 197 - {- {b Header parameters} — Header parameters are parsed but not included in 198 198 - generated function signatures.} 199 199 - {- {b Cookie parameters} — Cookie parameters are parsed but not included in 200 200 - generated functions.} 201 201 - {- {b Parameter references} — [$ref] in parameters are skipped; only inline 202 202 - parameters are used.}} 203 203 - 204 204 - {2 Content Types} 205 205 - 206 206 - {ul 207 207 - {- {b File uploads} — [multipart/form-data] is not supported. Binary file 208 208 - uploads require special handling not yet implemented.} 209 209 - {- {b XML} — Only [application/json] content types are supported.} 210 210 - {- {b Form encoding} — [application/x-www-form-urlencoded] is not supported.}} 211 211 - 212 212 - {2 Advanced Features} 213 213 - 214 214 - {ul 215 215 - {- {b Callbacks} — Webhook callbacks are parsed but no server code is 216 216 - generated.} 217 217 - {- {b Links} — Response links are parsed but not used in code generation.} 218 218 - {- {b External references} — Only internal [$ref] pointers starting with 219 219 - [#/] are supported. External file references are not resolved.}} 220 220 - 221 221 - {1:union-types Implementing Union Types} 222 222 - 223 223 - To properly support [oneOf]/[anyOf], the generator would need to: 224 224 - 225 225 - {ol 226 226 - {- Analyze schemas in the union to determine variant names} 227 227 - {- Use the [discriminator] property if present to determine the tag field} 228 228 - {- Generate an OCaml variant type with one constructor per schema} 229 229 - {- Generate a decoder that: 230 230 - {ul 231 231 - {- Reads the discriminator field if present} 232 232 - {- Pattern matches to select the appropriate decoder} 233 233 - {- Falls back to trying each decoder in order for anyOf}}} 234 234 - {- Generate an encoder that pattern matches on the variant}} 235 235 - 236 236 - Example of what generated code might look like: 237 237 - 238 238 - {[ 239 239 - (* For oneOf with discriminator *) 240 240 - type pet = 241 241 - | Dog of Dog.t 242 242 - | Cat of Cat.t 243 243 - 244 244 - let pet_jsont : pet Jsont.t = 245 245 - (* Read discriminator field "petType" to determine variant *) 246 246 - ... 247 247 - ]} 248 248 - 249 249 - {1 See Also} 250 250 - 251 251 - {ul 252 252 - {- {{:https://spec.openapis.org/oas/v3.0.3} OpenAPI 3.0 Specification}} 253 253 - {- {{:https://erratique.ch/software/jsont} jsont documentation}} 254 254 - {- {{:https://github.com/tarides/requests} requests library}}}

-13

ocaml-openapi/lib/openapi.ml

reviewed

··· 1 1 - (** OCaml OpenAPI - Code generator for OpenAPI specifications. 2 2 - 3 3 - This library provides: 4 4 - - {!module:Spec} - OpenAPI 3.x specification types with jsont codecs 5 5 - - {!module:Codegen} - Code generation from spec to OCaml 6 6 - - {!module:Runtime} - Runtime utilities for generated clients 7 7 - - {!module:Nestjs} - NestJS/Express error handling (optional) 8 8 - *) 9 9 - 10 10 - module Spec = Openapi_spec 11 11 - module Codegen = Openapi_codegen 12 12 - module Runtime = Openapi_runtime 13 13 - module Nestjs = Openapi_nestjs

-1069

ocaml-openapi/lib/openapi_codegen.ml

reviewed

··· 1 1 - (** Code generation from OpenAPI specifications. 2 2 - 3 3 - This module generates OCaml code from parsed OpenAPI specs: 4 4 - - Nested module structure grouped by common schema prefixes 5 5 - - Abstract types with accessor and constructor functions 6 6 - - Client functions placed in relevant type modules 7 7 - - Proper Eio error handling with context 8 8 - *) 9 9 - 10 10 - module Spec = Openapi_spec 11 11 - 12 12 - (** {1 Name Conversion} *) 13 13 - 14 14 - module Name = struct 15 15 - module StringSet = Set.Make(String) 16 16 - 17 17 - let ocaml_keywords = StringSet.of_list [ 18 18 - "and"; "as"; "assert"; "asr"; "begin"; "class"; "constraint"; "do"; "done"; 19 19 - "downto"; "else"; "end"; "exception"; "external"; "false"; "for"; "fun"; 20 20 - "function"; "functor"; "if"; "in"; "include"; "inherit"; "initializer"; 21 21 - "land"; "lazy"; "let"; "lor"; "lsl"; "lsr"; "lxor"; "match"; "method"; 22 22 - "mod"; "module"; "mutable"; "new"; "nonrec"; "object"; "of"; "open"; "or"; 23 23 - "private"; "rec"; "sig"; "struct"; "then"; "to"; "true"; "try"; "type"; 24 24 - "val"; "virtual"; "when"; "while"; "with" 25 25 - ] 26 26 - 27 27 - let escape_keyword s = 28 28 - if StringSet.mem s ocaml_keywords then s ^ "_" else s 29 29 - 30 30 - let to_snake_case s = 31 31 - let buf = Buffer.create (String.length s) in 32 32 - let prev_upper = ref false in 33 33 - String.iteri (fun i c -> 34 34 - match c with 35 35 - | 'A'..'Z' -> 36 36 - if i > 0 && not !prev_upper then Buffer.add_char buf '_'; 37 37 - Buffer.add_char buf (Char.lowercase_ascii c); 38 38 - prev_upper := true 39 39 - | 'a'..'z' | '0'..'9' | '_' -> 40 40 - Buffer.add_char buf c; 41 41 - prev_upper := false 42 42 - | '-' | ' ' | '.' | '/' -> 43 43 - Buffer.add_char buf '_'; 44 44 - prev_upper := false 45 45 - | _ -> 46 46 - prev_upper := false 47 47 - ) s; 48 48 - escape_keyword (Buffer.contents buf) 49 49 - 50 50 - let to_module_name s = 51 51 - let snake = to_snake_case s in 52 52 - let parts = String.split_on_char '_' snake in 53 53 - String.concat "" (List.map String.capitalize_ascii parts) 54 54 - 55 55 - let to_type_name s = String.lowercase_ascii (to_snake_case s) 56 56 - 57 57 - let to_variant_name s = String.capitalize_ascii (to_snake_case s) 58 58 - 59 59 - (** Split a schema name into prefix and suffix for nested modules. 60 60 - E.g., "AlbumResponseDto" -> ("Album", "ResponseDto") *) 61 61 - let split_schema_name (name : string) : string * string = 62 62 - (* Common suffixes to look for *) 63 63 - let suffixes = [ 64 64 - "ResponseDto"; "RequestDto"; "CreateDto"; "UpdateDto"; "Dto"; 65 65 - "Response"; "Request"; "Create"; "Update"; "Config"; "Info"; 66 66 - "Status"; "Type"; "Entity"; "Item"; "Entry"; "Data"; "Result" 67 67 - ] in 68 68 - let found = List.find_opt (fun suffix -> 69 69 - String.length name > String.length suffix && 70 70 - String.ends_with ~suffix name 71 71 - ) suffixes in 72 72 - match found with 73 73 - | Some suffix -> 74 74 - let prefix_len = String.length name - String.length suffix in 75 75 - let prefix = String.sub name 0 prefix_len in 76 76 - if prefix = "" then (name, "T") 77 77 - else (prefix, suffix) 78 78 - | None -> 79 79 - (* No known suffix, use as-is with submodule T *) 80 80 - (name, "T") 81 81 - 82 82 - let operation_name ~(method_ : string) ~(path : string) ~(operation_id : string option) = 83 83 - match operation_id with 84 84 - | Some id -> to_snake_case id 85 85 - | None -> 86 86 - let method_name = String.lowercase_ascii method_ in 87 87 - let path_parts = String.split_on_char '/' path 88 88 - |> List.filter (fun s -> s <> "" && not (String.length s > 0 && s.[0] = '{')) 89 89 - in 90 90 - let path_name = String.concat "_" (List.map to_snake_case path_parts) in 91 91 - method_name ^ "_" ^ path_name 92 92 - end 93 93 - 94 94 - (** {1 OCamldoc Helpers} *) 95 95 - 96 96 - let escape_doc s = 97 97 - let s = String.concat "\\}" (String.split_on_char '}' s) in 98 98 - String.concat "\\{" (String.split_on_char '{' s) 99 99 - 100 100 - let format_doc ?(indent=0) description = 101 101 - let prefix = String.make indent ' ' in 102 102 - match description with 103 103 - | None | Some "" -> "" 104 104 - | Some desc -> Printf.sprintf "%s(** %s *)\n" prefix (escape_doc desc) 105 105 - 106 106 - let format_doc_block ?(indent=0) ~summary ?description () = 107 107 - let prefix = String.make indent ' ' in 108 108 - match summary, description with 109 109 - | None, None -> "" 110 110 - | Some s, None -> Printf.sprintf "%s(** %s *)\n" prefix (escape_doc s) 111 111 - | None, Some d -> Printf.sprintf "%s(** %s *)\n" prefix (escape_doc d) 112 112 - | Some s, Some d -> 113 113 - Printf.sprintf "%s(** %s\n\n%s %s *)\n" prefix (escape_doc s) prefix (escape_doc d) 114 114 - 115 115 - let format_param_doc name description = 116 116 - match description with 117 117 - | None | Some "" -> "" 118 118 - | Some d -> Printf.sprintf " @param %s %s\n" name (escape_doc d) 119 119 - 120 120 - (** {1 JSON Helpers} *) 121 121 - 122 122 - let json_string = function 123 123 - | Jsont.String (s, _) -> Some s 124 124 - | _ -> None 125 125 - 126 126 - let json_object = function 127 127 - | Jsont.Object (mems, _) -> Some mems 128 128 - | _ -> None 129 129 - 130 130 - let get_ref json = 131 131 - Option.bind (json_object json) (fun mems -> 132 132 - List.find_map (fun ((n, _), v) -> 133 133 - if n = "$ref" then json_string v else None 134 134 - ) mems) 135 135 - 136 136 - let get_member name json = 137 137 - Option.bind (json_object json) (fun mems -> 138 138 - List.find_map (fun ((n, _), v) -> 139 139 - if n = name then Some v else None 140 140 - ) mems) 141 141 - 142 142 - let get_string_member name json = 143 143 - Option.bind (get_member name json) json_string 144 144 - 145 145 - (** {1 Schema Analysis} *) 146 146 - 147 147 - let schema_name_from_ref (ref_ : string) : string option = 148 148 - match String.split_on_char '/' ref_ with 149 149 - | ["#"; "components"; "schemas"; name] -> Some name 150 150 - | _ -> None 151 151 - 152 152 - let rec find_refs_in_json (json : Jsont.json) : string list = 153 153 - match json with 154 154 - | Jsont.Object (mems, _) -> 155 155 - (match List.find_map (fun ((n, _), v) -> 156 156 - if n = "$ref" then json_string v else None) mems with 157 157 - | Some ref_ -> Option.to_list (schema_name_from_ref ref_) 158 158 - | None -> List.concat_map (fun (_, v) -> find_refs_in_json v) mems) 159 159 - | Jsont.Array (items, _) -> List.concat_map find_refs_in_json items 160 160 - | _ -> [] 161 161 - 162 162 - let find_schema_dependencies (schema : Spec.schema) : string list = 163 163 - let from_properties = List.concat_map (fun (_, json) -> find_refs_in_json json) schema.properties in 164 164 - let refs_from_list = Option.fold ~none:[] ~some:(List.concat_map find_refs_in_json) in 165 165 - let from_items = Option.fold ~none:[] ~some:find_refs_in_json schema.items in 166 166 - List.sort_uniq String.compare 167 167 - (from_properties @ from_items @ refs_from_list schema.all_of 168 168 - @ refs_from_list schema.one_of @ refs_from_list schema.any_of) 169 169 - 170 170 - (** {1 Module Tree Structure} *) 171 171 - 172 172 - module StringMap = Map.Make(String) 173 173 - module StringSet = Set.Make(String) 174 174 - 175 175 - (** {1 Topological Sort} *) 176 176 - 177 177 - (** Kahn's algorithm for topological sorting. 178 178 - Returns nodes in dependency order (dependencies first). *) 179 179 - let topological_sort (nodes : string list) (deps : string -> string list) : string list = 180 180 - (* Build adjacency list and in-degree map *) 181 181 - let nodes_set = StringSet.of_list nodes in 182 182 - let in_degree = List.fold_left (fun m node -> 183 183 - StringMap.add node 0 m 184 184 - ) StringMap.empty nodes in 185 185 - let adj = List.fold_left (fun m node -> 186 186 - StringMap.add node [] m 187 187 - ) StringMap.empty nodes in 188 188 - (* Add edges: if A depends on B, add edge B -> A *) 189 189 - let (in_degree, adj) = List.fold_left (fun (in_degree, adj) node -> 190 190 - let node_deps = deps node |> List.filter (fun d -> StringSet.mem d nodes_set) in 191 191 - let in_degree = StringMap.add node (List.length node_deps) in_degree in 192 192 - let adj = List.fold_left (fun adj dep -> 193 193 - let existing = Option.value ~default:[] (StringMap.find_opt dep adj) in 194 194 - StringMap.add dep (node :: existing) adj 195 195 - ) adj node_deps in 196 196 - (in_degree, adj) 197 197 - ) (in_degree, adj) nodes in 198 198 - (* Start with nodes that have no dependencies *) 199 199 - let queue = List.filter (fun n -> 200 200 - StringMap.find n in_degree = 0 201 201 - ) nodes in 202 202 - let rec process queue in_degree result = 203 203 - match queue with 204 204 - | [] -> List.rev result 205 205 - | node :: rest -> 206 206 - let result = node :: result in 207 207 - let dependents = Option.value ~default:[] (StringMap.find_opt node adj) in 208 208 - let (queue', in_degree) = List.fold_left (fun (q, deg) dep -> 209 209 - let new_deg = StringMap.find dep deg - 1 in 210 210 - let deg = StringMap.add dep new_deg deg in 211 211 - if new_deg = 0 then (dep :: q, deg) else (q, deg) 212 212 - ) (rest, in_degree) dependents in 213 213 - process queue' in_degree result 214 214 - in 215 215 - process queue in_degree [] 216 216 - 217 217 - type field_info = { 218 218 - ocaml_name : string; 219 219 - json_name : string; 220 220 - ocaml_type : string; 221 221 - base_type : string; 222 222 - is_optional : bool; 223 223 - is_required : bool; 224 224 - description : string option; 225 225 - } 226 226 - 227 227 - type schema_info = { 228 228 - original_name : string; 229 229 - prefix : string; 230 230 - suffix : string; 231 231 - schema : Spec.schema; 232 232 - fields : field_info list; 233 233 - is_enum : bool; 234 234 - enum_variants : (string * string) list; (* ocaml_name, json_value *) 235 235 - description : string option; 236 236 - } 237 237 - 238 238 - type operation_info = { 239 239 - func_name : string; 240 240 - operation_id : string option; 241 241 - summary : string option; 242 242 - description : string option; 243 243 - tags : string list; 244 244 - path : string; 245 245 - method_ : string; 246 246 - path_params : (string * string * string option * bool) list; (* ocaml, json, desc, required *) 247 247 - query_params : (string * string * string option * bool) list; 248 248 - body_schema_ref : string option; 249 249 - response_schema_ref : string option; 250 250 - } 251 251 - 252 252 - type module_node = { 253 253 - name : string; 254 254 - schemas : schema_info list; 255 255 - operations : operation_info list; 256 256 - dependencies : StringSet.t; (* Other prefix modules this depends on *) 257 257 - children : module_node StringMap.t; 258 258 - } 259 259 - 260 260 - let empty_node name = { name; schemas = []; operations = []; dependencies = StringSet.empty; children = StringMap.empty } 261 261 - 262 262 - (** {1 Type Resolution} *) 263 263 - 264 264 - let rec type_of_json_schema (json : Jsont.json) : string * bool = 265 265 - (* Check if the schema is nullable *) 266 266 - let is_nullable = match get_member "nullable" json with 267 267 - | Some (Jsont.Bool (b, _)) -> b 268 268 - | _ -> false 269 269 - in 270 270 - match get_ref json with 271 271 - | Some ref_ -> 272 272 - (match schema_name_from_ref ref_ with 273 273 - | Some name -> 274 274 - let prefix, suffix = Name.split_schema_name name in 275 275 - (Printf.sprintf "%s.%s.t" (Name.to_module_name prefix) (Name.to_module_name suffix), is_nullable) 276 276 - | None -> ("Jsont.json", is_nullable)) 277 277 - | None -> 278 278 - match get_string_member "type" json with 279 279 - | Some "string" -> 280 280 - (match get_string_member "format" json with 281 281 - | Some "date-time" -> ("Ptime.t", is_nullable) 282 282 - | _ -> ("string", is_nullable)) 283 283 - | Some "integer" -> 284 284 - (match get_string_member "format" json with 285 285 - | Some "int64" -> ("int64", is_nullable) 286 286 - | Some "int32" -> ("int32", is_nullable) 287 287 - | _ -> ("int", is_nullable)) 288 288 - | Some "number" -> ("float", is_nullable) 289 289 - | Some "boolean" -> ("bool", is_nullable) 290 290 - | Some "array" -> 291 291 - (match get_member "items" json with 292 292 - | Some items -> 293 293 - let (elem_type, _) = type_of_json_schema items in 294 294 - (elem_type ^ " list", is_nullable) 295 295 - | None -> ("Jsont.json list", is_nullable)) 296 296 - | Some "object" -> ("Jsont.json", is_nullable) 297 297 - | _ -> ("Jsont.json", is_nullable) 298 298 - 299 299 - let rec jsont_of_base_type = function 300 300 - | "string" -> "Jsont.string" 301 301 - | "int" -> "Jsont.int" 302 302 - | "int32" -> "Jsont.int32" 303 303 - | "int64" -> "Jsont.int64" 304 304 - | "float" -> "Jsont.number" 305 305 - | "bool" -> "Jsont.bool" 306 306 - | "Ptime.t" -> "Openapi.Runtime.ptime_jsont" 307 307 - | "Jsont.json" -> "Jsont.json" 308 308 - | s when String.ends_with ~suffix:" list" s -> 309 309 - let elem = String.sub s 0 (String.length s - 5) in 310 310 - Printf.sprintf "(Jsont.list %s)" (jsont_of_base_type elem) 311 311 - | s when String.ends_with ~suffix:".t" s -> 312 312 - let module_path = String.sub s 0 (String.length s - 2) in 313 313 - module_path ^ ".jsont" 314 314 - | _ -> "Jsont.json" 315 315 - 316 316 - (** {1 Schema Processing} *) 317 317 - 318 318 - let analyze_schema (name : string) (schema : Spec.schema) : schema_info = 319 319 - let prefix, suffix = Name.split_schema_name name in 320 320 - let is_enum = Option.is_some schema.enum in 321 321 - let enum_variants = match schema.enum with 322 322 - | Some values -> 323 323 - List.filter_map (fun json -> 324 324 - match json with 325 325 - | Jsont.String (s, _) -> Some (Name.to_variant_name s, s) 326 326 - | _ -> None 327 327 - ) values 328 328 - | None -> [] 329 329 - in 330 330 - let fields = List.map (fun (field_name, field_json) -> 331 331 - let ocaml_name = Name.to_snake_case field_name in 332 332 - let is_required = List.mem field_name schema.required in 333 333 - let (base_type, json_nullable) = type_of_json_schema field_json in 334 334 - let is_optional = json_nullable || not is_required in 335 335 - let ocaml_type = if is_optional then base_type ^ " option" else base_type in 336 336 - let description = get_string_member "description" field_json in 337 337 - { ocaml_name; json_name = field_name; ocaml_type; base_type; is_optional; is_required; description } 338 338 - ) schema.properties in 339 339 - { original_name = name; prefix; suffix; schema; fields; is_enum; enum_variants; 340 340 - description = schema.description } 341 341 - 342 342 - (** {1 Operation Processing} *) 343 343 - 344 344 - let analyze_operation ~path ~method_ (op : Spec.operation) : operation_info = 345 345 - let func_name = Name.operation_name ~method_ ~path ~operation_id:op.operation_id in 346 346 - let params = List.filter_map (fun (p : Spec.parameter Spec.or_ref) -> 347 347 - match p with Spec.Value p -> Some p | Spec.Ref _ -> None 348 348 - ) op.parameters in 349 349 - 350 350 - let path_params = List.filter_map (fun (p : Spec.parameter) -> 351 351 - if p.in_ = Spec.Path then 352 352 - Some (Name.to_snake_case p.name, p.name, p.description, p.required) 353 353 - else None 354 354 - ) params in 355 355 - 356 356 - let query_params = List.filter_map (fun (p : Spec.parameter) -> 357 357 - if p.in_ = Spec.Query then 358 358 - Some (Name.to_snake_case p.name, p.name, p.description, p.required) 359 359 - else None 360 360 - ) params in 361 361 - 362 362 - let body_schema_ref = match op.request_body with 363 363 - | Some (Spec.Value (rb : Spec.request_body)) -> 364 364 - List.find_map (fun (ct, (media : Spec.media_type)) -> 365 365 - if String.length ct >= 16 && String.sub ct 0 16 = "application/json" then 366 366 - match media.schema with 367 367 - | Some (Spec.Ref r) -> schema_name_from_ref r 368 368 - | _ -> None 369 369 - else None 370 370 - ) rb.content 371 371 - | _ -> None 372 372 - in 373 373 - 374 374 - let response_schema_ref = 375 375 - let find_in_content content = 376 376 - List.find_map (fun (ct, (media : Spec.media_type)) -> 377 377 - if String.length ct >= 16 && String.sub ct 0 16 = "application/json" then 378 378 - match media.schema with 379 379 - | Some (Spec.Ref r) -> schema_name_from_ref r 380 380 - | Some (Spec.Value s) when s.type_ = Some "array" -> 381 381 - Option.bind s.items (fun items -> Option.bind (get_ref items) schema_name_from_ref) 382 382 - | _ -> None 383 383 - else None 384 384 - ) content 385 385 - in 386 386 - let try_status status = 387 387 - List.find_map (fun (code, resp) -> 388 388 - if code = status then 389 389 - match resp with 390 390 - | Spec.Value (r : Spec.response) -> find_in_content r.content 391 391 - | _ -> None 392 392 - else None 393 393 - ) op.responses.responses 394 394 - in 395 395 - match try_status "200" with 396 396 - | Some r -> Some r 397 397 - | None -> match try_status "201" with 398 398 - | Some r -> Some r 399 399 - | None -> match op.responses.default with 400 400 - | Some (Spec.Value (r : Spec.response)) -> find_in_content r.content 401 401 - | _ -> None 402 402 - in 403 403 - 404 404 - { func_name; operation_id = op.operation_id; summary = op.summary; 405 405 - description = op.description; tags = op.tags; path; method_; 406 406 - path_params; query_params; body_schema_ref; response_schema_ref } 407 407 - 408 408 - (** {1 Module Tree Building} *) 409 409 - 410 410 - (** Extract prefix module dependencies from a schema's fields *) 411 411 - let schema_prefix_deps (schema : schema_info) : StringSet.t = 412 412 - let deps = List.filter_map (fun (f : field_info) -> 413 413 - (* Check if the type references another module *) 414 414 - if String.contains f.base_type '.' then 415 415 - (* Extract first component before the dot *) 416 416 - match String.split_on_char '.' f.base_type with 417 417 - | prefix :: _ when prefix <> "Jsont" && prefix <> "Ptime" && prefix <> "Openapi" -> 418 418 - Some prefix 419 419 - | _ -> None 420 420 - else None 421 421 - ) schema.fields in 422 422 - StringSet.of_list deps 423 423 - 424 424 - (** Extract prefix module dependencies from an operation's types *) 425 425 - let operation_prefix_deps (op : operation_info) : StringSet.t = 426 426 - let body_dep = match op.body_schema_ref with 427 427 - | Some name -> 428 428 - let prefix, _ = Name.split_schema_name name in 429 429 - Some (Name.to_module_name prefix) 430 430 - | None -> None 431 431 - in 432 432 - let response_dep = match op.response_schema_ref with 433 433 - | Some name -> 434 434 - let prefix, _ = Name.split_schema_name name in 435 435 - Some (Name.to_module_name prefix) 436 436 - | None -> None 437 437 - in 438 438 - StringSet.of_list (List.filter_map Fun.id [body_dep; response_dep]) 439 439 - 440 440 - let build_module_tree (schemas : schema_info list) (operations : operation_info list) : module_node * string list = 441 441 - let root = empty_node "Root" in 442 442 - 443 443 - (* Add schemas to tree and track dependencies *) 444 444 - let root = List.fold_left (fun root schema -> 445 445 - let prefix_mod = Name.to_module_name schema.prefix in 446 446 - let child = match StringMap.find_opt prefix_mod root.children with 447 447 - | Some c -> c 448 448 - | None -> empty_node prefix_mod 449 449 - in 450 450 - let schema_deps = schema_prefix_deps schema in 451 451 - (* Remove self-dependency *) 452 452 - let schema_deps = StringSet.remove prefix_mod schema_deps in 453 453 - let child = { child with 454 454 - schemas = schema :: child.schemas; 455 455 - dependencies = StringSet.union child.dependencies schema_deps 456 456 - } in 457 457 - { root with children = StringMap.add prefix_mod child root.children } 458 458 - ) root schemas in 459 459 - 460 460 - (* Add operations to tree based on response type, and track operation dependencies *) 461 461 - let root = List.fold_left (fun root op -> 462 462 - match op.response_schema_ref with 463 463 - | Some ref_name -> 464 464 - let prefix, _ = Name.split_schema_name ref_name in 465 465 - let prefix_mod = Name.to_module_name prefix in 466 466 - let child = match StringMap.find_opt prefix_mod root.children with 467 467 - | Some c -> c 468 468 - | None -> empty_node prefix_mod 469 469 - in 470 470 - let op_deps = operation_prefix_deps op in 471 471 - (* Remove self-dependency *) 472 472 - let op_deps = StringSet.remove prefix_mod op_deps in 473 473 - let child = { child with 474 474 - operations = op :: child.operations; 475 475 - dependencies = StringSet.union child.dependencies op_deps 476 476 - } in 477 477 - { root with children = StringMap.add prefix_mod child root.children } 478 478 - | None -> 479 479 - (* Put in Client module for operations without typed response *) 480 480 - let child = match StringMap.find_opt "Client" root.children with 481 481 - | Some c -> c 482 482 - | None -> empty_node "Client" 483 483 - in 484 484 - let op_deps = operation_prefix_deps op in 485 485 - let op_deps = StringSet.remove "Client" op_deps in 486 486 - let child = { child with 487 487 - operations = op :: child.operations; 488 488 - dependencies = StringSet.union child.dependencies op_deps 489 489 - } in 490 490 - { root with children = StringMap.add "Client" child root.children } 491 491 - ) root operations in 492 492 - 493 493 - (* Get sorted list of module names (dependencies first) *) 494 494 - let module_names = StringMap.fold (fun name _ acc -> name :: acc) root.children [] in 495 495 - let deps_of name = 496 496 - match StringMap.find_opt name root.children with 497 497 - | Some node -> StringSet.elements node.dependencies 498 498 - | None -> [] 499 499 - in 500 500 - let sorted = topological_sort module_names deps_of in 501 501 - 502 502 - (root, sorted) 503 503 - 504 504 - (** {1 Code Generation} *) 505 505 - 506 506 - let gen_enum_impl (schema : schema_info) : string = 507 507 - let doc = format_doc schema.description in 508 508 - if schema.enum_variants = [] then 509 509 - Printf.sprintf "%stype t = string\n\nlet jsont = Jsont.string" doc 510 510 - else 511 511 - let type_def = Printf.sprintf "%stype t = [\n%s\n]" doc 512 512 - (String.concat "\n" (List.map (fun (v, _) -> " | `" ^ v) schema.enum_variants)) 513 513 - in 514 514 - let dec_cases = String.concat "\n" (List.map (fun (v, raw) -> 515 515 - Printf.sprintf " | %S -> `%s" raw v 516 516 - ) schema.enum_variants) in 517 517 - let enc_cases = String.concat "\n" (List.map (fun (v, raw) -> 518 518 - Printf.sprintf " | `%s -> %S" v raw 519 519 - ) schema.enum_variants) in 520 520 - Printf.sprintf {|%s 521 521 - 522 522 - let jsont : t Jsont.t = 523 523 - Jsont.map Jsont.string ~kind:%S 524 524 - ~dec:(function 525 525 - %s 526 526 - | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown value: %%s" s) 527 527 - ~enc:(function 528 528 - %s)|} type_def schema.original_name dec_cases enc_cases 529 529 - 530 530 - let gen_enum_intf (schema : schema_info) : string = 531 531 - let doc = format_doc schema.description in 532 532 - if schema.enum_variants = [] then 533 533 - Printf.sprintf "%stype t = string\n\nval jsont : t Jsont.t" doc 534 534 - else 535 535 - let type_def = Printf.sprintf "%stype t = [\n%s\n]" doc 536 536 - (String.concat "\n" (List.map (fun (v, _) -> " | `" ^ v) schema.enum_variants)) 537 537 - in 538 538 - Printf.sprintf "%s\n\nval jsont : t Jsont.t" type_def 539 539 - 540 540 - (** Localize an OCaml type string by stripping the current_prefix module *) 541 541 - let localize_type ~current_prefix (type_str : string) : string = 542 542 - (* Handle patterns like "User.ResponseDto.t" -> "ResponseDto.t" if current_prefix = "User" *) 543 543 - let prefix_dot = current_prefix ^ "." in 544 544 - let strip_prefix s = 545 545 - if String.length s >= String.length prefix_dot && 546 546 - String.sub s 0 (String.length prefix_dot) = prefix_dot then 547 547 - String.sub s (String.length prefix_dot) (String.length s - String.length prefix_dot) 548 548 - else s 549 549 - in 550 550 - (* Handle "X list", "X option", and nested combinations *) 551 551 - let rec localize s = 552 552 - if String.ends_with ~suffix:" list" s then 553 553 - let elem = String.sub s 0 (String.length s - 5) in 554 554 - (localize elem) ^ " list" 555 555 - else if String.ends_with ~suffix:" option" s then 556 556 - let elem = String.sub s 0 (String.length s - 7) in 557 557 - (localize elem) ^ " option" 558 558 - else 559 559 - strip_prefix s 560 560 - in 561 561 - localize type_str 562 562 - 563 563 - (** Localize a jsont codec string by stripping the current_prefix module *) 564 564 - let rec localize_jsont ~current_prefix (jsont_str : string) : string = 565 565 - let prefix_dot = current_prefix ^ "." in 566 566 - (* Handle patterns like "User.ResponseDto.jsont" -> "ResponseDto.jsont" *) 567 567 - (* Also handle "(Jsont.list User.ResponseDto.jsont)" *) 568 568 - if String.length jsont_str >= String.length prefix_dot then 569 569 - if String.sub jsont_str 0 (String.length prefix_dot) = prefix_dot then 570 570 - String.sub jsont_str (String.length prefix_dot) (String.length jsont_str - String.length prefix_dot) 571 571 - else if String.length jsont_str > 12 && String.sub jsont_str 0 12 = "(Jsont.list " then 572 572 - let inner = String.sub jsont_str 12 (String.length jsont_str - 13) in 573 573 - "(Jsont.list " ^ localize_jsont ~current_prefix inner ^ ")" 574 574 - else 575 575 - jsont_str 576 576 - else 577 577 - jsont_str 578 578 - 579 579 - let gen_record_impl ~current_prefix (schema : schema_info) : string = 580 580 - let loc_type = localize_type ~current_prefix in 581 581 - let loc_jsont = localize_jsont ~current_prefix in 582 582 - let doc = format_doc schema.description in 583 583 - if schema.fields = [] then 584 584 - Printf.sprintf "%stype t = Jsont.json\n\nlet jsont = Jsont.json\n\nlet v () = Jsont.Null ((), Jsont.Meta.none)" doc 585 585 - else 586 586 - (* Private type definition *) 587 587 - let type_fields = String.concat "\n" (List.map (fun (f : field_info) -> 588 588 - let field_doc = match f.description with 589 589 - | Some d -> Printf.sprintf " (** %s *)" (escape_doc d) 590 590 - | None -> "" 591 591 - in 592 592 - Printf.sprintf " %s : %s;%s" f.ocaml_name (loc_type f.ocaml_type) field_doc 593 593 - ) schema.fields) in 594 594 - 595 595 - let type_def = Printf.sprintf "%stype t = {\n%s\n}" doc type_fields in 596 596 - 597 597 - (* Constructor function v *) 598 598 - let required_fields = List.filter (fun (f : field_info) -> not f.is_optional) schema.fields in 599 599 - let optional_fields = List.filter (fun (f : field_info) -> f.is_optional) schema.fields in 600 600 - let v_params = 601 601 - (List.map (fun (f : field_info) -> Printf.sprintf "~%s" f.ocaml_name) required_fields) @ 602 602 - (List.map (fun (f : field_info) -> Printf.sprintf "?%s" f.ocaml_name) optional_fields) @ 603 603 - ["()"] 604 604 - in 605 605 - let v_body = String.concat "; " (List.map (fun (f : field_info) -> f.ocaml_name) schema.fields) in 606 606 - let v_func = Printf.sprintf "let v %s = { %s }" (String.concat " " v_params) v_body in 607 607 - 608 608 - (* Accessor functions *) 609 609 - let accessors = String.concat "\n" (List.map (fun (f : field_info) -> 610 610 - Printf.sprintf "let %s t = t.%s" f.ocaml_name f.ocaml_name 611 611 - ) schema.fields) in 612 612 - 613 613 - (* Jsont codec *) 614 614 - let make_params = String.concat " " (List.map (fun (f : field_info) -> f.ocaml_name) schema.fields) in 615 615 - let jsont_members = String.concat "\n" (List.map (fun (f : field_info) -> 616 616 - let codec = loc_jsont (jsont_of_base_type f.base_type) in 617 617 - if f.is_optional then 618 618 - if f.is_required then 619 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 620 - f.json_name codec f.ocaml_name 621 621 - else 622 622 - Printf.sprintf " |> Jsont.Object.opt_mem %S %s ~enc:(fun r -> r.%s)" 623 623 - f.json_name codec f.ocaml_name 624 624 - else 625 625 - Printf.sprintf " |> Jsont.Object.mem %S %s ~enc:(fun r -> r.%s)" 626 626 - f.json_name codec f.ocaml_name 627 627 - ) schema.fields) in 628 628 - 629 629 - Printf.sprintf {|%s 630 630 - 631 631 - %s 632 632 - 633 633 - %s 634 634 - 635 635 - let jsont : t Jsont.t = 636 636 - Jsont.Object.map ~kind:%S 637 637 - (fun %s -> { %s }) 638 638 - %s 639 639 - |> Jsont.Object.skip_unknown 640 640 - |> Jsont.Object.finish|} 641 641 - type_def v_func accessors schema.original_name make_params v_body jsont_members 642 642 - 643 643 - let gen_record_intf ~current_prefix (schema : schema_info) : string = 644 644 - let loc_type = localize_type ~current_prefix in 645 645 - let doc = format_doc schema.description in 646 646 - if schema.fields = [] then 647 647 - Printf.sprintf "%stype t\n\nval jsont : t Jsont.t\n\nval v : unit -> t" doc 648 648 - else 649 649 - (* Abstract type *) 650 650 - let type_decl = Printf.sprintf "%stype t" doc in 651 651 - 652 652 - (* Constructor signature *) 653 653 - let required_fields = List.filter (fun (f : field_info) -> not f.is_optional) schema.fields in 654 654 - let optional_fields = List.filter (fun (f : field_info) -> f.is_optional) schema.fields in 655 655 - let v_param_docs = String.concat "" 656 656 - ((List.map (fun (f : field_info) -> format_param_doc f.ocaml_name f.description) required_fields) @ 657 657 - (List.map (fun (f : field_info) -> format_param_doc f.ocaml_name f.description) optional_fields)) 658 658 - in 659 659 - let v_params = 660 660 - (List.map (fun (f : field_info) -> Printf.sprintf "%s:%s" f.ocaml_name (loc_type f.base_type)) required_fields) @ 661 661 - (List.map (fun (f : field_info) -> Printf.sprintf "?%s:%s" f.ocaml_name (loc_type f.base_type)) optional_fields) @ 662 662 - ["unit"; "t"] 663 663 - in 664 664 - let v_doc = if v_param_docs = "" then "(** Construct a value *)\n" 665 665 - else Printf.sprintf "(** Construct a value\n%s*)\n" v_param_docs in 666 666 - let v_sig = Printf.sprintf "%sval v : %s" v_doc (String.concat " -> " v_params) in 667 667 - 668 668 - (* Accessor signatures *) 669 669 - let accessor_sigs = String.concat "\n\n" (List.map (fun (f : field_info) -> 670 670 - let acc_doc = match f.description with 671 671 - | Some d -> Printf.sprintf "(** %s *)\n" (escape_doc d) 672 672 - | None -> "" 673 673 - in 674 674 - Printf.sprintf "%sval %s : t -> %s" acc_doc f.ocaml_name (loc_type f.ocaml_type) 675 675 - ) schema.fields) in 676 676 - 677 677 - Printf.sprintf "%s\n\n%s\n\n%s\n\nval jsont : t Jsont.t" 678 678 - type_decl v_sig accessor_sigs 679 679 - 680 680 - (** Format a jsont codec reference, stripping the current_prefix if present *) 681 681 - let format_jsont_ref ~current_prefix (schema_ref : string) : string = 682 682 - let prefix, suffix = Name.split_schema_name schema_ref in 683 683 - let prefix_mod = Name.to_module_name prefix in 684 684 - let suffix_mod = Name.to_module_name suffix in 685 685 - if prefix_mod = current_prefix then 686 686 - Printf.sprintf "%s.jsont" suffix_mod 687 687 - else 688 688 - Printf.sprintf "%s.%s.jsont" prefix_mod suffix_mod 689 689 - 690 690 - let gen_operation_impl ~current_prefix (op : operation_info) : string = 691 691 - let doc = format_doc_block ~summary:op.summary ?description:op.description () in 692 692 - let param_docs = String.concat "" 693 693 - ((List.map (fun (n, _, d, _) -> format_param_doc n d) op.path_params) @ 694 694 - (List.map (fun (n, _, d, _) -> format_param_doc n d) op.query_params)) in 695 695 - let full_doc = if param_docs = "" then doc 696 696 - else if doc = "" then Printf.sprintf "(**\n%s*)\n" param_docs 697 697 - else String.sub doc 0 (String.length doc - 3) ^ param_docs ^ "*)\n" in 698 698 - 699 699 - let path_args = List.map (fun (n, _, _, _) -> Printf.sprintf "~%s" n) op.path_params in 700 700 - let query_args = List.map (fun (n, _, _, req) -> 701 701 - if req then Printf.sprintf "~%s" n else Printf.sprintf "?%s" n 702 702 - ) op.query_params in 703 703 - (* DELETE and HEAD don't support body in the requests library *) 704 704 - let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in 705 705 - let body_arg = match op.body_schema_ref, method_supports_body with 706 706 - | Some _, true -> ["~body"] 707 707 - | _ -> [] 708 708 - in 709 709 - let all_args = path_args @ query_args @ body_arg @ ["client"; "()"] in 710 710 - 711 711 - let path_render = 712 712 - if op.path_params = [] then Printf.sprintf "%S" op.path 713 713 - else 714 714 - let bindings = List.map (fun (ocaml, json, _, _) -> 715 715 - Printf.sprintf "(%S, %s)" json ocaml 716 716 - ) op.path_params in 717 717 - Printf.sprintf "Openapi.Runtime.Path.render ~params:[%s] %S" 718 718 - (String.concat "; " bindings) op.path 719 719 - in 720 720 - 721 721 - let query_build = 722 722 - if op.query_params = [] then "\"\"" 723 723 - else 724 724 - let parts = List.map (fun (ocaml, json, _, req) -> 725 725 - if req then Printf.sprintf "Openapi.Runtime.Query.singleton ~key:%S ~value:%s" json ocaml 726 726 - else Printf.sprintf "Openapi.Runtime.Query.optional ~key:%S ~value:%s" json ocaml 727 727 - ) op.query_params in 728 728 - Printf.sprintf "Openapi.Runtime.Query.encode (List.concat [%s])" (String.concat "; " parts) 729 729 - in 730 730 - 731 731 - let method_lower = String.lowercase_ascii op.method_ in 732 732 - let body_codec = match op.body_schema_ref with 733 733 - | Some name -> format_jsont_ref ~current_prefix name 734 734 - | None -> "Jsont.json" 735 735 - in 736 736 - (* DELETE and HEAD don't support body in the requests library *) 737 737 - let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in 738 738 - let http_call = match op.body_schema_ref, method_supports_body with 739 739 - | Some _, true -> 740 740 - Printf.sprintf "Requests.%s client.session ~body:(Requests.Body.json (Openapi.Runtime.Json.encode_json %s body)) url" 741 741 - method_lower body_codec 742 742 - | Some _, false -> 743 743 - (* Method doesn't support body - ignore the body parameter *) 744 744 - Printf.sprintf "Requests.%s client.session url" method_lower 745 745 - | None, _ -> 746 746 - Printf.sprintf "Requests.%s client.session url" method_lower 747 747 - in 748 748 - 749 749 - let response_codec = match op.response_schema_ref with 750 750 - | Some name -> format_jsont_ref ~current_prefix name 751 751 - | None -> "Jsont.json" 752 752 - in 753 753 - 754 754 - let decode = if response_codec = "Jsont.json" then 755 755 - "Requests.Response.json response" 756 756 - else 757 757 - Printf.sprintf "Openapi.Runtime.Json.decode_json_exn %s (Requests.Response.json response)" response_codec 758 758 - in 759 759 - 760 760 - Printf.sprintf {|%slet %s %s = 761 761 - let op_name = %S in 762 762 - let url_path = %s in 763 763 - let query = %s in 764 764 - let url = client.base_url ^ url_path ^ query in 765 765 - let response = 766 766 - try %s 767 767 - with Eio.Io _ as ex -> 768 768 - let bt = Printexc.get_raw_backtrace () in 769 769 - Eio.Exn.reraise_with_context ex bt "calling %%s %%s" %S url 770 770 - in 771 771 - if Requests.Response.ok response then 772 772 - %s 773 773 - else 774 774 - raise (Openapi.Runtime.Api_error { 775 775 - operation = op_name; 776 776 - method_ = %S; 777 777 - url; 778 778 - status = Requests.Response.status_code response; 779 779 - body = Requests.Response.text response; 780 780 - })|} 781 781 - full_doc op.func_name (String.concat " " all_args) 782 782 - op.func_name path_render query_build http_call op.method_ decode op.method_ 783 783 - 784 784 - (** Format a type reference, stripping the current_prefix if present *) 785 785 - let format_type_ref ~current_prefix (schema_ref : string) : string = 786 786 - let prefix, suffix = Name.split_schema_name schema_ref in 787 787 - let prefix_mod = Name.to_module_name prefix in 788 788 - let suffix_mod = Name.to_module_name suffix in 789 789 - if prefix_mod = current_prefix then 790 790 - (* Local reference - use unqualified name *) 791 791 - Printf.sprintf "%s.t" suffix_mod 792 792 - else 793 793 - Printf.sprintf "%s.%s.t" prefix_mod suffix_mod 794 794 - 795 795 - let gen_operation_intf ~current_prefix (op : operation_info) : string = 796 796 - let doc = format_doc_block ~summary:op.summary ?description:op.description () in 797 797 - let param_docs = String.concat "" 798 798 - ((List.map (fun (n, _, d, _) -> format_param_doc n d) op.path_params) @ 799 799 - (List.map (fun (n, _, d, _) -> format_param_doc n d) op.query_params)) in 800 800 - let full_doc = if param_docs = "" then doc 801 801 - else if doc = "" then Printf.sprintf "(**\n%s*)\n" param_docs 802 802 - else String.sub doc 0 (String.length doc - 3) ^ param_docs ^ "*)\n" in 803 803 - 804 804 - let path_args = List.map (fun (n, _, _, _) -> Printf.sprintf "%s:string" n) op.path_params in 805 805 - let query_args = List.map (fun (n, _, _, req) -> 806 806 - if req then Printf.sprintf "%s:string" n else Printf.sprintf "?%s:string" n 807 807 - ) op.query_params in 808 808 - let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in 809 809 - let body_arg = match op.body_schema_ref, method_supports_body with 810 810 - | Some name, true -> [Printf.sprintf "body:%s" (format_type_ref ~current_prefix name)] 811 811 - | _ -> [] 812 812 - in 813 813 - let response_type = match op.response_schema_ref with 814 814 - | Some name -> format_type_ref ~current_prefix name 815 815 - | None -> "Jsont.json" 816 816 - in 817 817 - let all_args = path_args @ query_args @ body_arg @ ["t"; "unit"; response_type] in 818 818 - 819 819 - Printf.sprintf "%sval %s : %s" full_doc op.func_name (String.concat " -> " all_args) 820 820 - 821 821 - (** {1 Full Module Generation} *) 822 822 - 823 823 - let gen_submodule_impl ~current_prefix (schema : schema_info) : string = 824 824 - let suffix_mod = Name.to_module_name schema.suffix in 825 825 - let content = if schema.is_enum then gen_enum_impl schema else gen_record_impl ~current_prefix schema in 826 826 - let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in 827 827 - Printf.sprintf "module %s = struct\n%s\nend" suffix_mod indented 828 828 - 829 829 - let gen_submodule_intf ~current_prefix (schema : schema_info) : string = 830 830 - let suffix_mod = Name.to_module_name schema.suffix in 831 831 - let content = if schema.is_enum then gen_enum_intf schema else gen_record_intf ~current_prefix schema in 832 832 - let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in 833 833 - Printf.sprintf "module %s : sig\n%s\nend" suffix_mod indented 834 834 - 835 835 - (** Extract suffix module dependencies within the same prefix *) 836 836 - let schema_suffix_deps ~current_prefix (schema : schema_info) : string list = 837 837 - List.filter_map (fun (f : field_info) -> 838 838 - (* Check if the type references a sibling module (same prefix) *) 839 839 - if String.contains f.base_type '.' then 840 840 - match String.split_on_char '.' f.base_type with 841 841 - | prefix :: suffix :: _ when prefix = current_prefix -> 842 842 - Some (Name.to_module_name suffix) 843 843 - | _ -> None 844 844 - else None 845 845 - ) schema.fields 846 846 - 847 847 - (** Sort schemas within a prefix module by their dependencies *) 848 848 - let sort_schemas_by_deps ~current_prefix (schemas : schema_info list) : schema_info list = 849 849 - let suffix_of schema = Name.to_module_name schema.suffix in 850 850 - let suffix_names = List.map suffix_of schemas in 851 851 - let deps_of suffix = 852 852 - match List.find_opt (fun s -> suffix_of s = suffix) schemas with 853 853 - | Some schema -> schema_suffix_deps ~current_prefix schema |> List.filter (fun d -> List.mem d suffix_names) 854 854 - | None -> [] 855 855 - in 856 856 - let sorted = topological_sort suffix_names deps_of in 857 857 - List.filter_map (fun suffix -> 858 858 - List.find_opt (fun s -> suffix_of s = suffix) schemas 859 859 - ) sorted 860 860 - 861 861 - let gen_prefix_module_impl (node : module_node) : string = 862 862 - let sorted_schemas = sort_schemas_by_deps ~current_prefix:node.name node.schemas in 863 863 - let schema_mods = List.map (gen_submodule_impl ~current_prefix:node.name) sorted_schemas in 864 864 - let op_impls = List.map (gen_operation_impl ~current_prefix:node.name) (List.rev node.operations) in 865 865 - let content = String.concat "\n\n" (schema_mods @ op_impls) in 866 866 - let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in 867 867 - Printf.sprintf "module %s = struct\n%s\nend" node.name indented 868 868 - 869 869 - let gen_prefix_module_intf (node : module_node) : string = 870 870 - let sorted_schemas = sort_schemas_by_deps ~current_prefix:node.name node.schemas in 871 871 - let schema_mods = List.map (gen_submodule_intf ~current_prefix:node.name) sorted_schemas in 872 872 - let op_intfs = List.map (gen_operation_intf ~current_prefix:node.name) (List.rev node.operations) in 873 873 - let content = String.concat "\n\n" (schema_mods @ op_intfs) in 874 874 - let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in 875 875 - Printf.sprintf "module %s : sig\n%s\nend" node.name indented 876 876 - 877 877 - (** {1 Top-Level Generation} *) 878 878 - 879 879 - type config = { 880 880 - output_dir : string; 881 881 - package_name : string; 882 882 - spec_path : string option; 883 883 - } 884 884 - 885 885 - let generate_ml (spec : Spec.t) (package_name : string) : string = 886 886 - let api_desc = Option.value ~default:"Generated API client." spec.info.description in 887 887 - 888 888 - (* Collect schemas *) 889 889 - let schemas = match spec.components with 890 890 - | None -> [] 891 891 - | Some c -> List.filter_map (fun (name, sor) -> 892 892 - match sor with 893 893 - | Spec.Ref _ -> None 894 894 - | Spec.Value s -> Some (analyze_schema name s) 895 895 - ) c.schemas 896 896 - in 897 897 - 898 898 - (* Collect operations *) 899 899 - let operations = List.concat_map (fun (path, pi) -> 900 900 - let ops = [ 901 901 - ("GET", pi.Spec.get); ("POST", pi.post); ("PUT", pi.put); 902 902 - ("DELETE", pi.delete); ("PATCH", pi.patch); 903 903 - ("HEAD", pi.head); ("OPTIONS", pi.options); 904 904 - ] in 905 905 - List.filter_map (fun (method_, op_opt) -> 906 906 - Option.map (fun op -> analyze_operation ~path ~method_ op) op_opt 907 907 - ) ops 908 908 - ) spec.paths in 909 909 - 910 910 - (* Build module tree *) 911 911 - let (tree, sorted_modules) = build_module_tree schemas operations in 912 912 - 913 913 - (* Generate top-level client type and functions *) 914 914 - let client_impl = {|type t = { 915 915 - session : Requests.t; 916 916 - base_url : string; 917 917 - } 918 918 - 919 919 - let create ?session ~sw env ~base_url = 920 920 - let session = match session with 921 921 - | Some s -> s 922 922 - | None -> Requests.create ~sw env 923 923 - in 924 924 - { session; base_url } 925 925 - 926 926 - let base_url t = t.base_url 927 927 - let session t = t.session|} in 928 928 - 929 929 - (* Generate prefix modules in dependency order *) 930 930 - let prefix_mods = List.filter_map (fun name -> 931 931 - match StringMap.find_opt name tree.children with 932 932 - | None -> None 933 933 - | Some node -> 934 934 - if node.name = "Client" then 935 935 - (* Generate Client operations inline *) 936 936 - let ops = List.map (gen_operation_impl ~current_prefix:"Client") (List.rev node.operations) in 937 937 - if ops = [] then None 938 938 - else 939 939 - let content = String.concat "\n\n" ops in 940 940 - let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in 941 941 - Some (Printf.sprintf "module Client = struct\n%s\nend" indented) 942 942 - else 943 943 - Some (gen_prefix_module_impl node) 944 944 - ) sorted_modules in 945 945 - 946 946 - Printf.sprintf {|(** {1 %s} 947 947 - 948 948 - %s 949 949 - 950 950 - @version %s *) 951 951 - 952 952 - %s 953 953 - 954 954 - %s 955 955 - |} 956 956 - (Name.to_module_name package_name) (escape_doc api_desc) spec.info.version 957 957 - client_impl (String.concat "\n\n" prefix_mods) 958 958 - 959 959 - let generate_mli (spec : Spec.t) (package_name : string) : string = 960 960 - let api_desc = Option.value ~default:"Generated API client." spec.info.description in 961 961 - 962 962 - (* Collect schemas *) 963 963 - let schemas = match spec.components with 964 964 - | None -> [] 965 965 - | Some c -> List.filter_map (fun (name, sor) -> 966 966 - match sor with 967 967 - | Spec.Ref _ -> None 968 968 - | Spec.Value s -> Some (analyze_schema name s) 969 969 - ) c.schemas 970 970 - in 971 971 - 972 972 - (* Collect operations *) 973 973 - let operations = List.concat_map (fun (path, pi) -> 974 974 - let ops = [ 975 975 - ("GET", pi.Spec.get); ("POST", pi.post); ("PUT", pi.put); 976 976 - ("DELETE", pi.delete); ("PATCH", pi.patch); 977 977 - ("HEAD", pi.head); ("OPTIONS", pi.options); 978 978 - ] in 979 979 - List.filter_map (fun (method_, op_opt) -> 980 980 - Option.map (fun op -> analyze_operation ~path ~method_ op) op_opt 981 981 - ) ops 982 982 - ) spec.paths in 983 983 - 984 984 - (* Build module tree *) 985 985 - let (tree, sorted_modules) = build_module_tree schemas operations in 986 986 - 987 987 - (* Generate top-level client type and function interfaces *) 988 988 - let client_intf = {|type t 989 989 - 990 990 - val create : 991 991 - ?session:Requests.t -> 992 992 - sw:Eio.Switch.t -> 993 993 - < net : _ Eio.Net.t ; fs : Eio.Fs.dir_ty Eio.Path.t ; clock : _ Eio.Time.clock ; .. > -> 994 994 - base_url:string -> 995 995 - t 996 996 - 997 997 - val base_url : t -> string 998 998 - val session : t -> Requests.t|} in 999 999 - 1000 1000 - (* Generate prefix modules in dependency order *) 1001 1001 - let prefix_mods = List.filter_map (fun name -> 1002 1002 - match StringMap.find_opt name tree.children with 1003 1003 - | None -> None 1004 1004 - | Some node -> 1005 1005 - if node.name = "Client" then 1006 1006 - let ops = List.map (gen_operation_intf ~current_prefix:"Client") (List.rev node.operations) in 1007 1007 - if ops = [] then None 1008 1008 - else 1009 1009 - let content = String.concat "\n\n" ops in 1010 1010 - let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in 1011 1011 - Some (Printf.sprintf "module Client : sig\n%s\nend" indented) 1012 1012 - else 1013 1013 - Some (gen_prefix_module_intf node) 1014 1014 - ) sorted_modules in 1015 1015 - 1016 1016 - Printf.sprintf {|(** {1 %s} 1017 1017 - 1018 1018 - %s 1019 1019 - 1020 1020 - @version %s *) 1021 1021 - 1022 1022 - %s 1023 1023 - 1024 1024 - %s 1025 1025 - |} 1026 1026 - (Name.to_module_name package_name) (escape_doc api_desc) spec.info.version 1027 1027 - client_intf (String.concat "\n\n" prefix_mods) 1028 1028 - 1029 1029 - let generate_dune (package_name : string) : string = 1030 1030 - Printf.sprintf {|(library 1031 1031 - (name %s) 1032 1032 - (libraries openapi jsont jsont.bytesrw requests ptime eio) 1033 1033 - (wrapped true)) 1034 1034 - 1035 1035 - (include dune.inc) 1036 1036 - |} package_name 1037 1037 - 1038 1038 - let generate_dune_inc ~(spec_path : string option) (package_name : string) : string = 1039 1039 - match spec_path with 1040 1040 - | None -> "; No spec path provided - regeneration rules not generated\n" 1041 1041 - | Some path -> 1042 1042 - Printf.sprintf {|; Generated rules for OpenAPI code regeneration 1043 1043 - ; Run: dune build @gen --auto-promote 1044 1044 - 1045 1045 - (rule 1046 1046 - (alias gen) 1047 1047 - (mode (promote (until-clean))) 1048 1048 - (targets %s.ml %s.mli) 1049 1049 - (deps %s) 1050 1050 - (action 1051 1051 - (run openapi-gen generate -o . -n %s %%{deps}))) 1052 1052 - |} package_name package_name path package_name 1053 1053 - 1054 1054 - let generate ~(config : config) (spec : Spec.t) : (string * string) list = 1055 1055 - let package_name = config.package_name in 1056 1056 - [ 1057 1057 - ("dune", generate_dune package_name); 1058 1058 - ("dune.inc", generate_dune_inc ~spec_path:config.spec_path package_name); 1059 1059 - (package_name ^ ".ml", generate_ml spec package_name); 1060 1060 - (package_name ^ ".mli", generate_mli spec package_name); 1061 1061 - ] 1062 1062 - 1063 1063 - let write_files ~(output_dir : string) (files : (string * string) list) : unit = 1064 1064 - List.iter (fun (filename, content) -> 1065 1065 - let path = Filename.concat output_dir filename in 1066 1066 - let oc = open_out path in 1067 1067 - output_string oc content; 1068 1068 - close_out oc 1069 1069 - ) files

-156

ocaml-openapi/lib/openapi_nestjs.ml

reviewed

··· 1 1 - (*--------------------------------------------------------------------------- 2 2 - Copyright (c) 2025 Anil Madhavapeddy. All rights reserved. 3 3 - SPDX-License-Identifier: ISC 4 4 - ---------------------------------------------------------------------------*) 5 5 - 6 6 - (** NestJS-style API error handling. 7 7 - 8 8 - NestJS/Express applications return errors in a standard format: 9 9 - {[ 10 10 - { 11 11 - "message": "Missing required permission: person.read", 12 12 - "error": "Forbidden", 13 13 - "statusCode": 403, 14 14 - "correlationId": "koskgk9d" 15 15 - } 16 16 - ]} 17 17 - 18 18 - This module provides types and utilities for parsing and handling 19 19 - these errors in a structured way. 20 20 - 21 21 - {2 Usage} 22 22 - 23 23 - {[ 24 24 - match Immich.People.get_all_people client () with 25 25 - | people -> ... 26 26 - | exception Openapi.Runtime.Api_error e -> 27 27 - match Openapi.Nestjs.of_api_error e with 28 28 - | Some nestjs_error -> 29 29 - Fmt.epr "Error: %s (correlation: %s)@." 30 30 - nestjs_error.message 31 31 - (Option.value ~default:"none" nestjs_error.correlation_id) 32 32 - | None -> 33 33 - (* Not a NestJS error, use raw body *) 34 34 - Fmt.epr "Error: %s@." e.body 35 35 - ]} 36 36 - *) 37 37 - 38 38 - (** {1 Error Types} *) 39 39 - 40 40 - (** A structured NestJS HTTP exception. *) 41 41 - type t = { 42 42 - status_code : int; 43 43 - (** HTTP status code (e.g., 403, 404, 500). *) 44 44 - 45 45 - error : string option; 46 46 - (** Error category (e.g., "Forbidden", "Not Found", "Internal Server Error"). *) 47 47 - 48 48 - message : string; 49 49 - (** Human-readable error message. Can be a single string or concatenated 50 50 - from an array of validation messages. *) 51 51 - 52 52 - correlation_id : string option; 53 53 - (** Request correlation ID for debugging/support. *) 54 54 - } 55 55 - 56 56 - (** {1 JSON Codec} *) 57 57 - 58 58 - (** Jsont codec for NestJS errors. 59 59 - 60 60 - Handles both string and array message formats: 61 61 - - {[ "message": "error text" ]} 62 62 - - {[ "message": ["validation error 1", "validation error 2"] ]} *) 63 63 - let jsont : t Jsont.t = 64 64 - (* Message can be string or array of strings *) 65 65 - let message_jsont = 66 66 - Jsont.map Jsont.json ~kind:"message" 67 67 - ~dec:(fun json -> 68 68 - match json with 69 69 - | Jsont.String (s, _) -> s 70 70 - | Jsont.Array (items, _) -> 71 71 - items 72 72 - |> List.filter_map (function 73 73 - | Jsont.String (s, _) -> Some s 74 74 - | _ -> None) 75 75 - |> String.concat "; " 76 76 - | _ -> "Unknown error") 77 77 - ~enc:(fun s -> Jsont.String (s, Jsont.Meta.none)) 78 78 - in 79 79 - Jsont.Object.map ~kind:"NestjsError" 80 80 - (fun status_code error message correlation_id -> 81 81 - { status_code; error; message; correlation_id }) 82 82 - |> Jsont.Object.mem "statusCode" Jsont.int ~enc:(fun e -> e.status_code) 83 83 - |> Jsont.Object.opt_mem "error" Jsont.string ~enc:(fun e -> e.error) 84 84 - |> Jsont.Object.mem "message" message_jsont ~enc:(fun e -> e.message) 85 85 - |> Jsont.Object.opt_mem "correlationId" Jsont.string ~enc:(fun e -> e.correlation_id) 86 86 - |> Jsont.Object.skip_unknown 87 87 - |> Jsont.Object.finish 88 88 - 89 89 - (** {1 Parsing} *) 90 90 - 91 91 - (** Parse a JSON string into a NestJS error. 92 92 - Returns [None] if the string is not valid NestJS error JSON. *) 93 93 - let of_string (s : string) : t option = 94 94 - match Jsont_bytesrw.decode_string jsont s with 95 95 - | Ok e -> Some e 96 96 - | Error _ -> None 97 97 - 98 98 - (** Parse an {!Openapi.Runtime.Api_error} into a structured NestJS error. 99 99 - Returns [None] if the error body is not valid NestJS error JSON. *) 100 100 - let of_api_error (e : Openapi_runtime.api_error) : t option = 101 101 - of_string e.body 102 102 - 103 103 - (** {1 Convenience Functions} *) 104 104 - 105 105 - (** Check if this is a permission/authorization error (401 or 403). *) 106 106 - let is_auth_error (e : t) : bool = 107 107 - e.status_code = 401 || e.status_code = 403 108 108 - 109 109 - (** Check if this is a "not found" error (404). *) 110 110 - let is_not_found (e : t) : bool = 111 111 - e.status_code = 404 112 112 - 113 113 - (** Check if this is a validation error (400 with message array). *) 114 114 - let is_validation_error (e : t) : bool = 115 115 - e.status_code = 400 116 116 - 117 117 - (** Check if this is a server error (5xx). *) 118 118 - let is_server_error (e : t) : bool = 119 119 - e.status_code >= 500 && e.status_code < 600 120 120 - 121 121 - (** {1 Pretty Printing} *) 122 122 - 123 123 - (** Pretty-print a NestJS error. *) 124 124 - let pp ppf (e : t) = 125 125 - match e.correlation_id with 126 126 - | Some cid -> 127 127 - Format.fprintf ppf "%s [%d] (correlationId: %s)" 128 128 - e.message e.status_code cid 129 129 - | None -> 130 130 - Format.fprintf ppf "%s [%d]" e.message e.status_code 131 131 - 132 132 - (** Convert to a human-readable string. *) 133 133 - let to_string (e : t) : string = 134 134 - Format.asprintf "%a" pp e 135 135 - 136 136 - (** {1 Exception Handling} *) 137 137 - 138 138 - (** Exception for NestJS-specific errors. 139 139 - Use this when you want to distinguish NestJS errors from generic API errors. *) 140 140 - exception Error of t 141 141 - 142 142 - (** Register a pretty printer for the exception. *) 143 143 - let () = 144 144 - Printexc.register_printer (function 145 145 - | Error e -> Some (Format.asprintf "Nestjs.Error: %a" pp e) 146 146 - | _ -> None) 147 147 - 148 148 - (** Handle an {!Openapi.Runtime.Api_error}, converting it to a NestJS error 149 149 - if possible. 150 150 - 151 151 - @raise Error if the error body parses as a NestJS error 152 152 - @raise Openapi.Runtime.Api_error if parsing fails (re-raises original) *) 153 153 - let raise_if_nestjs (e : Openapi_runtime.api_error) = 154 154 - match of_api_error e with 155 155 - | Some nestjs -> raise (Error nestjs) 156 156 - | None -> raise (Openapi_runtime.Api_error e)

-104

ocaml-openapi/lib/openapi_nestjs.mli

reviewed

··· 1 1 - (*--------------------------------------------------------------------------- 2 2 - Copyright (c) 2025 Anil Madhavapeddy. All rights reserved. 3 3 - SPDX-License-Identifier: ISC 4 4 - ---------------------------------------------------------------------------*) 5 5 - 6 6 - (** NestJS-style API error handling. 7 7 - 8 8 - NestJS/Express applications return errors in a standard format: 9 9 - {[ 10 10 - { 11 11 - "message": "Missing required permission: person.read", 12 12 - "error": "Forbidden", 13 13 - "statusCode": 403, 14 14 - "correlationId": "koskgk9d" 15 15 - } 16 16 - ]} 17 17 - 18 18 - This module provides types and utilities for parsing and handling 19 19 - these errors in a structured way. 20 20 - 21 21 - {2 Usage} 22 22 - 23 23 - {[ 24 24 - match Immich.People.get_all_people client () with 25 25 - | people -> ... 26 26 - | exception Openapi.Runtime.Api_error e -> 27 27 - match Openapi.Nestjs.of_api_error e with 28 28 - | Some nestjs_error -> 29 29 - Fmt.epr "Error: %s (correlation: %s)@." 30 30 - nestjs_error.message 31 31 - (Option.value ~default:"none" nestjs_error.correlation_id) 32 32 - | None -> 33 33 - (* Not a NestJS error, use raw body *) 34 34 - Fmt.epr "Error: %s@." e.body 35 35 - ]} 36 36 - *) 37 37 - 38 38 - (** {1 Error Types} *) 39 39 - 40 40 - (** A structured NestJS HTTP exception. *) 41 41 - type t = { 42 42 - status_code : int; 43 43 - (** HTTP status code (e.g., 403, 404, 500). *) 44 44 - 45 45 - error : string option; 46 46 - (** Error category (e.g., "Forbidden", "Not Found", "Internal Server Error"). *) 47 47 - 48 48 - message : string; 49 49 - (** Human-readable error message. Can be a single string or concatenated 50 50 - from an array of validation messages. *) 51 51 - 52 52 - correlation_id : string option; 53 53 - (** Request correlation ID for debugging/support. *) 54 54 - } 55 55 - 56 56 - (** {1 JSON Codec} *) 57 57 - 58 58 - val jsont : t Jsont.t 59 59 - (** Jsont codec for NestJS errors. *) 60 60 - 61 61 - (** {1 Parsing} *) 62 62 - 63 63 - val of_string : string -> t option 64 64 - (** Parse a JSON string into a NestJS error. 65 65 - Returns [None] if the string is not valid NestJS error JSON. *) 66 66 - 67 67 - val of_api_error : Openapi_runtime.api_error -> t option 68 68 - (** Parse an {!Openapi_runtime.api_error} into a structured NestJS error. 69 69 - Returns [None] if the error body is not valid NestJS error JSON. *) 70 70 - 71 71 - (** {1 Convenience Functions} *) 72 72 - 73 73 - val is_auth_error : t -> bool 74 74 - (** Check if this is a permission/authorization error (401 or 403). *) 75 75 - 76 76 - val is_not_found : t -> bool 77 77 - (** Check if this is a "not found" error (404). *) 78 78 - 79 79 - val is_validation_error : t -> bool 80 80 - (** Check if this is a validation error (400 with message array). *) 81 81 - 82 82 - val is_server_error : t -> bool 83 83 - (** Check if this is a server error (5xx). *) 84 84 - 85 85 - (** {1 Pretty Printing} *) 86 86 - 87 87 - val pp : Format.formatter -> t -> unit 88 88 - (** Pretty-print a NestJS error. *) 89 89 - 90 90 - val to_string : t -> string 91 91 - (** Convert to a human-readable string. *) 92 92 - 93 93 - (** {1 Exception Handling} *) 94 94 - 95 95 - exception Error of t 96 96 - (** Exception for NestJS-specific errors. 97 97 - Use this when you want to distinguish NestJS errors from generic API errors. *) 98 98 - 99 99 - val raise_if_nestjs : Openapi_runtime.api_error -> 'a 100 100 - (** Handle an {!Openapi_runtime.api_error}, converting it to a NestJS error 101 101 - if possible. 102 102 - 103 103 - @raise Error if the error body parses as a NestJS error 104 104 - @raise Openapi_runtime.Api_error if parsing fails (re-raises original) *)

-200

ocaml-openapi/lib/openapi_runtime.ml

reviewed

··· 1 1 - (** Runtime utilities for generated OpenAPI clients. 2 2 - 3 3 - This module provides utilities used by generated client code: 4 4 - - Path template rendering 5 5 - - Query parameter building 6 6 - - JSON encoding/decoding helpers 7 7 - *) 8 8 - 9 9 - (** {1 Path Templates} *) 10 10 - 11 11 - module Path = struct 12 12 - (** Render a path template like "/users/{id}/posts/{postId}" with parameters *) 13 13 - let render ~(params : (string * string) list) (template : string) : string = 14 14 - List.fold_left 15 15 - (fun path (name, value) -> 16 16 - match String.split_on_char '{' path with 17 17 - | [only] -> only 18 18 - | parts -> 19 19 - String.concat "" (List.mapi (fun i part -> 20 20 - if i = 0 then part 21 21 - else 22 22 - match String.split_on_char '}' part with 23 23 - | [var; rest] when var = name -> value ^ rest 24 24 - | _ -> "{" ^ part 25 25 - ) parts)) 26 26 - template params 27 27 - 28 28 - (** Extract parameter names from a path template *) 29 29 - let parameters (template : string) : string list = 30 30 - let rec extract acc s = 31 31 - match String.index_opt s '{' with 32 32 - | None -> List.rev acc 33 33 - | Some i -> 34 34 - let rest = String.sub s (i + 1) (String.length s - i - 1) in 35 35 - match String.index_opt rest '}' with 36 36 - | None -> List.rev acc 37 37 - | Some j -> 38 38 - let name = String.sub rest 0 j in 39 39 - let remaining = String.sub rest (j + 1) (String.length rest - j - 1) in 40 40 - extract (name :: acc) remaining 41 41 - in 42 42 - extract [] template 43 43 - end 44 44 - 45 45 - (** {1 Query Parameters} *) 46 46 - 47 47 - module Query = struct 48 48 - type param = string * string 49 49 - 50 50 - (** Helper for optional parameters with custom stringifier *) 51 51 - let optional_with ~key ~value ~to_string : param list = 52 52 - Option.fold ~none:[] ~some:(fun v -> [(key, to_string v)]) value 53 53 - 54 54 - let singleton ~key ~value : param list = [(key, value)] 55 55 - 56 56 - let optional ~key ~value : param list = 57 57 - optional_with ~key ~value ~to_string:Fun.id 58 58 - 59 59 - let list ~key ~values : param list = 60 60 - List.map (fun v -> (key, v)) values 61 61 - 62 62 - let int ~key ~value : param list = [(key, string_of_int value)] 63 63 - 64 64 - let int_opt ~key ~value : param list = 65 65 - optional_with ~key ~value ~to_string:string_of_int 66 66 - 67 67 - let bool ~key ~value : param list = 68 68 - [(key, if value then "true" else "false")] 69 69 - 70 70 - let bool_opt ~key ~value : param list = 71 71 - optional_with ~key ~value ~to_string:(fun b -> if b then "true" else "false") 72 72 - 73 73 - let float ~key ~value : param list = [(key, string_of_float value)] 74 74 - 75 75 - let float_opt ~key ~value : param list = 76 76 - optional_with ~key ~value ~to_string:string_of_float 77 77 - 78 78 - let encode (params : param list) : string = 79 79 - if params = [] then "" 80 80 - else 81 81 - "?" ^ 82 82 - String.concat "&" (List.map (fun (k, v) -> 83 83 - (* URL encode the value *) 84 84 - let encode_char c = 85 85 - match c with 86 86 - | 'A'..'Z' | 'a'..'z' | '0'..'9' | '-' | '_' | '.' | '~' -> 87 87 - String.make 1 c 88 88 - | c -> 89 89 - Printf.sprintf "%%%02X" (Char.code c) 90 90 - in 91 91 - let encoded_v = String.to_seq v 92 92 - |> Seq.map encode_char 93 93 - |> List.of_seq 94 94 - |> String.concat "" 95 95 - in 96 96 - k ^ "=" ^ encoded_v 97 97 - ) params) 98 98 - end 99 99 - 100 100 - (** {1 JSON Helpers} *) 101 101 - 102 102 - module Json = struct 103 103 - let decode codec s = 104 104 - Jsont_bytesrw.decode_string codec s 105 105 - 106 106 - let decode' codec s = 107 107 - Jsont_bytesrw.decode_string' codec s 108 108 - 109 109 - let encode codec v = 110 110 - Jsont_bytesrw.encode_string codec v 111 111 - 112 112 - let encode' codec v = 113 113 - Jsont_bytesrw.encode_string' codec v 114 114 - 115 115 - let encode_compact codec v = 116 116 - Jsont_bytesrw.encode_string ~format:Jsont.Minify codec v 117 117 - 118 118 - (** Decode a Jsont.json value through a codec. 119 119 - Encodes to string then decodes - not optimal but works. *) 120 120 - let decode_json (codec : 'a Jsont.t) (json : Jsont.json) : ('a, string) result = 121 121 - match Jsont_bytesrw.encode_string Jsont.json json with 122 122 - | Ok s -> Jsont_bytesrw.decode_string codec s 123 123 - | Error e -> Error e 124 124 - 125 125 - (** Decode a Jsont.json value, raising on error *) 126 126 - let decode_json_exn (codec : 'a Jsont.t) (json : Jsont.json) : 'a = 127 127 - match decode_json codec json with 128 128 - | Ok v -> v 129 129 - | Error e -> failwith e 130 130 - 131 131 - (** Encode a value to Jsont.json *) 132 132 - let encode_json (codec : 'a Jsont.t) (v : 'a) : Jsont.json = 133 133 - match Jsont_bytesrw.encode_string codec v with 134 134 - | Ok s -> 135 135 - (match Jsont_bytesrw.decode_string Jsont.json s with 136 136 - | Ok json -> json 137 137 - | Error _ -> Jsont.Null ((), Jsont.Meta.none)) 138 138 - | Error _ -> Jsont.Null ((), Jsont.Meta.none) 139 139 - end 140 140 - 141 141 - (** {1 HTTP Method} *) 142 142 - 143 143 - type http_method = Get | Post | Put | Patch | Delete | Head | Options 144 144 - 145 145 - let string_of_method = function 146 146 - | Get -> "GET" 147 147 - | Post -> "POST" 148 148 - | Put -> "PUT" 149 149 - | Patch -> "PATCH" 150 150 - | Delete -> "DELETE" 151 151 - | Head -> "HEAD" 152 152 - | Options -> "OPTIONS" 153 153 - 154 154 - (** {1 Common Types} *) 155 155 - 156 156 - (** ISO 8601 date-time codec *) 157 157 - let ptime_jsont : Ptime.t Jsont.t = 158 158 - Jsont.map Jsont.string ~kind:"datetime" 159 159 - ~dec:(fun s -> 160 160 - match Ptime.of_rfc3339 s with 161 161 - | Ok (t, _, _) -> t 162 162 - | Error _ -> Jsont.Error.msgf Jsont.Meta.none "Invalid datetime: %s" s) 163 163 - ~enc:(fun t -> Ptime.to_rfc3339 t) 164 164 - 165 165 - (** UUID as string *) 166 166 - let uuid_jsont : string Jsont.t = Jsont.string 167 167 - 168 168 - (** Base64 encoded bytes *) 169 169 - let base64_jsont : string Jsont.t = Jsont.string 170 170 - 171 171 - (** {1 Nullable wrapper} *) 172 172 - 173 173 - let nullable (codec : 'a Jsont.t) : 'a option Jsont.t = 174 174 - Jsont.option codec 175 175 - 176 176 - (** {1 Any JSON value wrapper} *) 177 177 - 178 178 - type json = Jsont.json 179 179 - 180 180 - let json_jsont : json Jsont.t = Jsont.json 181 181 - 182 182 - (** {1 API Errors} *) 183 183 - 184 184 - (** Error raised when an API call fails with a non-2xx status code *) 185 185 - type api_error = { 186 186 - operation : string; 187 187 - method_ : string; 188 188 - url : string; 189 189 - status : int; 190 190 - body : string; 191 191 - } 192 192 - 193 193 - exception Api_error of api_error 194 194 - 195 195 - let () = 196 196 - Printexc.register_printer (function 197 197 - | Api_error e -> 198 198 - Some (Printf.sprintf "Api_error: %s %s returned %d: %s" 199 199 - e.method_ e.url e.status e.body) 200 200 - | _ -> None)

-876

ocaml-openapi/lib/openapi_spec.ml

reviewed

··· 1 1 - (** OpenAPI 3.x specification types with jsont codecs. 2 2 - 3 3 - This module defines types that mirror the OpenAPI 3.0/3.1 specification, 4 4 - with bidirectional JSON codecs using jsont. *) 5 5 - 6 6 - (** {1 Reference handling} *) 7 7 - 8 8 - type 'a or_ref = 9 9 - | Ref of string (** A $ref pointer like "#/components/schemas/Pet" *) 10 10 - | Value of 'a (** An inline value *) 11 11 - 12 12 - (** Find a member by name in an object's member list *) 13 13 - let find_member name (mems : Jsont.mem list) : Jsont.json option = 14 14 - List.find_map (fun ((n, _meta), v) -> 15 15 - if n = name then Some v else None 16 16 - ) mems 17 17 - 18 18 - (** Create an or_ref codec that handles $ref pointers. 19 19 - Uses JSON as intermediate to detect $ref field. *) 20 20 - let or_ref_jsont (value_jsont : 'a Jsont.t) : 'a or_ref Jsont.t = 21 21 - Jsont.map Jsont.json ~kind:"or_ref" 22 22 - ~dec:(fun json -> 23 23 - match json with 24 24 - | Jsont.Object (mems, _meta) -> 25 25 - (match find_member "$ref" mems with 26 26 - | Some (Jsont.String (ref_str, _)) -> Ref ref_str 27 27 - | _ -> 28 28 - (* Not a $ref, decode as value using bytesrw *) 29 29 - match Jsont_bytesrw.decode_string value_jsont 30 30 - (Result.get_ok (Jsont_bytesrw.encode_string Jsont.json json)) with 31 31 - | Ok v -> Value v 32 32 - | Error e -> Jsont.Error.msg Jsont.Meta.none e) 33 33 - | _ -> 34 34 - (* Non-object, decode as value *) 35 35 - match Jsont_bytesrw.decode_string value_jsont 36 36 - (Result.get_ok (Jsont_bytesrw.encode_string Jsont.json json)) with 37 37 - | Ok v -> Value v 38 38 - | Error e -> Jsont.Error.msg Jsont.Meta.none e) 39 39 - ~enc:(function 40 40 - | Ref r -> Jsont.Object ([(("$ref", Jsont.Meta.none), Jsont.String (r, Jsont.Meta.none))], Jsont.Meta.none) 41 41 - | Value v -> 42 42 - match Jsont_bytesrw.encode_string value_jsont v with 43 43 - | Ok s -> 44 44 - (match Jsont_bytesrw.decode_string Jsont.json s with 45 45 - | Ok json -> json 46 46 - | Error _ -> Jsont.Null ((), Jsont.Meta.none)) 47 47 - | Error _ -> Jsont.Null ((), Jsont.Meta.none)) 48 48 - 49 49 - (** {1 String Map} *) 50 50 - 51 51 - module StringMap = Map.Make(String) 52 52 - 53 53 - let string_map_jsont (value_jsont : 'a Jsont.t) : (string * 'a) list Jsont.t = 54 54 - let map_jsont = Jsont.Object.as_string_map value_jsont in 55 55 - Jsont.map ~kind:"string_map" 56 56 - ~dec:(fun m -> StringMap.bindings m) 57 57 - ~enc:(fun pairs -> List.fold_left (fun m (k, v) -> StringMap.add k v m) StringMap.empty pairs) 58 58 - map_jsont 59 59 - 60 60 - (** {1 Contact} *) 61 61 - 62 62 - type contact = { 63 63 - name : string option; 64 64 - url : string option; 65 65 - email : string option; 66 66 - } 67 67 - 68 68 - let contact_jsont : contact Jsont.t = 69 69 - Jsont.Object.map ~kind:"Contact" 70 70 - (fun name url email -> { name; url; email }) 71 71 - |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun c -> c.name) 72 72 - |> Jsont.Object.opt_mem "url" Jsont.string ~enc:(fun c -> c.url) 73 73 - |> Jsont.Object.opt_mem "email" Jsont.string ~enc:(fun c -> c.email) 74 74 - |> Jsont.Object.skip_unknown 75 75 - |> Jsont.Object.finish 76 76 - 77 77 - (** {1 License} *) 78 78 - 79 79 - type license = { 80 80 - name : string; 81 81 - url : string option; 82 82 - } 83 83 - 84 84 - let license_jsont : license Jsont.t = 85 85 - Jsont.Object.map ~kind:"License" 86 86 - (fun name url -> { name; url }) 87 87 - |> Jsont.Object.mem "name" Jsont.string ~enc:(fun l -> l.name) 88 88 - |> Jsont.Object.opt_mem "url" Jsont.string ~enc:(fun l -> l.url) 89 89 - |> Jsont.Object.skip_unknown 90 90 - |> Jsont.Object.finish 91 91 - 92 92 - (** {1 Info} *) 93 93 - 94 94 - type info = { 95 95 - title : string; 96 96 - description : string option; 97 97 - terms_of_service : string option; 98 98 - contact : contact option; 99 99 - license : license option; 100 100 - version : string; 101 101 - } 102 102 - 103 103 - let info_jsont : info Jsont.t = 104 104 - Jsont.Object.map ~kind:"Info" 105 105 - (fun title description terms_of_service contact license version -> 106 106 - { title; description; terms_of_service; contact; license; version }) 107 107 - |> Jsont.Object.mem "title" Jsont.string ~enc:(fun i -> i.title) 108 108 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun i -> i.description) 109 109 - |> Jsont.Object.opt_mem "termsOfService" Jsont.string ~enc:(fun i -> i.terms_of_service) 110 110 - |> Jsont.Object.opt_mem "contact" contact_jsont ~enc:(fun i -> i.contact) 111 111 - |> Jsont.Object.opt_mem "license" license_jsont ~enc:(fun i -> i.license) 112 112 - |> Jsont.Object.mem "version" Jsont.string ~enc:(fun i -> i.version) 113 113 - |> Jsont.Object.skip_unknown 114 114 - |> Jsont.Object.finish 115 115 - 116 116 - (** {1 Server} *) 117 117 - 118 118 - type server_variable = { 119 119 - enum : string list option; 120 120 - default : string; 121 121 - description : string option; 122 122 - } 123 123 - 124 124 - let server_variable_jsont : server_variable Jsont.t = 125 125 - Jsont.Object.map ~kind:"ServerVariable" 126 126 - (fun enum default description -> { enum; default; description }) 127 127 - |> Jsont.Object.opt_mem "enum" Jsont.(list string) ~enc:(fun sv -> sv.enum) 128 128 - |> Jsont.Object.mem "default" Jsont.string ~enc:(fun sv -> sv.default) 129 129 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun sv -> sv.description) 130 130 - |> Jsont.Object.skip_unknown 131 131 - |> Jsont.Object.finish 132 132 - 133 133 - type server = { 134 134 - url : string; 135 135 - description : string option; 136 136 - variables : (string * server_variable) list; 137 137 - } 138 138 - 139 139 - let server_jsont : server Jsont.t = 140 140 - Jsont.Object.map ~kind:"Server" 141 141 - (fun url description variables -> { url; description; variables }) 142 142 - |> Jsont.Object.mem "url" Jsont.string ~enc:(fun s -> s.url) 143 143 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun s -> s.description) 144 144 - |> Jsont.Object.mem "variables" (string_map_jsont server_variable_jsont) 145 145 - ~dec_absent:[] ~enc:(fun s -> s.variables) 146 146 - |> Jsont.Object.skip_unknown 147 147 - |> Jsont.Object.finish 148 148 - 149 149 - (** {1 External Documentation} *) 150 150 - 151 151 - type external_docs = { 152 152 - description : string option; 153 153 - url : string; 154 154 - } 155 155 - 156 156 - let external_docs_jsont : external_docs Jsont.t = 157 157 - Jsont.Object.map ~kind:"ExternalDocs" 158 158 - (fun description url -> { description; url }) 159 159 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun ed -> ed.description) 160 160 - |> Jsont.Object.mem "url" Jsont.string ~enc:(fun ed -> ed.url) 161 161 - |> Jsont.Object.skip_unknown 162 162 - |> Jsont.Object.finish 163 163 - 164 164 - (** {1 Tag} *) 165 165 - 166 166 - type tag = { 167 167 - name : string; 168 168 - description : string option; 169 169 - external_docs : external_docs option; 170 170 - } 171 171 - 172 172 - let tag_jsont : tag Jsont.t = 173 173 - Jsont.Object.map ~kind:"Tag" 174 174 - (fun name description external_docs -> { name; description; external_docs }) 175 175 - |> Jsont.Object.mem "name" Jsont.string ~enc:(fun t -> t.name) 176 176 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun t -> t.description) 177 177 - |> Jsont.Object.opt_mem "externalDocs" external_docs_jsont ~enc:(fun t -> t.external_docs) 178 178 - |> Jsont.Object.skip_unknown 179 179 - |> Jsont.Object.finish 180 180 - 181 181 - (** {1 Discriminator} *) 182 182 - 183 183 - type discriminator = { 184 184 - property_name : string; 185 185 - mapping : (string * string) list; 186 186 - } 187 187 - 188 188 - let discriminator_jsont : discriminator Jsont.t = 189 189 - Jsont.Object.map ~kind:"Discriminator" 190 190 - (fun property_name mapping -> { property_name; mapping }) 191 191 - |> Jsont.Object.mem "propertyName" Jsont.string ~enc:(fun d -> d.property_name) 192 192 - |> Jsont.Object.mem "mapping" (string_map_jsont Jsont.string) 193 193 - ~dec_absent:[] ~enc:(fun d -> d.mapping) 194 194 - |> Jsont.Object.skip_unknown 195 195 - |> Jsont.Object.finish 196 196 - 197 197 - (** {1 Schema} 198 198 - 199 199 - JSON Schema with OpenAPI extensions. We use a simplified approach 200 200 - where references are stored as schema or_ref. *) 201 201 - 202 202 - type schema = { 203 203 - title : string option; 204 204 - description : string option; 205 205 - type_ : string option; 206 206 - format : string option; 207 207 - default : Jsont.json option; 208 208 - nullable : bool; 209 209 - read_only : bool; 210 210 - write_only : bool; 211 211 - deprecated : bool; 212 212 - (* Validation *) 213 213 - enum : Jsont.json list option; 214 214 - const : Jsont.json option; 215 215 - minimum : float option; 216 216 - maximum : float option; 217 217 - exclusive_minimum : float option; 218 218 - exclusive_maximum : float option; 219 219 - multiple_of : float option; 220 220 - min_length : int option; 221 221 - max_length : int option; 222 222 - pattern : string option; 223 223 - min_items : int option; 224 224 - max_items : int option; 225 225 - unique_items : bool; 226 226 - min_properties : int option; 227 227 - max_properties : int option; 228 228 - (* Composition - stored as JSON for simplicity *) 229 229 - all_of : Jsont.json list option; 230 230 - one_of : Jsont.json list option; 231 231 - any_of : Jsont.json list option; 232 232 - not_ : Jsont.json option; 233 233 - (* Object - stored as JSON for simplicity *) 234 234 - properties : (string * Jsont.json) list; 235 235 - required : string list; 236 236 - additional_properties : Jsont.json option; 237 237 - (* Array *) 238 238 - items : Jsont.json option; 239 239 - (* Discriminator *) 240 240 - discriminator : discriminator option; 241 241 - (* Examples *) 242 242 - example : Jsont.json option; 243 243 - } 244 244 - 245 245 - let empty_schema = { 246 246 - title = None; description = None; type_ = None; format = None; default = None; 247 247 - nullable = false; read_only = false; write_only = false; deprecated = false; 248 248 - enum = None; const = None; minimum = None; maximum = None; 249 249 - exclusive_minimum = None; exclusive_maximum = None; multiple_of = None; 250 250 - min_length = None; max_length = None; pattern = None; 251 251 - min_items = None; max_items = None; unique_items = false; 252 252 - min_properties = None; max_properties = None; 253 253 - all_of = None; one_of = None; any_of = None; not_ = None; 254 254 - properties = []; required = []; additional_properties = None; 255 255 - items = None; discriminator = None; example = None; 256 256 - } 257 257 - 258 258 - let schema_jsont : schema Jsont.t = 259 259 - Jsont.Object.map ~kind:"Schema" 260 260 - (fun title description type_ format default nullable read_only write_only 261 261 - deprecated enum const minimum maximum exclusive_minimum exclusive_maximum 262 262 - multiple_of min_length max_length pattern min_items max_items unique_items 263 263 - min_properties max_properties all_of one_of any_of not_ properties required 264 264 - additional_properties items discriminator example -> 265 265 - { title; description; type_; format; default; nullable; read_only; write_only; 266 266 - deprecated; enum; const; minimum; maximum; exclusive_minimum; exclusive_maximum; 267 267 - multiple_of; min_length; max_length; pattern; min_items; max_items; unique_items; 268 268 - min_properties; max_properties; all_of; one_of; any_of; not_; properties; required; 269 269 - additional_properties; items; discriminator; example }) 270 270 - |> Jsont.Object.opt_mem "title" Jsont.string ~enc:(fun s -> s.title) 271 271 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun s -> s.description) 272 272 - |> Jsont.Object.opt_mem "type" Jsont.string ~enc:(fun s -> s.type_) 273 273 - |> Jsont.Object.opt_mem "format" Jsont.string ~enc:(fun s -> s.format) 274 274 - |> Jsont.Object.opt_mem "default" Jsont.json ~enc:(fun s -> s.default) 275 275 - |> Jsont.Object.mem "nullable" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.nullable) 276 276 - |> Jsont.Object.mem "readOnly" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.read_only) 277 277 - |> Jsont.Object.mem "writeOnly" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.write_only) 278 278 - |> Jsont.Object.mem "deprecated" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.deprecated) 279 279 - |> Jsont.Object.opt_mem "enum" Jsont.(list json) ~enc:(fun s -> s.enum) 280 280 - |> Jsont.Object.opt_mem "const" Jsont.json ~enc:(fun s -> s.const) 281 281 - |> Jsont.Object.opt_mem "minimum" Jsont.number ~enc:(fun s -> s.minimum) 282 282 - |> Jsont.Object.opt_mem "maximum" Jsont.number ~enc:(fun s -> s.maximum) 283 283 - |> Jsont.Object.opt_mem "exclusiveMinimum" Jsont.number ~enc:(fun s -> s.exclusive_minimum) 284 284 - |> Jsont.Object.opt_mem "exclusiveMaximum" Jsont.number ~enc:(fun s -> s.exclusive_maximum) 285 285 - |> Jsont.Object.opt_mem "multipleOf" Jsont.number ~enc:(fun s -> s.multiple_of) 286 286 - |> Jsont.Object.opt_mem "minLength" Jsont.int ~enc:(fun s -> s.min_length) 287 287 - |> Jsont.Object.opt_mem "maxLength" Jsont.int ~enc:(fun s -> s.max_length) 288 288 - |> Jsont.Object.opt_mem "pattern" Jsont.string ~enc:(fun s -> s.pattern) 289 289 - |> Jsont.Object.opt_mem "minItems" Jsont.int ~enc:(fun s -> s.min_items) 290 290 - |> Jsont.Object.opt_mem "maxItems" Jsont.int ~enc:(fun s -> s.max_items) 291 291 - |> Jsont.Object.mem "uniqueItems" Jsont.bool ~dec_absent:false ~enc:(fun s -> s.unique_items) 292 292 - |> Jsont.Object.opt_mem "minProperties" Jsont.int ~enc:(fun s -> s.min_properties) 293 293 - |> Jsont.Object.opt_mem "maxProperties" Jsont.int ~enc:(fun s -> s.max_properties) 294 294 - |> Jsont.Object.opt_mem "allOf" Jsont.(list json) ~enc:(fun s -> s.all_of) 295 295 - |> Jsont.Object.opt_mem "oneOf" Jsont.(list json) ~enc:(fun s -> s.one_of) 296 296 - |> Jsont.Object.opt_mem "anyOf" Jsont.(list json) ~enc:(fun s -> s.any_of) 297 297 - |> Jsont.Object.opt_mem "not" Jsont.json ~enc:(fun s -> s.not_) 298 298 - |> Jsont.Object.mem "properties" (string_map_jsont Jsont.json) 299 299 - ~dec_absent:[] ~enc:(fun s -> s.properties) 300 300 - |> Jsont.Object.mem "required" Jsont.(list string) 301 301 - ~dec_absent:[] ~enc:(fun s -> s.required) 302 302 - |> Jsont.Object.opt_mem "additionalProperties" Jsont.json 303 303 - ~enc:(fun s -> s.additional_properties) 304 304 - |> Jsont.Object.opt_mem "items" Jsont.json ~enc:(fun s -> s.items) 305 305 - |> Jsont.Object.opt_mem "discriminator" discriminator_jsont ~enc:(fun s -> s.discriminator) 306 306 - |> Jsont.Object.opt_mem "example" Jsont.json ~enc:(fun s -> s.example) 307 307 - |> Jsont.Object.skip_unknown 308 308 - |> Jsont.Object.finish 309 309 - 310 310 - let schema_or_ref_jsont = or_ref_jsont schema_jsont 311 311 - 312 312 - (** {1 Parameter} *) 313 313 - 314 314 - type parameter_location = Query | Header | Path | Cookie 315 315 - 316 316 - let parameter_location_jsont : parameter_location Jsont.t = 317 317 - Jsont.map Jsont.string ~kind:"parameter_location" 318 318 - ~dec:(function 319 319 - | "query" -> Query 320 320 - | "header" -> Header 321 321 - | "path" -> Path 322 322 - | "cookie" -> Cookie 323 323 - | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown parameter location: %s" s) 324 324 - ~enc:(function 325 325 - | Query -> "query" 326 326 - | Header -> "header" 327 327 - | Path -> "path" 328 328 - | Cookie -> "cookie") 329 329 - 330 330 - type parameter_style = 331 331 - | Matrix | Label | Form | Simple | SpaceDelimited 332 332 - | PipeDelimited | DeepObject 333 333 - 334 334 - let parameter_style_jsont : parameter_style Jsont.t = 335 335 - Jsont.map Jsont.string ~kind:"parameter_style" 336 336 - ~dec:(function 337 337 - | "matrix" -> Matrix 338 338 - | "label" -> Label 339 339 - | "form" -> Form 340 340 - | "simple" -> Simple 341 341 - | "spaceDelimited" -> SpaceDelimited 342 342 - | "pipeDelimited" -> PipeDelimited 343 343 - | "deepObject" -> DeepObject 344 344 - | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown parameter style: %s" s) 345 345 - ~enc:(function 346 346 - | Matrix -> "matrix" 347 347 - | Label -> "label" 348 348 - | Form -> "form" 349 349 - | Simple -> "simple" 350 350 - | SpaceDelimited -> "spaceDelimited" 351 351 - | PipeDelimited -> "pipeDelimited" 352 352 - | DeepObject -> "deepObject") 353 353 - 354 354 - (** {1 Example} *) 355 355 - 356 356 - type example = { 357 357 - summary : string option; 358 358 - description : string option; 359 359 - value : Jsont.json option; 360 360 - external_value : string option; 361 361 - } 362 362 - 363 363 - let example_jsont : example Jsont.t = 364 364 - Jsont.Object.map ~kind:"Example" 365 365 - (fun summary description value external_value -> 366 366 - { summary; description; value; external_value }) 367 367 - |> Jsont.Object.opt_mem "summary" Jsont.string ~enc:(fun e -> e.summary) 368 368 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun e -> e.description) 369 369 - |> Jsont.Object.opt_mem "value" Jsont.json ~enc:(fun e -> e.value) 370 370 - |> Jsont.Object.opt_mem "externalValue" Jsont.string ~enc:(fun e -> e.external_value) 371 371 - |> Jsont.Object.skip_unknown 372 372 - |> Jsont.Object.finish 373 373 - 374 374 - let example_or_ref_jsont = or_ref_jsont example_jsont 375 375 - 376 376 - (** {1 Header} *) 377 377 - 378 378 - type header = { 379 379 - description : string option; 380 380 - required : bool; 381 381 - deprecated : bool; 382 382 - schema : schema or_ref option; 383 383 - } 384 384 - 385 385 - let header_jsont : header Jsont.t = 386 386 - Jsont.Object.map ~kind:"Header" 387 387 - (fun description required deprecated schema -> 388 388 - { description; required; deprecated; schema }) 389 389 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun h -> h.description) 390 390 - |> Jsont.Object.mem "required" Jsont.bool ~dec_absent:false ~enc:(fun h -> h.required) 391 391 - |> Jsont.Object.mem "deprecated" Jsont.bool ~dec_absent:false ~enc:(fun h -> h.deprecated) 392 392 - |> Jsont.Object.opt_mem "schema" schema_or_ref_jsont ~enc:(fun h -> h.schema) 393 393 - |> Jsont.Object.skip_unknown 394 394 - |> Jsont.Object.finish 395 395 - 396 396 - let header_or_ref_jsont = or_ref_jsont header_jsont 397 397 - 398 398 - (** {1 Encoding} *) 399 399 - 400 400 - type encoding = { 401 401 - content_type : string option; 402 402 - headers : (string * header or_ref) list; 403 403 - style : parameter_style option; 404 404 - explode : bool option; 405 405 - allow_reserved : bool; 406 406 - } 407 407 - 408 408 - let encoding_jsont : encoding Jsont.t = 409 409 - Jsont.Object.map ~kind:"Encoding" 410 410 - (fun content_type headers style explode allow_reserved -> 411 411 - { content_type; headers; style; explode; allow_reserved }) 412 412 - |> Jsont.Object.opt_mem "contentType" Jsont.string ~enc:(fun e -> e.content_type) 413 413 - |> Jsont.Object.mem "headers" (string_map_jsont header_or_ref_jsont) 414 414 - ~dec_absent:[] ~enc:(fun e -> e.headers) 415 415 - |> Jsont.Object.opt_mem "style" parameter_style_jsont ~enc:(fun e -> e.style) 416 416 - |> Jsont.Object.opt_mem "explode" Jsont.bool ~enc:(fun e -> e.explode) 417 417 - |> Jsont.Object.mem "allowReserved" Jsont.bool ~dec_absent:false ~enc:(fun e -> e.allow_reserved) 418 418 - |> Jsont.Object.skip_unknown 419 419 - |> Jsont.Object.finish 420 420 - 421 421 - (** {1 Media Type} *) 422 422 - 423 423 - type media_type = { 424 424 - schema : schema or_ref option; 425 425 - example : Jsont.json option; 426 426 - examples : (string * example or_ref) list; 427 427 - encoding : (string * encoding) list; 428 428 - } 429 429 - 430 430 - let media_type_jsont : media_type Jsont.t = 431 431 - Jsont.Object.map ~kind:"MediaType" 432 432 - (fun schema example examples encoding -> 433 433 - { schema; example; examples; encoding }) 434 434 - |> Jsont.Object.opt_mem "schema" schema_or_ref_jsont ~enc:(fun mt -> mt.schema) 435 435 - |> Jsont.Object.opt_mem "example" Jsont.json ~enc:(fun mt -> mt.example) 436 436 - |> Jsont.Object.mem "examples" (string_map_jsont example_or_ref_jsont) 437 437 - ~dec_absent:[] ~enc:(fun mt -> mt.examples) 438 438 - |> Jsont.Object.mem "encoding" (string_map_jsont encoding_jsont) 439 439 - ~dec_absent:[] ~enc:(fun mt -> mt.encoding) 440 440 - |> Jsont.Object.skip_unknown 441 441 - |> Jsont.Object.finish 442 442 - 443 443 - (** {1 Parameter} *) 444 444 - 445 445 - type parameter = { 446 446 - name : string; 447 447 - in_ : parameter_location; 448 448 - description : string option; 449 449 - required : bool; 450 450 - deprecated : bool; 451 451 - allow_empty_value : bool; 452 452 - style : parameter_style option; 453 453 - explode : bool option; 454 454 - allow_reserved : bool; 455 455 - schema : schema or_ref option; 456 456 - example : Jsont.json option; 457 457 - content : (string * media_type) list; 458 458 - } 459 459 - 460 460 - let parameter_jsont : parameter Jsont.t = 461 461 - Jsont.Object.map ~kind:"Parameter" 462 462 - (fun name in_ description required deprecated allow_empty_value style 463 463 - explode allow_reserved schema example content -> 464 464 - { name; in_; description; required; deprecated; allow_empty_value; 465 465 - style; explode; allow_reserved; schema; example; content }) 466 466 - |> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name) 467 467 - |> Jsont.Object.mem "in" parameter_location_jsont ~enc:(fun p -> p.in_) 468 468 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun p -> p.description) 469 469 - |> Jsont.Object.mem "required" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.required) 470 470 - |> Jsont.Object.mem "deprecated" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.deprecated) 471 471 - |> Jsont.Object.mem "allowEmptyValue" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.allow_empty_value) 472 472 - |> Jsont.Object.opt_mem "style" parameter_style_jsont ~enc:(fun p -> p.style) 473 473 - |> Jsont.Object.opt_mem "explode" Jsont.bool ~enc:(fun p -> p.explode) 474 474 - |> Jsont.Object.mem "allowReserved" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.allow_reserved) 475 475 - |> Jsont.Object.opt_mem "schema" schema_or_ref_jsont ~enc:(fun p -> p.schema) 476 476 - |> Jsont.Object.opt_mem "example" Jsont.json ~enc:(fun p -> p.example) 477 477 - |> Jsont.Object.mem "content" (string_map_jsont media_type_jsont) 478 478 - ~dec_absent:[] ~enc:(fun p -> p.content) 479 479 - |> Jsont.Object.skip_unknown 480 480 - |> Jsont.Object.finish 481 481 - 482 482 - let parameter_or_ref_jsont = or_ref_jsont parameter_jsont 483 483 - 484 484 - (** {1 Request Body} *) 485 485 - 486 486 - type request_body = { 487 487 - description : string option; 488 488 - content : (string * media_type) list; 489 489 - required : bool; 490 490 - } 491 491 - 492 492 - let request_body_jsont : request_body Jsont.t = 493 493 - Jsont.Object.map ~kind:"RequestBody" 494 494 - (fun description content required -> { description; content; required }) 495 495 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun rb -> rb.description) 496 496 - |> Jsont.Object.mem "content" (string_map_jsont media_type_jsont) 497 497 - ~dec_absent:[] ~enc:(fun rb -> rb.content) 498 498 - |> Jsont.Object.mem "required" Jsont.bool ~dec_absent:false ~enc:(fun rb -> rb.required) 499 499 - |> Jsont.Object.skip_unknown 500 500 - |> Jsont.Object.finish 501 501 - 502 502 - let request_body_or_ref_jsont = or_ref_jsont request_body_jsont 503 503 - 504 504 - (** {1 Link} *) 505 505 - 506 506 - type link = { 507 507 - operation_ref : string option; 508 508 - operation_id : string option; 509 509 - parameters : (string * Jsont.json) list; 510 510 - request_body : Jsont.json option; 511 511 - description : string option; 512 512 - server : server option; 513 513 - } 514 514 - 515 515 - let link_jsont : link Jsont.t = 516 516 - Jsont.Object.map ~kind:"Link" 517 517 - (fun operation_ref operation_id parameters request_body description server -> 518 518 - { operation_ref; operation_id; parameters; request_body; description; server }) 519 519 - |> Jsont.Object.opt_mem "operationRef" Jsont.string ~enc:(fun l -> l.operation_ref) 520 520 - |> Jsont.Object.opt_mem "operationId" Jsont.string ~enc:(fun l -> l.operation_id) 521 521 - |> Jsont.Object.mem "parameters" (string_map_jsont Jsont.json) 522 522 - ~dec_absent:[] ~enc:(fun l -> l.parameters) 523 523 - |> Jsont.Object.opt_mem "requestBody" Jsont.json ~enc:(fun l -> l.request_body) 524 524 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun l -> l.description) 525 525 - |> Jsont.Object.opt_mem "server" server_jsont ~enc:(fun l -> l.server) 526 526 - |> Jsont.Object.skip_unknown 527 527 - |> Jsont.Object.finish 528 528 - 529 529 - let link_or_ref_jsont = or_ref_jsont link_jsont 530 530 - 531 531 - (** {1 Response} *) 532 532 - 533 533 - type response = { 534 534 - description : string; 535 535 - headers : (string * header or_ref) list; 536 536 - content : (string * media_type) list; 537 537 - links : (string * link or_ref) list; 538 538 - } 539 539 - 540 540 - let response_jsont : response Jsont.t = 541 541 - Jsont.Object.map ~kind:"Response" 542 542 - (fun description headers content links -> 543 543 - { description; headers; content; links }) 544 544 - |> Jsont.Object.mem "description" Jsont.string ~dec_absent:"" ~enc:(fun r -> r.description) 545 545 - |> Jsont.Object.mem "headers" (string_map_jsont header_or_ref_jsont) 546 546 - ~dec_absent:[] ~enc:(fun r -> r.headers) 547 547 - |> Jsont.Object.mem "content" (string_map_jsont media_type_jsont) 548 548 - ~dec_absent:[] ~enc:(fun r -> r.content) 549 549 - |> Jsont.Object.mem "links" (string_map_jsont link_or_ref_jsont) 550 550 - ~dec_absent:[] ~enc:(fun r -> r.links) 551 551 - |> Jsont.Object.skip_unknown 552 552 - |> Jsont.Object.finish 553 553 - 554 554 - let response_or_ref_jsont = or_ref_jsont response_jsont 555 555 - 556 556 - (** {1 Responses} *) 557 557 - 558 558 - type responses = { 559 559 - default : response or_ref option; 560 560 - responses : (string * response or_ref) list; (* status code -> response *) 561 561 - } 562 562 - 563 563 - let responses_jsont : responses Jsont.t = 564 564 - (* Responses is an object where keys are status codes or "default" *) 565 565 - Jsont.map (Jsont.Object.as_string_map response_or_ref_jsont) ~kind:"Responses" 566 566 - ~dec:(fun m -> 567 567 - let default = StringMap.find_opt "default" m in 568 568 - let responses = 569 569 - StringMap.bindings m 570 570 - |> List.filter (fun (k, _) -> k <> "default") 571 571 - in 572 572 - { default; responses }) 573 573 - ~enc:(fun r -> 574 574 - let m = List.fold_left (fun m (k, v) -> StringMap.add k v m) StringMap.empty r.responses in 575 575 - match r.default with 576 576 - | Some d -> StringMap.add "default" d m 577 577 - | None -> m) 578 578 - 579 579 - (** {1 Security Requirement} *) 580 580 - 581 581 - type security_requirement = (string * string list) list 582 582 - 583 583 - let security_requirement_jsont : security_requirement Jsont.t = 584 584 - string_map_jsont Jsont.(list string) 585 585 - 586 586 - (** {1 Callback - simplified to JSON} *) 587 587 - 588 588 - type callback = Jsont.json 589 589 - 590 590 - let callback_jsont : callback Jsont.t = Jsont.json 591 591 - let callback_or_ref_jsont = or_ref_jsont callback_jsont 592 592 - 593 593 - (** {1 Operation} *) 594 594 - 595 595 - type operation = { 596 596 - tags : string list; 597 597 - summary : string option; 598 598 - description : string option; 599 599 - external_docs : external_docs option; 600 600 - operation_id : string option; 601 601 - parameters : parameter or_ref list; 602 602 - request_body : request_body or_ref option; 603 603 - responses : responses; 604 604 - callbacks : (string * callback or_ref) list; 605 605 - deprecated : bool; 606 606 - security : security_requirement list option; 607 607 - servers : server list; 608 608 - } 609 609 - 610 610 - let operation_jsont : operation Jsont.t = 611 611 - Jsont.Object.map ~kind:"Operation" 612 612 - (fun tags summary description external_docs operation_id parameters 613 613 - request_body responses callbacks deprecated security servers -> 614 614 - { tags; summary; description; external_docs; operation_id; parameters; 615 615 - request_body; responses; callbacks; deprecated; security; servers }) 616 616 - |> Jsont.Object.mem "tags" Jsont.(list string) ~dec_absent:[] ~enc:(fun o -> o.tags) 617 617 - |> Jsont.Object.opt_mem "summary" Jsont.string ~enc:(fun o -> o.summary) 618 618 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun o -> o.description) 619 619 - |> Jsont.Object.opt_mem "externalDocs" external_docs_jsont ~enc:(fun o -> o.external_docs) 620 620 - |> Jsont.Object.opt_mem "operationId" Jsont.string ~enc:(fun o -> o.operation_id) 621 621 - |> Jsont.Object.mem "parameters" Jsont.(list parameter_or_ref_jsont) 622 622 - ~dec_absent:[] ~enc:(fun o -> o.parameters) 623 623 - |> Jsont.Object.opt_mem "requestBody" request_body_or_ref_jsont ~enc:(fun o -> o.request_body) 624 624 - |> Jsont.Object.mem "responses" responses_jsont 625 625 - ~dec_absent:{ default = None; responses = [] } ~enc:(fun o -> o.responses) 626 626 - |> Jsont.Object.mem "callbacks" (string_map_jsont callback_or_ref_jsont) 627 627 - ~dec_absent:[] ~enc:(fun o -> o.callbacks) 628 628 - |> Jsont.Object.mem "deprecated" Jsont.bool ~dec_absent:false ~enc:(fun o -> o.deprecated) 629 629 - |> Jsont.Object.opt_mem "security" Jsont.(list security_requirement_jsont) 630 630 - ~enc:(fun o -> o.security) 631 631 - |> Jsont.Object.mem "servers" Jsont.(list server_jsont) 632 632 - ~dec_absent:[] ~enc:(fun o -> o.servers) 633 633 - |> Jsont.Object.skip_unknown 634 634 - |> Jsont.Object.finish 635 635 - 636 636 - (** {1 Path Item} *) 637 637 - 638 638 - type path_item = { 639 639 - ref_ : string option; 640 640 - summary : string option; 641 641 - description : string option; 642 642 - get : operation option; 643 643 - put : operation option; 644 644 - post : operation option; 645 645 - delete : operation option; 646 646 - options : operation option; 647 647 - head : operation option; 648 648 - patch : operation option; 649 649 - trace : operation option; 650 650 - servers : server list; 651 651 - parameters : parameter or_ref list; 652 652 - } 653 653 - 654 654 - let path_item_jsont : path_item Jsont.t = 655 655 - Jsont.Object.map ~kind:"PathItem" 656 656 - (fun ref_ summary description get put post delete options head patch trace 657 657 - servers parameters -> 658 658 - { ref_; summary; description; get; put; post; delete; options; head; 659 659 - patch; trace; servers; parameters }) 660 660 - |> Jsont.Object.opt_mem "$ref" Jsont.string ~enc:(fun pi -> pi.ref_) 661 661 - |> Jsont.Object.opt_mem "summary" Jsont.string ~enc:(fun pi -> pi.summary) 662 662 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun pi -> pi.description) 663 663 - |> Jsont.Object.opt_mem "get" operation_jsont ~enc:(fun pi -> pi.get) 664 664 - |> Jsont.Object.opt_mem "put" operation_jsont ~enc:(fun pi -> pi.put) 665 665 - |> Jsont.Object.opt_mem "post" operation_jsont ~enc:(fun pi -> pi.post) 666 666 - |> Jsont.Object.opt_mem "delete" operation_jsont ~enc:(fun pi -> pi.delete) 667 667 - |> Jsont.Object.opt_mem "options" operation_jsont ~enc:(fun pi -> pi.options) 668 668 - |> Jsont.Object.opt_mem "head" operation_jsont ~enc:(fun pi -> pi.head) 669 669 - |> Jsont.Object.opt_mem "patch" operation_jsont ~enc:(fun pi -> pi.patch) 670 670 - |> Jsont.Object.opt_mem "trace" operation_jsont ~enc:(fun pi -> pi.trace) 671 671 - |> Jsont.Object.mem "servers" Jsont.(list server_jsont) 672 672 - ~dec_absent:[] ~enc:(fun pi -> pi.servers) 673 673 - |> Jsont.Object.mem "parameters" Jsont.(list parameter_or_ref_jsont) 674 674 - ~dec_absent:[] ~enc:(fun pi -> pi.parameters) 675 675 - |> Jsont.Object.skip_unknown 676 676 - |> Jsont.Object.finish 677 677 - 678 678 - let path_item_or_ref_jsont = or_ref_jsont path_item_jsont 679 679 - 680 680 - (** {1 Security Scheme} *) 681 681 - 682 682 - type security_scheme_type = 683 683 - | ApiKey 684 684 - | Http 685 685 - | OAuth2 686 686 - | OpenIdConnect 687 687 - 688 688 - let security_scheme_type_jsont : security_scheme_type Jsont.t = 689 689 - Jsont.map Jsont.string ~kind:"security_scheme_type" 690 690 - ~dec:(function 691 691 - | "apiKey" -> ApiKey 692 692 - | "http" -> Http 693 693 - | "oauth2" -> OAuth2 694 694 - | "openIdConnect" -> OpenIdConnect 695 695 - | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown security scheme type: %s" s) 696 696 - ~enc:(function 697 697 - | ApiKey -> "apiKey" 698 698 - | Http -> "http" 699 699 - | OAuth2 -> "oauth2" 700 700 - | OpenIdConnect -> "openIdConnect") 701 701 - 702 702 - type oauth_flow = { 703 703 - authorization_url : string option; 704 704 - token_url : string option; 705 705 - refresh_url : string option; 706 706 - scopes : (string * string) list; 707 707 - } 708 708 - 709 709 - let oauth_flow_jsont : oauth_flow Jsont.t = 710 710 - Jsont.Object.map ~kind:"OAuthFlow" 711 711 - (fun authorization_url token_url refresh_url scopes -> 712 712 - { authorization_url; token_url; refresh_url; scopes }) 713 713 - |> Jsont.Object.opt_mem "authorizationUrl" Jsont.string ~enc:(fun f -> f.authorization_url) 714 714 - |> Jsont.Object.opt_mem "tokenUrl" Jsont.string ~enc:(fun f -> f.token_url) 715 715 - |> Jsont.Object.opt_mem "refreshUrl" Jsont.string ~enc:(fun f -> f.refresh_url) 716 716 - |> Jsont.Object.mem "scopes" (string_map_jsont Jsont.string) 717 717 - ~dec_absent:[] ~enc:(fun f -> f.scopes) 718 718 - |> Jsont.Object.skip_unknown 719 719 - |> Jsont.Object.finish 720 720 - 721 721 - type oauth_flows = { 722 722 - implicit : oauth_flow option; 723 723 - password : oauth_flow option; 724 724 - client_credentials : oauth_flow option; 725 725 - authorization_code : oauth_flow option; 726 726 - } 727 727 - 728 728 - let oauth_flows_jsont : oauth_flows Jsont.t = 729 729 - Jsont.Object.map ~kind:"OAuthFlows" 730 730 - (fun implicit password client_credentials authorization_code -> 731 731 - { implicit; password; client_credentials; authorization_code }) 732 732 - |> Jsont.Object.opt_mem "implicit" oauth_flow_jsont ~enc:(fun f -> f.implicit) 733 733 - |> Jsont.Object.opt_mem "password" oauth_flow_jsont ~enc:(fun f -> f.password) 734 734 - |> Jsont.Object.opt_mem "clientCredentials" oauth_flow_jsont ~enc:(fun f -> f.client_credentials) 735 735 - |> Jsont.Object.opt_mem "authorizationCode" oauth_flow_jsont ~enc:(fun f -> f.authorization_code) 736 736 - |> Jsont.Object.skip_unknown 737 737 - |> Jsont.Object.finish 738 738 - 739 739 - type security_scheme = { 740 740 - type_ : security_scheme_type; 741 741 - description : string option; 742 742 - name : string option; 743 743 - in_ : parameter_location option; 744 744 - scheme : string option; 745 745 - bearer_format : string option; 746 746 - flows : oauth_flows option; 747 747 - open_id_connect_url : string option; 748 748 - } 749 749 - 750 750 - let security_scheme_jsont : security_scheme Jsont.t = 751 751 - Jsont.Object.map ~kind:"SecurityScheme" 752 752 - (fun type_ description name in_ scheme bearer_format flows open_id_connect_url -> 753 753 - { type_; description; name; in_; scheme; bearer_format; flows; open_id_connect_url }) 754 754 - |> Jsont.Object.mem "type" security_scheme_type_jsont ~enc:(fun ss -> ss.type_) 755 755 - |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun ss -> ss.description) 756 756 - |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun ss -> ss.name) 757 757 - |> Jsont.Object.opt_mem "in" parameter_location_jsont ~enc:(fun ss -> ss.in_) 758 758 - |> Jsont.Object.opt_mem "scheme" Jsont.string ~enc:(fun ss -> ss.scheme) 759 759 - |> Jsont.Object.opt_mem "bearerFormat" Jsont.string ~enc:(fun ss -> ss.bearer_format) 760 760 - |> Jsont.Object.opt_mem "flows" oauth_flows_jsont ~enc:(fun ss -> ss.flows) 761 761 - |> Jsont.Object.opt_mem "openIdConnectUrl" Jsont.string ~enc:(fun ss -> ss.open_id_connect_url) 762 762 - |> Jsont.Object.skip_unknown 763 763 - |> Jsont.Object.finish 764 764 - 765 765 - let security_scheme_or_ref_jsont = or_ref_jsont security_scheme_jsont 766 766 - 767 767 - (** {1 Components} *) 768 768 - 769 769 - type components = { 770 770 - schemas : (string * schema or_ref) list; 771 771 - responses : (string * response or_ref) list; 772 772 - parameters : (string * parameter or_ref) list; 773 773 - examples : (string * example or_ref) list; 774 774 - request_bodies : (string * request_body or_ref) list; 775 775 - headers : (string * header or_ref) list; 776 776 - security_schemes : (string * security_scheme or_ref) list; 777 777 - links : (string * link or_ref) list; 778 778 - callbacks : (string * callback or_ref) list; 779 779 - path_items : (string * path_item or_ref) list; 780 780 - } 781 781 - 782 782 - let components_jsont : components Jsont.t = 783 783 - Jsont.Object.map ~kind:"Components" 784 784 - (fun schemas responses parameters examples request_bodies headers 785 785 - security_schemes links callbacks path_items -> 786 786 - { schemas; responses; parameters; examples; request_bodies; 787 787 - headers; security_schemes; links; callbacks; path_items }) 788 788 - |> Jsont.Object.mem "schemas" (string_map_jsont schema_or_ref_jsont) 789 789 - ~dec_absent:[] ~enc:(fun c -> c.schemas) 790 790 - |> Jsont.Object.mem "responses" (string_map_jsont response_or_ref_jsont) 791 791 - ~dec_absent:[] ~enc:(fun c -> c.responses) 792 792 - |> Jsont.Object.mem "parameters" (string_map_jsont parameter_or_ref_jsont) 793 793 - ~dec_absent:[] ~enc:(fun c -> c.parameters) 794 794 - |> Jsont.Object.mem "examples" (string_map_jsont example_or_ref_jsont) 795 795 - ~dec_absent:[] ~enc:(fun c -> c.examples) 796 796 - |> Jsont.Object.mem "requestBodies" (string_map_jsont request_body_or_ref_jsont) 797 797 - ~dec_absent:[] ~enc:(fun c -> c.request_bodies) 798 798 - |> Jsont.Object.mem "headers" (string_map_jsont header_or_ref_jsont) 799 799 - ~dec_absent:[] ~enc:(fun c -> c.headers) 800 800 - |> Jsont.Object.mem "securitySchemes" (string_map_jsont security_scheme_or_ref_jsont) 801 801 - ~dec_absent:[] ~enc:(fun c -> c.security_schemes) 802 802 - |> Jsont.Object.mem "links" (string_map_jsont link_or_ref_jsont) 803 803 - ~dec_absent:[] ~enc:(fun c -> c.links) 804 804 - |> Jsont.Object.mem "callbacks" (string_map_jsont callback_or_ref_jsont) 805 805 - ~dec_absent:[] ~enc:(fun c -> c.callbacks) 806 806 - |> Jsont.Object.mem "pathItems" (string_map_jsont path_item_or_ref_jsont) 807 807 - ~dec_absent:[] ~enc:(fun c -> c.path_items) 808 808 - |> Jsont.Object.skip_unknown 809 809 - |> Jsont.Object.finish 810 810 - 811 811 - (** {1 OpenAPI Document} *) 812 812 - 813 813 - type t = { 814 814 - openapi : string; 815 815 - info : info; 816 816 - servers : server list; 817 817 - paths : (string * path_item) list; 818 818 - webhooks : (string * path_item or_ref) list; 819 819 - components : components option; 820 820 - security : security_requirement list; 821 821 - tags : tag list; 822 822 - external_docs : external_docs option; 823 823 - } 824 824 - 825 825 - let jsont : t Jsont.t = 826 826 - Jsont.Object.map ~kind:"OpenAPI" 827 827 - (fun openapi info servers paths webhooks components security tags external_docs -> 828 828 - { openapi; info; servers; paths; webhooks; components; security; tags; external_docs }) 829 829 - |> Jsont.Object.mem "openapi" Jsont.string ~enc:(fun t -> t.openapi) 830 830 - |> Jsont.Object.mem "info" info_jsont ~enc:(fun t -> t.info) 831 831 - |> Jsont.Object.mem "servers" Jsont.(list server_jsont) 832 832 - ~dec_absent:[] ~enc:(fun t -> t.servers) 833 833 - |> Jsont.Object.mem "paths" (string_map_jsont path_item_jsont) 834 834 - ~dec_absent:[] ~enc:(fun t -> t.paths) 835 835 - |> Jsont.Object.mem "webhooks" (string_map_jsont path_item_or_ref_jsont) 836 836 - ~dec_absent:[] ~enc:(fun t -> t.webhooks) 837 837 - |> Jsont.Object.opt_mem "components" components_jsont ~enc:(fun t -> t.components) 838 838 - |> Jsont.Object.mem "security" Jsont.(list security_requirement_jsont) 839 839 - ~dec_absent:[] ~enc:(fun t -> t.security) 840 840 - |> Jsont.Object.mem "tags" Jsont.(list tag_jsont) 841 841 - ~dec_absent:[] ~enc:(fun t -> t.tags) 842 842 - |> Jsont.Object.opt_mem "externalDocs" external_docs_jsont ~enc:(fun t -> t.external_docs) 843 843 - |> Jsont.Object.skip_unknown 844 844 - |> Jsont.Object.finish 845 845 - 846 846 - (** {1 Parsing} *) 847 847 - 848 848 - let of_string s = 849 849 - Jsont_bytesrw.decode_string jsont s 850 850 - 851 851 - let of_string' s = 852 852 - Jsont_bytesrw.decode_string' jsont s 853 853 - 854 854 - let to_string t = 855 855 - Jsont_bytesrw.encode_string ~format:Jsont.Indent jsont t 856 856 - 857 857 - let to_string' t = 858 858 - Jsont_bytesrw.encode_string' ~format:Jsont.Indent jsont t 859 859 - 860 860 - (** {1 Reference Resolution} *) 861 861 - 862 862 - let resolve_schema_ref (ref_str : string) (spec : t) : schema option = 863 863 - (* Parse $ref like "#/components/schemas/Pet" *) 864 864 - if not (String.length ref_str > 0 && ref_str.[0] = '#') then None 865 865 - else 866 866 - let parts = String.split_on_char '/' ref_str in 867 867 - match parts with 868 868 - | ["#"; "components"; "schemas"; name] -> 869 869 - (match spec.components with 870 870 - | None -> None 871 871 - | Some c -> 872 872 - match List.assoc_opt name c.schemas with 873 873 - | Some (Value s) -> Some s 874 874 - | Some (Ref _) -> None (* nested refs not supported yet *) 875 875 - | None -> None) 876 876 - | _ -> None

-39

ocaml-openapi/openapi.opam

reviewed

··· 1 1 - # This file is generated by dune, edit dune-project instead 2 2 - opam-version: "2.0" 3 3 - synopsis: "OpenAPI code generator for OCaml with requests and jsont" 4 4 - description: """ 5 5 - Generate type-safe OCaml API clients from OpenAPI 3.x specifications. 6 6 - Uses the requests HTTP library and jsont for JSON codecs.""" 7 7 - maintainer: ["Anil Madhavapeddy <anil@recoil.org>"] 8 8 - authors: ["Anil Madhavapeddy"] 9 9 - license: "ISC" 10 10 - homepage: "https://tangled.org/@anil.recoil.org/ocaml-openapi" 11 11 - bug-reports: "https://tangled.org/anil.recoil.org/ocaml-openapi/issues" 12 12 - depends: [ 13 13 - "dune" {>= "3.21"} 14 14 - "ocaml" {>= "5.1.0"} 15 15 - "jsont" 16 16 - "bytesrw" 17 17 - "fmt" 18 18 - "logs" 19 19 - "ptime" 20 20 - "cmdliner" {>= "1.2.0"} 21 21 - "odoc" {with-doc} 22 22 - "alcotest" {with-test} 23 23 - ] 24 24 - build: [ 25 25 - ["dune" "subst"] {dev} 26 26 - [ 27 27 - "dune" 28 28 - "build" 29 29 - "-p" 30 30 - name 31 31 - "-j" 32 32 - jobs 33 33 - "@install" 34 34 - "@runtest" {with-test} 35 35 - "@doc" {with-doc} 36 36 - ] 37 37 - ] 38 38 - dev-repo: "git+https://tangled.org/anil.recoil.org/ocaml-openapi" 39 39 - x-maintenance-intent: ["(latest)"]

-3

ocaml-openapi/test/dune

reviewed

··· 1 1 - (test 2 2 - (name test_openapi) 3 3 - (libraries openapi alcotest))

-341

ocaml-openapi/test/test_openapi.ml

reviewed

··· 1 1 - (** Tests for ocaml-openapi *) 2 2 - 3 3 - module Spec = Openapi.Spec 4 4 - module Codegen = Openapi.Codegen 5 5 - module Runtime = Openapi.Runtime 6 6 - 7 7 - (** {1 Path Template Tests} *) 8 8 - 9 9 - let test_path_render_simple () = 10 10 - let result = Runtime.Path.render ~params:[] "/users" in 11 11 - Alcotest.(check string) "no params" "/users" result 12 12 - 13 13 - let test_path_render_one_param () = 14 14 - let result = Runtime.Path.render ~params:[("id", "123")] "/users/{id}" in 15 15 - Alcotest.(check string) "one param" "/users/123" result 16 16 - 17 17 - let test_path_render_multiple_params () = 18 18 - let result = Runtime.Path.render 19 19 - ~params:[("userId", "42"); ("postId", "99")] 20 20 - "/users/{userId}/posts/{postId}" in 21 21 - Alcotest.(check string) "multiple params" "/users/42/posts/99" result 22 22 - 23 23 - let test_path_parameters () = 24 24 - let params = Runtime.Path.parameters "/users/{userId}/posts/{postId}" in 25 25 - Alcotest.(check (list string)) "extract params" ["userId"; "postId"] params 26 26 - 27 27 - (** {1 Query Parameter Tests} *) 28 28 - 29 29 - let test_query_singleton () = 30 30 - let params = Runtime.Query.singleton ~key:"name" ~value:"alice" in 31 31 - Alcotest.(check (list (pair string string))) "singleton" [("name", "alice")] params 32 32 - 33 33 - let test_query_optional_some () = 34 34 - let params = Runtime.Query.optional ~key:"name" ~value:(Some "alice") in 35 35 - Alcotest.(check (list (pair string string))) "optional some" [("name", "alice")] params 36 36 - 37 37 - let test_query_optional_none () = 38 38 - let params = Runtime.Query.optional ~key:"name" ~value:None in 39 39 - Alcotest.(check (list (pair string string))) "optional none" [] params 40 40 - 41 41 - let test_query_encode_empty () = 42 42 - let result = Runtime.Query.encode [] in 43 43 - Alcotest.(check string) "empty query" "" result 44 44 - 45 45 - let test_query_encode_single () = 46 46 - let result = Runtime.Query.encode [("name", "alice")] in 47 47 - Alcotest.(check string) "single query" "?name=alice" result 48 48 - 49 49 - let test_query_encode_multiple () = 50 50 - let result = Runtime.Query.encode [("name", "alice"); ("age", "30")] in 51 51 - Alcotest.(check string) "multiple query" "?name=alice&age=30" result 52 52 - 53 53 - let test_query_encode_special_chars () = 54 54 - let result = Runtime.Query.encode [("q", "hello world")] in 55 55 - Alcotest.(check string) "special chars" "?q=hello%20world" result 56 56 - 57 57 - (** {1 Name Conversion Tests} *) 58 58 - 59 59 - let test_snake_case_simple () = 60 60 - let result = Codegen.Name.to_snake_case "getUserById" in 61 61 - Alcotest.(check string) "camel to snake" "get_user_by_id" result 62 62 - 63 63 - let test_snake_case_with_dashes () = 64 64 - let result = Codegen.Name.to_snake_case "user-name" in 65 65 - Alcotest.(check string) "dashes to underscore" "user_name" result 66 66 - 67 67 - let test_snake_case_reserved () = 68 68 - let result = Codegen.Name.to_snake_case "type" in 69 69 - Alcotest.(check string) "reserved word" "type_" result 70 70 - 71 71 - let test_module_name () = 72 72 - let result = Codegen.Name.to_module_name "user_profile" in 73 73 - Alcotest.(check string) "module name" "UserProfile" result 74 74 - 75 75 - let test_variant_name () = 76 76 - let result = Codegen.Name.to_variant_name "active_user" in 77 77 - Alcotest.(check string) "variant name" "Active_user" result 78 78 - 79 79 - (** {1 Spec Parsing Tests} *) 80 80 - 81 81 - let minimal_spec = {|{ 82 82 - "openapi": "3.0.0", 83 83 - "info": { 84 84 - "title": "Test API", 85 85 - "version": "1.0.0" 86 86 - }, 87 87 - "paths": {} 88 88 - }|} 89 89 - 90 90 - let test_parse_minimal_spec () = 91 91 - match Spec.of_string minimal_spec with 92 92 - | Error e -> Alcotest.fail e 93 93 - | Ok spec -> 94 94 - Alcotest.(check string) "openapi version" "3.0.0" spec.openapi; 95 95 - Alcotest.(check string) "title" "Test API" spec.info.title; 96 96 - Alcotest.(check string) "version" "1.0.0" spec.info.version 97 97 - 98 98 - let spec_with_schema = {|{ 99 99 - "openapi": "3.0.0", 100 100 - "info": { 101 101 - "title": "Test API", 102 102 - "version": "1.0.0" 103 103 - }, 104 104 - "paths": {}, 105 105 - "components": { 106 106 - "schemas": { 107 107 - "User": { 108 108 - "type": "object", 109 109 - "properties": { 110 110 - "id": { "type": "integer" }, 111 111 - "name": { "type": "string" }, 112 112 - "email": { "type": "string", "format": "email" } 113 113 - }, 114 114 - "required": ["id", "name"] 115 115 - } 116 116 - } 117 117 - } 118 118 - }|} 119 119 - 120 120 - let test_parse_schema () = 121 121 - match Spec.of_string spec_with_schema with 122 122 - | Error e -> Alcotest.fail e 123 123 - | Ok spec -> 124 124 - match spec.components with 125 125 - | None -> Alcotest.fail "expected components" 126 126 - | Some c -> 127 127 - Alcotest.(check int) "schema count" 1 (List.length c.schemas); 128 128 - match List.assoc_opt "User" c.schemas with 129 129 - | None -> Alcotest.fail "expected User schema" 130 130 - | Some (Spec.Ref _) -> Alcotest.fail "expected value not ref" 131 131 - | Some (Spec.Value s) -> 132 132 - Alcotest.(check (option string)) "type" (Some "object") s.type_; 133 133 - Alcotest.(check int) "properties" 3 (List.length s.properties); 134 134 - Alcotest.(check (list string)) "required" ["id"; "name"] s.required 135 135 - 136 136 - let spec_with_enum = {|{ 137 137 - "openapi": "3.0.0", 138 138 - "info": { 139 139 - "title": "Test API", 140 140 - "version": "1.0.0" 141 141 - }, 142 142 - "paths": {}, 143 143 - "components": { 144 144 - "schemas": { 145 145 - "Status": { 146 146 - "type": "string", 147 147 - "enum": ["active", "inactive", "pending"] 148 148 - } 149 149 - } 150 150 - } 151 151 - }|} 152 152 - 153 153 - let test_parse_enum () = 154 154 - match Spec.of_string spec_with_enum with 155 155 - | Error e -> Alcotest.fail e 156 156 - | Ok spec -> 157 157 - match spec.components with 158 158 - | None -> Alcotest.fail "expected components" 159 159 - | Some c -> 160 160 - match List.assoc_opt "Status" c.schemas with 161 161 - | None -> Alcotest.fail "expected Status schema" 162 162 - | Some (Spec.Ref _) -> Alcotest.fail "expected value not ref" 163 163 - | Some (Spec.Value s) -> 164 164 - match s.enum with 165 165 - | None -> Alcotest.fail "expected enum" 166 166 - | Some values -> 167 167 - Alcotest.(check int) "enum count" 3 (List.length values) 168 168 - 169 169 - let spec_with_paths = {|{ 170 170 - "openapi": "3.0.0", 171 171 - "info": { 172 172 - "title": "Test API", 173 173 - "version": "1.0.0" 174 174 - }, 175 175 - "paths": { 176 176 - "/users": { 177 177 - "get": { 178 178 - "operationId": "listUsers", 179 179 - "summary": "List all users", 180 180 - "responses": { 181 181 - "200": { 182 182 - "description": "Success" 183 183 - } 184 184 - } 185 185 - }, 186 186 - "post": { 187 187 - "operationId": "createUser", 188 188 - "summary": "Create a user", 189 189 - "responses": { 190 190 - "201": { 191 191 - "description": "Created" 192 192 - } 193 193 - } 194 194 - } 195 195 - }, 196 196 - "/users/{id}": { 197 197 - "get": { 198 198 - "operationId": "getUser", 199 199 - "parameters": [ 200 200 - { 201 201 - "name": "id", 202 202 - "in": "path", 203 203 - "required": true, 204 204 - "schema": { "type": "integer" } 205 205 - } 206 206 - ], 207 207 - "responses": { 208 208 - "200": { 209 209 - "description": "Success" 210 210 - } 211 211 - } 212 212 - } 213 213 - } 214 214 - } 215 215 - }|} 216 216 - 217 217 - let test_parse_paths () = 218 218 - match Spec.of_string spec_with_paths with 219 219 - | Error e -> Alcotest.fail e 220 220 - | Ok spec -> 221 221 - Alcotest.(check int) "path count" 2 (List.length spec.paths); 222 222 - match List.assoc_opt "/users" spec.paths with 223 223 - | None -> Alcotest.fail "expected /users path" 224 224 - | Some path_item -> 225 225 - (match path_item.get with 226 226 - | None -> Alcotest.fail "expected GET" 227 227 - | Some op -> 228 228 - Alcotest.(check (option string)) "operation id" (Some "listUsers") op.operation_id); 229 229 - (match path_item.post with 230 230 - | None -> Alcotest.fail "expected POST" 231 231 - | Some op -> 232 232 - Alcotest.(check (option string)) "operation id" (Some "createUser") op.operation_id) 233 233 - 234 234 - (** {1 Code Generation Tests} *) 235 235 - 236 236 - let contains_substring s sub = 237 237 - let len_s = String.length s in 238 238 - let len_sub = String.length sub in 239 239 - if len_sub > len_s then false 240 240 - else 241 241 - let rec check i = 242 242 - if i > len_s - len_sub then false 243 243 - else if String.sub s i len_sub = sub then true 244 244 - else check (i + 1) 245 245 - in 246 246 - check 0 247 247 - 248 248 - let test_split_schema_name () = 249 249 - let p, s = Codegen.Name.split_schema_name "AlbumResponseDto" in 250 250 - Alcotest.(check string) "prefix" "Album" p; 251 251 - Alcotest.(check string) "suffix" "ResponseDto" s 252 252 - 253 253 - let test_split_schema_name_no_suffix () = 254 254 - let p, s = Codegen.Name.split_schema_name "User" in 255 255 - Alcotest.(check string) "prefix" "User" p; 256 256 - Alcotest.(check string) "suffix" "T" s 257 257 - 258 258 - let test_generate_files () = 259 259 - match Spec.of_string spec_with_schema with 260 260 - | Error e -> Alcotest.fail e 261 261 - | Ok spec -> 262 262 - let config = Codegen.{ 263 263 - output_dir = "."; 264 264 - package_name = "test_api"; 265 265 - spec_path = None; 266 266 - } in 267 267 - let files = Codegen.generate ~config spec in 268 268 - Alcotest.(check int) "file count" 4 (List.length files); 269 269 - let ml = List.assoc_opt "test_api.ml" files in 270 270 - (match ml with 271 271 - | None -> Alcotest.fail "missing .ml file" 272 272 - | Some content -> 273 273 - Alcotest.(check bool) "contains module User" true 274 274 - (contains_substring content "module User")) 275 275 - 276 276 - let test_generate_enum_schema () = 277 277 - match Spec.of_string spec_with_enum with 278 278 - | Error e -> Alcotest.fail e 279 279 - | Ok spec -> 280 280 - let config = Codegen.{ 281 281 - output_dir = "."; 282 282 - package_name = "test_enum"; 283 283 - spec_path = None; 284 284 - } in 285 285 - let files = Codegen.generate ~config spec in 286 286 - let ml = List.assoc_opt "test_enum.ml" files in 287 287 - (match ml with 288 288 - | None -> Alcotest.fail "missing .ml file" 289 289 - | Some content -> 290 290 - Alcotest.(check bool) "contains Active variant" true 291 291 - (contains_substring content "Active")) 292 292 - 293 293 - (** {1 Test Suites} *) 294 294 - 295 295 - let path_tests = [ 296 296 - "render simple", `Quick, test_path_render_simple; 297 297 - "render one param", `Quick, test_path_render_one_param; 298 298 - "render multiple params", `Quick, test_path_render_multiple_params; 299 299 - "extract parameters", `Quick, test_path_parameters; 300 300 - ] 301 301 - 302 302 - let query_tests = [ 303 303 - "singleton", `Quick, test_query_singleton; 304 304 - "optional some", `Quick, test_query_optional_some; 305 305 - "optional none", `Quick, test_query_optional_none; 306 306 - "encode empty", `Quick, test_query_encode_empty; 307 307 - "encode single", `Quick, test_query_encode_single; 308 308 - "encode multiple", `Quick, test_query_encode_multiple; 309 309 - "encode special chars", `Quick, test_query_encode_special_chars; 310 310 - ] 311 311 - 312 312 - let name_tests = [ 313 313 - "snake case simple", `Quick, test_snake_case_simple; 314 314 - "snake case dashes", `Quick, test_snake_case_with_dashes; 315 315 - "snake case reserved", `Quick, test_snake_case_reserved; 316 316 - "module name", `Quick, test_module_name; 317 317 - "variant name", `Quick, test_variant_name; 318 318 - ] 319 319 - 320 320 - let spec_tests = [ 321 321 - "parse minimal", `Quick, test_parse_minimal_spec; 322 322 - "parse schema", `Quick, test_parse_schema; 323 323 - "parse enum", `Quick, test_parse_enum; 324 324 - "parse paths", `Quick, test_parse_paths; 325 325 - ] 326 326 - 327 327 - let codegen_tests = [ 328 328 - "split schema name", `Quick, test_split_schema_name; 329 329 - "split schema name no suffix", `Quick, test_split_schema_name_no_suffix; 330 330 - "generate files", `Quick, test_generate_files; 331 331 - "generate enum schema", `Quick, test_generate_enum_schema; 332 332 - ] 333 333 - 334 334 - let () = 335 335 - Alcotest.run "openapi" [ 336 336 - "Path", path_tests; 337 337 - "Query", query_tests; 338 338 - "Name", name_tests; 339 339 - "Spec", spec_tests; 340 340 - "Codegen", codegen_tests; 341 341 - ]