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 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