Add toRdf algorithm.

Julien LepillerSun Apr 12 20:09:05+0200 2020

6b44eeb

Add toRdf algorithm.

Makefile.am

66 
  jsonld/context-processing.scm \
77 
  jsonld/context.scm \
88 
  jsonld/create-term-definition.scm \
9+
  jsonld/deserialize-jsonld.scm \
910 
  jsonld/download.scm \
1011 
  jsonld/expansion.scm \
1112 
  jsonld/flattening.scm \

…

1516 
  jsonld/iri-expansion.scm \
1617 
  jsonld/iri.scm \
1718 
  jsonld/json.scm \
19+
  jsonld/list-to-rdf.scm \
1820 
  jsonld/memoization.scm \
1921 
  jsonld/merge-node-maps.scm \
2022 
  jsonld/node-map-generation.scm \
23+
  jsonld/object-to-rdf.scm \
2124 
  jsonld/options.scm \
2225 
  jsonld/term-selection.scm \
2326 
  jsonld/value-compaction.scm \

…

3235 
TESTS = tests/compact.scm \
3336 
		tests/expand.scm \
3437 
		tests/flatten.scm \
35-
		#tests/html.scm \   not properly implemented
3638 
		tests/remote-doc.scm
3739 
EXTRA_DIST += $(TESTS)
3840 
README.md
121121 
to carry additional configuration information.  An additional context can be
122122 
passed in order to run the compaction algorithm on the result.
123123 
124+
**Scheme Procedure**: jsonld->rdf input [#:options (new-jsonld-options)]
125+
126+
Transforms the given input into an RDF dataset (in the format expected by
127+
guile-rdf).  This procedure takes an input, which can be a Json object (as
128+
produced by the guile-json library) or a string representing the URL of a JsonLD
129+
document.  The options can be used to carry additional configuration information.
130+
124131 
### The JsonLDOptions Type
125132 
126133 
The `jsonld-options` type is used to pass various options to the JsonLdProcessor
configure.ac
2929 
AC_CONFIG_FILES([tests/html.scm], [chmod +x tests/html.scm])
3030 
AC_CONFIG_FILES([tests/remote-doc.scm], [chmod +x tests/remote-doc.scm])
3131 
AC_CONFIG_FILES([tests/report.scm], [chmod +x tests/report.scm])
32+
AC_CONFIG_FILES([tests/tordf.scm], [chmod +x tests/tordf.scm])
3233 
AC_CONFIG_FILES(Makefile)
3334 
AC_REQUIRE_AUX_FILE([tap-driver.sh])
3435 
AC_PROG_AWK
jsonld.scm
1919 
  #:use-module (jsonld compaction)
2020 
  #:use-module (jsonld context)
2121 
  #:use-module (jsonld context-processing)
22+
  #:use-module (jsonld deserialize-jsonld)
2223 
  #:use-module (jsonld download)
2324 
  #:use-module (jsonld expansion)
2425 
  #:use-module (jsonld flattening)
26+
  #:use-module (jsonld generate-blank-node-identifier)
2527 
  #:use-module (jsonld inverse-context-creation)
2628 
  #:use-module (jsonld iri)
2729 
  #:use-module (jsonld iri-compaction)
2830 
  #:use-module (jsonld json)
31+
  #:use-module (jsonld node-map-generation)
2932 
  #:use-module (jsonld options)
33+
  #:use-module (rdf rdf)
3034 
  #:export (compact
3135 
            expand
32-
            flatten))
36+
            flatten
37+
            jsonld->rdf))
3338 
3439 
(define* (compact input context #:key (options (new-jsonld-options)))
3540 
  (call-with-values
…
177182 
      ;; TODO
178183 
      (set! flattened-output (compact flattened-output context #:options options)))
179184 
    flattened-output))
185+
186+
(define* (jsonld->rdf input #:key (options (new-jsonld-options)))
187+
  (call-with-values
188+
    (lambda ()
189+
      ;; TODO: set ordered to #f
190+
      (expand-with-base input #:options options))
191+
    ;; 2 and 3
192+
    (lambda (expanded-input context-base)
193+
      (pk 'expanded expanded-input)
194+
      (let* ((generate-blank-node (get-generate-blank-node-identifier))
195+
             (generate-node-map (get-node-map-generation generate-blank-node))
196+
             (node-map (generate-node-map expanded-input '()))
197+
             (node-map (assoc-ref node-map "node-map")))
198+
        (pk node-map)
199+
        (deserialize-jsonld
200+
          generate-blank-node node-map (make-rdf-dataset '() '())
201+
          #:produce-generalized-rdf?
202+
          (jsonld-options-produce-generalized-rdf? options)
203+
          #:rdf-direction (jsonld-options-rdf-direction options))))))
jsonld/deserialize-jsonld.scm unknown status 1
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 deserialize-jsonld)
19+
  #:use-module (ice-9 match)
20+
  #:use-module (jsonld iri)
21+
  #:use-module (jsonld json)
22+
  #:use-module (jsonld generate-blank-node-identifier)
23+
  #:use-module (jsonld object-to-rdf)
24+
  #:use-module ((rdf rdf) #:hide (blank-node?))
25+
  #:export (deserialize-jsonld
26+
            well-formed?
27+
            rdf-iri
28+
            xsd-iri
29+
            blank-node->rdf-blank-node))
30+
31+
(define (uniq lst)
32+
  (match lst
33+
    (() '())
34+
    ((element lst ...)
35+
     (if (member element lst)
36+
         (uniq lst)
37+
         (cons element (uniq lst))))))
38+
39+
(define (blank-node->rdf-blank-node node)
40+
  "Convert a blank node generated from the generate blank node algorithm to
41+
a representation suitable for guile-rdf.  This involves removing the leading
42+
_:b and converting to a number."
43+
  (string->number (substring node 3)))
44+
45+
(define (rdf-iri name)
46+
  (string-append "http://www.w3.org/1999/02/22-rdf-syntax-ns#" name))
47+
48+
(define (xsd-iri name)
49+
  (string-append "http://www.w3.org/2001/XMLSchema#" name))
50+
51+
(define (well-formed? node)
52+
  (or (absolute-iri? node) (blank-node? node)))
53+
54+
(define* (deserialize-jsonld generate-blank-node node-map dataset
55+
                             #:key produce-generalized-rdf? rdf-direction)
56+
  ;; 1
57+
  (for-each-pair
58+
    (lambda (graph-name graph)
59+
      ;; 1.1
60+
      (when (or (well-formed? graph-name) (equal? graph-name "@default"))
61+
        ;; 1.2
62+
        (let ((triples (if (equal? graph-name "@default")
63+
                           (rdf-dataset-default-graph dataset)
64+
                           '())))
65+
          ;; 1.3
66+
          (for-each-pair
67+
            (lambda (subject node)
68+
              ;; 1.3.1
69+
              (when (well-formed? subject)
70+
                (when (blank-node? subject)
71+
                  (set! subject (blank-node->rdf-blank-node subject)))
72+
                ;; 1.3.2
73+
                (for-each-pair
74+
                  (lambda (property values)
75+
                    (cond
76+
                      ((equal? property "@type")
77+
                       (for-each
78+
                         (lambda (type)
79+
                           (when (well-formed? type)
80+
                             (when (blank-node? type)
81+
                               (set! type (blank-node->rdf-blank-node type)))
82+
                             (set! triples
83+
                               (cons
84+
                                 (make-rdf-triple subject (rdf-iri "type")
85+
                                                  type)
86+
                                 triples))))
87+
                         (array->list values)))
88+
                      ((json-keyword? property)
89+
                       #t)
90+
                      ((and (blank-node? property) (not produce-generalized-rdf?))
91+
                       #t)
92+
                      ((not (well-formed? property))
93+
                       #t)
94+
                      (else
95+
                        (when (blank-node? property)
96+
                          (set! property (blank-node->rdf-blank-node property)))
97+
                        (for-each
98+
                          (lambda (item)
99+
                            (let* ((res
100+
                                     (object-to-rdf generate-blank-node
101+
                                                    rdf-direction item '()))
102+
                                   (list-triples (assoc-ref res "list-triples"))
103+
                                   (res (assoc-ref res "result")))
104+
                              (unless (equal? res #nil)
105+
                                (set! triples
106+
                                  (cons
107+
                                    (make-rdf-triple subject property res)
108+
                                    (append triples list-triples))))))
109+
                          (array->list values)))))
110+
                  (alist-sort-by-key node))))
111+
            (alist-sort-by-key graph))
112+
          ;; 1.2 (cont.)
113+
          (set! triples (uniq triples))
114+
          (if (equal? graph-name "@default")
115+
              (set! dataset
116+
                (make-rdf-dataset triples (rdf-dataset-named-graphs dataset)))
117+
              (unless (null? triples)
118+
                (set! dataset
119+
                  (make-rdf-dataset (rdf-dataset-default-graph dataset)
120+
                                    (alist-set
121+
                                      (rdf-dataset-named-graphs dataset)
122+
                                      (if (blank-node? graph-name)
123+
                                          (blank-node->rdf-blank-node graph-name)
124+
                                          graph-name)
125+
                                      triples))))))))
126+
    node-map)
127+
  dataset)
jsonld/iri.scm
111111 
112112 
  ;; This algorithm is not always called with sane values, so prevent errors
113113 
  ;; in some edge cases.
114-
  (if (and base (string? reference))
114+
  (if (and base (string? reference) (not (string->uri reference))
115+
           (string->uri-reference reference))
115116 
   (uri->string
116117 
     (transform-references (set-iri-path (string->uri base))
117118 
                           (string->uri-reference reference)))
jsonld/list-to-rdf.scm unknown status 1
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 list-to-rdf)
19+
  #:use-module (jsonld deserialize-jsonld)
20+
  #:use-module (jsonld iri)
21+
  #:use-module (jsonld json)
22+
  #:use-module (jsonld object-to-rdf)
23+
  #:use-module (rdf rdf)
24+
  #:export (list-to-rdf))
25+
26+
(define* (list-to-rdf generate-blank-node rdf-direction lst list-triples)
27+
  (let ((result #nil))
28+
    (if (null? lst)
29+
        ;; 1
30+
        (set! result (rdf-iri "nil"))
31+
        ;; 2
32+
        (let ((bnodes (map
33+
                        (lambda _
34+
                          (blank-node->rdf-blank-node (generate-blank-node #nil)))
35+
                        lst)))
36+
          ;; 3
37+
          (let loop ((bnodes bnodes) (lst lst))
38+
            (unless (null? bnodes)
39+
              ;; 3.2
40+
              (let* ((subject (car bnodes))
41+
                     (item (car lst))
42+
                     (rest (cdr bnodes))
43+
                     (rest (if (null? rest) (rdf-iri "nil") (car rest)))
44+
                     (res (object-to-rdf generate-blank-node rdf-direction
45+
                                         item '()))
46+
                     (object (assoc-ref res "result"))
47+
                     (embedded-triples (assoc-ref res "list-triples")))
48+
                ;; 3.3
49+
                (unless (equal? object #nil)
50+
                  (set! list-triples
51+
                    (cons (make-rdf-triple subject (rdf-iri "first") object)
52+
                          list-triples)))
53+
                ;; 3.4
54+
                (set! list-triples
55+
                  (cons (make-rdf-triple subject (rdf-iri "rest") rest)
56+
                        list-triples))
57+
                ;; 3.5
58+
                (set! list-triples
59+
                  (append list-triples embedded-triples)))
60+
              (loop (cdr bnodes) (cdr lst))))
61+
          ;; 4
62+
          (if (null? bnodes)
63+
              (set! result (rdf-iri "nil"))
64+
              (set! result (car bnodes)))))
65+
    `(("result" . ,result)
66+
      ("list-triples" . ,list-triples))))
jsonld/node-map-generation.scm
152152 
        ;; 6
153153 
        (when (node-object? element)
154154 
          ;; 6.1
155-
          (let* ((id (if (json-has-key? element "@id")
156-
                         (assoc-ref element "@id")
157-
                         #f))
158-
                 (id (if id
159-
                         (if (blank-node? id) (generate-blank-node id) id)
160-
                         (generate-blank-node #nil))))
155+
          (let ((id (if (json-has-key? element "@id")
156+
                        (if (blank-node? (assoc-ref element "@id"))
157+
                            (generate-blank-node (assoc-ref element "@id"))
158+
                            (assoc-ref element "@id"))
159+
                        (generate-blank-node #nil))))
161160 
            ;; 6.3
162-
            (unless (json-has-key? graph id)
161+
            (unless (or (json-has-key? graph id) (not id))
163162 
              (set! graph
164163 
                (alist-set graph id `(("@id" . ,id))))
165164 
              (set! node-map (alist-set node-map active-graph graph)))
166165 
            ;; 6.4
167-
            (let ((node (assoc-ref graph id)))
166+
            (let ((node (or (assoc-ref graph id) '())))
168167 
              (cond
169168 
                ;; 6.5
170169 
                ((json-object? active-subject)
…
175174 
                     ;; 6.5.1
176175 
                     (set! node
177176 
                       (alist-set node active-property `#(,active-subject))))
178-
                 (set! graph (alist-set graph id node))
177+
                 (when id
178+
                   (set! graph (alist-set graph id node)))
179179 
                 (set! node-map (alist-set node-map active-graph graph)))
180180 
                ;; 6.6
181181 
                ((not (equal? active-property #nil))
…
202202 
              (when (json-has-key? element "@type")
203203 
                (set! node
204204 
                  (append-if-not-in node "@type" (assoc-ref element "@type")))
205-
                (set! graph
206-
                  (alist-set graph id node))
205+
                (when id
206+
                  (set! graph (alist-set graph id node)))
207207 
                (set! node-map (alist-set node-map active-graph graph)))
208208 
              ;; 6.8
209209 
              (when (json-has-key? element "@index")
…
236236 
                            (set! graph (assoc-ref node-map active-graph))
237237 
                            (set! subject-node (or (assoc-ref graph active-subject)
238238 
                                                   '()))
239-
                            (set! node (assoc-ref graph id))))
239+
                            (when id
240+
                              (set! node (assoc-ref graph id)))))
240241 
                        (array->list values)))
241242 
                    reverse-map)
242243 
                  ;; 6.9.4
…
250251 
                  (set! node-map (assoc-ref res "node-map"))
251252 
                  (set! graph (assoc-ref node-map active-graph))
252253 
                  (set! subject-node (or (assoc-ref graph active-subject) '()))
253-
                  (set! node (assoc-ref graph id)))
254+
                  (when id
255+
                    (set! node (assoc-ref graph id))))
254256 
                (set! element (alist-remove element "@graph")))
255257 
              ;; 6.11
256258 
              (when (json-has-key? element "@included")
…
261263 
                  (set! node-map (assoc-ref res "node-map"))
262264 
                  (set! graph (assoc-ref node-map active-graph))
263265 
                  (set! subject-node (or (assoc-ref graph active-subject) '()))
264-
                  (set! node (assoc-ref graph id)))
266+
                  (when id
267+
                    (set! node (assoc-ref graph id))))
265268 
                (set! element (alist-remove element "@included")))
266269 
              ;; 6.12
267270 
              (for-each-pair
…
272275 
                  ;; 6.12.2
273276 
                  (unless (json-has-key? node property)
274277 
                    (set! node (alist-set node property #()))
275-
                    (set! graph (alist-set graph id node))
278+
                    (when id
279+
                      (set! graph (alist-set graph id node)))
276280 
                    (set! node-map (alist-set node-map active-graph graph)))
277281 
                  ;; 6.12.3
278282 
                  (let ((res (node-map-generation
…
282286 
                    (set! node-map (assoc-ref res "node-map"))
283287 
                    (set! graph (assoc-ref node-map active-graph))
284288 
                    (set! subject-node (or (assoc-ref graph active-subject) '()))
285-
                    (set! node (assoc-ref graph id))))
289+
                    (when id
290+
                      (set! node (assoc-ref graph id)))))
286291 
                (alist-sort-by-key element))
287-
              (set! graph (alist-set graph id node)))))
292+
              (when id
293+
                (set! graph (alist-set graph id node))))))
288294 
        (when (string? active-subject)
289295 
          (set! graph (alist-set graph active-subject subject-node)))
290296 
        (set! node-map (alist-set node-map active-graph graph))))
jsonld/object-to-rdf.scm unknown status 1
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 object-to-rdf)
19+
  #:use-module (ice-9 match)
20+
  #:use-module (ice-9 regex)
21+
  #:use-module (jsonld deserialize-jsonld)
22+
  #:use-module (jsonld iri)
23+
  #:use-module (jsonld json)
24+
  #:use-module (jsonld list-to-rdf)
25+
  #:use-module (json)
26+
  #:use-module ((rdf rdf) #:hide (blank-node?))
27+
  #:use-module (srfi srfi-1)
28+
  #:export (object-to-rdf
29+
            well-formed-language-tag?))
30+
31+
(define (canonical-double value)
32+
  (let ((exponent (inexact->exact (floor (log10 value)))))
33+
    (string-append
34+
      (number->string (exact->inexact (/ value (expt 10 exponent))))
35+
      "E"
36+
      (number->string exponent))))
37+
38+
(define (canonical-json value)
39+
  (cond
40+
    ((member value '(#t #f #nil))
41+
     value)
42+
    ((string? value) value)
43+
    ((number? value)
44+
     (if (integer? (inexact->exact value))
45+
         (inexact->exact value)
46+
         value))
47+
    ((list? value)
48+
     (map
49+
       (match-lambda
50+
         ((k . v)
51+
          (cons k (canonical-json v))))
52+
       (alist-sort-by-key value)))
53+
    ((array? value)
54+
     (list->array
55+
       1
56+
       (fold-right
57+
         (lambda (val result)
58+
           (cons (canonical-json val) result))
59+
         '()
60+
         (array->list value))))))
61+
62+
(define (well-formed-language-tag? tag)
63+
  (let ((match (string-match "[a-z]{1,8}(-[0-9a-z]{1,8})*" tag)))
64+
    (if match
65+
        (let* ((match (cadr (array->list match)))
66+
               (fst (car match))
67+
               (snd (cdr match)))
68+
          (and (equal? fst 0)
69+
               (equal? snd (string-length tag))))
70+
        #f)))
71+
72+
(define* (object-to-rdf generate-blank-node rdf-direction item list-triples)
73+
  (let ((result #nil))
74+
    (cond
75+
      ;; 1
76+
      ((and (node-object? item) (not (well-formed? (assoc-ref item "@id"))))
77+
       (set! result #nil))
78+
      ;; 2
79+
      ((node-object? item)
80+
       (set! result (assoc-ref item "@id")))
81+
      ;; 3
82+
      ((list-object? item)
83+
       (let* ((res (list-to-rdf generate-blank-node rdf-direction
84+
                                (array->list (assoc-ref item "@list"))
85+
                                list-triples))
86+
              (lst (assoc-ref res "list-triples"))
87+
              (res (assoc-ref res "result")))
88+
         (set! result res)
89+
         (set! list-triples lst)))
90+
      (else
91+
        ;; 4
92+
        (let ((value (assoc-ref item "@value"))
93+
              (datatype (or (assoc-ref item "@type") #nil)))
94+
          (cond
95+
            ;; 6
96+
            ((and (not (equal? datatype #nil)) (not (equal? datatype "@json"))
97+
                    (not (well-formed? datatype)))
98+
             (set! result #nil))
99+
            ;; 7
100+
            ((and
101+
               (json-has-key? item "@language")
102+
               (not (well-formed-language-tag? (assoc-ref item "@language"))))
103+
              (set! result #nil))
104+
            (else
105+
              ;; 8
106+
              (when (equal? datatype "@json")
107+
                (set! value (scm->json-string (canonical-json value)))
108+
                (set! datatype (rdf-iri "JSON")))
109+
              (cond
110+
                ;; 9
111+
                ((boolean? value)
112+
                 (when (equal? datatype #nil)
113+
                   (set! datatype (xsd-iri "boolean")))
114+
                 (set! value (if value "true" "false")))
115+
                ;; 10
116+
                ((and (number? value)
117+
                      (or (not (integer? (inexact->exact value)))
118+
                          (>= (abs value) (expt 10 21))
119+
                          (equal? datatype (xsd-iri "double"))))
120+
                 (when (equal? datatype #nil)
121+
                   (set! datatype (xsd-iri "double")))
122+
                 (set! value (canonical-double value)))
123+
                ;; 11
124+
                ((number? value)
125+
                 (set! value (number->string (inexact->exact value)))
126+
                 (when (equal? datatype #nil)
127+
                   (set! datatype (xsd-iri "integer"))))
128+
                ;; 12
129+
                ((equal? datatype #nil)
130+
                 (set! datatype
131+
                   (if (json-has-key? item "@language")
132+
                       (rdf-iri "langString")
133+
                       (xsd-iri "string")))))
134+
              (if (and (json-has-key? item "@direction") (not (equal? rdf-direction #f)))
135+
                  ;; 13
136+
                  (let* ((language (or (assoc-ref item "@language") ""))
137+
                         (language (string-downcase language)))
138+
                    (if (equal? rdf-direction "i18n-datatype")
139+
                        ;; 13.2
140+
                        (begin
141+
                          (set! datatype
142+
                            (string-append "https://www.w3.org/ns/i18n#" language "_"
143+
                                           (assoc-ref item "@direction")))
144+
                          (set! result
145+
                            (make-rdf-literal value datatype #f)))
146+
                        ;; 13.3
147+
                        (when (equal? rdf-direction "compound-literal")
148+
                          (let ((literal (blank-node->rdf-blank-node
149+
                                           (generate-blank-node #nil))))
150+
                            ;; 13.3.2
151+
                            (set! list-triples
152+
                              (cons
153+
                                ;; XXX: the spec says "of the @value in item as object",
154+
                                ;; but should it be "value" instead?
155+
                                (make-rdf-triple literal (rdf-iri "value")
156+
                                  (make-rdf-literal
157+
                                    (assoc-ref item "@value")
158+
                                    (xsd-iri "string")
159+
                                    #f))
160+
                                list-triples))
161+
                            ;; 13.3.3
162+
                            (when (json-has-key? item "@language")
163+
                              (set! list-triples
164+
                                (cons
165+
                                  (make-rdf-triple literal (rdf-iri "language")
166+
                                    (make-rdf-literal
167+
                                      language
168+
                                      (xsd-iri "string")
169+
                                      #f))
170+
                                  list-triples)))
171+
                            (set! list-triples
172+
                              (cons
173+
                                (make-rdf-triple literal (rdf-iri "direction")
174+
                                  (make-rdf-literal
175+
                                    (assoc-ref item "@direction")
176+
                                    (xsd-iri "string")
177+
                                    #f))
178+
                                list-triples))
179+
                            (set! result literal)))))
180+
                  ;; 14
181+
                  (set! result
182+
                    (make-rdf-literal value datatype (assoc-ref item "@language")))))))))
183+
    (when (blank-node? result)
184+
      (set! result (blank-node->rdf-blank-node result)))
185+
    `(("result" . ,result)
186+
      ("list-triples" . ,list-triples))))
test-modules/download.scm
2121 
  #:use-module (jsonld json)
2222 
  #:use-module (jsonld memoization)
2323 
  #:use-module (jsonld options)
24+
  #:use-module (nquads tordf)
25+
  #:use-module (rnrs bytevectors)
2426 
  #:use-module (test-modules testsuite)
2527 
  #:use-module (web client)
2628 
  #:use-module (web response)
2729 
  #:use-module (web uri)
28-
  #:export (test-http-get get-test-document-loader))
30+
  #:export (test-http-get get-test-document-loader download-nq))
2931 
3032 
(define* (update-response response
3133 
                          #:key
…
9395 
    (lambda args
9496 
      (apply download-json
9597 
             (append args `(#:http-get ,(test-http-get options)))))))
98+
99+
(define (download-nq url)
100+
  (call-with-values
101+
    (lambda ()
102+
      (http-get url))
103+
    (lambda (hdr body)
104+
      (if (equal? (response-code hdr) 200)
105+
          (nquads->rdf
106+
            (if (string? body)
107+
                body
108+
                (utf8->string body)))
109+
          (throw 'download-error (response-code hdr) url)))))
test-modules/online.scm
2727 
  #:use-module (jsonld)
2828 
  #:use-module (jsonld options)
2929 
  #:use-module (jsonld iri)
30+
  #:use-module (rdf rdf)
31+
  #:use-module (nquads fromrdf)
3032 
  #:export (run-test-suite
3133 
            run-test-suites
3234 
            get-test-doc))
…
4042 
;; us to download a few other JsonLD documents, run a function on them and compare
4143 
;; the result.  This is what this file does.
4244 
45+
(define (download-document url)
46+
  (match (car (reverse (string-split url #\.)))
47+
    ("nq" (download-nq url))
48+
    (_ (json-document-document (download-json url)))))
49+
50+
(define (good-result? result expected)
51+
  (if (rdf-dataset? result)
52+
      (begin
53+
        (with-output-to-file "test-result.nq"
54+
          (lambda _
55+
            (format #t "~a~%" (rdf->nquads result))))
56+
        (pk 'result result)
57+
        (pk 'expected expected)
58+
        (rdf-dataset-isomorphic? result expected))
59+
      (same-json? result expected)))
60+
4361 
(define (execute-test test)
4462 
  "Execute one test described by a Json object @var{test}.  Return a Json object
4563 
as the output of the test, or throws an exception if something went wrong."
…
4866 
         (context (assoc-ref document "context"))
4967 
         (type (array->list (assoc-ref document "@type")))
5068 
         (options (assoc-ref document "option"))
69+
         (requires (assoc-ref document "requires"))
5170 
         (spec-version (assoc-ref options "specVersion"))
5271 
         (document-loader (get-test-document-loader options)))
5372 
    (cond
…
119138 
                    ,@(if (json-has-key? options "compactArrays")
120139 
                          `(#:compact-arrays? ,(assoc-ref options "compactArrays"))
121140 
                          '())))))
141+
      ((member "jld:ToRDFTest" type)
142+
       (when (equal? requires "GeneralizedRdf")
143+
         (throw 'cannot-run-test "Expected file is not in a valid nquads format"))
144+
       (jsonld->rdf (string-append jsonld-test-url input)
145+
                    #:options
146+
                    (apply
147+
                      new-jsonld-options
148+
                      #:ordered? #t
149+
                      #:document-loader document-loader
150+
                      `(,@(if (assoc-ref options "base")
151+
                              `(#:base ,(assoc-ref options "base"))
152+
                              '())
153+
                        ,@(if (assoc-ref options "processingMode")
154+
                              `(#:processing-mode ,(assoc-ref options "processingMode"))
155+
                              '())
156+
                        ,@(if (assoc-ref options "produceGeneralizedRdf")
157+
                              `(#:produce-generalized-rdf? #t)
158+
                              `(#:produce-generalized-rdf? #f))
159+
                        ,@(if (assoc-ref options "expandContext")
160+
                              `(#:expand-context ,(string-append
161+
                                                    jsonld-test-url
162+
                                                    (assoc-ref options "expandContext")))
163+
                              '())
164+
                        ,@(if (assoc-ref options "rdfDirection")
165+
                              `(#:rdf-direction
166+
                                ,(assoc-ref options "rdfDirection"))
167+
                              '())))))
122168 
      (else (throw 'unrecognized-test type)))))
123169 
124170 
(define (run-test test)
…
155201 
            (update-test-case test
156202 
              #:result 'skip
157203 
              #:reason "unsupported JsonLD version"))
204+
           ((equal? key 'cannot-run-test)
205+
            (update-test-case test
206+
              #:result 'skip
207+
              #:reason (format #f "impossible to run test: ~a" value)))
158208 
           ((equal? (jsonld-error->string key) expect-error)
159209 
            (update-test-case test #:result 'pass))
160210 
           (else
…
182232 
            (update-test-case test
183233 
              #:result 'skip
184234 
              #:reason "unsupported JsonLD version"))
235+
           ((equal? key 'cannot-run-test)
236+
            (update-test-case test
237+
              #:result 'skip
238+
              #:reason (format #f "impossible to run test: ~a" value)))
185239 
           (else
186240 
            (update-test-case test
187241 
              #:result 'fail
188242 
              #:reason (format #f "Expected success but got ~a: ~a"
189243 
                               key value)))))
190-
        (_ (let ((expected (json-document-document
191-
                             (download-json
192-
                               (string-append jsonld-test-url expect)))))
193-
             (if (same-json? result expected)
194-
                 (update-test-case test #:result 'pass)
195-
                 (update-test-case test
196-
                   #:result 'fail
197-
                   #:reason (format #f "Expected ~a but got ~a"
198-
                                    expected result)))))))))
244+
        (_ (if (member "jld:PositiveSyntaxTest" type)
245+
               (update-test-case test #:result 'pass)
246+
               (let ((expected (download-document
247+
                                 (string-append jsonld-test-url expect))))
248+
                 (if (good-result? result expected)
249+
                     (update-test-case test #:result 'pass)
250+
                     (update-test-case test
251+
                       #:result 'fail
252+
                       #:reason (format #f "Expected ~a but got ~a"
253+
                                        expected result))))))))))
199254 
200255 
(define (run-tests tests expected-failures driver)
201256 
  "Run all the tests of the @var{tests} test suite, using identifiers starting
test-modules/testsuite.scm
2222 
            flatten-test-url
2323 
            html-test-url
2424 
            remote-doc-test-url
25-
            jsonld-test-url))
25+
            jsonld-test-url
26+
            tordf-test-url))
2627 
2728 
(define jsonld-test-url "https://w3c.github.io/json-ld-api/tests/")
2829 
…
4142 
(define remote-doc-test-url
4243 
  (string-append jsonld-test-url "remote-doc-manifest.jsonld"))
4344 
45+
(define tordf-test-url
46+
  (string-append jsonld-test-url "toRdf-manifest.jsonld"))
47+
4448 
(define expected-failures
4549 
  `(("https://w3c.github.io/json-ld-api/tests/html-manifest.jsonld#te010" .
4650 
       "entities are not preserved by xml->sxml")
tests/tordf.scm unknown status 1
1+
#!/data/tyreunom/projects/guile-jsonld/pre-inst-env guile
2+
!#
3+
;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
4+
;;;; 
5+
;;;; This library is free software; you can redistribute it and/or
6+
;;;; modify it under the terms of the GNU Lesser General Public
7+
;;;; License as published by the Free Software Foundation; either
8+
;;;; version 3 of the License, or (at your option) any later version.
9+
;;;; 
10+
;;;; This library is distributed in the hope that it will be useful,
11+
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12+
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13+
;;;; Lesser General Public License for more details.
14+
;;;; 
15+
;;;; You should have received a copy of the GNU Lesser General Public
16+
;;;; License along with this library; if not, write to the Free Software
17+
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18+
;;;; 
19+
20+
(use-modules (test-modules online))
21+
(use-modules (test-modules result))
22+
(use-modules (test-modules testsuite))
23+
24+
(run-test-suite tordf-test-url expected-failures tap-driver)