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