expansion.scm
1 | ;;;; Copyright (C) 2019, 2020 Julien Lepiller <julien@lepiller.eu> |
2 | ;;;; |
3 | ;;;; This library is free software; you can redistribute it and/or |
4 | ;;;; modify it under the terms of the GNU Lesser General Public |
5 | ;;;; License as published by the Free Software Foundation; either |
6 | ;;;; version 3 of the License, or (at your option) any later version. |
7 | ;;;; |
8 | ;;;; This library is distributed in the hope that it will be useful, |
9 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
10 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | ;;;; Lesser General Public License for more details. |
12 | ;;;; |
13 | ;;;; You should have received a copy of the GNU Lesser General Public |
14 | ;;;; License along with this library; if not, write to the Free Software |
15 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
16 | ;;;; |
17 | |
18 | (define-module (jsonld expansion) |
19 | #:use-module (jsonld context) |
20 | #:use-module (jsonld context-processing) |
21 | #:use-module (jsonld iri-expansion) |
22 | #:use-module (jsonld value-expansion) |
23 | #:use-module (jsonld json) |
24 | #:use-module (jsonld options) |
25 | #:use-module (ice-9 match) |
26 | #:use-module (srfi srfi-1) |
27 | #:use-module (web uri) |
28 | #:export (expansion)) |
29 | |
30 | ;; 13.7 |
31 | (define* (execute-when-language active-context key value expanded-property |
32 | active-property expanded-value result options) |
33 | ;; 13.7.2 |
34 | (let ((direction (active-context-direction active-context))) |
35 | ;; 13.7.1 |
36 | (set! expanded-value '()) |
37 | ;; 13.7.3 |
38 | (when (term-definition? (term-definition-ref active-context key)) |
39 | (set! direction (term-definition-direction |
40 | (term-definition-ref active-context key))) |
41 | (when (equal? direction #f) |
42 | (set! direction (active-context-direction active-context)))) |
43 | ;; 13.7.4 |
44 | (for-each-pair |
45 | (lambda (language language-value) |
46 | ;; 13.7.4.1 |
47 | (if (json-array? language-value) |
48 | (set! language-value (array->list language-value)) |
49 | (set! language-value (list language-value))) |
50 | ;; 13.7.4.2 |
51 | (for-each |
52 | (lambda (item) |
53 | ;; 13.7.4.2.1 |
54 | (unless (json-null? item) |
55 | ;; 13.7.4.2.2 |
56 | (unless (string? item) |
57 | (throw 'invalid-language-map-value)) |
58 | ;; 13.7.4.2.3 |
59 | (let ((v `(("@value" . ,item) |
60 | ("@language" . ,(string-downcase language))))) |
61 | ;; TODO: if @language is not a bcp-47 one, we should issue a warning |
62 | (when (equal? (expand-key active-context language) "@none") |
63 | (set! v (alist-remove v "@language"))) |
64 | (when (not-null-or-false direction) |
65 | (set! v (alist-set v "@direction" direction))) |
66 | (set! expanded-value |
67 | (append expanded-value (list v)))))) |
68 | language-value)) |
69 | (if (jsonld-options-ordered? options) |
70 | (alist-sort-by-key value) |
71 | value)) |
72 | (set! expanded-value (list->array 1 expanded-value))) |
73 | `(("expanded-value" . ,expanded-value))) |
74 | |
75 | ;; 13.8 |
76 | (define* (execute-when-index active-context key value expanded-property |
77 | active-property expanded-value result |
78 | container-mapping base-url options) |
79 | ;; 13.8.1 |
80 | (set! expanded-value '()) |
81 | ;; 13.8.2 |
82 | (let ((index-key |
83 | (if (term-definition? (term-definition-ref active-context key)) |
84 | (or (term-definition-index |
85 | (term-definition-ref active-context key)) |
86 | "@index") |
87 | "@index")) |
88 | ;; Should not be null, if it fails because of that, there's a weird corner case |
89 | (map-context json-null) |
90 | (expanded-index json-null)) |
91 | ;; 13.8.3 |
92 | (for-each-pair |
93 | (lambda (index index-value) |
94 | ;; 13.8.3.1 |
95 | (when (or (member "@id" container-mapping) |
96 | (member "@type" container-mapping)) |
97 | (let ((previous (active-context-previous active-context))) |
98 | (set! map-context (or (if (not-null-or-false previous) previous #f) |
99 | active-context)))) |
100 | ;; 13.8.3.2 |
101 | (when (and (member "@type" container-mapping) |
102 | (term-definition? (term-definition-ref map-context index)) |
103 | (not (equal? (term-definition-context |
104 | (term-definition-ref map-context index)) |
105 | #f))) |
106 | (set! map-context |
107 | (context-processing map-context |
108 | (term-definition-context |
109 | (term-definition-ref map-context index)) |
110 | (term-definition-base-url |
111 | (term-definition-ref map-context index)) |
112 | #:options options))) |
113 | ;; 13.8.3.3 |
114 | (when (json-null? map-context) |
115 | (set! map-context active-context)) |
116 | ;; 13.8.3.4 |
117 | (set! expanded-index (assoc-ref |
118 | (iri-expansion active-context index |
119 | ; XXX: or map-context? |
120 | #:vocab? #t |
121 | #:options options) |
122 | "iri")) |
123 | ;; 13.8.3.5 |
124 | (unless (json-array? index-value) |
125 | (set! index-value `#(,index-value))) |
126 | ;; 13.8.3.6 |
127 | (set! index-value (expansion map-context key index-value base-url |
128 | #:options options)) |
129 | ;; 13.8.3.7 |
130 | (for-each |
131 | (lambda (item) |
132 | ;; 13.8.3.7.1 |
133 | (when (member "@graph" container-mapping) |
134 | (set! item |
135 | (if (json-has-key? item "@graph") |
136 | item |
137 | `(("@graph" . ,(if (json-array? item) item `#(,item))))))) |
138 | (cond |
139 | ;; 13.8.3.7.2 |
140 | ((and (member "@index" container-mapping) |
141 | (not (equal? index-key "@index")) |
142 | (not (equal? expanded-index "@none"))) |
143 | (let* (;; 13.8.3.7.2.1 |
144 | (re-expanded-index (value-expansion active-context index-key index)) |
145 | ;; 13.8.3.7.2.2 |
146 | (expanded-index-key |
147 | (assoc-ref |
148 | (iri-expansion active-context index-key |
149 | #:vocab? #t |
150 | #:options options) |
151 | "iri")) |
152 | ;; 13.8.3.7.2.3 |
153 | (index-key-values (assoc-ref item expanded-index-key)) |
154 | (index-key-values (or index-key-values #())) |
155 | (index-key-values (if (json-array? index-key-values) |
156 | (array->list index-key-values) |
157 | (list index-key-values))) |
158 | (index-property-values |
159 | (cons re-expanded-index index-key-values))) |
160 | (set! item |
161 | (alist-set item expanded-index-key |
162 | (list->array 1 index-property-values))) |
163 | (when (json-has-key? item "@value") |
164 | (unless (null? (filter |
165 | (lambda (kv) |
166 | (not (equal? (car kv) "@value"))) |
167 | item)) |
168 | (throw 'invalid-value-object))))) |
169 | ;; 13.8.3.7.3 |
170 | ((and (member "@index" container-mapping) |
171 | (not (json-has-key? item "@index")) |
172 | (not (equal? expanded-index "@none"))) |
173 | (set! item (alist-set item "@index" index))) |
174 | ;; 13.8.3.7.4 |
175 | ((and (member "@id" container-mapping) |
176 | (not (json-has-key? item "@id")) |
177 | (not (equal? expanded-index "@none"))) |
178 | (set! expanded-index |
179 | (assoc-ref |
180 | (iri-expansion active-context index |
181 | #:vocab? #f |
182 | #:document-relative? #t |
183 | #:options options) |
184 | "iri")) |
185 | (set! item (alist-set item "@id" expanded-index))) |
186 | ;; 13.8.3.7.5 |
187 | ((member "@type" container-mapping) |
188 | (let* ((types (assoc-ref item "@type")) |
189 | (types (or types #())) |
190 | (types (if (json-array? types) |
191 | (array->list types) |
192 | (list types))) |
193 | (types (if (equal? expanded-index "@none") |
194 | types |
195 | (cons expanded-index types)))) |
196 | (unless (equal? (length types) 0) |
197 | (set! item (alist-set item "@type" (list->array 1 types)))))) |
198 | (else #t)) |
199 | (set! expanded-value (append expanded-value (list item)))) |
200 | (array->list index-value))) |
201 | (if (jsonld-options-ordered? options) |
202 | (alist-sort-by-key value) |
203 | value)) |
204 | (set! expanded-value (list->array 1 expanded-value)) |
205 | `(("expanded-value" . ,expanded-value)))) |
206 | |
207 | ;; 13.4 |
208 | (define (execute-when-keyword active-context key value expanded-property |
209 | active-property expanded-value continue? result |
210 | type-scoped-context input-type nests base-url options) |
211 | (cond |
212 | ;; 13.4.1 |
213 | ((equal? active-property "@reverse") |
214 | (throw 'invalid-reverse-property-map)) |
215 | ;; 13.4.2 |
216 | ((and (json-has-key? result expanded-property) |
217 | (or (processing-mode-1.0? (jsonld-options-processing-mode options)) |
218 | (not (member expanded-property '("@included" "@type"))))) |
219 | (throw 'colliding-keywords)) |
220 | ;; 13.4.3 |
221 | ((equal? expanded-property "@id") |
222 | (unless (or (string? value) |
223 | (and (jsonld-options-frame-expansion? options) |
224 | (or (equal? value '()) |
225 | (not (equal? value #())) |
226 | (string-array? value)))) |
227 | (throw 'invalid-@id-value)) |
228 | (cond |
229 | ((string? value) |
230 | (set! expanded-value (assoc-ref |
231 | (iri-expansion active-context value |
232 | #:document-relative? #t |
233 | #:options options) |
234 | "iri")) |
235 | (when (jsonld-options-frame-expansion? options) |
236 | (set! expanded-value `#(,expanded-value)))) |
237 | ((equal? value '()) |
238 | ;; XXX: is the the right thing to do? |
239 | (set! expanded-value `#(()))) |
240 | ((json-array? value) |
241 | (set! expanded-value |
242 | (map |
243 | (lambda (v) |
244 | (assoc-ref |
245 | (iri-expansion active-context v |
246 | #:document-relative? #t |
247 | #:options options) |
248 | "iri")) |
249 | (array->list value))) |
250 | (set! expanded-value (list->array 1 expanded-value))))) |
251 | ;; 13.4.4 |
252 | ((equal? expanded-property "@type") |
253 | ;; 13.4.4.1 |
254 | (unless (or (string? value) |
255 | (string-array? value) |
256 | (and |
257 | (jsonld-options-frame-expansion? options) |
258 | (or |
259 | (equal? value '()) |
260 | (and (json-object? value) |
261 | (json-has-key? value "@default"))))) |
262 | (throw 'invalid-type-value)) |
263 | (cond |
264 | ;; 13.4.4.2 |
265 | ((equal? value '()) |
266 | (set! expanded-value '())) |
267 | ;; 13.4.4.3 |
268 | ((json-has-key? value "@default") |
269 | (let ((iri (assoc-ref |
270 | (iri-expansion type-scoped-context (assoc-ref value "@default") |
271 | #:vocab? #t |
272 | #:document-relative? #t |
273 | #:options options) |
274 | "iri"))) |
275 | (unless (absolute-iri? iri) |
276 | (throw 'invalid-type-value)) |
277 | (set! expanded-value (alist-set value "@default" iri)))) |
278 | ;; 13.4.4.4 |
279 | ((string? value) |
280 | (set! expanded-value |
281 | (assoc-ref |
282 | (iri-expansion type-scoped-context value |
283 | #:vocab? #t |
284 | #:document-relative? #t |
285 | #:options options) |
286 | "iri"))) |
287 | ((string-array? value) |
288 | (set! expanded-value |
289 | (list->array 1 |
290 | (map |
291 | (lambda (v) |
292 | (assoc-ref |
293 | (iri-expansion type-scoped-context v |
294 | #:vocab? #t |
295 | #:document-relative? #t |
296 | #:options options) |
297 | "iri")) |
298 | (array->list value)))))) |
299 | ;; 13.4.4.5 |
300 | (when (json-has-key? result "@type") |
301 | (set! expanded-value |
302 | (list->array 1 (append |
303 | (array->list |
304 | (if (json-array? (assoc-ref result "@type")) |
305 | (assoc-ref result "@type") |
306 | `#(,(assoc-ref result "@type")))) |
307 | (array->list |
308 | (if (json-array? expanded-value) |
309 | expanded-value |
310 | `#(,expanded-value)))))))) |
311 | ;; 13.4.5 |
312 | ((equal? expanded-property "@graph") |
313 | (set! expanded-value (expansion active-context "@graph" value base-url |
314 | #:options options)) |
315 | (unless (json-array? expanded-value) |
316 | (set! expanded-value `#(,expanded-value)))) |
317 | ;; 13.4.6 |
318 | ((equal? expanded-property "@included") |
319 | (if (processing-mode-1.0? (jsonld-options-processing-mode options)) |
320 | (set! continue? #f)) |
321 | (begin |
322 | ;; 13.4.6.2 |
323 | (set! expanded-value |
324 | (expansion active-context active-property value base-url |
325 | #:options options)) |
326 | (if (json-array? expanded-value) |
327 | (set! expanded-value (array->list expanded-value)) |
328 | (set! expanded-value (list expanded-value))) |
329 | ;; 13.4.6.3 |
330 | (unless (null? (filter |
331 | (lambda (v) |
332 | (not (node-object? v))) |
333 | expanded-value)) |
334 | (throw 'invalid-@included-value)) |
335 | ;; 13.4.6.4 |
336 | (set! expanded-value |
337 | (append |
338 | (if (json-has-key? result "@included") |
339 | (array->list (assoc-ref result "@included")) |
340 | '()) |
341 | expanded-value)) |
342 | (set! expanded-value (list->array 1 expanded-value)))) |
343 | ;; 13.4.7 |
344 | ((equal? expanded-property "@value") |
345 | ;; 13.4.7.1 |
346 | (if (equal? input-type "@json") |
347 | (begin |
348 | (set! expanded-value value) |
349 | (when (processing-mode-1.0? (jsonld-options-processing-mode options)) |
350 | (throw 'invalid-value-object-value))) |
351 | ;; 13.4.7.2 |
352 | (begin |
353 | (unless (or (scalar? value) |
354 | (json-null? value) |
355 | (and (jsonld-options-frame-expansion? options) |
356 | (or (equal? value '()) |
357 | (scalar-array? value)))) |
358 | (throw 'invalid-value-object-value)))) |
359 | ;; 13.4.7.3 |
360 | (set! expanded-value value) |
361 | (when (jsonld-options-frame-expansion? options) |
362 | (when (equal? expanded-value '()) |
363 | (set! expanded-value #(()))) |
364 | (when (scalar? expanded-value) |
365 | (set! expanded-value #(,expanded-value)))) |
366 | ;; 13.4.7.4 |
367 | (when (json-null? expanded-value) |
368 | (set! continue? #f) |
369 | (set! result (alist-set result "@value" json-null)))) |
370 | ;; 13.4.8 |
371 | ((equal? expanded-property "@language") |
372 | (unless (or (string? value) |
373 | (and (jsonld-options-frame-expansion? options) |
374 | (or (string-array? value) |
375 | (equal? value '())))) |
376 | (throw 'invalid-language-tagged-string)) |
377 | ;; TODO: warning when value is to bcp-47 compliant |
378 | (cond |
379 | ((string? value) |
380 | (set! expanded-value (string-downcase value)) |
381 | (when (jsonld-options-frame-expansion? options) |
382 | (set! expanded-value `#(,expanded-value)))) |
383 | ((equal? value '()) |
384 | (set! expanded-value #(()))) |
385 | ((string-array? value) |
386 | (set! expanded-value value)))) |
387 | ;; 13.4.9 |
388 | ((equal? expanded-property "@direction") |
389 | (if (processing-mode-1.0? (jsonld-options-processing-mode options)) |
390 | (set! continue? #f) |
391 | (begin |
392 | (unless (or (equal? value "ltr") (equal? value "rtl") |
393 | (and (jsonld-options-frame-expansion? options) |
394 | (or (string-array? value) |
395 | (equal? value '())))) |
396 | (throw 'invalid-base-direction)) |
397 | (cond |
398 | ((string? value) |
399 | (set! expanded-value value) |
400 | (when (jsonld-options-frame-expansion? options) |
401 | (set! expanded-value `#(,expanded-value)))) |
402 | ((equal? value '()) |
403 | (set! expanded-value #(()))) |
404 | ((string-array? value) |
405 | (set! expanded-value value)))))) |
406 | ;; 13.4.10 |
407 | ((equal? expanded-property "@index") |
408 | (if (string? value) |
409 | (set! expanded-value value) |
410 | (throw 'invalid-@index-value))) |
411 | ;; 13.4.11 |
412 | ((equal? expanded-property "@list") |
413 | (if (or (equal? active-property "@graph") (json-null? active-property)) |
414 | ;; 13.4.11.1 |
415 | (set! continue? #f) |
416 | (begin |
417 | ;; 13.4.11.2 |
418 | (set! expanded-value |
419 | (expansion active-context active-property value base-url |
420 | #:options options)) |
421 | ;; Not in spec, but expected from the tests and implemented elsewhere |
422 | (unless (json-array? expanded-value) |
423 | (set! expanded-value `#(,expanded-value)))))) |
424 | ;; 13.4.12 |
425 | ((equal? expanded-property "@set") |
426 | (set! expanded-value (expansion active-context active-property value base-url |
427 | #:options options))) |
428 | ;; 13.4.13 |
429 | ((equal? expanded-property "@reverse") |
430 | (unless (json-object? value) |
431 | (throw 'invalid-@reverse-value)) |
432 | ;; 13.4.13.2 |
433 | (set! expanded-value (expansion active-context "@reverse" value base-url |
434 | #:options options)) |
435 | ;; 13.4.13.3 |
436 | (when (json-has-key? expanded-value "@reverse") |
437 | (for-each-pair |
438 | (lambda (property item) |
439 | (if (json-has-key? result property) |
440 | (set! result |
441 | (alist-set result property |
442 | (list->array 1 |
443 | (append |
444 | (array->list (assoc-ref result property)) |
445 | (list item))))) |
446 | (set! result |
447 | (alist-set result property |
448 | (if (json-array? item) item `#(,item)))))) |
449 | (assoc-ref expanded-value "@reverse"))) |
450 | ;; 13.4.13.4 |
451 | (unless (null? (filter |
452 | (lambda (p) (not (equal? (car p) "@reverse"))) |
453 | expanded-value)) |
454 | ;; 13.4.13.4.1 and 13.4.13.4.2 |
455 | (let ((reverse-map |
456 | (if (json-has-key? result "@reverse") |
457 | (assoc-ref result "@reverse") |
458 | '()))) |
459 | (for-each-pair |
460 | ;; 13.4.13.4.3 |
461 | (lambda (property items) |
462 | (unless (equal? property "@reverse") |
463 | (for-each |
464 | ;; 13.4.13.4.3.1 |
465 | (lambda (item) |
466 | ;; 13.4.13.4.3.1.1 |
467 | (when (json-has-key? item "@value") |
468 | (throw 'invalid-reverse-property-value)) |
469 | (when (json-has-key? item "@list") |
470 | (throw 'invalid-reverse-property-value)) |
471 | (if (json-has-key? reverse-map property) |
472 | ;; 13.4.13.4.3.1.2 |
473 | (set! reverse-map |
474 | (alist-set reverse-map property |
475 | (list->array 1 |
476 | (append |
477 | (array->list |
478 | (assoc-ref reverse-map property)) |
479 | (list item))))) |
480 | ;; 13.4.13.4.3.1.3 |
481 | (set! reverse-map |
482 | (alist-set reverse-map property `#(,item))))) |
483 | (array->list items)))) |
484 | expanded-value) |
485 | (set! result (alist-set result "@reverse" reverse-map)))) |
486 | ;; 13.4.13.5 |
487 | (set! continue? #f)) |
488 | ;; 13.4.14 |
489 | ((equal? expanded-property "@nest") |
490 | (set! nests (cons key (or nests '()))) |
491 | (set! continue? #f)) |
492 | ;; 13.4.15 |
493 | ((and (jsonld-options-frame-expansion? options) |
494 | (member expanded-property '("@explicit" "@default" "@embed" |
495 | "@omitDefault" "@requireAll"))) |
496 | (set! expanded-value (expansion active-context active-property value base-url |
497 | #:options options)))) |
498 | ;; 13.4.16 |
499 | (unless (or (not continue?) |
500 | (and (json-null? expanded-value) |
501 | (equal? expanded-property "@value") |
502 | (equal? input-type "@json"))) |
503 | (set! result (alist-set result expanded-property expanded-value))) |
504 | `(("result" . ,result) ("nests" . ,nests))) |
505 | |
506 | (define (execute-13 active-context active-property element property-scoped-context |
507 | type-scoped-context result nests input-type base-url options) |
508 | (for-each-pair |
509 | (lambda (key value) |
510 | ;; 13.1: skip is @context |
511 | (unless (equal? key "@context") |
512 | ;; 13.2 |
513 | (let ((expanded-property |
514 | (assoc-ref (iri-expansion active-context key |
515 | #:vocab? #t |
516 | #:options options) |
517 | "iri")) |
518 | (expanded-value json-null) |
519 | ;; whether we continue evaluating this key or not. #f means go |
520 | ;; immediately to processing the next key-value pair. |
521 | (continue? #t) |
522 | (container-mapping #f)) |
523 | (cond |
524 | ;; 13.3 |
525 | ((or (json-null? expanded-property) |
526 | (not (or (json-keyword? expanded-property) |
527 | (string-index expanded-property #\:)))) |
528 | (set! continue? #f)) |
529 | ;; 13.4 |
530 | ((json-keyword? expanded-property) |
531 | (let ((exec-result (execute-when-keyword |
532 | active-context key value expanded-property |
533 | active-property expanded-value continue? result |
534 | type-scoped-context input-type nests base-url |
535 | options))) |
536 | (set! result (assoc-ref exec-result "result")) |
537 | (set! nests (assoc-ref exec-result "nests"))) |
538 | (set! continue? #f)) |
539 | ;; 13.5 |
540 | (else |
541 | (set! container-mapping |
542 | (let* ((def (term-definition-ref active-context key)) |
543 | (container (and (term-definition? def) |
544 | (term-definition-container def)))) |
545 | (and (term-definition? def) |
546 | (if (json-array? container) |
547 | (array->list container) |
548 | (if container (list container) '()))))) |
549 | (cond |
550 | ;; 13.6 |
551 | ((and |
552 | (term-definition? (term-definition-ref active-context key)) |
553 | (equal? |
554 | (term-definition-type |
555 | (term-definition-ref active-context key)) |
556 | "@json")) |
557 | (set! expanded-value `(("@value" . ,value) ("@type" . "@json")))) |
558 | ;; 13.7 |
559 | ((and container-mapping |
560 | (member "@language" container-mapping) |
561 | (json-object? value)) |
562 | (let ((exec-result (execute-when-language |
563 | active-context key value expanded-property |
564 | active-property expanded-value result |
565 | options))) |
566 | (set! expanded-value (assoc-ref exec-result "expanded-value")))) |
567 | ;; 13.8 |
568 | ((and container-mapping |
569 | (or |
570 | (member "@index" container-mapping) |
571 | (member "@type" container-mapping) |
572 | (member "@id" container-mapping)) |
573 | (json-object? value)) |
574 | (let ((exec-result (execute-when-index |
575 | active-context key value expanded-property |
576 | active-property expanded-value result |
577 | container-mapping base-url options))) |
578 | (set! expanded-value (assoc-ref exec-result "expanded-value")))) |
579 | ;; 13.9 |
580 | (else |
581 | (set! expanded-value |
582 | (expansion active-context key value base-url |
583 | #:options options)))))) |
584 | ;; 13.10 and previous (via continue?): do we process further, or |
585 | ;; go to the next key immediately? |
586 | (when (and continue? (not (json-null? expanded-value))) |
587 | ;; 13.11 |
588 | (when (and container-mapping |
589 | (member "@list" container-mapping) |
590 | (not (json-has-key? expanded-value "@list"))) |
591 | (set! expanded-value |
592 | `(("@list" . ,(if (json-array? expanded-value) |
593 | expanded-value |
594 | `#(,expanded-value)))))) |
595 | ;; 13.12 |
596 | (when (and container-mapping |
597 | (member "@graph" container-mapping) |
598 | (not (member "@id" container-mapping)) |
599 | (not (member "@index" container-mapping))) |
600 | (if (json-array? expanded-value) |
601 | (set! expanded-value (array->list expanded-value)) |
602 | (set! expanded-value (list expanded-value))) |
603 | (set! expanded-value |
604 | (map |
605 | (lambda (ev) |
606 | `(("@graph" . ,(if (json-array? ev) ev `#(,ev))))) |
607 | expanded-value)) |
608 | (set! expanded-value (list->array 1 expanded-value))) |
609 | ;; 13.13 |
610 | (if (and (term-definition? |
611 | (term-definition-ref active-context key)) |
612 | (term-definition-reverse? |
613 | (term-definition-ref active-context key))) |
614 | ;; 13.13.1 and 13.13.2 |
615 | (let ((reverse-map |
616 | (if (json-has-key? result "@reverse") |
617 | (assoc-ref result "@reverse") |
618 | '()))) |
619 | (for-each |
620 | ;; 13.13.4 |
621 | (lambda (item) |
622 | ;; 13.13.4.1 |
623 | (when (json-has-key? item "@value") |
624 | (throw 'invalid-reverse-property-value)) |
625 | ;; 13.13.4.1 |
626 | (when (json-has-key? item "@list") |
627 | (throw 'invalid-reverse-property-value)) |
628 | ;; 13.13.4.2 and 13.13.4.3 |
629 | (set! reverse-map |
630 | (alist-set reverse-map expanded-property |
631 | (list->array 1 |
632 | (append |
633 | (array->list |
634 | (if (json-has-key? reverse-map expanded-property) |
635 | (assoc-ref reverse-map expanded-property) |
636 | #())) |
637 | (list item)))))) |
638 | ;; 13.13.3 |
639 | (if (json-array? expanded-value) |
640 | (array->list expanded-value) |
641 | (list expanded-value))) |
642 | (set! result (alist-set result "@reverse" reverse-map))) |
643 | ;; 13.14 |
644 | (set! result |
645 | (alist-set result expanded-property |
646 | (list->array 1 |
647 | (if (json-array? expanded-value) |
648 | (append |
649 | (array->list |
650 | (if (json-has-key? result expanded-property) |
651 | (assoc-ref result expanded-property) |
652 | #())) |
653 | (array->list expanded-value)) |
654 | (append |
655 | (array->list |
656 | (if (json-has-key? result expanded-property) |
657 | (assoc-ref result expanded-property) |
658 | #())) |
659 | (list expanded-value))))))))))) |
660 | (if (jsonld-options-ordered? options) |
661 | (alist-sort-by-key element) |
662 | element)) |
663 | `(("result" . ,result) |
664 | ("nests" . ,nests))) |
665 | |
666 | (define (execute-14 active-context active-property element property-scoped-context |
667 | type-scoped-context result nests input-type base-url options) |
668 | ;; 14 |
669 | (for-each |
670 | (lambda (nesting-key) |
671 | ;; 14.1 |
672 | (let ((nested-values (assoc-ref element nesting-key))) |
673 | (unless (json-array? nested-values) |
674 | (set! nested-values `#(,nested-values))) |
675 | ;; 14.2 |
676 | (for-each |
677 | (lambda (nested-value) |
678 | ;; 14.2.1 |
679 | (unless (and (json-object? nested-value) |
680 | ;; XXX: "expand to @value" |
681 | (not (json-key-expanded-to? active-context nested-value "@value"))) |
682 | (throw 'invalid-@nest-value)) |
683 | ;; 14.2.2 |
684 | (let* ((active-property nesting-key) |
685 | (active-property-term-definition |
686 | (term-definition-ref active-context active-property)) |
687 | (property-scoped-context |
688 | (if (and (term-definition? active-property-term-definition) |
689 | (not (equal? (term-definition-context active-property-term-definition) #f))) |
690 | (term-definition-context active-property-term-definition) |
691 | property-scoped-context)) |
692 | (active-context |
693 | (if property-scoped-context |
694 | (context-processing active-context property-scoped-context |
695 | base-url |
696 | #:override-protected? #t |
697 | #:options options) |
698 | active-context)) |
699 | (exec-result |
700 | (execute-13 active-context active-property |
701 | nested-value property-scoped-context |
702 | type-scoped-context result '() |
703 | input-type base-url options))) |
704 | (set! result (assoc-ref exec-result "result")) |
705 | (set! nests (assoc-ref exec-result "nests")) |
706 | (let ((exec-result |
707 | (execute-14 active-context active-property |
708 | nested-value property-scoped-context |
709 | type-scoped-context result nests input-type |
710 | base-url options))) |
711 | (set! result (assoc-ref exec-result "result"))))) |
712 | (array->list nested-values)))) |
713 | ;; nests was built with cons, so we have to reverse it |
714 | (reverse nests)) |
715 | `(("result" . ,result))) |
716 | |
717 | (define* (expansion active-context active-property element base-url |
718 | #:key (from-map? #f) (options (new-jsonld-options))) |
719 | "Expand a JsonLD document. This is an implementation of the expansion |
720 | algorithm defined in the JsonLD API specification. |
721 | |
722 | See @url{https://www.w3.org/TR/2014/REC-json-ld-api-20140116}." |
723 | ;; 3 |
724 | (define property-scoped-context |
725 | (if (term-definition? (term-definition-ref active-context active-property)) |
726 | ;; can be null, so we cannot use `or` here |
727 | (term-definition-context (term-definition-ref |
728 | active-context active-property)) |
729 | #f)) |
730 | ;; 2 |
731 | (when (equal? active-property "@default") |
732 | (set! options (update-jsonld-options options #:frame-expansion? #f))) |
733 | (cond |
734 | ;; 1 |
735 | ((json-null? element) json-null) |
736 | ;; 4 |
737 | ((scalar? element) |
738 | (if (member active-property `(,json-null "@graph")) |
739 | ;; 4.1 |
740 | json-null |
741 | (begin |
742 | ;; 4.2 |
743 | (unless (equal? property-scoped-context #f) |
744 | (set! active-context |
745 | (context-processing active-context property-scoped-context base-url))) |
746 | ;; 4.3 |
747 | (value-expansion active-context active-property element #:options options)))) |
748 | ;; 5 |
749 | ((array? element) |
750 | ;; 5.1 |
751 | (let ((result '())) |
752 | ;; 5.2 |
753 | (for-each |
754 | (lambda (item) |
755 | ;; 5.2.1 |
756 | (let ((expanded-item (expansion active-context active-property item base-url |
757 | #:from-map? from-map? |
758 | #:options options))) |
759 | ;; 5.2.2 |
760 | (when (and |
761 | (term-definition? (term-definition-ref active-context active-property)) |
762 | (term-definition-container (term-definition-ref active-context active-property)) |
763 | (member "@list" (array->list (term-definition-container (term-definition-ref active-context active-property)))) |
764 | (json-array? expanded-item)) |
765 | (set! expanded-item `(("@list" . ,expanded-item)))) |
766 | ;; 5.2.3 |
767 | (if (json-array? expanded-item) |
768 | (set! result (append result (array->list expanded-item))) |
769 | (unless (json-null? expanded-item) |
770 | (set! result (append result (list expanded-item))))))) |
771 | (array->list element)) |
772 | ;; 5.3 |
773 | (list->array 1 result))) |
774 | ;; 6 |
775 | (else |
776 | ;; 7 |
777 | (unless (json-null? (active-context-previous active-context)) |
778 | (let ((previous (active-context-previous active-context))) |
779 | (unless (or from-map? (json-key-expanded-to? active-context element "@value") |
780 | (and |
781 | (= (length element) 1) |
782 | (json-key-expanded-to? previous element "@id"))) |
783 | (set! active-context (active-context-previous active-context))))) |
784 | ;; 8 |
785 | (unless (equal? property-scoped-context #f) |
786 | (let* ((def (term-definition-ref active-context active-property)) |
787 | (base-url |
788 | (if (term-definition? def) |
789 | (term-definition-base-url def) |
790 | base-url))) |
791 | (set! active-context |
792 | (context-processing active-context property-scoped-context base-url |
793 | #:override-protected? #t |
794 | #:options options)))) |
795 | ;; 9 |
796 | (when (json-has-key? element "@context") |
797 | (set! active-context |
798 | (context-processing active-context (assoc-ref element "@context") |
799 | base-url #:options options))) |
800 | ;; 10, 12 |
801 | (let ((type-scoped-context active-context) |
802 | (result '()) |
803 | (nests '()) |
804 | (input-type json-null) |
805 | (found-first-entry? #f)) |
806 | ;; 11 |
807 | (for-each-pair |
808 | (lambda (key value) |
809 | (when (equal? (expand-key active-context key) "@type") |
810 | ;; 12 |
811 | (unless found-first-entry? |
812 | (match value |
813 | ((? json-array? value) |
814 | (set! input-type (car (reverse (array->list value))))) |
815 | (_ (set! input-type value))) |
816 | (set! input-type |
817 | (assoc-ref |
818 | (iri-expansion active-context input-type #:vocab? #t) |
819 | "iri"))) |
820 | (set! found-first-entry? #t) |
821 | ;; 11.1 |
822 | (unless (json-array? value) |
823 | (set! value `#(,value))) |
824 | ;; 11.2 |
825 | (for-each |
826 | (lambda (term) |
827 | (when (and (term-definition? (term-definition-ref type-scoped-context term)) |
828 | (not (equal? |
829 | (term-definition-context |
830 | (term-definition-ref type-scoped-context term)) |
831 | #f))) |
832 | (set! active-context |
833 | (context-processing active-context |
834 | (term-definition-context |
835 | (term-definition-ref type-scoped-context |
836 | term)) |
837 | (term-definition-base-url |
838 | (term-definition-ref type-scoped-context |
839 | term)) |
840 | #:propagate? #f |
841 | #:options options)))) |
842 | (sort (filter string? (array->list value)) string<=?)))) |
843 | (alist-sort-by-key element)) |
844 | ;; 13 |
845 | (let ((exec-result |
846 | (execute-13 active-context active-property element |
847 | property-scoped-context type-scoped-context result |
848 | nests input-type base-url options))) |
849 | (set! result (assoc-ref exec-result "result")) |
850 | (set! nests (assoc-ref exec-result "nests"))) |
851 | ;; 14 |
852 | (let ((exec-result |
853 | (execute-14 active-context active-property element |
854 | property-scoped-context type-scoped-context result |
855 | nests input-type base-url options))) |
856 | (set! result (assoc-ref exec-result "result"))) |
857 | (cond |
858 | ;; 15 |
859 | ((json-has-key? result "@value") |
860 | (begin |
861 | ;; 15.1 |
862 | (unless (null? |
863 | (filter |
864 | (lambda (p) |
865 | (not |
866 | (member (car p) |
867 | '("@direction" "@value" "@type" "@language" "@index")))) |
868 | result)) |
869 | (throw 'invalid-value-object)) |
870 | (when (and |
871 | (or |
872 | (json-has-key? result "@language") |
873 | (json-has-key? result "@direction")) |
874 | (json-has-key? result "@type")) |
875 | (throw 'invalid-value-object)) |
876 | ;; 15.2 |
877 | (unless (equal? (assoc-ref result "@type") "@json") |
878 | ;; 15.3 |
879 | (when (json-null? (assoc-ref result "@value")) |
880 | (set! result json-null)) |
881 | ;; 15.4 |
882 | (unless (or |
883 | (string? (assoc-ref result "@value")) |
884 | (not (json-has-key? result "@language"))) |
885 | (throw 'invalid-language-tagged-value)) |
886 | ;; 15.5 |
887 | (unless (or |
888 | (not (json-has-key? result "@type")) |
889 | (absolute-iri? (assoc-ref result "@type"))) |
890 | ;; XXX: what if it's a list? is it valid? |
891 | (throw 'invalid-typed-value))))) |
892 | ;; 16 |
893 | ((json-has-key? result "@type") |
894 | (unless (json-array? (assoc-ref result "@type")) |
895 | (set! result |
896 | (alist-set result "@type" `#(,(assoc-ref result "@type")))))) |
897 | ;; 17 |
898 | ((json-has-key? result "@list") |
899 | ;; 17.1 |
900 | (unless (null? |
901 | (filter |
902 | (lambda (p) |
903 | (not (member (car p) '("@list" "@index")))) |
904 | result)) |
905 | (throw 'invalid-set-or-list-object))) |
906 | ;; 17 |
907 | ((json-has-key? result "@set") |
908 | ;; 17.1 |
909 | (unless (null? |
910 | (filter |
911 | (lambda (p) |
912 | (not (member (car p) '("@set" "@index")))) |
913 | result)) |
914 | (throw 'invalid-set-or-list-object)) |
915 | ;; 17.2 |
916 | (set! result (assoc-ref result "@set"))) |
917 | (else #t)) |
918 | (cond |
919 | ;; 18 |
920 | ((and (json-has-key? result "@language") |
921 | (null? (filter (lambda (p) (not (equal? (car p) "@language"))) |
922 | result))) |
923 | (set! result json-null)) |
924 | ;; 19 |
925 | ((or (json-null? active-property) (equal? active-property "@graph")) |
926 | (if (or (equal? result '()) |
927 | (json-has-key? result "@value") |
928 | (json-has-key? result "@list")) |
929 | (set! result json-null) |
930 | (when (and |
931 | (not (jsonld-options-frame-expansion? options)) |
932 | (json-has-key? result "@id") |
933 | (null? (filter (lambda (p) (not (equal? (car p) "@id"))) |
934 | result))) |
935 | (set! result json-null)))) |
936 | ;; 20 |
937 | (else #t)) |
938 | result)))) |
939 |