Compare commits
2 Enmetoj
cc81dee054
...
2132a00a6a
Author | SHA1 | Date | |
---|---|---|---|
Jaidyn Ann | 2132a00a6a | ||
Jaidyn Ann | b2e9e5340d |
|
@ -97,6 +97,10 @@ If you would like to change it on an object-level, set the @CONTEXT slot."))
|
|||
(cdr alist-cell)))
|
||||
(json-ld-etc obj)))
|
||||
|
||||
(defmethod yason:encode ((obj json-ld-object) &optional (stream *standard-output))
|
||||
(yason:with-output (stream)
|
||||
(yason:encode-object obj)))
|
||||
|
||||
|
||||
|
||||
;;; CLOS definition
|
||||
|
@ -198,12 +202,14 @@ into a DEFCLASS format."
|
|||
"Helper-macro for DEFINE-JSON-CLOS-CLASS.
|
||||
This actually defines the YASON-encoder for a JSON-LD node-type.
|
||||
CLASS is the class-name; see DEFINE-JSON-TYPE’s docstring about DIRECT-SLOTS."
|
||||
(append
|
||||
`(defmethod yason:encode-slots progn ((obj ,class)))
|
||||
`(progn
|
||||
(defmethod yason:encode-slots progn ((obj ,class))
|
||||
,(append
|
||||
`(progn)
|
||||
(mapcar (lambda (slot)
|
||||
`(when (slot-boundp obj ',(car slot))
|
||||
(yason:encode-object-element ,(cadr slot) (slot-value obj ',(car slot)))))
|
||||
direct-slots)))
|
||||
direct-slots)))))
|
||||
|
||||
|
||||
|
||||
|
@ -249,34 +255,27 @@ name, though it might be unresolved if context was unprovided or lacking."
|
|||
|
||||
(defun parse (str)
|
||||
"Parse the JSON-LD document contained in STR."
|
||||
(let ((ctx (make-hash-table :test #'equal)) ; Parsed context: IRI→name,etc.
|
||||
(rev-ctx (make-hash-table :test #'equal)) ; Inversed ctx: name→IRI
|
||||
(let ((ctx (make-hash-table :test #'equal)) ; Parsed context
|
||||
(parsed (yason:parse str)))
|
||||
(values (parse-item parsed ctx rev-ctx)
|
||||
(values (parse-item parsed ctx)
|
||||
ctx)))
|
||||
|
||||
(defun parse-item (item &optional ctx rev-ctx)
|
||||
(defun parse-item (item &optional ctx)
|
||||
"Parse an individual ITEM of a YASON-decoded JSON-LD document."
|
||||
(typecase item
|
||||
(hash-table (parse-table item ctx rev-ctx))
|
||||
(hash-table (parse-table item ctx))
|
||||
(list (mapcar (lambda (a) (parse-item a ctx)) item))
|
||||
(T item)))
|
||||
|
||||
(defun parse-table (table &optional ctx rev-ctx)
|
||||
(defun parse-table (table &optional ctx)
|
||||
"Parse a JSON “node object” (as decoded by YASON into a hash-TABLE."
|
||||
(let ((ctx (parse-context (gethash "@context" table) ctx)))
|
||||
;; Update our inverted context-table, so we can resolve property-names→IRIs.
|
||||
(when (not (eq (hash-table-count rev-ctx)
|
||||
(hash-table-count ctx)))
|
||||
(copy-hash-table-to ctx rev-ctx)
|
||||
(invert-hash-table rev-ctx (lambda (val)
|
||||
(getf val :id))))
|
||||
;; Now, actually parse.
|
||||
(let* ((parsed-table (parse-table-inplace table ctx))
|
||||
(type (identify-json-type table ctx))
|
||||
(type-def (or (gethash type *json-types*)
|
||||
(gethash "*" *json-types*))))
|
||||
(parse-table-into-object parsed-table type-def ctx rev-ctx))))
|
||||
(parse-table-into-object parsed-table type-def ctx))))
|
||||
|
||||
(defun parse-table-inplace (table ctx)
|
||||
"Expand a YASON-parsed JSON-LD node-object in TABLE. That is, replace all
|
||||
|
@ -300,12 +299,11 @@ CTX should be the parsed-context corresponding to the table."
|
|||
table)
|
||||
table)
|
||||
|
||||
(defun parse-table-into-object (table type-def ctx rev-ctx)
|
||||
(defun parse-table-into-object (table type-def ctx)
|
||||
"Parse an expanded-form JSON-LD object (TABLE) into a CLOS object.
|
||||
TYPE-DEF is a type-definition list of the form found in *JSON-TYPES* and made
|
||||
by REGISTER-JSON-TYPE.
|
||||
CTX is the according parsed-context, and REV-CTX is the reversed
|
||||
(IRI → property-name) context."
|
||||
CTX is the according parsed-context."
|
||||
(let ((obj (make-instance (caar type-def))))
|
||||
(maphash
|
||||
(lambda (property value)
|
||||
|
@ -411,7 +409,10 @@ IRI values whose prefix hasn’t yet been parsed into CTX."
|
|||
(cond ((and id (not parsed-id))
|
||||
(push (cons term iri) unresolvable))
|
||||
(T
|
||||
(setf (gethash term ctx) (list :id parsed-id :type type))))))
|
||||
(setf (gethash term ctx)
|
||||
(list :id parsed-id :type type))
|
||||
(setf (gethash (format nil ".~A" parsed-id) ctx)
|
||||
term)))))
|
||||
table)
|
||||
unresolvable))
|
||||
|
||||
|
@ -512,33 +513,6 @@ returned."
|
|||
"Makes a GET request to URI, returning the resultant string."
|
||||
(dexador:get uri :headers headers :force-string 't))
|
||||
|
||||
(defun invert-hash-table (table &optional tf)
|
||||
"Return a copy of TABLE with the keys and values inverted.
|
||||
All values are the new keys for the old keys, and all old keys are…
|
||||
wait, I’m getting confused now. Oh, whatever, you know what’s up!
|
||||
|
||||
Optionally, a TF function can be provided, which will be executed
|
||||
with the new key as its parameter, and whose return-value will be
|
||||
the key. Useful for sanitization!"
|
||||
(let ((new-table (alexandria:copy-hash-table table)))
|
||||
(maphash (lambda (old-key old-val)
|
||||
(let ((new-key (if tf (funcall tf old-val) old-val)))
|
||||
(remhash old-key new-table)
|
||||
(setf (gethash new-key new-table) old-key)))
|
||||
new-table)
|
||||
new-table))
|
||||
|
||||
(defun copy-hash-table-to (from to &optional (clobber nil))
|
||||
"Shallowly copies the keys+values of hash-table FROM into TO.
|
||||
If CLOBBER is set, old-values in TO will be overwritten."
|
||||
(maphash (lambda (key val)
|
||||
(let ((in-to (gethash key to)))
|
||||
(when (or (and clobber in-to)
|
||||
(not in-to))
|
||||
(setf (gethash key to) val))))
|
||||
from)
|
||||
to)
|
||||
|
||||
(defun plist-keys (plist)
|
||||
"Return a list of keys in a property list."
|
||||
(remove-if #'not
|
||||
|
|
Ŝarĝante…
Reference in New Issue