Add fromRdf algorithm

Julien LepillerSun Apr 12 20:55:37+0200 2020

801b7a6

Add fromRdf algorithm

.gitignore

2222 
tests/html.scm
2323 
tests/remote-doc.scm
2424 
tests/report.scm
25+
tests/fromrdf.scm
2526 
reports

Makefile.am

2222 
  jsonld/node-map-generation.scm \
2323 
  jsonld/object-to-rdf.scm \
2424 
  jsonld/options.scm \
25+
  jsonld/rdf-to-object.scm \
26+
  jsonld/serialize-rdf.scm \
2527 
  jsonld/term-selection.scm \
2628 
  jsonld/value-compaction.scm \
2729 
  jsonld/value-expansion.scm \

…

3638 
		tests/expand.scm \
3739 
		tests/flatten.scm \
3840 
		tests/remote-doc.scm \
39-
		tests/to-rdf.scm
41+
		tests/fromrdf.scm \
42+
		tests/tordf.scm
4043 
EXTRA_DIST += $(TESTS)
4144 
4245 
coverage:
README.md
128128 
produced by the guile-json library) or a string representing the URL of a JsonLD
129129 
document.  The options can be used to carry additional configuration information.
130130 
131+
**Scheme Procedure**: rdf->jsonld dataset [#:options (new-jsonld-options)]
132+
133+
Transforms the given dataset into a JsonLD document in expanded form.  This
134+
procedure takes as input an RDF dataset (as produced by the guile-rdf
135+
library) and returns the same dataset in JsonLD format, in the expanded form.
136+
The options can be used to carry additional configuration information.
137+
131138 
### The JsonLDOptions Type
132139 
133140 
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/fromrdf.scm], [chmod +x tests/fromrdf.scm])
3233 
AC_CONFIG_FILES([tests/tordf.scm], [chmod +x tests/tordf.scm])
3334 
AC_CONFIG_FILES(Makefile)
3435 
AC_REQUIRE_AUX_FILE([tap-driver.sh])
jsonld.scm
3030 
  #:use-module (jsonld json)
3131 
  #:use-module (jsonld node-map-generation)
3232 
  #:use-module (jsonld options)
33+
  #:use-module (jsonld serialize-rdf)
3334 
  #:use-module (rdf rdf)
3435 
  #:export (compact
3536 
            expand
3637 
            flatten
37-
            jsonld->rdf))
38+
            jsonld->rdf
39+
            rdf->jsonld))
3840 
3941 
(define* (compact input context #:key (options (new-jsonld-options)))
4042 
  (call-with-values
…
201203 
          #:produce-generalized-rdf?
202204 
          (jsonld-options-produce-generalized-rdf? options)
203205 
          #:rdf-direction (jsonld-options-rdf-direction options))))))
206+
207+
(define* (rdf->jsonld input #:key (options (new-jsonld-options)))
208+
  (serialize-rdf input
209+
                 #:ordered? (jsonld-options-ordered? options)
210+
                 #:rdf-direction (jsonld-options-rdf-direction options)
211+
                 #:use-native-types? (jsonld-options-use-native-types? options)
212+
                 #:use-rdf-type? (jsonld-options-use-rdf-type? options)
213+
                 #:processing-mode (jsonld-options-processing-mode options)))
jsonld/json.scm
4949 
            processing-mode-1.0?
5050 
            relative-iri?
5151 
            same-json?
52+
            identical-json?
5253 
            scalar?
5354 
            scalar-array?
5455 
            set-object?
…
207208 
       (not (json-has-key? o "@list"))
208209 
       (not (json-has-key? o "@set"))))
209210 
210-
(define (has-keys-of json other)
211+
(define (has-identical-keys-of json other)
211212 
  (let loop ((json json) (result #t))
212213 
    (match json
213214 
      (#f (not other))
214215 
      (() result)
215216 
      (((key . value) json ...)
216-
       (loop json (and result (same-json? value (assoc-ref other key))))))))
217+
       (loop json (and result (identical-json? value (assoc-ref other key))))))))
217218 
218-
(define (has-same-values json other)
219+
(define (has-identical-values json other)
219220 
  (let loop ((json json) (other other) (result #t))
220221 
    (match json
221222 
      (() (if (null? other) result #f))
…
223224 
       (match other
224225 
         (() #f)
225226 
         ((v2 other ...)
226-
          (loop json other (and result (same-json? v v2)))))))))
227+
          (loop json other (and result (identical-json? v v2)))))))))
227228 
228-
(define (same-json? json other)
229+
(define (identical-json? json other)
229230 
  "Compare two Json documents and returns whether they are the same, comparing
230-
the keys, their values, their order and their presence in both documents."
231+
the keys, their values, their order and their presence in both documents.
232+
This variant compares the value of blank nodes."
231233 
  (match json
232234 
    ((? array? json)
233235 
     (and
234236 
       (array? other)
235-
       (has-same-values (array->list json) (array->list other))))
237+
       (has-identical-values (array->list json) (array->list other))))
236238 
    ((? list? json)
237-
     (and (list? other) (has-keys-of json other) (has-keys-of other json)))
239+
     (and (list? other) (has-identical-keys-of json other)
240+
          (has-identical-keys-of other json)))
238241 
    (_ (equal? json other))))
239242 
243+
(define (has-keys-of json other equivalences)
244+
  (let loop ((json json) (equivalences equivalences))
245+
    (match json
246+
      (#f (and (not other) equivalences))
247+
      (() equivalences)
248+
      (((key . value) json ...)
249+
       (if (blank-node? key)
250+
           (if (assoc-ref equivalences key)
251+
               (loop json (included-json?
252+
                            value
253+
                            (assoc-ref
254+
                              other (assoc-ref equivalences key)) equivalences))
255+
               (let loop2 ((candidates (filter (lambda (e) (blank-node? (car e)))
256+
                                               other)))
257+
                 (match candidates
258+
                   (() #f)
259+
                   (((k . v) candidates ...)
260+
                    (let ((res (included-json?
261+
                                 value
262+
                                 v
263+
                                 (cons (cons key k) equivalences))))
264+
                      (if res res (loop2 candidates)))))))
265+
           (loop json (included-json? value (assoc-ref other key) equivalences)))))))
266+
267+
(define (has-same-values json other equivalences)
268+
  (let loop ((json json) (other other) (equivalences equivalences))
269+
    (match json
270+
      (() (if (null? other) equivalences #f))
271+
      ((v json ...)
272+
       (match other
273+
         (() #f)
274+
         ((v2 other ...)
275+
          (loop json other (included-json? v v2 equivalences))))))))
276+
277+
(define (included-json? json other equivalences)
278+
  (match json
279+
    ((? json-array? json)
280+
     (and
281+
       (array? other)
282+
       (has-same-values (array->list json) (array->list other) equivalences)))
283+
    ((? list? json)
284+
     (and (list? other) (has-keys-of json other equivalences)))
285+
    ((? blank-node? json)
286+
     (and (blank-node? other)
287+
          (if (assoc-ref json equivalences)
288+
              (and (equal? (assoc-ref json equivalences) other) equivalences)
289+
              (cons (cons json other) equivalences))))
290+
    (_ (and (equal? json other) equivalences))))
291+
292+
(define (same-json? json other)
293+
  "Compare two Json documents and returns whether they are the same, comparing
294+
the keys, their values, their order and their presence in both documents.
295+
This variant tries to map blank nodes from one object to the other."
296+
  (and (included-json? json other '()) (included-json? other json '())))
297+
240298 
(define (jsonld-error->string err)
241299 
  "Convert an error to a string."
242300 
  (match err
jsonld/node-map-generation.scm
2424 
    (set! array #()))
2525 
  (unless (json-array? array)
2626 
    (set! array `#(,array)))
27-
  (not (null? (filter (lambda (o) (same-json? o json)) (array->list array)))))
27+
  (not (null? (filter (lambda (o) (identical-json? o json)) (array->list array)))))
2828 
2929 
(define (add-to-list array element)
3030 
  (when (equal? array #f)
…
7373 
                                (lst #nil))
7474 
    ;; 1
7575 
    (if (json-array? element)
76-
      (list->array 1
77-
        (map
78-
          (lambda (item)
79-
            (let ((res (node-map-generation item node-map
80-
                                            #:active-graph active-graph
81-
                                            #:active-subject active-subject
82-
                                            #:active-property  active-property
83-
                                            #:lst lst)))
84-
              (set! node-map (assoc-ref res "node-map"))
85-
              (set! lst (assoc-ref res "list"))))
86-
          (array->list element)))
76+
      (for-each
77+
        (lambda (item)
78+
          (let ((res (node-map-generation item node-map
79+
                                          #:active-graph active-graph
80+
                                          #:active-subject active-subject
81+
                                          #:active-property  active-property
82+
                                          #:lst lst)))
83+
            (set! node-map (assoc-ref res "node-map"))
84+
            (set! lst (assoc-ref res "list"))))
85+
        (array->list element))
8786 
      ;; 2: otherwise
8887 
      (let* ((graph (or (assoc-ref node-map active-graph) '()))
8988 
             (subject-node (if (equal? active-subject #nil)
jsonld/rdf-to-object.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 rdf-to-object)
19+
  #:use-module (jsonld deserialize-jsonld)
20+
  #:use-module (jsonld iri)
21+
  #:use-module (jsonld json)
22+
  #:use-module (json)
23+
  #:use-module ((rdf rdf) #:hide (blank-node?))
24+
  #:use-module ((rdf xsd) #:prefix xsd:)
25+
  #:use-module (srfi srfi-1)
26+
  #:export (rdf-to-object))
27+
28+
(define* (rdf-to-object value rdf-direction use-native-types?
29+
                        #:key processing-mode)
30+
  (if (or (blank-node? value) (absolute-iri? value))
31+
      `(("@id" . ,value))
32+
      ;; 2
33+
      (let ((result '())
34+
            (converted-value (rdf-literal-lexical-form value))
35+
            (datatype (rdf-literal-type value))
36+
            (type #nil))
37+
        (cond
38+
          ;; 2.4
39+
          (use-native-types?
40+
            (cond
41+
              ;; 2.4.1
42+
              ((equal? datatype (xsd-iri "string"))
43+
               (set! converted-value (rdf-literal-lexical-form value)))
44+
              ;; 2.4.2
45+
              ((equal? datatype (xsd-iri "boolean"))
46+
               (cond
47+
                 ((equal? (rdf-literal-lexical-form value) "true")
48+
                  (set! converted-value #t))
49+
                 ((equal? (rdf-literal-lexical-form value) "false")
50+
                  (set! converted-value #f))
51+
                 (else
52+
                   (set! converted-value (rdf-literal-lexical-form value))
53+
                   (set! type (xsd-iri "boolean")))))
54+
              ;; 2.4.3
55+
              ((and (equal? datatype (xsd-iri "integer"))
56+
                    ((rdf-datatype-lexical? xsd:integer) converted-value))
57+
               (set! converted-value ((rdf-datatype-lexical->value xsd:integer)
58+
                                      converted-value)))
59+
              ((and (equal? datatype (xsd-iri "double"))
60+
                    ((rdf-datatype-lexical? xsd:double) converted-value))
61+
               (set! converted-value ((rdf-datatype-lexical->value xsd:double)
62+
                                      converted-value)))
63+
              (else
64+
                (set! type datatype))))
65+
          ;; 2.5
66+
          ((and (not (processing-mode-1.0? processing-mode))
67+
                (equal? datatype (rdf-iri "JSON")))
68+
           (set! type "@json")
69+
           (catch #t
70+
             (lambda _
71+
               (set! converted-value (json-string->scm (rdf-literal-lexical-form value))))
72+
             (lambda _
73+
               (throw 'invalid-json-literal))))
74+
          ;; 2.6
75+
          ((and (> (string-length datatype) (string-length "https://www.w3.org/ns/i18n#"))
76+
                (equal? (substring datatype 0 (string-length "https://www.w3.org/ns/i18n#"))
77+
                        "https://www.w3.org/ns/i18n#")
78+
                (equal? rdf-direction "i18n-datatype"))
79+
           ;; 2.6.1
80+
           (set! converted-value (rdf-literal-lexical-form value))
81+
           (let* ((fragment (substring datatype (string-length "https://www.w3.org/ns/i18n#")))
82+
                  (fragment (string-split fragment #\_))
83+
                  (language (car fragment))
84+
                  (direction (cadr fragment)))
85+
             ;; 2.6.2
86+
             (unless (equal? language "")
87+
               (set! result (alist-set result "@language" language)))
88+
             ;; 2.6.3
89+
             (unless (equal? direction "")
90+
               (set! result (alist-set result "@direction" direction)))))
91+
          ;; 2.7
92+
          ((rdf-literal-langtag value)
93+
           (set! result (alist-set result "@language" (rdf-literal-langtag value))))
94+
          ;; 2.8
95+
          (else
96+
            (unless (equal? datatype (xsd-iri "string"))
97+
              (set! type datatype))))
98+
        ;; 2.9
99+
        (set! result (alist-set result "@value" converted-value))
100+
        ;; 2.10
101+
        (when type
102+
          (set! result (alist-set result "@type" type)))
103+
        ;; 2.11
104+
        result)))
jsonld/serialize-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 serialize-rdf)
19+
  #:use-module (ice-9 match)
20+
  #:use-module (jsonld deserialize-jsonld)
21+
  #:use-module (jsonld iri)
22+
  #:use-module (jsonld json)
23+
  #:use-module (jsonld object-to-rdf)
24+
  #:use-module (jsonld rdf-to-object)
25+
  #:use-module (json)
26+
  #:use-module ((rdf rdf) #:hide (blank-node?))
27+
  #:use-module ((rdf rdf) #:select (blank-node?) #:prefix rdf:)
28+
  #:use-module (srfi srfi-1)
29+
  #:export (serialize-rdf))
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 (jsonld-ref object spec)
40+
  (match spec
41+
    (() object)
42+
    (((? string? key) spec ...)
43+
     (jsonld-ref (assoc-ref object key) spec))
44+
    (((? number? key) spec ...)
45+
     (jsonld-ref (if (array? object) (array-ref object key) #f) spec))))
46+
47+
(define (jsonld-set object spec value)
48+
  (match spec
49+
    (() value)
50+
    (((? string? key) spec ...)
51+
     (alist-set object key (jsonld-set (assoc-ref object key) spec value)))
52+
    (((? number? key) spec ...)
53+
     (array-set! object (jsonld-set (array-ref object key) spec value) key)
54+
     object)))
55+
56+
(define (convert-blank-nodes dataset)
57+
  (define (node-convert-blank-nodes node)
58+
    (if (rdf:blank-node? node)
59+
        (string-append "_:b" (number->string node))
60+
        node))
61+
62+
  (define (graph-convert-blank-nodes graph)
63+
    (map
64+
      (match-lambda
65+
        (($ rdf-triple subject predicate object)
66+
         (make-rdf-triple
67+
           (node-convert-blank-nodes subject)
68+
           (node-convert-blank-nodes predicate)
69+
           (node-convert-blank-nodes object))))
70+
      graph))
71+
72+
  (make-rdf-dataset
73+
    (graph-convert-blank-nodes (rdf-dataset-default-graph dataset))
74+
    (map
75+
      (lambda (ng)
76+
        (cons (car ng)
77+
              (graph-convert-blank-nodes (cdr ng))))
78+
      (rdf-dataset-named-graphs dataset))))
79+
80+
(define (single-element-array? object)
81+
  (and (array? object) (not (string? object))
82+
       (equal? (array-length object) 1)))
83+
84+
(define* (serialize-rdf dataset
85+
                        #:key
86+
                        ordered? rdf-direction use-native-types? use-rdf-type?
87+
                        processing-mode)
88+
  (set! dataset (convert-blank-nodes dataset))
89+
  (set! dataset
90+
    (make-rdf-dataset
91+
      (uniq (rdf-dataset-default-graph dataset))
92+
      (map
93+
        (lambda (ng)
94+
          (cons (car ng)
95+
                (uniq (cdr ng))))
96+
        (rdf-dataset-named-graphs dataset))))
97+
  ;; 1
98+
  (let ((default-graph '())
99+
        ;; 2
100+
        (graph-map `(("@default" . ())))
101+
        ;; 3
102+
        (referenced-once '())
103+
        ;; 4
104+
        (compound-literal-subjects '()))
105+
    ;; 5
106+
    (for-each-pair
107+
      (lambda (name graph)
108+
        ;; 5.2
109+
        (unless (json-has-key? graph-map name)
110+
          (set! graph-map (alist-set graph-map name '())))
111+
        ;; 5.3
112+
        (unless (json-has-key? compound-literal-subjects name)
113+
          (set! compound-literal-subjects
114+
            (alist-set compound-literal-subjects name '())))
115+
        (set! default-graph (assoc-ref graph-map "@default"))
116+
        ;; 5.4
117+
        (unless (or (equal? name "@default")
118+
                    (json-has-key? default-graph name))
119+
          (set! default-graph (alist-set (assoc-ref graph-map "@default")
120+
                                         name `(("@id" . ,name))))
121+
          (set! graph-map (alist-set graph-map "@default" default-graph)))
122+
        ;; 5.5
123+
        (let ((node-map (assoc-ref graph-map name))
124+
              ;; 5.6
125+
              (compound-map (assoc-ref compound-literal-subjects name)))
126+
          (for-each
127+
            (match-lambda
128+
              (($ rdf-triple subject predicate object)
129+
               ;; 5.7.1
130+
               (unless (json-has-key? node-map subject)
131+
                 (set! node-map (alist-set node-map subject `(("@id" . ,subject)))))
132+
                 ;; 5.7.2
133+
               (let ((node-ref (list name subject))
134+
                     (node (assoc-ref node-map subject))
135+
                     (continue? #t))
136+
                 ;; 5.7.3
137+
                 (when (and (equal? rdf-direction "compound-literal")
138+
                            (equal? predicate (rdf-iri "direction")))
139+
                   (set! compound-map (alist-set compound-map subject #t)))
140+
                 (when (or (absolute-iri? object) (blank-node? object))
141+
                   ;; 5.7.4
142+
                   (unless (json-has-key? node-map object)
143+
                     (set! node-map (alist-set node-map object `(("@id" . ,object)))))
144+
                   ;; 5.7.5
145+
                   (when (and (equal? predicate (rdf-iri "type"))
146+
                              (not use-rdf-type?))
147+
                     (let* ((types (or (assoc-ref node "@type") #()))
148+
                            (types (array->list types))
149+
                            (types (if (member object types)
150+
                                       types
151+
                                       (append types (list object))))
152+
                            (types (list->array 1 types)))
153+
                       (set! node (alist-set node "@type" types))
154+
                       (set! node-map (alist-set node-map subject node))
155+
                       (set! continue? #f))))
156+
                 ;; 5.7.6
157+
                 (when continue?
158+
                   (let* ((value (rdf-to-object object rdf-direction use-native-types?
159+
                                                #:processing-mode
160+
                                                processing-mode))
161+
                          (value-ref (append node-ref (list predicate)))
162+
                          ;; 5.7.7
163+
                          (node-value (or (assoc-ref node predicate) #()))
164+
                          (node-value (array->list node-value)))
165+
                     ;; 5.7.8
166+
                     (let loop ((nodes node-value) (num 0))
167+
                       (match nodes
168+
                         (()
169+
                          (set! node-value (cons value node-value))
170+
                          (set! value-ref (append value-ref (list num))))
171+
                         ((n nodes ...)
172+
                          (if (identical-json? value n)
173+
                              (set! value-ref (append value-ref (list num)))
174+
                              (loop nodes (1+ num))))))
175+
                     ;; 5.7.7
176+
                     (set! node (alist-set node predicate (list->array 1 node-value)))
177+
                     (set! node-map (alist-set node-map subject node))
178+
                     (cond
179+
                        ;; 5.7.9
180+
                       ((equal? object (rdf-iri "nil"))
181+
                        (let* ((usages (or (assoc-ref (assoc-ref node-map object)
182+
                                                      "usages")
183+
                                           #()))
184+
                               (usages (array->list usages)))
185+
                          (set! usages
186+
                            (append
187+
                              usages
188+
                              (list `(("node" . ,node-ref)
189+
                                      ("property" . ,predicate)
190+
                                      ("value" . ,value-ref)))))
191+
                          (set! node-map
192+
                            (jsonld-set
193+
                              node-map (list object "usages")
194+
                              (list->array 1 usages)))))
195+
                       ;; 5.7.10
196+
                       ((json-has-key? referenced-once object)
197+
                        (set! referenced-once
198+
                          (alist-set referenced-once object #f)))
199+
                       ((blank-node? object)
200+
                        (set! referenced-once
201+
                          (alist-set referenced-once object
202+
                                     `(("node" . ,node-ref)
203+
                                       ("property" . ,predicate)
204+
                                       ("value" . ,value-ref)))))))))))
205+
            graph)
206+
          (set! graph-map (alist-set graph-map name node-map))
207+
          (set! compound-literal-subjects
208+
            (alist-set compound-literal-subjects name compound-map))))
209+
      (cons (cons "@default" (rdf-dataset-default-graph dataset))
210+
            (rdf-dataset-named-graphs dataset)))
211+
    (set! default-graph (assoc-ref graph-map "@default"))
212+
    ;; 6
213+
    (for-each-pair
214+
      (lambda (name graph-object)
215+
        ;; 6.1
216+
        (when (list? (assoc-ref compound-literal-subjects name))
217+
          (for-each-pair
218+
            (lambda (cl _)
219+
              ;; 6.1.1
220+
              (let ((cl-entry (assoc-ref referenced-once cl)))
221+
                (when (list? cl-entry)
222+
                  ;; 6.1.2
223+
                  (let* ((node-ref (assoc-ref cl-entry "node"))
224+
                         (node (jsonld-ref graph-map node-ref))
225+
                         ;; 6.1.3
226+
                         (property (assoc-ref cl-entry "property"))
227+
                         ;; 6.1.4
228+
                         (value-ref (assoc-ref cl-entry "value"))
229+
                         (value (jsonld-ref graph-map value-ref))
230+
                         ;; 6.1.5
231+
                         (cl-node (assoc-ref graph-object cl)))
232+
                    (set! graph-object (alist-remove graph-object cl))
233+
                    (when (equal? name "@default")
234+
                      (set! default-graph graph-object))
235+
                    (set! graph-map (alist-set graph-map name graph-object))
236+
                    (when (list? cl-node)
237+
                      ;; 6.1.6
238+
                      (let* ((refs (array->list (assoc-ref node property))))
239+
                        (set! refs
240+
                          (map
241+
                            (lambda (cl-reference)
242+
                              (when (equal? (assoc-ref cl-reference "@id") cl)
243+
                                ;; 6.1.6.1
244+
                                (set! cl-reference (alist-remove cl-reference "@id"))
245+
                                ;; 6.1.6.2
246+
                                (let* ((value (assoc-ref cl-node (rdf-iri "value")))
247+
                                       (value (array-ref value 0))
248+
                                       (value (assoc-ref value "@value")))
249+
                                  (set! cl-reference
250+
                                    (alist-set cl-reference "@value" value)))
251+
                                ;; 6.1.6.3
252+
                                (let ((language (assoc-ref cl-node (rdf-iri "language"))))
253+
                                  (when language
254+
                                    (let* ((language (array-ref language 0))
255+
                                           (language (assoc-ref language "@value")))
256+
                                      (set! cl-reference
257+
                                        (alist-set cl-reference "@language" language))
258+
                                      (unless (well-formed-language-tag? language)
259+
                                        (throw 'invalid-language-tagged-string language)))))
260+
                                ;; 6.1.6.4
261+
                                (let ((direction (assoc-ref cl-node (rdf-iri "direction"))))
262+
                                  (when direction
263+
                                    (let* ((direction (array-ref direction 0))
264+
                                           (direction (assoc-ref direction "@value")))
265+
                                      (set! cl-reference
266+
                                        (alist-set cl-reference "@direction" direction))
267+
                                      (unless (member direction '("ltr" "rtl"))
268+
                                        (throw 'invalid-base-direction direction))))))
269+
                              cl-reference)
270+
                            refs))
271+
                        (set! node (alist-set node property (list->array 1 refs))))
272+
                      (set! graph-map (jsonld-set graph-map node-ref node)))))))
273+
            (assoc-ref compound-literal-subjects name)))
274+
        ;; 6.2
275+
        (when (json-has-key? graph-object (rdf-iri "nil"))
276+
          ;; 6.3
277+
          (let* ((nil (assoc-ref graph-object (rdf-iri "nil")))
278+
                 (usages (array->list (or (assoc-ref nil "usages") #()))))
279+
            (set! usages
280+
              (sort usages (lambda (a b)
281+
                             (or (not (equal? (assoc-ref a "node") (assoc-ref b "node")))
282+
                                 (and (equal? (assoc-ref a "property") (rdf-iri "first"))
283+
                                      (equal? (assoc-ref b "property") (rdf-iri "rest")))))))
284+
            ;; 6.4
285+
            (for-each
286+
              (lambda (usage)
287+
                (let* ((node-ref (assoc-ref usage "node"))
288+
                       (node (jsonld-ref graph-map node-ref))
289+
                       (property (assoc-ref usage "property"))
290+
                       (head-ref (assoc-ref usage "value"))
291+
                       (head (jsonld-ref graph-map head-ref))
292+
                       ;; 6.4.2
293+
                       (lst '())
294+
                       (list-nodes '()))
295+
                  ;; 6.4.3
296+
                  (let loop ()
297+
                    (when (and (equal? property (rdf-iri "rest"))
298+
                               (blank-node? (assoc-ref node "@id"))
299+
                               (list? (assoc-ref referenced-once
300+
                                                 (assoc-ref node "@id")))
301+
                               (single-element-array? (assoc-ref node (rdf-iri "first")))
302+
                               (single-element-array? (assoc-ref node (rdf-iri "rest")))
303+
                               (null? (filter
304+
                                        (lambda (e)
305+
                                          (not (member (car e) 
306+
                                                       (list (rdf-iri "first")
307+
                                                             (rdf-iri "rest")
308+
                                                             "@type"
309+
                                                             "@id"))))
310+
                                        node))
311+
                               (or (not (json-has-key? node "@type"))
312+
                                   (null?
313+
                                     (filter
314+
                                       (lambda (t)
315+
                                         (not (equal? t (rdf-iri "List"))))
316+
                                       (array->list (assoc-ref node "@type"))))))
317+
                      ;; 6.4.3.1
318+
                      (set! lst
319+
                        (cons (array-ref (assoc-ref node (rdf-iri "first")) 0)
320+
                              lst))
321+
                      ;; 6.4.3.2
322+
                      (set! list-nodes
323+
                        (cons (assoc-ref node "@id") list-nodes))
324+
                      ;; 6.4.3.3
325+
                      (let ((node-usage (assoc-ref referenced-once
326+
                                                   (assoc-ref node "@id"))))
327+
                        ;; 6.4.3.4
328+
                        (set! node-ref (assoc-ref node-usage "node"))
329+
                        (set! node (jsonld-ref graph-map node-ref))
330+
                        (set! property (assoc-ref node-usage "property"))
331+
                        (set! head-ref (assoc-ref node-usage "value"))
332+
                        (set! head (jsonld-ref graph-map head-ref))
333+
                        (loop))))
334+
                  ;; 6.4.4
335+
                  (set! head (alist-remove head "@id"))
336+
                  ;; 6.4.6
337+
                  (set! head (alist-set head "@list" (list->array 1 lst)))
338+
                  (set! graph-map (jsonld-set graph-map head-ref head))
339+
                  ;; 6.4.7
340+
                  (for-each
341+
                    (lambda (node-id)
342+
                      (set! graph-object (alist-remove graph-object node-id))
343+
                      (when (equal? name "@default")
344+
                        (set! default-graph graph-object))
345+
                      (set! graph-map (alist-set graph-map name graph-object)))
346+
                    list-nodes)))
347+
              usages))))
348+
      graph-map)
349+
    (set! default-graph (assoc-ref graph-map "@default"))
350+
    ;; 7
351+
    (let ((result '()))
352+
      ;; 8
353+
      (for-each-pair
354+
        (lambda (subject node)
355+
          ;; 8.1
356+
          (when (json-has-key? graph-map subject)
357+
            (let ((new-graph '()))
358+
              (for-each-pair
359+
                (lambda (s n)
360+
                  ;; 8.1.2
361+
                  (unless (null? (filter
362+
                                   (lambda (e)
363+
                                     (not (member (car e) '("usages" "@id"))))
364+
                                   n))
365+
                    (set! new-graph
366+
                      (append new-graph (list (alist-remove n "usages"))))))
367+
                (if ordered?
368+
                    (alist-sort-by-key (or (assoc-ref graph-map subject) '()))
369+
                    (or (assoc-ref graph-map subject) '())))
370+
              ;; 8.1.1
371+
              (set! node (alist-set node "@graph" (list->array 1 new-graph)))))
372+
          ;; 8.2
373+
          (unless (null? (filter
374+
                           (lambda (e)
375+
                             (not (member (car e) '("usages" "@id"))))
376+
                           node))
377+
            (set! result
378+
              (append result (list (alist-remove node "usages"))))))
379+
        (if ordered?
380+
            (alist-sort-by-key default-graph)
381+
            default-graph))
382+
      ;; 9
383+
      (list->array 1 result))))
test-modules/online.scm
165165 
                              `(#:rdf-direction
166166 
                                ,(assoc-ref options "rdfDirection"))
167167 
                              '())))))
168+
      ((member "jld:FromRDFTest" type)
169+
       (rdf->jsonld (download-nq (string-append jsonld-test-url input))
170+
                    #:options
171+
                    (apply
172+
                      new-jsonld-options
173+
                      #:ordered? #t
174+
                      #:document-loader document-loader
175+
                      `(,@(if (assoc-ref options "base")
176+
                              `(#:base ,(assoc-ref options "base"))
177+
                              '())
178+
                        ,@(if (assoc-ref options "processingMode")
179+
                              `(#:processing-mode ,(assoc-ref options "processingMode"))
180+
                              '())
181+
                        ,@(if (assoc-ref options "produceGeneralizedRdf")
182+
                              `(#:produce-generalized-rdf? #t)
183+
                              `(#:produce-generalized-rdf? #f))
184+
                        ,@(if (assoc-ref options "expandContext")
185+
                              `(#:expand-context ,(string-append
186+
                                                    jsonld-test-url
187+
                                                    (assoc-ref options "expandContext")))
188+
                              '())
189+
                        ,@(if (assoc-ref options "useNativeTypes")
190+
                              `(#:use-native-types? #t)
191+
                              '())
192+
                        ,@(if (assoc-ref options "useRdfType")
193+
                              `(#:use-rdf-type? #t)
194+
                              '())
195+
                        ,@(if (assoc-ref options "rdfDirection")
196+
                              `(#:rdf-direction
197+
                                ,(assoc-ref options "rdfDirection"))
198+
                              '())))))
168199 
      (else (throw 'unrecognized-test type)))))
169200 
170201 
(define (run-test test)
test-modules/testsuite.scm
2323 
            html-test-url
2424 
            remote-doc-test-url
2525 
            jsonld-test-url
26+
            fromrdf-test-url
2627 
            tordf-test-url))
2728 
2829 
(define jsonld-test-url "https://w3c.github.io/json-ld-api/tests/")
…
4243 
(define remote-doc-test-url
4344 
  (string-append jsonld-test-url "remote-doc-manifest.jsonld"))
4445 
46+
(define fromrdf-test-url
47+
  (string-append jsonld-test-url "fromRdf-manifest.jsonld"))
48+
4549 
(define tordf-test-url
4650 
  (string-append jsonld-test-url "toRdf-manifest.jsonld"))
4751 
tests/fromrdf.scm.in unknown status 1
1+
#!@abs_top_srcdir@/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 fromrdf-test-url expected-failures tap-driver)