Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/encoding/json-ld/api.lisp

KindCoveredAll%
expression18200 9.0
branch18 12.5
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 ;;; (map nil #'(lambda (name) (load (make-pathname :name name :type "lisp"))) '("patches" "package" "api" "classes" "context"))
6
 ;;; external interface
7
 
8
 
9
 (defgeneric json-ld:find-term-definition (context key))
10
 (defgeneric json-ld:find-term-definition-container (context key))
11
 (defgeneric json-ld:find-term-definition-language (context key))
12
 (defgeneric json-ld:find-term-definition-term (context key))
13
 (defgeneric json-ld:find-term-definition-type (context key))
14
 
15
 (defgeneric json-ld:term-definition-container (term-definition))
16
 (defgeneric json-ld:term-definition-term (term-definition))
17
 (defgeneric (setf json-ld:term-definition-term) (value term-definition))
18
 (defgeneric json-ld:term-definition-term-number (term-definition))
19
 (defgeneric (setf json-ld:term-definition-term-number) (value term-definition))
20
 (defgeneric json-ld:term-definition-type (term-definition))
21
 (defgeneric json-ld:term-definition-language (term-definition))
22
 (defgeneric json-ld:term-definition-reverse-property (term-definition))
23
 (defgeneric (setf json-ld:object-member-value) (value context key))
24
 (defgeneric json-ld:object-member (context key)
25
   (:method ((object list) key)
26
     (assoc key object :test #'string=)))
27
 (defgeneric json-ld:object-member-value (context key)
28
   (:method ((object list) key)
29
     (rest (assoc key object :test #'string=))))
30
 
31
 (defmethod json-ld:object-member-value-vector ((object list) key)
32
   (let ((value (rest (assoc key object :test #'string=))))
33
     (typecase value
34
       (null nil)
35
       (vector value)
36
       (t (make-array 1 :fill-pointer 1 :adjustable t :initial-contents (list value))))))
37
 
38
 (defmethod (setf json-ld:object-member-value) (value (object cons) key)
39
   (let ((member (assoc key (json-ld:object-members object) :test #'string=)))
40
     (if member
41
       (setf (rest member) value)
42
       (setf (rest object) (cons key value)))
43
     value))
44
 
45
 (defmethod (setf json-ld:object-member-value) ((value null) (object cons) key)
46
   (remove key object :key #'first :test #'string=)
47
   nil)
48
 
49
 (defmethod json-ld:append-object-member-value ((object cons) key value)
50
    (let ((member (assoc key (json-ld:object-members object) :test #'equalp)))
51
     (cond (member
52
            (let ((member-value (rest member)))
53
              (typecase member-value
54
                (vector (vector-push-extend value member-value))
55
                (t
56
                 (setf (rest member) (make-array 2 :fill-pointer 2 :adjustable t
57
                                                 :initial-contents (list member-value value)))))
58
              value))
59
           (t
60
            (setf (rest object) (cons key value))
61
            value))))
62
 
63
 ;;; internal operators
64
 
65
 (defgeneric json-ld:key= (v1 v2)
66
   (:method ((v1 string) (v2 symbol))
67
     (string= v1 (if (iri-p v2) (iri-lexical-form v2) (symbol-name v2))))
68
   (:method ((v1 symbol) (v2 string))
69
     (string= (if (iri-p v1) (iri-lexical-form v1) (symbol-name v1)) v2))
70
   (:method ((v1 string) (v2 spocq:iri))
71
     (string= v1 (spocq:iri-lexical-form v2)))
72
   (:method ((v1 spocq:iri) (v2 string))
73
     (string= (spocq:iri-lexical-form v1) v2))
74
   (:method ((v1 t) (v2 t))
75
     (equalp v1 v2)))
76
 
77
 
78
 (defgeneric json-ld:keywordp (object)
79
   (:method ((object t))
80
     nil)
81
   (:method ((object symbol))
82
     (json-ld:keywordp (symbol-name object)))
83
   (:method ((object string))
84
     (find-symbol object :@)))
85
 
86
 (defgeneric json-ld:atomp (object)
87
   (:method ((object t))
88
     nil)
89
   (:method ((object symbol))
90
     (case object
91
       ((:|true| :|false|) t)
92
       (t nil)))
93
   (:method ((object number))
94
     t)
95
   (:method ((object string))
96
     t))
97
 
98
 (defun json-ld:null (object)
99
   (eq object :|null|))
100
 
101
 (deftype json-ld:atom () '(satisfies json-ld:atomp))
102
 (deftype json-ld:keyword () '(satisfies json-ld:keywordp))
103
 (deftype json-ld:null () '(eql :|null|))
104
 (deftype json-ld:array () '(and vector (not string)))
105
 
106
 (defun json-ld:arrayp (object)
107
   (typecase object
108
     (string nil)
109
     (vector t)
110
     (t nil)))
111
 
112
 (defgeneric json-ld:blank-node-p (object)
113
   (:method ((object spocq:blank-node))
114
     object)
115
   (:method ((object string))
116
     (is-blank_node_label object))
117
   (:method ((object t))
118
     nil))
119
 
120
 (defgeneric json-ld:make-blank-node (token)
121
   (:method ((token string))
122
     (when (and (> (length token) 2) (string= "_:" token :end2 2))
123
       (setf token (subseq token 2)))
124
     (intern-term-aspects :node token nil nil))
125
   (:method ((object spocq:blank-node))
126
     object))
127
 
128
 (defgeneric json-ld:absolute-iri-p (object)
129
   (:method ((object spocq:iri))
130
     (is-absolute-iri-string (spocq:iri-lexical-form object)))
131
   (:method ((object symbol))
132
     (and object
133
          (is-absolute-iri-string (iri-lexical-form object))))
134
   (:method ((object string))
135
     (is-absolute-iri-string object))
136
   (:method ((object t))
137
     nil))
138
 
139
 (defgeneric json-ld:make-iri (token)
140
   (:method ((token string))
141
     (intern-term-aspects :uri token nil nil))
142
   (:method ((iri spocq:iri))
143
     iri)
144
   (:method ((iri symbol))
145
     (assert (iri-p iri) () "Invalid IRI: ~s" iri)
146
     iri))
147
 
148
 (defgeneric json-ld:lexical-form (object) ) 
149
 
150
 (defgeneric json-ld:object-base (object)
151
   (:documentation "Return the respective object base.")
152
   (:method ((object list))
153
     (rest (assoc @:|@base| object :test #'json-ld:key=))))
154
 
155
 (defgeneric (setf json-ld:object-base) (base object)
156
   (:documentation "Set the respective object base to the given value.
157
     nil clears the value. anything else is coerced to an iri."))
158
 
159
 (defgeneric json-ld:object-members (object)
160
   (:documentation "Given an object instance, return its members.
161
     For other representations, coerce, as required.")
162
   (:method ((object list))
163
     object)
164
   (:method ((object string))
165
     (multiple-value-bind (parsed-members length success-p)
166
                          (parse-json object)
167
       (declare (ignore length))
168
       (unless success-p
169
         (error "Invalid json object expression: ~s" object))
170
       parsed-members)))
171
 
172
 (defgeneric json-ld:object-member-names (object)
173
   (:documentation "Return all member names")
174
   (:method ((object list))
175
     (mapcar #'first object)))
176
 
177
 (defgeneric json-ld:object-member-values (object)
178
   (:documentation "Return all member values")
179
   (:method ((object list))
180
     (mapcar #'rest object)))
181
 
182
 (defgeneric json-ld:object-member-value (object key)
183
   (:documentation "Return all member values")
184
   (:method ((object list) key)
185
     (rest (assoc key object :test #'string=))))
186
 
187
 
188
 (defstruct node-map-entry
189
   "Collect the information used to 'frame' a resource node. This includes
190
  primarily a output member a-list, but also caches its id and type. The
191
  latter can be either an integer term number or an interned term value.
192
  In order to interpose id-objects for cycles, the stream is cached to
193
  mark the cycle"
194
   cycle
195
   type
196
   id
197
   members)
198
 
199