value-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 value-expansion) |
| 19 | #:use-module (jsonld context) |
| 20 | #:use-module (jsonld iri-expansion) |
| 21 | #:use-module (jsonld json) |
| 22 | #:use-module (jsonld options) |
| 23 | #:use-module (ice-9 match) |
| 24 | #:use-module (srfi srfi-1) |
| 25 | #:use-module (web uri) |
| 26 | #:export (value-expansion)) |
| 27 | |
| 28 | (define* (value-expansion active-context active-property value |
| 29 | #:key (options (new-jsonld-options))) |
| 30 | "Expand a value. This is an implementation of the value expansion algorithm |
| 31 | defined in the JsonLD API specification. |
| 32 | |
| 33 | See @url{https://www.w3.org/TR/json-ld-api/#value-expansion}." |
| 34 | (let* ((definition (term-definition-ref active-context active-property)) |
| 35 | (type-mapping |
| 36 | (if (term-definition? definition) |
| 37 | (term-definition-type definition) |
| 38 | #f)) |
| 39 | (language-mapping |
| 40 | (if (term-definition? definition) |
| 41 | (term-definition-language definition) |
| 42 | #f)) |
| 43 | (direction-mapping |
| 44 | (if (term-definition? definition) |
| 45 | (term-definition-direction definition) |
| 46 | #f))) |
| 47 | (cond |
| 48 | ;; 1 |
| 49 | ((and (string? value) |
| 50 | (equal? type-mapping "@id")) |
| 51 | (let ((result (iri-expansion active-context value |
| 52 | #:document-relative? #t |
| 53 | #:options options))) |
| 54 | `(("@id" . ,(assoc-ref result "iri"))))) |
| 55 | ;; 2 |
| 56 | ((and (string? value) |
| 57 | (equal? type-mapping "@vocab")) |
| 58 | (let ((result (iri-expansion active-context value |
| 59 | #:document-relative? #t |
| 60 | #:vocab? #t |
| 61 | #:options options))) |
| 62 | `(("@id" . ,(assoc-ref result "iri"))))) |
| 63 | (else |
| 64 | ;; 3 |
| 65 | (let ((result `(("@value" . ,value)))) |
| 66 | ;; 4 |
| 67 | (when (and type-mapping (not (member type-mapping '("@id" "@vocab" "@none")))) |
| 68 | (set! result (alist-set result "@type" type-mapping))) |
| 69 | ;; 5 |
| 70 | (when (string? value) |
| 71 | (let* ((language (or language-mapping (active-context-language active-context))) |
| 72 | (direction (or direction-mapping (active-context-direction active-context)))) |
| 73 | (when (equal? language-mapping #nil) |
| 74 | (set! language #nil)) |
| 75 | (when (equal? direction-mapping #nil) |
| 76 | (set! direction #nil)) |
| 77 | (when language |
| 78 | (set! result (alist-set result "@language" language))) |
| 79 | (when direction |
| 80 | (set! result (alist-set result "@direction" direction))))) |
| 81 | ;; 6 |
| 82 | result))))) |
| 83 |