guile-jsonld/jsonld/expansion.scm

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 ((exec-result
685
                    (execute-13 active-context active-property
686
                                nested-value property-scoped-context
687
                                type-scoped-context result '()
688
                                input-type base-url options)))
689
              (set! result (assoc-ref exec-result "result"))
690
              (set! nests (assoc-ref exec-result "nests"))
691
              (let ((exec-result
692
                      (execute-14 active-context active-property
693
                                  nested-value property-scoped-context
694
                                  type-scoped-context result nests input-type
695
                                  base-url options)))
696
                (set! result (assoc-ref exec-result "result")))))
697
          (array->list nested-values))))
698
    ;; nests was built with cons, so we have to reverse it
699
    (reverse nests))
700
  `(("result" . ,result)))
701
702
(define* (expansion active-context active-property element base-url
703
                    #:key (from-map? #f) (options (new-jsonld-options)))
704
  "Expand a JsonLD document.  This is an implementation of the expansion
705
algorithm defined in the JsonLD API specification.
706
707
See @url{https://www.w3.org/TR/2014/REC-json-ld-api-20140116}."
708
  ;; 3
709
  (define property-scoped-context
710
    (if (term-definition? (term-definition-ref active-context active-property))
711
        ;; can be null, so we cannot use `or` here
712
        (term-definition-context (term-definition-ref
713
                                   active-context active-property))
714
        #f))
715
  ;; 2
716
  (when (equal? active-property "@default")
717
    (set! options (update-jsonld-options options #:frame-expansion? #f)))
718
  (cond
719
    ;; 1
720
    ((json-null? element) json-null)
721
    ;; 4
722
    ((scalar? element)
723
     (if (member active-property `(,json-null "@graph"))
724
       ;; 4.1
725
       json-null
726
       (begin
727
         ;; 4.2
728
         (unless (equal? property-scoped-context #f)
729
           (set! active-context
730
             (context-processing active-context property-scoped-context base-url)))
731
         ;; 4.3
732
         (value-expansion active-context active-property element #:options options))))
733
    ;; 5
734
    ((array? element)
735
     ;; 5.1
736
     (let ((result '()))
737
       ;; 5.2
738
       (for-each
739
         (lambda (item)
740
           ;; 5.2.1
741
           (let ((expanded-item (expansion active-context active-property item base-url
742
                                           #:from-map? from-map?
743
                                           #:options options)))
744
             ;; 5.2.2
745
             (when (and
746
                     (term-definition? (term-definition-ref active-context active-property))
747
                     (term-definition-container (term-definition-ref active-context active-property))
748
                     (member "@list" (array->list (term-definition-container (term-definition-ref active-context active-property))))
749
                     (json-array? expanded-item))
750
               (set! expanded-item `(("@list" . ,expanded-item))))
751
             ;; 5.2.3
752
             (if (json-array? expanded-item)
753
               (set! result (append result (array->list expanded-item)))
754
               (unless (json-null? expanded-item)
755
                 (set! result (append result (list expanded-item)))))))
756
         (array->list element))
757
       ;; 5.3
758
       (list->array 1 result)))
759
    ;; 6
760
    (else
761
      ;; 7
762
      (unless (json-null? (active-context-previous active-context))
763
        (let ((previous (active-context-previous active-context)))
764
          (unless (or from-map? (json-key-expanded-to? active-context element "@value")
765
                      (and
766
                        (= (length element) 1)
767
                        (json-key-expanded-to? previous element "@id")))
768
            (set! active-context (active-context-previous active-context)))))
769
      ;; 8
770
      (unless (equal? property-scoped-context #f)
771
        (let* ((def (term-definition-ref active-context active-property))
772
               (base-url
773
                 (if (term-definition? def)
774
                     (term-definition-base-url def)
775
                     base-url)))
776
          (set! active-context
777
            (context-processing active-context property-scoped-context base-url
778
                                #:override-protected? #t
779
                                #:options options))))
780
      ;; 9
781
      (when (json-has-key? element "@context")
782
        (set! active-context
783
          (context-processing active-context (assoc-ref element "@context")
784
                              base-url #:options options)))
785
      ;; 10, 12
786
      (let ((type-scoped-context active-context)
787
            (result '())
788
            (nests '())
789
            (input-type json-null)
790
            (found-first-entry? #f))
791
        ;; 11
792
        (for-each-pair
793
          (lambda (key value)
794
            (when (equal? (expand-key active-context key) "@type")
795
              ;; 12
796
              (unless found-first-entry?
797
                (match value
798
                  ((? json-array? value)
799
                   (set! input-type (car (reverse (array->list value)))))
800
                  (_ (set! input-type value)))
801
                (set! input-type
802
                  (assoc-ref
803
                    (iri-expansion active-context input-type #:vocab? #t)
804
                    "iri")))
805
              (set! found-first-entry? #t)
806
              ;; 11.1
807
              (unless (json-array? value)
808
                (set! value `#(,value)))
809
              ;; 11.2
810
              (for-each
811
                (lambda (term)
812
                  (when (and (term-definition? (term-definition-ref type-scoped-context term))
813
                             (not (equal?
814
                                    (term-definition-context
815
                                      (term-definition-ref type-scoped-context term))
816
                                    #f)))
817
                    (set! active-context
818
                      (context-processing active-context
819
                                          (term-definition-context
820
                                            (term-definition-ref type-scoped-context
821
                                                                 term))
822
                                          (term-definition-base-url
823
                                            (term-definition-ref type-scoped-context
824
                                                                 term))
825
                                          #:propagate? #f
826
                                          #:options options))))
827
                (sort (filter string? (array->list value)) string<=?))))
828
          (alist-sort-by-key element))
829
        ;; 13
830
        (let ((exec-result
831
                (execute-13 active-context active-property element
832
                            property-scoped-context type-scoped-context result
833
                            nests input-type base-url options)))
834
          (set! result (assoc-ref exec-result "result"))
835
          (set! nests (assoc-ref exec-result "nests")))
836
        ;; 14
837
        (let ((exec-result
838
                (execute-14 active-context active-property element
839
                            property-scoped-context type-scoped-context result
840
                            nests input-type base-url options)))
841
          (set! result (assoc-ref exec-result "result")))
842
        (cond
843
          ;; 15
844
          ((json-has-key? result "@value")
845
            (begin
846
             ;; 15.1
847
             (unless (null?
848
                       (filter
849
                         (lambda (p)
850
                           (not
851
                             (member (car p)
852
                                     '("@direction" "@value" "@type" "@language" "@index"))))
853
                         result))
854
               (throw 'invalid-value-object))
855
             (when (and
856
                     (or
857
                       (json-has-key? result "@language")
858
                       (json-has-key? result "@direction"))
859
                     (json-has-key? result "@type"))
860
               (throw 'invalid-value-object))
861
             ;; 15.2
862
             (unless (equal? (assoc-ref result "@type") "@json")
863
               ;; 15.3
864
               (when (json-null? (assoc-ref result "@value"))
865
                 (set! result json-null))
866
               ;; 15.4
867
               (unless (or
868
                         (string? (assoc-ref result "@value"))
869
                         (not (json-has-key? result "@language")))
870
                 (throw 'invalid-language-tagged-value))
871
               ;; 15.5
872
               (unless (or
873
                         (not (json-has-key? result "@type"))
874
                         (absolute-iri? (assoc-ref result "@type")))
875
                 ;; XXX: what if it's a list? is it valid?
876
                 (throw 'invalid-typed-value)))))
877
          ;; 16
878
          ((json-has-key? result "@type")
879
           (unless (json-array? (assoc-ref result "@type"))
880
             (set! result
881
               (alist-set result "@type" `#(,(assoc-ref result "@type"))))))
882
          ;; 17
883
          ((json-has-key? result "@list")
884
           ;; 17.1
885
           (unless (null?
886
                     (filter
887
                       (lambda (p)
888
                         (not (member (car p) '("@list" "@index"))))
889
                       result))
890
             (throw 'invalid-set-or-list-object)))
891
          ;; 17
892
          ((json-has-key? result "@set")
893
           ;; 17.1
894
           (unless (null?
895
                     (filter
896
                       (lambda (p)
897
                         (not (member (car p) '("@set" "@index"))))
898
                       result))
899
             (throw 'invalid-set-or-list-object))
900
           ;; 17.2
901
           (set! result (assoc-ref result "@set")))
902
          (else #t))
903
        (cond
904
          ;; 18
905
          ((and (json-has-key? result "@language")
906
                (null? (filter (lambda (p) (not (equal? (car p) "@language")))
907
                               result)))
908
           (set! result json-null))
909
          ;; 19
910
          ((or (json-null? active-property) (equal? active-property "@graph"))
911
           (if (or (equal? result '())
912
                   (json-has-key? result "@value")
913
                   (json-has-key? result "@list"))
914
               (set! result json-null)
915
               (when (and
916
                       (not (jsonld-options-frame-expansion? options))
917
                       (json-has-key? result "@id")
918
                       (null? (filter (lambda (p) (not (equal? (car p) "@id")))
919
                                      result)))
920
                 (set! result json-null))))
921
          ;; 20
922
          (else #t))
923
        result))))
924