src/json-ld.lisp

@@ -97,10 +97,6 @@ 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
@@ -202,14 +198,12 @@ 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."
-  `(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)))))
+  (append
+   `(defmethod yason:encode-slots progn ((obj ,class)))
+   (mapcar (lambda (slot)
+             `(when (slot-boundp obj ',(car slot))
+                (yason:encode-object-element ,(cadr slot) (slot-value obj ',(car slot)))))
+           direct-slots)))
 
 
 
@@ -255,27 +249,34 @@ 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
+  (let ((ctx     (make-hash-table :test #'equal)) ; Parsed context: IRI→name,etc.
+        (rev-ctx (make-hash-table :test #'equal)) ; Inversed ctx: name→IRI
         (parsed (yason:parse str)))
-    (values (parse-item parsed ctx)
+    (values (parse-item parsed ctx rev-ctx)
             ctx)))
 
-(defun parse-item (item &optional ctx)
+(defun parse-item (item &optional ctx rev-ctx)
   "Parse an individual ITEM of a YASON-decoded JSON-LD document."
   (typecase item
-    (hash-table (parse-table item ctx))
+    (hash-table (parse-table item ctx rev-ctx))
     (list       (mapcar (lambda (a) (parse-item a ctx)) item))
     (T          item)))
 
-(defun parse-table (table &optional ctx)
+(defun parse-table (table &optional ctx rev-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))))
+      (parse-table-into-object parsed-table type-def ctx rev-ctx))))
 
 (defun parse-table-inplace (table ctx)
   "Expand a YASON-parsed JSON-LD node-object in TABLE. That is, replace all
@@ -299,11 +300,12 @@ CTX should be the parsed-context corresponding to the table."
    table)
   table)
 
-(defun parse-table-into-object (table type-def ctx)
+(defun parse-table-into-object (table type-def ctx rev-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."
+CTX is the according parsed-context, and REV-CTX is the reversed
+(IRI → property-name) context."
   (let ((obj (make-instance (caar type-def))))
     (maphash
      (lambda (property value)
@@ -409,10 +411,7 @@ 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 (format nil ".~A" parsed-id) ctx)
-                      term)))))
+                (setf (gethash term ctx) (list :id parsed-id :type type))))))
      table)
     unresolvable))
 
@@ -513,6 +512,33 @@ 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