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