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 |