Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
55 changes: 41 additions & 14 deletions client/core.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -125,31 +125,58 @@ The list is ordered alphabetically and excludes the describe-object method."
(to-lisp-case
(replace-all "." "-" string))))

(declaim (ftype (function (hash-table) cons) schema-to-type))
(declaim (ftype (function (hash-table) list) schema-to-type))
(defun schema-to-type (schema)
"Convert JSON types to CL types. Supports one or multiple types."
"Convert JSON types to CL types. Supports direct types, multiple types,
oneOf, anyOf, allOf composition keywords, $ref, enum, const, and implicit object types."
(let ((type (gethash "type" schema))
(one-of (gethash "oneOf" schema))
(any-of (gethash "anyOf" schema))
(all-of (gethash "allOf" schema))
(ref (gethash "$ref" schema))
(properties (gethash "properties" schema))
(enum-values (gethash "enum" schema))
(const-value (gethash "const" schema))
(type-list nil))
(declare (type (or string cons) type)
(list type-list))
(declare (list type-list))
(flet ((%schema-to-type (type)
(cond ((string-equal type "integer") (push 'integer type-list))
((string-equal type "number")
(push 'double-float type-list)
(push 'integer type-list))
(push 'double-float type-list)
(push 'integer type-list))
((string-equal type "string") (push 'string type-list))
((string-equal type "boolean")
(push '(eql false) type-list)
(push '(eql t) type-list))
((string-equal type "object") (push 'hash-table type-list))
((string-equal type "boolean")
(push '(eql false) type-list)
(push '(eql t) type-list))
((string-equal type "object") (push 'hash-table type-list))
((string-equal type "array") (push 'list type-list))
((string-equal type "null") (push 'null type-list))
(t
(error "Type ~S is not supported yet."
type)))))
(if (stringp type)
(%schema-to-type type)
(mapc #'%schema-to-type type)))
type))))
(collect-types-from-subschemas (subschemas)
(dolist (sub-schema subschemas)
(dolist (sub-type (schema-to-type sub-schema))
(pushnew sub-type type-list :test #'equal)))))
(cond
;; Handle oneOf/anyOf/allOf - collect types from all sub-schemas
(one-of (collect-types-from-subschemas one-of))
(any-of (collect-types-from-subschemas any-of))
(all-of (collect-types-from-subschemas all-of))
;; Handle direct type (existing behavior)
(type
(if (stringp type)
(%schema-to-type type)
(mapc #'%schema-to-type type)))
;; Handle implicit object type (properties without explicit type)
(properties
(push 'hash-table type-list))
;; Handle $ref/enum/const - accept any type since we can't determine the exact type
((or ref enum-values const-value)
(push t type-list))
;; No recognized schema pattern - error
(t
(error "Schema has no type, oneOf, anyOf, allOf, properties, $ref, enum, or const: ~S" schema))))
(nreverse type-list)))

(defun generate-generic-lambda-list (params)
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
nil
5 changes: 5 additions & 0 deletions t/client/regress-data/schema-patterns/client-class.lisp
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
((defclass the-class (jsonrpc/client:client) nil)
(defun make-the-class () (make-instance 'the-class))
(defmethod describe-object ((jsonrpc/client:client the-class) stream)
(openrpc-client/core::generate-method-descriptions
(class-of jsonrpc/client:client) stream)))
143 changes: 143 additions & 0 deletions t/client/regress-data/schema-patterns/methods.lisp
Original file line number Diff line number Diff line change
@@ -0,0 +1,143 @@
((defgeneric test-one-of
(jsonrpc/client:client value)
(:documentation "Test method for oneOf schema"))
(defmethod test-one-of ((jsonrpc/client:client the-class) (value string))
(let* ((#:g1
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "value" openrpc-client/core::args) value)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testOneOf"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g1))))
(defmethod test-one-of ((jsonrpc/client:client the-class) (value integer))
(let* ((#:g2
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "value" openrpc-client/core::args) value)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testOneOf"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g2))))
(defgeneric test-any-of
(jsonrpc/client:client value)
(:documentation "Test method for anyOf schema"))
(defmethod test-any-of ((jsonrpc/client:client the-class) (value string))
(let* ((#:g3
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "value" openrpc-client/core::args) value)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testAnyOf"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g3))))
(defmethod test-any-of ((jsonrpc/client:client the-class) (value integer))
(let* ((#:g4
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "value" openrpc-client/core::args) value)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testAnyOf"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g4))))
(defmethod test-any-of ((jsonrpc/client:client the-class) (value null))
(let* ((#:g5
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "value" openrpc-client/core::args) value)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testAnyOf"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g5))))
(defgeneric test-all-of
(jsonrpc/client:client value)
(:documentation "Test method for allOf schema"))
(defmethod test-all-of ((jsonrpc/client:client the-class) (value hash-table))
(let* ((#:g6
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "value" openrpc-client/core::args) value)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testAllOf"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g6))))
(defgeneric test-implicit-object
(jsonrpc/client:client config)
(:documentation
"Test method for implicit object type (properties without type)"))
(defmethod test-implicit-object
((jsonrpc/client:client the-class) (config hash-table))
(let* ((#:g7
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "config" openrpc-client/core::args) config)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testImplicitObject"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g7))))
(defgeneric test-ref
(jsonrpc/client:client data)
(:documentation "Test method for $ref schema"))
(defmethod test-ref ((jsonrpc/client:client the-class) (data t))
(let* ((#:g8
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "data" openrpc-client/core::args) data)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testRef"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g8))))
(defgeneric test-enum
(jsonrpc/client:client status)
(:documentation "Test method for enum schema without type"))
(defmethod test-enum ((jsonrpc/client:client the-class) (status t))
(let* ((#:g9
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "status" openrpc-client/core::args) status)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testEnum"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g9))))
(defgeneric test-const
(jsonrpc/client:client version)
(:documentation "Test method for const schema"))
(defmethod test-const ((jsonrpc/client:client the-class) (version t))
(let* ((#:g10
(let ((openrpc-client/core::args (make-hash-table :test 'equal)))
(setf (gethash "version" openrpc-client/core::args) version)
openrpc-client/core::args)))
(labels ((openrpc-client/core::retrieve-data (openrpc-client/core::args)
(let ((openrpc-client/core::raw-response
(openrpc-client/core::rpc-call jsonrpc/client:client
"testConst"
openrpc-client/core::args)))
openrpc-client/core::raw-response)))
(openrpc-client/core::retrieve-data #:g10)))))
157 changes: 157 additions & 0 deletions t/client/regress-data/schema-patterns/spec.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,157 @@
{
"openrpc": "1.0.0",
"info": {
"title": "Schema Patterns Test API",
"version": "0.1.0"
},
"methods": [
{
"name": "testOneOf",
"params": [
{
"name": "value",
"schema": {
"title": "A value matching one of the types",
"oneOf": [
{"title": "String value", "type": "string"},
{"title": "Integer value", "type": "integer"}
]
},
"required": true,
"summary": "Parameter using oneOf"
}
],
"result": {
"name": "result",
"schema": { "type": "object" }
},
"summary": "Test method for oneOf schema"
},
{
"name": "testAnyOf",
"params": [
{
"name": "value",
"schema": {
"anyOf": [
{"type": "string"},
{"type": "integer"},
{"type": "null"}
]
},
"required": true,
"summary": "Parameter using anyOf"
}
],
"result": {
"name": "result",
"schema": { "type": "string" }
},
"summary": "Test method for anyOf schema"
},
{
"name": "testAllOf",
"params": [
{
"name": "value",
"schema": {
"allOf": [
{ "type": "object" },
{ "type": "object" }
]
},
"required": true,
"summary": "Parameter using allOf"
}
],
"result": {
"name": "result",
"schema": { "type": "string" }
},
"summary": "Test method for allOf schema"
},
{
"name": "testImplicitObject",
"params": [
{
"name": "config",
"schema": {
"title": "Configuration object",
"required": ["name"],
"properties": {
"name": { "type": "string" },
"value": { "type": "integer" }
}
},
"required": true,
"summary": "Parameter with implicit object type"
}
],
"result": {
"name": "result",
"schema": { "type": "string" }
},
"summary": "Test method for implicit object type (properties without type)"
},
{
"name": "testRef",
"params": [
{
"name": "data",
"schema": {
"$ref": "#/components/schemas/SomeType"
},
"required": true,
"summary": "Parameter using $ref"
}
],
"result": {
"name": "result",
"schema": { "type": "string" }
},
"summary": "Test method for $ref schema"
},
{
"name": "testEnum",
"params": [
{
"name": "status",
"schema": {
"enum": ["pending", "active", "completed"]
},
"required": true,
"summary": "Parameter using enum without type"
}
],
"result": {
"name": "result",
"schema": { "type": "string" }
},
"summary": "Test method for enum schema without type"
},
{
"name": "testConst",
"params": [
{
"name": "version",
"schema": {
"const": "v1"
},
"required": true,
"summary": "Parameter using const"
}
],
"result": {
"name": "result",
"schema": { "type": "string" }
},
"summary": "Test method for const schema"
}
],
"servers": [
{
"name": "default",
"url": "https://example.org/"
}
]
}
6 changes: 3 additions & 3 deletions t/client/regression.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -108,13 +108,13 @@
(%generate-client 'the-class spec :export-symbols nil))

(compare client-class
"multiple-types"
test-name
"client-class")
(compare class-definitions
"multiple-types"
test-name
"class-definitions")
(compare methods
"multiple-types"
test-name
"methods")))))))

(generate-client
Expand Down
Loading