guile-jsonld

guile-jsonld/jsonld/node-map-generation.scm

node-map-generation.scm

;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 

(define-module (jsonld node-map-generation)
  #:use-module (jsonld json)
  #:export (get-node-map-generation))

(define (contains-json? array json)
  (when (equal? array #f)
    (set! array #()))
  (unless (json-array? array)
    (set! array `#(,array)))
  (not (null? (filter (lambda (o) (identical-json? o json)) (array->list array)))))

(define (add-to-list array element)
  (when (equal? array #f)
    (set! array #()))
  (unless (json-array? array)
    (set! array `#(,array)))
  (list->array 1 (append
                   (array->list array)
                   (list element))))

(define (append-to-list a1 a2)
  (when (equal? a1 #f)
    (set! a1 #()))
  (unless (json-array? a1)
    (set! a1 `#(,a1)))
  (when (equal? a2 #f)
    (set! a2 #()))
  (unless (json-array? a2)
    (set! a2 `#(,a2)))
  (list->array 1 (append
                   (array->list a1)
                   (array->list a2))))

(define (add-if-not-in object property element)
  (let ((array (assoc-ref object property)))
    (if (contains-json? array element)
        object
        (alist-set
          object property
          (add-to-list array element)))))

(define (append-if-not-in object property elements)
  (if (json-array? elements)
    (set! elements (array->list elements))
    (set! elements (list elements)))
  (let loop ((elements elements) (object object))
    (if (null? elements)
        object
        (loop (cdr elements) (add-if-not-in object property (car elements))))))

(define (get-node-map-generation generate-blank-node)
  (define* (node-map-generation element node-map
                                #:key (active-graph "@default")
                                (active-subject #nil)
                                (active-property #nil)
                                (lst #nil))
    ;; 1
    (if (json-array? element)
      (for-each
        (lambda (item)
          (let ((res (node-map-generation item node-map
                                          #:active-graph active-graph
                                          #:active-subject active-subject
                                          #:active-property  active-property
                                          #:lst lst)))
            (set! node-map (assoc-ref res "node-map"))
            (set! lst (assoc-ref res "list"))))
        (array->list element))
      ;; 2: otherwise
      (let* ((graph (or (assoc-ref node-map active-graph) '()))
             (subject-node (if (equal? active-subject #nil)
                               '()
                               (or (assoc-ref graph active-subject) '())))
             (types (assoc-ref element "@type"))
             (types (if (json-array? types)
                        (array->list types)
                        (if types (list types) '())))
             ;; 3
             (types
               (map
                 (lambda (item)
                   (if (blank-node? item)
                       (generate-blank-node item)
                       item))
                 types)))
        (unless (null? types)
          (if (json-array? (assoc-ref element "@type"))
            (set! element (alist-set element "@type" (list->array 1 types)))
            (set! element (alist-set element "@type" (car types)))))
        ;; 4
        (when (json-has-key? element "@value")
          (if (equal? lst #nil)
              (begin
                ;; 4.1.1
                (unless (json-has-key? subject-node active-property)
                  (set! subject-node
                    (alist-set subject-node active-property `#(,element))))
                ;; 4.1.2
                (set! subject-node
                  (add-if-not-in subject-node active-property element)))
              ;; 4.2
              (set! lst
                (alist-set lst "@list"
                           (add-to-list (assoc-ref lst "@list") element)))))
        ;; 5
        (when (json-has-key? element "@list")
          (let ((result `(("@list" . #()))))
            ;; 5.2
            (let ((res (node-map-generation
                         (assoc-ref element "@list") node-map
                         #:active-graph active-graph
                         #:active-subject active-subject
                         #:active-property active-property
                         #:lst result)))
              (set! result (assoc-ref res "list"))
              (set! node-map (assoc-ref res "node-map"))
              (set! graph (assoc-ref node-map active-graph))
              (set! subject-node (or (assoc-ref graph active-subject) '()))
              (if (equal? lst #nil)
                ;; 5.3
                (begin
                  (set! subject-node
                    (alist-set
                      subject-node
                      active-property
                      (add-to-list (assoc-ref subject-node active-property)
                                   result)))
                  (set! graph (alist-set graph active-subject subject-node))
                  (set! node-map (alist-set node-map active-graph graph)))
                (set! lst
                  (alist-set lst "@list"
                    (add-to-list (assoc-ref lst "@list")
                                 result)))))))
        ;; 6
        (when (node-object? element)
          ;; 6.1
          (let ((id (if (json-has-key? element "@id")
                        (if (blank-node? (assoc-ref element "@id"))
                            (generate-blank-node (assoc-ref element "@id"))
                            (assoc-ref element "@id"))
                        (generate-blank-node #nil))))
            ;; 6.3
            (unless (or (json-has-key? graph id) (not id))
              (set! graph
                (alist-set graph id `(("@id" . ,id))))
              (set! node-map (alist-set node-map active-graph graph)))
            ;; 6.4
            (let ((node (or (assoc-ref graph id) '())))
              (cond
                ;; 6.5
                ((json-object? active-subject)
                 (if (json-has-key? node active-property)
                     ;; 6.5.2
                     (set! node
                       (add-if-not-in node active-property active-subject))
                     ;; 6.5.1
                     (set! node
                       (alist-set node active-property `#(,active-subject))))
                 (when id
                   (set! graph (alist-set graph id node)))
                 (set! node-map (alist-set node-map active-graph graph)))
                ;; 6.6
                ((not (equal? active-property #nil))
                 ;; 6.6.1
                 (let ((reference `(("@id" . ,id))))
                   (if (equal? lst #nil)
                       ;; 6.6.2
                       (begin
                         (if (json-has-key? subject-node active-property)
                             ;; 6.6.2.2
                             (set! subject-node
                               (add-if-not-in subject-node active-property reference))
                             ;; 6.6.2.1
                             (set! subject-node
                               (alist-set subject-node active-property `#(,reference))))
                         (set! graph (alist-set graph active-subject subject-node))
                         (set! node-map (alist-set node-map active-graph graph)))
                       ;; 6.6.3
                       (set! lst
                         (alist-set lst "@list"
                                    (add-to-list (assoc-ref lst "@list")
                                                 reference)))))))
              ;; 6.7
              (when (json-has-key? element "@type")
                (set! node
                  (append-if-not-in node "@type" (assoc-ref element "@type")))
                (when id
                  (set! graph (alist-set graph id node)))
                (set! node-map (alist-set node-map active-graph graph)))
              ;; 6.8
              (when (json-has-key? element "@index")
                (when (json-has-key? node "@index")
                  (throw 'conflicting-indexes))
                (set! node
                  (alist-set node "@index" (assoc-ref element "@index")))
                  (unless (string? id)
                    (throw 'eee))
                (set! graph (alist-set graph id node))
                (set! node-map (alist-set node-map active-graph graph))
                (set! element (alist-remove element "@index")))
              ;; 6.9
              (when (json-has-key? element "@reverse")
                ;; 6.9.1
                (let ((referenced-node `(("@id" . ,id)))
                      ;; 6.9.2
                      (reverse-map (assoc-ref element "@reverse")))
                  ;; 6.9.3
                  (for-each-pair
                    (lambda (property values)
                      (for-each
                        (lambda (value)
                          (let ((res (node-map-generation
                                       value node-map
                                       #:active-graph active-graph
                                       #:active-subject referenced-node
                                       #:active-property property)))
                            (set! node-map (assoc-ref res "node-map"))
                            (set! graph (assoc-ref node-map active-graph))
                            (set! subject-node (or (assoc-ref graph active-subject)
                                                   '()))
                            (when id
                              (set! node (assoc-ref graph id)))))
                        (array->list values)))
                    reverse-map)
                  ;; 6.9.4
                  (set! element (alist-remove element "@reverse"))))
              ;; 6.10
              (when (json-has-key? element "@graph")
                (let ((res (node-map-generation
                             (assoc-ref element "@graph")
                             node-map
                             #:active-graph id)))
                  (set! node-map (assoc-ref res "node-map"))
                  (set! graph (assoc-ref node-map active-graph))
                  (set! subject-node (or (assoc-ref graph active-subject) '()))
                  (when id
                    (set! node (assoc-ref graph id))))
                (set! element (alist-remove element "@graph")))
              ;; 6.11
              (when (json-has-key? element "@included")
                (let ((res (node-map-generation
                             (assoc-ref element "@included")
                             node-map
                             #:active-graph active-graph)))
                  (set! node-map (assoc-ref res "node-map"))
                  (set! graph (assoc-ref node-map active-graph))
                  (set! subject-node (or (assoc-ref graph active-subject) '()))
                  (when id
                    (set! node (assoc-ref graph id))))
                (set! element (alist-remove element "@included")))
              ;; 6.12
              (for-each-pair
                (lambda (property value)
                  ;; 6.12.1
                  (when (blank-node? property)
                    (set! property (generate-blank-node property)))
                  ;; 6.12.2
                  (unless (json-has-key? node property)
                    (set! node (alist-set node property #()))
                    (when id
                      (set! graph (alist-set graph id node)))
                    (set! node-map (alist-set node-map active-graph graph)))
                  ;; 6.12.3
                  (let ((res (node-map-generation
                               value node-map #:active-graph active-graph
                               #:active-subject id
                               #:active-property property)))
                    (set! node-map (assoc-ref res "node-map"))
                    (set! graph (assoc-ref node-map active-graph))
                    (set! subject-node (or (assoc-ref graph active-subject) '()))
                    (when id
                      (set! node (assoc-ref graph id)))))
                (alist-sort-by-key element))
              (when id
                (set! graph (alist-set graph id node))))))
        (when (string? active-subject)
          (set! graph (alist-set graph active-subject subject-node)))
        (set! node-map (alist-set node-map active-graph graph))))
    ;; The algorithm returns nothing, but may have modified these two references
    `(("node-map" . ,node-map) ("list" . ,lst)))
  node-map-generation)


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 node-map-generation)
19	#:use-module (jsonld json)
20	#:export (get-node-map-generation))
21
22	(define (contains-json? array json)
23	(when (equal? array #f)
24	(set! array #()))
25	(unless (json-array? array)
26	(set! array `#(,array)))
27	(not (null? (filter (lambda (o) (identical-json? o json)) (array->list array)))))
28
29	(define (add-to-list array element)
30	(when (equal? array #f)
31	(set! array #()))
32	(unless (json-array? array)
33	(set! array `#(,array)))
34	(list->array 1 (append
35	(array->list array)
36	(list element))))
37
38	(define (append-to-list a1 a2)
39	(when (equal? a1 #f)
40	(set! a1 #()))
41	(unless (json-array? a1)
42	(set! a1 `#(,a1)))
43	(when (equal? a2 #f)
44	(set! a2 #()))
45	(unless (json-array? a2)
46	(set! a2 `#(,a2)))
47	(list->array 1 (append
48	(array->list a1)
49	(array->list a2))))
50
51	(define (add-if-not-in object property element)
52	(let ((array (assoc-ref object property)))
53	(if (contains-json? array element)
54	object
55	(alist-set
56	object property
57	(add-to-list array element)))))
58
59	(define (append-if-not-in object property elements)
60	(if (json-array? elements)
61	(set! elements (array->list elements))
62	(set! elements (list elements)))
63	(let loop ((elements elements) (object object))
64	(if (null? elements)
65	object
66	(loop (cdr elements) (add-if-not-in object property (car elements))))))
67
68	(define (get-node-map-generation generate-blank-node)
69	(define* (node-map-generation element node-map
70	#:key (active-graph "@default")
71	(active-subject #nil)
72	(active-property #nil)
73	(lst #nil))
74	;; 1
75	(if (json-array? 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))
86	;; 2: otherwise
87	(let* ((graph (or (assoc-ref node-map active-graph) '()))
88	(subject-node (if (equal? active-subject #nil)
89	'()
90	(or (assoc-ref graph active-subject) '())))
91	(types (assoc-ref element "@type"))
92	(types (if (json-array? types)
93	(array->list types)
94	(if types (list types) '())))
95	;; 3
96	(types
97	(map
98	(lambda (item)
99	(if (blank-node? item)
100	(generate-blank-node item)
101	item))
102	types)))
103	(unless (null? types)
104	(if (json-array? (assoc-ref element "@type"))
105	(set! element (alist-set element "@type" (list->array 1 types)))
106	(set! element (alist-set element "@type" (car types)))))
107	;; 4
108	(when (json-has-key? element "@value")
109	(if (equal? lst #nil)
110	(begin
111	;; 4.1.1
112	(unless (json-has-key? subject-node active-property)
113	(set! subject-node
114	(alist-set subject-node active-property `#(,element))))
115	;; 4.1.2
116	(set! subject-node
117	(add-if-not-in subject-node active-property element)))
118	;; 4.2
119	(set! lst
120	(alist-set lst "@list"
121	(add-to-list (assoc-ref lst "@list") element)))))
122	;; 5
123	(when (json-has-key? element "@list")
124	(let ((result `(("@list" . #()))))
125	;; 5.2
126	(let ((res (node-map-generation
127	(assoc-ref element "@list") node-map
128	#:active-graph active-graph
129	#:active-subject active-subject
130	#:active-property active-property
131	#:lst result)))
132	(set! result (assoc-ref res "list"))
133	(set! node-map (assoc-ref res "node-map"))
134	(set! graph (assoc-ref node-map active-graph))
135	(set! subject-node (or (assoc-ref graph active-subject) '()))
136	(if (equal? lst #nil)
137	;; 5.3
138	(begin
139	(set! subject-node
140	(alist-set
141	subject-node
142	active-property
143	(add-to-list (assoc-ref subject-node active-property)
144	result)))
145	(set! graph (alist-set graph active-subject subject-node))
146	(set! node-map (alist-set node-map active-graph graph)))
147	(set! lst
148	(alist-set lst "@list"
149	(add-to-list (assoc-ref lst "@list")
150	result)))))))
151	;; 6
152	(when (node-object? element)
153	;; 6.1
154	(let ((id (if (json-has-key? element "@id")
155	(if (blank-node? (assoc-ref element "@id"))
156	(generate-blank-node (assoc-ref element "@id"))
157	(assoc-ref element "@id"))
158	(generate-blank-node #nil))))
159	;; 6.3
160	(unless (or (json-has-key? graph id) (not id))
161	(set! graph
162	(alist-set graph id `(("@id" . ,id))))
163	(set! node-map (alist-set node-map active-graph graph)))
164	;; 6.4
165	(let ((node (or (assoc-ref graph id) '())))
166	(cond
167	;; 6.5
168	((json-object? active-subject)
169	(if (json-has-key? node active-property)
170	;; 6.5.2
171	(set! node
172	(add-if-not-in node active-property active-subject))
173	;; 6.5.1
174	(set! node
175	(alist-set node active-property `#(,active-subject))))
176	(when id
177	(set! graph (alist-set graph id node)))
178	(set! node-map (alist-set node-map active-graph graph)))
179	;; 6.6
180	((not (equal? active-property #nil))
181	;; 6.6.1
182	(let ((reference `(("@id" . ,id))))
183	(if (equal? lst #nil)
184	;; 6.6.2
185	(begin
186	(if (json-has-key? subject-node active-property)
187	;; 6.6.2.2
188	(set! subject-node
189	(add-if-not-in subject-node active-property reference))
190	;; 6.6.2.1
191	(set! subject-node
192	(alist-set subject-node active-property `#(,reference))))
193	(set! graph (alist-set graph active-subject subject-node))
194	(set! node-map (alist-set node-map active-graph graph)))
195	;; 6.6.3
196	(set! lst
197	(alist-set lst "@list"
198	(add-to-list (assoc-ref lst "@list")
199	reference)))))))
200	;; 6.7
201	(when (json-has-key? element "@type")
202	(set! node
203	(append-if-not-in node "@type" (assoc-ref element "@type")))
204	(when id
205	(set! graph (alist-set graph id node)))
206	(set! node-map (alist-set node-map active-graph graph)))
207	;; 6.8
208	(when (json-has-key? element "@index")
209	(when (json-has-key? node "@index")
210	(throw 'conflicting-indexes))
211	(set! node
212	(alist-set node "@index" (assoc-ref element "@index")))
213	(unless (string? id)
214	(throw 'eee))
215	(set! graph (alist-set graph id node))
216	(set! node-map (alist-set node-map active-graph graph))
217	(set! element (alist-remove element "@index")))
218	;; 6.9
219	(when (json-has-key? element "@reverse")
220	;; 6.9.1
221	(let ((referenced-node `(("@id" . ,id)))
222	;; 6.9.2
223	(reverse-map (assoc-ref element "@reverse")))
224	;; 6.9.3
225	(for-each-pair
226	(lambda (property values)
227	(for-each
228	(lambda (value)
229	(let ((res (node-map-generation
230	value node-map
231	#:active-graph active-graph
232	#:active-subject referenced-node
233	#:active-property property)))
234	(set! node-map (assoc-ref res "node-map"))
235	(set! graph (assoc-ref node-map active-graph))
236	(set! subject-node (or (assoc-ref graph active-subject)
237	'()))
238	(when id
239	(set! node (assoc-ref graph id)))))
240	(array->list values)))
241	reverse-map)
242	;; 6.9.4
243	(set! element (alist-remove element "@reverse"))))
244	;; 6.10
245	(when (json-has-key? element "@graph")
246	(let ((res (node-map-generation
247	(assoc-ref element "@graph")
248	node-map
249	#:active-graph id)))
250	(set! node-map (assoc-ref res "node-map"))
251	(set! graph (assoc-ref node-map active-graph))
252	(set! subject-node (or (assoc-ref graph active-subject) '()))
253	(when id
254	(set! node (assoc-ref graph id))))
255	(set! element (alist-remove element "@graph")))
256	;; 6.11
257	(when (json-has-key? element "@included")
258	(let ((res (node-map-generation
259	(assoc-ref element "@included")
260	node-map
261	#:active-graph active-graph)))
262	(set! node-map (assoc-ref res "node-map"))
263	(set! graph (assoc-ref node-map active-graph))
264	(set! subject-node (or (assoc-ref graph active-subject) '()))
265	(when id
266	(set! node (assoc-ref graph id))))
267	(set! element (alist-remove element "@included")))
268	;; 6.12
269	(for-each-pair
270	(lambda (property value)
271	;; 6.12.1
272	(when (blank-node? property)
273	(set! property (generate-blank-node property)))
274	;; 6.12.2
275	(unless (json-has-key? node property)
276	(set! node (alist-set node property #()))
277	(when id
278	(set! graph (alist-set graph id node)))
279	(set! node-map (alist-set node-map active-graph graph)))
280	;; 6.12.3
281	(let ((res (node-map-generation
282	value node-map #:active-graph active-graph
283	#:active-subject id
284	#:active-property property)))
285	(set! node-map (assoc-ref res "node-map"))
286	(set! graph (assoc-ref node-map active-graph))
287	(set! subject-node (or (assoc-ref graph active-subject) '()))
288	(when id
289	(set! node (assoc-ref graph id)))))
290	(alist-sort-by-key element))
291	(when id
292	(set! graph (alist-set graph id node))))))
293	(when (string? active-subject)
294	(set! graph (alist-set graph active-subject subject-node)))
295	(set! node-map (alist-set node-map active-graph graph))))
296	;; The algorithm returns nothing, but may have modified these two references
297	`(("node-map" . ,node-map) ("list" . ,lst)))
298	node-map-generation)
299