guile-jsonld/jsonld.scm

jsonld.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)
19
  #:use-module (jsonld compaction)
20
  #:use-module (jsonld context)
21
  #:use-module (jsonld context-processing)
22
  #:use-module (jsonld download)
23
  #:use-module (jsonld expansion)
24
  #:use-module (jsonld flattening)
25
  #:use-module (jsonld inverse-context-creation)
26
  #:use-module (jsonld iri)
27
  #:use-module (jsonld iri-compaction)
28
  #:use-module (jsonld json)
29
  #:use-module (jsonld options)
30
  #:export (compact
31
            expand
32
            flatten))
33
34
(define* (compact input context #:key (options (new-jsonld-options)))
35
  (call-with-values
36
    (lambda ()
37
      ;; TODO: set ordered to #f
38
      (expand-with-base input #:options options))
39
    ;; 2 and 3
40
    (lambda (expanded-input context-base)
41
      (when (string? context)
42
        (set! context
43
          (json-document-document
44
            ((jsonld-options-document-loader options)
45
             context))))
46
      ;; 4
47
      (when (json-has-key? context "@context")
48
        (set! context (assoc-ref context "@context")))
49
      (let* ((base-iri (or (jsonld-options-base options)
50
                           (and (jsonld-options-compact-to-relative? options)
51
                                (string? input)
52
                                input)))
53
             (active-context (context-processing (new-active-context
54
                                                   #:base base-iri)
55
                                                 context context-base
56
                                                 #:options options))
57
             (inverse-context (inverse-context-creation active-context))
58
             (compacted-output
59
               (compaction active-context inverse-context
60
                           #nil ;; active-property
61
                           expanded-input ;; element
62
                           #:compact-arrays? (jsonld-options-compact-arrays? options)
63
                           #:ordered? (jsonld-options-ordered? options)
64
                           #:processing-mode
65
                           (jsonld-options-processing-mode options))))
66
        (if (equal? compacted-output #())
67
            (set! compacted-output '())
68
            (when (json-array? compacted-output)
69
              (set! compacted-output `((,(iri-compaction active-context
70
                                                         inverse-context
71
                                                         "@graph"
72
                                                         #:vocab? #t
73
                                                         #:reverse? #f) .
74
                                         ,compacted-output)))))
75
        (when (and context (not (null? compacted-output)) (not (null? context)))
76
          (set! compacted-output
77
            (cons (cons "@context" context) compacted-output)))
78
        compacted-output))))
79
80
(define* (expand-with-base input #:key (options (new-jsonld-options)))
81
  (let ((document input)
82
        (remote-document #f)
83
        (active-context (new-active-context
84
                          #:base (jsonld-options-base options)
85
                          #:original-base (jsonld-options-base options)))
86
        (document-base (jsonld-options-base options)))
87
    (when (string? input)
88
      ;; 2
89
      (catch #t
90
        (lambda ()
91
          (set! remote-document
92
            ((jsonld-options-document-loader options)
93
             input
94
             #:extract-all-scripts? (jsonld-options-extract-all-scripts? options))))
95
        (lambda (key . value)
96
          (cond
97
            ((member key '(loading-document-failed multiple-context-link-headers
98
                           invalid-script-element))
99
             (apply throw key value))
100
            (else
101
              (apply throw 'loading-document-failed key value)))))
102
      ;; 3
103
      (set! document (json-document-document remote-document))
104
      (set! document-base (json-document-document-url remote-document))
105
      ;; 4
106
      (set! active-context
107
        (update-active-context active-context
108
                               #:base (or (jsonld-options-base options)
109
                                          (json-document-document-url remote-document))
110
                               #:original-base
111
                               (or (json-document-document-url remote-document)
112
                                   (jsonld-options-base options)))))
113
114
    ;; 5
115
    (when (jsonld-options-expand-context options)
116
      (set! active-context
117
        (let* ((local-context (jsonld-options-expand-context options))
118
               (local-context (if (json-has-key? local-context "@context")
119
                                  (assoc-ref local-context "@context")
120
                                  local-context)))
121
          (context-processing active-context local-context
122
                              (active-context-original-base active-context)))))
123
124
    ;; 6
125
    (when (and remote-document (json-document-context-url remote-document))
126
      (let ((context-url (json-document-context-url remote-document)))
127
        (set! active-context
128
          (context-processing active-context context-url context-url))))
129
130
    ;; 7
131
    (let ((expanded-output (expansion active-context #nil document
132
                                      (if remote-document
133
                                          (or (json-document-document-url remote-document)
134
                                              (jsonld-options-base options))
135
                                          (jsonld-options-base options))
136
                                      #:options options)))
137
      (when (and
138
              (json-object? expanded-output)
139
              (json-has-key? expanded-output "@graph")
140
              (null? (filter
141
                       (lambda (kv)
142
                         (not (equal? (car kv) "@graph")))
143
                       expanded-output)))
144
        (set! expanded-output (assoc-ref expanded-output "@graph")))
145
      (when (equal? expanded-output #nil)
146
        (set! expanded-output #()))
147
      (unless (json-array? expanded-output)
148
        (set! expanded-output `#(,expanded-output)))
149
      ;; 8
150
      (values expanded-output document-base))))
151
152
(define* (expand input #:key (options (new-jsonld-options)))
153
  (call-with-values
154
    (lambda ()
155
      (expand-with-base input #:options options))
156
    (lambda (out base)
157
      out)))
158
159
(define* (flatten input #:key (context #f) (options (new-jsonld-options)))
160
  ;; 2
161
  (let* ((expanded-input
162
           (expand input #:options (update-jsonld-options
163
                                     options #:ordered? #t)))
164
         ;; 3
165
         (base-iri (or (jsonld-options-base options)
166
                       (and (jsonld-options-compact-to-relative? options)
167
                            (string? input)
168
                            input)))
169
         ;; 4
170
         (identifier-map '())
171
         ;; 5
172
         (flattened-output (flattening expanded-input
173
                                       #:ordered?
174
                                       (jsonld-options-ordered? options))))
175
    ;; 5.1
176
    (when context
177
      ;; TODO
178
      (set! flattened-output (compact flattened-output context #:options options)))
179
    flattened-output))
180