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 json-null)
                                (active-property json-null)
                                (lst json-null))
    ;; 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 (not-null-or-false (assoc-ref node-map active-graph))
                        '()))
             (subject-node (if (json-null? active-subject)
                               '()
                               (or (not-null-or-false (assoc-ref graph active-subject))
                                   '())))
             (types (assoc-ref element "@type"))
             (types (if (json-array? types)
                        (array->list types)
                        (if (not-null-or-false 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 (json-null? lst)
              (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 (not-null-or-false (assoc-ref graph active-subject))
                                     '()))
              (if (json-null? lst)
                ;; 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 json-null))))
            ;; 6.3
            (unless (or (json-has-key? graph id) (not (not-null-or-false id)))
              (set! graph
                (alist-set graph id `(("@id" . ,id))))
              (set! node-map (alist-set node-map active-graph graph)))
            ;; 6.4
            (let ((node (or (not-null-or-false (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 (not-null-or-false id)
                   (set! graph (alist-set graph id node)))
                 (set! node-map (alist-set node-map active-graph graph)))
                ;; 6.6
                ((not (json-null? active-property))
                 ;; 6.6.1
                 (let ((reference `(("@id" . ,id))))
                   (if (json-null? lst)
                       ;; 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 (not-null-or-false 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 (not-null-or-false
                                                     (assoc-ref graph active-subject))
                                                   '()))
                            (when (not-null-or-false 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 (not-null-or-false
                                           (assoc-ref graph active-subject))
                                         '()))
                  (when (not-null-or-false 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 (not-null-or-false
                                           (assoc-ref graph active-subject))
                                         '()))
                  (when (not-null-or-false 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 (not-null-or-false 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 (not-null-or-false
                                             (assoc-ref graph active-subject))
                                           '()))
                    (when (not-null-or-false id)
                      (set! node (assoc-ref graph id)))))
                (alist-sort-by-key element))
              (when (not-null-or-false 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 json-null)
72	(active-property json-null)
73	(lst json-null))
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 (not-null-or-false (assoc-ref node-map active-graph))
88	'()))
89	(subject-node (if (json-null? active-subject)
90	'()
91	(or (not-null-or-false (assoc-ref graph active-subject))
92	'())))
93	(types (assoc-ref element "@type"))
94	(types (if (json-array? types)
95	(array->list types)
96	(if (not-null-or-false types) (list types) '())))
97	;; 3
98	(types
99	(map
100	(lambda (item)
101	(if (blank-node? item)
102	(generate-blank-node item)
103	item))
104	types)))
105	(unless (null? types)
106	(if (json-array? (assoc-ref element "@type"))
107	(set! element (alist-set element "@type" (list->array 1 types)))
108	(set! element (alist-set element "@type" (car types)))))
109	;; 4
110	(when (json-has-key? element "@value")
111	(if (json-null? lst)
112	(begin
113	;; 4.1.1
114	(unless (json-has-key? subject-node active-property)
115	(set! subject-node
116	(alist-set subject-node active-property `#(,element))))
117	;; 4.1.2
118	(set! subject-node
119	(add-if-not-in subject-node active-property element)))
120	;; 4.2
121	(set! lst
122	(alist-set lst "@list"
123	(add-to-list (assoc-ref lst "@list") element)))))
124	;; 5
125	(when (json-has-key? element "@list")
126	(let ((result `(("@list" . #()))))
127	;; 5.2
128	(let ((res (node-map-generation
129	(assoc-ref element "@list") node-map
130	#:active-graph active-graph
131	#:active-subject active-subject
132	#:active-property active-property
133	#:lst result)))
134	(set! result (assoc-ref res "list"))
135	(set! node-map (assoc-ref res "node-map"))
136	(set! graph (assoc-ref node-map active-graph))
137	(set! subject-node (or (not-null-or-false (assoc-ref graph active-subject))
138	'()))
139	(if (json-null? lst)
140	;; 5.3
141	(begin
142	(set! subject-node
143	(alist-set
144	subject-node
145	active-property
146	(add-to-list (assoc-ref subject-node active-property)
147	result)))
148	(set! graph (alist-set graph active-subject subject-node))
149	(set! node-map (alist-set node-map active-graph graph)))
150	(set! lst
151	(alist-set lst "@list"
152	(add-to-list (assoc-ref lst "@list")
153	result)))))))
154	;; 6
155	(when (node-object? element)
156	;; 6.1
157	(let ((id (if (json-has-key? element "@id")
158	(if (blank-node? (assoc-ref element "@id"))
159	(generate-blank-node (assoc-ref element "@id"))
160	(assoc-ref element "@id"))
161	(generate-blank-node json-null))))
162	;; 6.3
163	(unless (or (json-has-key? graph id) (not (not-null-or-false id)))
164	(set! graph
165	(alist-set graph id `(("@id" . ,id))))
166	(set! node-map (alist-set node-map active-graph graph)))
167	;; 6.4
168	(let ((node (or (not-null-or-false (assoc-ref graph id)) '())))
169	(cond
170	;; 6.5
171	((json-object? active-subject)
172	(if (json-has-key? node active-property)
173	;; 6.5.2
174	(set! node
175	(add-if-not-in node active-property active-subject))
176	;; 6.5.1
177	(set! node
178	(alist-set node active-property `#(,active-subject))))
179	(when (not-null-or-false id)
180	(set! graph (alist-set graph id node)))
181	(set! node-map (alist-set node-map active-graph graph)))
182	;; 6.6
183	((not (json-null? active-property))
184	;; 6.6.1
185	(let ((reference `(("@id" . ,id))))
186	(if (json-null? lst)
187	;; 6.6.2
188	(begin
189	(if (json-has-key? subject-node active-property)
190	;; 6.6.2.2
191	(set! subject-node
192	(add-if-not-in subject-node active-property reference))
193	;; 6.6.2.1
194	(set! subject-node
195	(alist-set subject-node active-property `#(,reference))))
196	(set! graph (alist-set graph active-subject subject-node))
197	(set! node-map (alist-set node-map active-graph graph)))
198	;; 6.6.3
199	(set! lst
200	(alist-set lst "@list"
201	(add-to-list (assoc-ref lst "@list")
202	reference)))))))
203	;; 6.7
204	(when (json-has-key? element "@type")
205	(set! node
206	(append-if-not-in node "@type" (assoc-ref element "@type")))
207	(when (not-null-or-false id)
208	(set! graph (alist-set graph id node)))
209	(set! node-map (alist-set node-map active-graph graph)))
210	;; 6.8
211	(when (json-has-key? element "@index")
212	(when (json-has-key? node "@index")
213	(throw 'conflicting-indexes))
214	(set! node
215	(alist-set node "@index" (assoc-ref element "@index")))
216	(unless (string? id)
217	(throw 'eee))
218	(set! graph (alist-set graph id node))
219	(set! node-map (alist-set node-map active-graph graph))
220	(set! element (alist-remove element "@index")))
221	;; 6.9
222	(when (json-has-key? element "@reverse")
223	;; 6.9.1
224	(let ((referenced-node `(("@id" . ,id)))
225	;; 6.9.2
226	(reverse-map (assoc-ref element "@reverse")))
227	;; 6.9.3
228	(for-each-pair
229	(lambda (property values)
230	(for-each
231	(lambda (value)
232	(let ((res (node-map-generation
233	value node-map
234	#:active-graph active-graph
235	#:active-subject referenced-node
236	#:active-property property)))
237	(set! node-map (assoc-ref res "node-map"))
238	(set! graph (assoc-ref node-map active-graph))
239	(set! subject-node (or (not-null-or-false
240	(assoc-ref graph active-subject))
241	'()))
242	(when (not-null-or-false id)
243	(set! node (assoc-ref graph id)))))
244	(array->list values)))
245	reverse-map)
246	;; 6.9.4
247	(set! element (alist-remove element "@reverse"))))
248	;; 6.10
249	(when (json-has-key? element "@graph")
250	(let ((res (node-map-generation
251	(assoc-ref element "@graph")
252	node-map
253	#:active-graph id)))
254	(set! node-map (assoc-ref res "node-map"))
255	(set! graph (assoc-ref node-map active-graph))
256	(set! subject-node (or (not-null-or-false
257	(assoc-ref graph active-subject))
258	'()))
259	(when (not-null-or-false id)
260	(set! node (assoc-ref graph id))))
261	(set! element (alist-remove element "@graph")))
262	;; 6.11
263	(when (json-has-key? element "@included")
264	(let ((res (node-map-generation
265	(assoc-ref element "@included")
266	node-map
267	#:active-graph active-graph)))
268	(set! node-map (assoc-ref res "node-map"))
269	(set! graph (assoc-ref node-map active-graph))
270	(set! subject-node (or (not-null-or-false
271	(assoc-ref graph active-subject))
272	'()))
273	(when (not-null-or-false id)
274	(set! node (assoc-ref graph id))))
275	(set! element (alist-remove element "@included")))
276	;; 6.12
277	(for-each-pair
278	(lambda (property value)
279	;; 6.12.1
280	(when (blank-node? property)
281	(set! property (generate-blank-node property)))
282	;; 6.12.2
283	(unless (json-has-key? node property)
284	(set! node (alist-set node property #()))
285	(when (not-null-or-false id)
286	(set! graph (alist-set graph id node)))
287	(set! node-map (alist-set node-map active-graph graph)))
288	;; 6.12.3
289	(let ((res (node-map-generation
290	value node-map #:active-graph active-graph
291	#:active-subject id
292	#:active-property property)))
293	(set! node-map (assoc-ref res "node-map"))
294	(set! graph (assoc-ref node-map active-graph))
295	(set! subject-node (or (not-null-or-false
296	(assoc-ref graph active-subject))
297	'()))
298	(when (not-null-or-false id)
299	(set! node (assoc-ref graph id)))))
300	(alist-sort-by-key element))
301	(when (not-null-or-false id)
302	(set! graph (alist-set graph id node))))))
303	(when (string? active-subject)
304	(set! graph (alist-set graph active-subject subject-node)))
305	(set! node-map (alist-set node-map active-graph graph))))
306	;; The algorithm returns nothing, but may have modified these two references
307	`(("node-map" . ,node-map) ("list" . ,lst)))
308	node-map-generation)
309