value-compaction.scm
1 | ;;;; Copyright (C) 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-compaction) |
19 | #:use-module (jsonld context) |
20 | #:use-module (jsonld iri-compaction) |
21 | #:use-module (jsonld json) |
22 | #:export (value-compaction |
23 | container-mapping)) |
24 | |
25 | (define (container-mapping active-context active-property) |
26 | (let* ((def (term-definition-ref active-context active-property)) |
27 | (container-mapping |
28 | (if (term-definition? def) |
29 | (or (not-null-or-false (term-definition-container def)) #()) |
30 | #()))) |
31 | (if (json-array? container-mapping) |
32 | (array->list container-mapping) |
33 | (list container-mapping)))) |
34 | |
35 | (define (value-compaction active-context active-property value processing-mode) |
36 | (let* ((result value) |
37 | (active-def (term-definition-ref active-context active-property)) |
38 | ;; 2 |
39 | (language (if (term-definition? active-def) |
40 | (term-definition-language active-def) |
41 | #f)) |
42 | ;; 3 |
43 | (direction (if (term-definition? active-def) |
44 | (term-definition-direction active-def) |
45 | #f))) |
46 | (when (equal? language #f) |
47 | (set! language (active-context-language active-context))) |
48 | (when (equal? direction #f) |
49 | (set! direction (active-context-direction active-context))) |
50 | (cond |
51 | ;; 4 |
52 | ((and (json-has-key? value "@id") |
53 | (null? (filter |
54 | (lambda (kv) |
55 | (not (member (car kv) '("@id" "@index")))) |
56 | value))) |
57 | (cond |
58 | ((and (term-definition? active-def) |
59 | (equal? (term-definition-type active-def) "@id")) |
60 | (set! result (iri-compaction active-context |
61 | (assoc-ref value "@id") #:vocab? #f |
62 | #:processing-mode processing-mode))) |
63 | ((and (term-definition? active-def) |
64 | (equal? (term-definition-type active-def) "@vocab")) |
65 | (set! result (iri-compaction active-context |
66 | (assoc-ref value "@id") #:vocab? #t |
67 | #:processing-mode processing-mode))))) |
68 | ;; 5 |
69 | ((and (json-has-key? value "@type") |
70 | (term-definition? active-def) |
71 | (equal? (assoc-ref value "@type") |
72 | (term-definition-type active-def))) |
73 | (set! result (assoc-ref value "@value"))) |
74 | ;; 6 |
75 | ((or (and (term-definition? active-def) |
76 | (equal? (term-definition-type active-def) "@none")) |
77 | (json-has-key? value "@type")) |
78 | (when (json-has-key? result "@type") |
79 | (let ((type (iri-compaction active-context |
80 | (assoc-ref result "@type") |
81 | #:vocab? #t |
82 | #:processing-mode |
83 | processing-mode))) |
84 | (set! result |
85 | (alist-set result "@type" |
86 | (if (json-array? type) |
87 | (if (= (array-length type) 1) |
88 | (car (array->list type)) |
89 | type) |
90 | type)))))) |
91 | ;; 7 |
92 | ((and |
93 | (json-has-key? value "@value") |
94 | (not (string? (assoc-ref value "@value")))) |
95 | (when (or (and (json-has-key? value "@index") |
96 | (term-definition? active-def) |
97 | (member "@index" (container-mapping active-context |
98 | active-property))) |
99 | (not (json-has-key? value "@index"))) |
100 | (set! result (assoc-ref value "@value")))) |
101 | ;; 8 |
102 | ((and (or (and (not-null-or-false language) |
103 | (equal? language (assoc-ref value "@language"))) |
104 | (and (not (not-null-or-false language)) |
105 | (not (json-has-key? value "@language")))) |
106 | (or (and (not-null-or-false direction) |
107 | (equal? direction (assoc-ref value "@direction"))) |
108 | (and (not (not-null-or-false direction)) |
109 | (not (json-has-key? value "@direction"))))) |
110 | (when (or (and (json-has-key? value "@index") |
111 | (term-definition? active-def) |
112 | (member "@index" (container-mapping |
113 | active-context active-property))) |
114 | (not (json-has-key? value "@index"))) |
115 | (when (json-has-key? value "@value") |
116 | (set! result (assoc-ref value "@value")))))) |
117 | ;; 9 |
118 | (when (json-object? result) |
119 | (set! result |
120 | (map |
121 | (lambda (kv) |
122 | (cons |
123 | (iri-compaction active-context (car kv) #:vocab? #t) |
124 | (cdr kv))) |
125 | result))) |
126 | ;; 10 |
127 | result)) |
128 |