Fix collections and test parsing

Julien LepillerWed Apr 01 23:50:12+0200 2020

c9d8285

Fix collections and test parsing

test-modules/online.scm

123123 
124124 
  (define manifest (turtle->rdf document url))
125125 
126+
  (define tests-node
127+
    (rdf-triple-object
128+
      (car
129+
        (filter
130+
          (lambda (triple)
131+
            (and (equal? (rdf-triple-subject triple) url)
132+
                 (equal? (rdf-triple-predicate triple)
133+
                         (string-append "http://www.w3.org/2001/sw/DataAccess/"
134+
                                        "tests/test-manifest#entries"))))
135+
          manifest))))
136+
137+
  (define (find-rest node)
138+
    (pk 'rest node)
139+
    (rdf-triple-object
140+
      (car
141+
        (filter
142+
          (lambda (triple)
143+
            (and (equal? (rdf-triple-subject triple) node)
144+
                 (equal? (rdf-triple-predicate triple)
145+
                         (string-append "http://www.w3.org/1999/02/22-rdf-syntax-ns"
146+
                                        "#rest"))))
147+
          manifest))))
148+
149+
  (define (find-first node)
150+
    (rdf-triple-object
151+
      (car
152+
        (filter
153+
          (lambda (triple)
154+
            (and (equal? (rdf-triple-subject triple) node)
155+
                 (equal? (rdf-triple-predicate triple)
156+
                         (string-append "http://www.w3.org/1999/02/22-rdf-syntax-ns"
157+
                                        "#first"))))
158+
          manifest))))
159+
126160 
  (define tests
127-
    (map
128-
      rdf-triple-object
129-
      (filter
130-
        (lambda (triple)
131-
          (and (equal? (rdf-triple-subject triple) url)
132-
               (equal? (rdf-triple-predicate triple)
133-
                       (string-append "http://www.w3.org/2001/sw/DataAccess/"
134-
                                      "tests/test-manifest#entries"))))
135-
        manifest)))
161+
    (let loop ((tests-node tests-node) (tests '()))
162+
      (let ((first (find-first tests-node))
163+
            (tests-node (find-rest tests-node)))
164+
        (if (blank-node? tests-node)
165+
            (loop tests-node (cons first tests))
166+
            tests))))
136167 
137168 
  (cdr
138169 
    (fold
turtle/tordf.scm
2626 
2727 
(define-record-type parser-state
2828 
  (make-parser-state base-uri namespaces bnode-labels cur-subject cur-predicate
29-
                     blank-node-gen result)
29+
                     cur-object blank-node-gen result)
3030 
  parser-state?
3131 
  (base-uri       parser-state-base-uri)
3232 
  (namespaces     parser-state-namespaces)
3333 
  (bnode-labels   parser-state-bnode-labels)
3434 
  (cur-subject    parser-state-cur-subject)
3535 
  (cur-predicate  parser-state-cur-predicate)
36+
  (cur-object     parser-state-cur-object)
3637 
  (blank-node-gen parser-state-blank-node-gen)
3738 
  (result         parser-state-result))
3839 
…
4243 
                       (bnode-labels (parser-state-bnode-labels state))
4344 
                       (cur-subject (parser-state-cur-subject state))
4445 
                       (cur-predicate (parser-state-cur-predicate state))
46+
                       (cur-object (parser-state-cur-object state))
4547 
                       (blank-node-gen (parser-state-blank-node-gen state))
4648 
                       (result (parser-state-result state)))
4749 
  (make-parser-state base-uri namespaces bnode-labels cur-subject cur-predicate
48-
                     blank-node-gen result))
50+
                     cur-object blank-node-gen result))
4951 
5052 
(define (create-generate-blank-node)
5153 
  (define num 0)
…
7880 
       ("state" . ,state)))
7981 
    (('iri ('iriref iri))
8082 
     `(("iri" . ,(resolve-iri (parser-state-base-uri state) iri))
81-
       ("state" . ,state)))
82-
    (('blank-node ('blank-node-label label))
83-
     (if (assoc-ref (parser-state-bnode-labels state) label)
84-
         `(("iri" . ,(assoc-ref (parser-state-bnode-labels state) label))
85-
           ("state" . ,state))
86-
         (let ((node ((parser-state-blank-node-gen state))))
87-
           `(("iri" . ,node)
88-
             ("state" . ,(update-parser-state state
89-
                           #:bnode-labels
90-
                           (cons
91-
                             (cons label node)
92-
                             (parser-state-bnode-labels state))))))))))
83+
       ("state" . ,state)))))
9384 
9485 
(define (parse-verb verb state)
9586 
  (match verb
…
10495 
  (pk 'object object)
10596 
  (match object
10697 
    (('rdf-literal ('string-pat (_ str)))
107-
     (update-parser-state state
108-
       #:result
109-
       (cons
110-
         (make-rdf-triple
111-
           (parser-state-cur-subject state)
112-
           (parser-state-cur-predicate state)
113-
           (make-rdf-literal str "http://www.w3.org/2001/XMLSchema#string" #f))
114-
         (parser-state-result state))))
98+
     (let ((object
99+
             (make-rdf-literal str "http://www.w3.org/2001/XMLSchema#string" #f)))
100+
       (update-parser-state state
101+
         #:cur-object object
102+
         #:result
103+
         (cons
104+
           (make-rdf-triple
105+
             (parser-state-cur-subject state)
106+
             (parser-state-cur-predicate state)
107+
             (make-rdf-literal str "http://www.w3.org/2001/XMLSchema#string" #f))
108+
           (parser-state-result state)))))
109+
    (('rdf-literal ('string-pat (_ str)) ("^^" iri))
110+
     (let* ((res (parse-iri iri state))
111+
            (iri (assoc-ref res "iri"))
112+
            (state (assoc-ref res "state"))
113+
            (object (make-rdf-literal str iri #f)))
114+
       (update-parser-state state
115+
         #:cur-object object
116+
         #:result
117+
         (cons
118+
           (make-rdf-triple
119+
             (parser-state-cur-subject state)
120+
             (parser-state-cur-predicate state)
121+
             (make-rdf-literal str "http://www.w3.org/2001/XMLSchema#string" #f))
122+
           (parser-state-result state)))))
115123 
    (('rdf-literal ('string-pat (_ str)) ('langtag lang))
116-
     (update-parser-state state
117-
       #:result
118-
       (cons
119-
         (make-rdf-triple
120-
           (parser-state-cur-subject state)
121-
           (parser-state-cur-predicate state)
124+
     (let ((object
122125 
           (make-rdf-literal
123-
             str "http://www.w3.org/1999/02/22-rdf-syntax-ns#langString" lang))
124-
         (parser-state-result state))))
126+
             str "http://www.w3.org/1999/02/22-rdf-syntax-ns#langString" lang)))
127+
       (update-parser-state state
128+
         #:cur-object object
129+
         #:result
130+
         (cons
131+
           (make-rdf-triple
132+
             (parser-state-cur-subject state)
133+
             (parser-state-cur-predicate state)
134+
             object)
135+
           (parser-state-result state)))))
136+
    (('numeric-literal ('decimal num))
137+
     (let ((object
138+
            (make-rdf-literal num "http://www.w3.org/2001/XMLSchema#decimal" #f)))
139+
       (update-parser-state state
140+
         #:cur-object object
141+
         #:result
142+
         (cons
143+
           (make-rdf-triple
144+
             (parser-state-cur-subject state)
145+
             (parser-state-cur-predicate state)
146+
             object)
147+
           (parser-state-result state)))))
125148 
    (('numeric-literal ('integer int))
126-
     (update-parser-state state
127-
       #:result
128-
       (cons
129-
         (make-rdf-triple
130-
           (parser-state-cur-subject state)
131-
           (parser-state-cur-predicate state)
132-
           (make-rdf-literal int "http://www.w3.org/2001/XMLSchema#integer" #f))
133-
         (parser-state-result state))))
149+
     (let ((object
150+
           (make-rdf-literal int "http://www.w3.org/2001/XMLSchema#integer" #f)))
151+
       (update-parser-state state
152+
         #:cur-object object
153+
         #:result
154+
         (cons
155+
           (make-rdf-triple
156+
             (parser-state-cur-subject state)
157+
             (parser-state-cur-predicate state)
158+
             object)
159+
           (parser-state-result state)))))
160+
    (('numeric-literal ('double num))
161+
     (let ((object
162+
            (make-rdf-literal num "http://www.w3.org/2001/XMLSchema#double" #f)))
163+
       (update-parser-state state
164+
         #:cur-object object
165+
         #:result
166+
         (cons
167+
           (make-rdf-triple
168+
             (parser-state-cur-subject state)
169+
             (parser-state-cur-predicate state)
170+
             object)
171+
           (parser-state-result state)))))
134172 
    (('boolean-literal bool)
135-
     (update-parser-state state
136-
       #:result
137-
       (cons
138-
         (make-rdf-triple
139-
           (parser-state-cur-subject state)
140-
           (parser-state-cur-predicate state)
141-
           (make-rdf-literal bool "http://www.w3.org/2001/XMLSchema#boolean" #f))
142-
         (parser-state-result state))))
173+
     (let ((object
174+
             (make-rdf-literal bool "http://www.w3.org/2001/XMLSchema#boolean" #f)))
175+
       (update-parser-state state
176+
         #:cur-object object
177+
         #:result
178+
         (cons
179+
           (make-rdf-triple
180+
             (parser-state-cur-subject state)
181+
             (parser-state-cur-predicate state)
182+
             object)
183+
           (parser-state-result state)))))
184+
    (('blank-node ('anon _))
185+
     (let ((node ((parser-state-blank-node-gen state))))
186+
       (update-parser-state state
187+
         #:cur-object node
188+
         #:result
189+
         (cons
190+
           (make-rdf-triple
191+
             (parser-state-cur-subject state)
192+
             (parser-state-cur-predicate state)
193+
             node)
194+
           (parser-state-result state)))))
143195 
    (('blank-node-property-list ('predicate-object-list po ...))
144196 
     (let* ((node ((parser-state-blank-node-gen state)))
145197 
            (new-state (parse-predicate-object
146198 
                         po (update-parser-state state #:cur-subject node))))
147199 
       (update-parser-state new-state
200+
         #:cur-object node
148201 
         #:cur-subject (parser-state-cur-subject state)
149202 
         #:cur-predicate (parser-state-cur-predicate state)
150203 
         #:result
…
154207 
             (parser-state-cur-predicate state)
155208 
             node)
156209 
           (parser-state-result new-state)))))
210+
    ('collection
211+
     (let ((object "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil"))
212+
       (update-parser-state state
213+
         #:cur-object object
214+
         #:result
215+
         (cons
216+
           (make-rdf-triple
217+
             (parser-state-cur-subject state)
218+
             (parser-state-cur-predicate state)
219+
             object)
220+
           (parser-state-result state)))))
157221 
    (('collection objects ...)
158-
     (let loop ((objects objects) (state state))
159-
       (match objects
160-
         ('() state)
161-
         ((('object object) objects ...)
162-
          (loop objects (parse-object object state))))))
222+
     (let ((state (parse-collection objects state)))
223+
       (update-parser-state state
224+
         #:result
225+
         (cons
226+
           (make-rdf-triple
227+
             (parser-state-cur-subject state)
228+
             (parser-state-cur-predicate state)
229+
             (parser-state-cur-object state))
230+
           (parser-state-result state)))))
163231 
    (('iri _)
164232 
     (let* ((res (parse-iri object state))
165233 
            (iri (assoc-ref res "iri"))
166234 
            (state (assoc-ref res "state")))
167235 
       (update-parser-state state
236+
         #:cur-object iri
168237 
         #:result
169238 
         (cons
170239 
           (make-rdf-triple
…
173242 
             iri)
174243 
           (parser-state-result state)))))))
175244 
245+
(define (parse-collection collection state)
246+
  (let ((node ((parser-state-blank-node-gen state))))
247+
    (let loop ((objects collection)
248+
               (new-state
249+
                 (update-parser-state state
250+
                   #:cur-subject node
251+
                   #:cur-predicate
252+
                   "http://www.w3.org/1999/02/22-rdf-syntax-ns#first"))
253+
               (previous-object #nil))
254+
      (match objects
255+
        ('()
256+
         (update-parser-state new-state
257+
           #:cur-object node
258+
           #:cur-subject (parser-state-cur-subject state)
259+
           #:cur-predicate (parser-state-cur-predicate state)
260+
           #:result
261+
           (cons
262+
             (make-rdf-triple
263+
               previous-object
264+
               "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"
265+
               "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil")
266+
             (parser-state-result new-state))))
267+
        ((('object object) objects ...)
268+
         (if (equal? previous-object #nil)
269+
             (let ((new-state (parse-object object new-state)))
270+
               (loop objects new-state node))
271+
             (let* ((node ((parser-state-blank-node-gen new-state)))
272+
                    (new-state
273+
                      (update-parser-state new-state
274+
                        #:cur-subject node))
275+
                    (new-state (parse-object object new-state)))
276+
               (loop
277+
                 objects
278+
                 (update-parser-state new-state
279+
                   #:result
280+
                   (cons
281+
                     (make-rdf-triple
282+
                       previous-object
283+
                       "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"
284+
                       node)
285+
                     (parser-state-result new-state)))
286+
                 node))))))))
287+
176288 
(define (parse-object-list ol state)
177289 
  (let loop ((ol ol) (state state))
178290 
    (pk 'ol ol)
…
212324 
      ((po)
213325 
       (loop po state)))))
214326 
327+
(define (parse-subject s state)
328+
  (match s
329+
    (('iri _ ...)
330+
     (let ((res (parse-iri s state)))
331+
       `(("subject" . ,(assoc-ref res "iri"))
332+
         ("state" . ,(assoc-ref res "state")))))
333+
    (('collection objects ...)
334+
     (let ((res (parse-collection objects state)))
335+
       `(("subject" . ,(parser-state-cur-object res))
336+
         ("state" . ,res))))
337+
    ('collection
338+
     `(("subject" . "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil")
339+
       ("state" . ,state)))
340+
    (('blank-node ('anon _))
341+
     (let ((node ((parser-state-blank-node-gen state))))
342+
       `(("subject" . ,node)
343+
         ("state" . ,state))))
344+
    (('blank-node ('blank-node-label label))
345+
     (if (assoc-ref (parser-state-bnode-labels state) label)
346+
         `(("subject" . ,(assoc-ref (parser-state-bnode-labels state) label))
347+
           ("state" . ,state))
348+
         (let ((node ((parser-state-blank-node-gen state))))
349+
           `(("subject" . ,node)
350+
             ("state" . ,(update-parser-state state
351+
                           #:bnode-labels
352+
                           (cons
353+
                             (cons label node)
354+
                             (parser-state-bnode-labels state))))))))))
355+
215356 
(define (parse-triples t state)
216357 
  (match t
217-
    ((('subject iri) ('predicate-object-list predicate-object ...))
218-
     (let* ((res (parse-iri iri state))
219-
            (iri (assoc-ref res "iri"))
358+
    ((('subject subject) ('predicate-object-list predicate-object ...))
359+
     (let* ((res (parse-subject subject state))
360+
            (subject (assoc-ref res "subject"))
220361 
            (state (assoc-ref res "state"))
221362 
            (state (update-parser-state state
222-
                    #:cur-subject iri)))
223-
       (parse-predicate-object predicate-object state)))))
363+
                    #:cur-subject subject)))
364+
       (parse-predicate-object predicate-object state)))
365+
    ((('blank-node-property-list ('predicate-object-list po ...))
366+
      ('predicate-object-list predicate-object ...))
367+
     (let* ((subject ((parser-state-blank-node-gen state)))
368+
            (new-state (parse-predicate-object
369+
                         po (update-parser-state state #:cur-subject subject))))
370+
       (parse-predicate-object predicate-object new-state)))))
224371 
225372 
(define (parse-turtle-doc parse-tree state)
226373 
  (let loop ((parse-tree parse-tree) (state state))
…
259406 
260407 
(define (tordf parse-tree base)
261408 
  (define state
262-
    (make-parser-state base '() '() #f #f (create-generate-blank-node) '()))
409+
    (make-parser-state base '() '() #f #f #f (create-generate-blank-node) '()))
263410 
  (parse-turtle-doc parse-tree state))
264411 
265412 
(define (turtle->rdf str-or-file base)