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