guile-jsonld/jsonld/value-compaction.scm

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