Remove reverse-context and related functions
There is a simpler way of doing this!
This commit is contained in:
parent
b2e9e5340d
commit
2132a00a6a
|
@ -255,34 +255,27 @@ name, though it might be unresolved if context was unprovided or lacking."
|
||||||
|
|
||||||
(defun parse (str)
|
(defun parse (str)
|
||||||
"Parse the JSON-LD document contained in STR."
|
"Parse the JSON-LD document contained in STR."
|
||||||
(let ((ctx (make-hash-table :test #'equal)) ; Parsed context: IRI→name,etc.
|
(let ((ctx (make-hash-table :test #'equal)) ; Parsed context
|
||||||
(rev-ctx (make-hash-table :test #'equal)) ; Inversed ctx: name→IRI
|
|
||||||
(parsed (yason:parse str)))
|
(parsed (yason:parse str)))
|
||||||
(values (parse-item parsed ctx rev-ctx)
|
(values (parse-item parsed ctx)
|
||||||
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."
|
"Parse an individual ITEM of a YASON-decoded JSON-LD document."
|
||||||
(typecase item
|
(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))
|
(list (mapcar (lambda (a) (parse-item a ctx)) item))
|
||||||
(T 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."
|
"Parse a JSON “node object” (as decoded by YASON into a hash-TABLE."
|
||||||
(let ((ctx (parse-context (gethash "@context" table) ctx)))
|
(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.
|
;; Now, actually parse.
|
||||||
(let* ((parsed-table (parse-table-inplace table ctx))
|
(let* ((parsed-table (parse-table-inplace table ctx))
|
||||||
(type (identify-json-type table ctx))
|
(type (identify-json-type table ctx))
|
||||||
(type-def (or (gethash type *json-types*)
|
(type-def (or (gethash type *json-types*)
|
||||||
(gethash "*" *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)
|
(defun parse-table-inplace (table ctx)
|
||||||
"Expand a YASON-parsed JSON-LD node-object in TABLE. That is, replace all
|
"Expand a YASON-parsed JSON-LD node-object in TABLE. That is, replace all
|
||||||
|
@ -306,12 +299,11 @@ CTX should be the parsed-context corresponding to the table."
|
||||||
table)
|
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.
|
"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
|
TYPE-DEF is a type-definition list of the form found in *JSON-TYPES* and made
|
||||||
by REGISTER-JSON-TYPE.
|
by REGISTER-JSON-TYPE.
|
||||||
CTX is the according parsed-context, and REV-CTX is the reversed
|
CTX is the according parsed-context."
|
||||||
(IRI → property-name) context."
|
|
||||||
(let ((obj (make-instance (caar type-def))))
|
(let ((obj (make-instance (caar type-def))))
|
||||||
(maphash
|
(maphash
|
||||||
(lambda (property value)
|
(lambda (property value)
|
||||||
|
@ -417,7 +409,10 @@ IRI values whose prefix hasn’t yet been parsed into CTX."
|
||||||
(cond ((and id (not parsed-id))
|
(cond ((and id (not parsed-id))
|
||||||
(push (cons term iri) unresolvable))
|
(push (cons term iri) unresolvable))
|
||||||
(T
|
(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)
|
table)
|
||||||
unresolvable))
|
unresolvable))
|
||||||
|
|
||||||
|
@ -518,33 +513,6 @@ returned."
|
||||||
"Makes a GET request to URI, returning the resultant string."
|
"Makes a GET request to URI, returning the resultant string."
|
||||||
(dexador:get uri :headers headers :force-string 't))
|
(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)
|
(defun plist-keys (plist)
|
||||||
"Return a list of keys in a property list."
|
"Return a list of keys in a property list."
|
||||||
(remove-if #'not
|
(remove-if #'not
|
||||||
|
|
Ŝarĝante…
Reference in New Issue