source: trunk/playground/abcl-test/lisp-code/TM-SPARQL/sparql_parser.lisp

Last change on this file was 395, checked in by lgiessmann, 14 years ago

playground: added a project that uses some test cases with ABCL
File size: 20.5 KB
Line 
1;;+-----------------------------------------------------------------------------
2;;+  Isidorus
3;;+  (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
4;;+
5;;+  Isidorus is freely distributable under the LLGPL license.
6;;+  You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and
7;;+  trunk/docs/LGPL-LICENSE.txt.
8;;+-----------------------------------------------------------------------------
9
10(in-package :TM-SPARQL)
11
12(defun parse-closed-value(query-string query-object &key (open "<") (close ">"))
13  "A helper function that checks the value of a statement within
14   two brackets, i.e. <prefix-value>. A list of the
15   form (:next-query string :value string) is returned."
16  (declare (String query-string open close)
17           (SPARQL-Query query-object))
18  (let ((trimmed-string (cut-comment query-string)))
19    (if (string-starts-with trimmed-string open)
20        (let* ((pref-url (string-until (string-after trimmed-string open) close))
21               (next-query-str (string-after trimmed-string close)))
22          (unless next-query-str
23            (error (make-sparql-parser-condition
24                    trimmed-string (original-query query-object)
25                    close)))
26          (list :next-query next-query-str
27                :value pref-url))
28        (error (make-sparql-parser-condition
29                trimmed-string (original-query query-object)
30                close)))))
31
32
33(defun cut-comment (query-string)
34  "Returns the given string back. If the query starts with a # or
35   space # the characters until the nextline are removed."
36  (declare (String query-string))
37  (let ((trimmed-str (trim-whitespace-left query-string)))
38    (if (string-starts-with trimmed-str "#")
39        (let ((next-query (string-after trimmed-str (string #\newline))))
40          (if next-query
41              next-query
42              ""))
43        trimmed-str)))
44
45
46(defgeneric parser-start(construct query-string)
47  (:documentation "The entry point of the SPARQL-parser.")
48  (:method ((construct SPARQL-Query) (query-string String))
49    (let ((trimmed-query-string (cut-comment query-string)))
50      (cond ((string-starts-with trimmed-query-string "SELECT")
51             (parse-select
52              construct (string-after trimmed-query-string "SELECT")))
53            ((string-starts-with trimmed-query-string "PREFIX")
54             (parse-prefixes
55              construct (string-after trimmed-query-string "PREFIX")))
56            ((string-starts-with trimmed-query-string "BASE")
57             (parse-base construct (string-after trimmed-query-string "BASE")
58                         #'parser-start))
59            ((= (length trimmed-query-string) 0)
60             ;; If there is only a BASE and/or PREFIX statement return a
61             ;; query-object with the result nil
62             construct)
63            (t
64             (error (make-sparql-parser-condition
65                     trimmed-query-string (original-query construct)
66                     (format nil "SELECT, PREFIX or BASE, but found: ~a..."
67                             (subseq trimmed-query-string 0 10)))))))))
68
69
70(defgeneric parse-select (construct query-string)
71  (:documentation "The entry-point of the parsing of the select - where
72                   statement.")
73  (:method ((construct SPARQL-Query) (query-string String))
74    (let* ((trimmed-str (cut-comment query-string))
75           (next-query (if (string-starts-with trimmed-str "WHERE")
76                           trimmed-str
77                           (parse-variables construct trimmed-str))))
78      (unless (string-starts-with next-query "WHERE")
79        (error (make-sparql-parser-condition
80                next-query (original-query construct) "WHERE")))
81      (let* ((triples (string-after next-query "WHERE"))
82             (query-tail (parse-where construct triples)))
83        (when (> (length query-tail) 0)
84          (error (make-sparql-parser-condition
85                  query-tail (original-query construct)
86                  "The end of the query. Solution sequence modifiers are not supported yet.")))
87        construct))))
88
89
90(defgeneric parse-where (construct query-string)
91  (:documentation "The entry-point for the parsing of the WHERE statement.")
92  (:method ((construct SPARQL-Query) (query-string String))
93    (let ((trimmed-str (cut-comment query-string)))
94      (unless (string-starts-with trimmed-str "{")
95        (error (make-sparql-parser-condition trimmed-str
96                                             (original-query construct) "{")))
97      (let ((query-tail (parse-group construct (subseq trimmed-str 1))))
98        (when (> (length (trim-whitespace query-tail)) 0)
99          (make-sparql-parser-condition
100           query-tail (original-query construct) "end of query, solution sequences and modifiers are not supported"))
101        query-tail))))
102
103
104(defgeneric parse-group (construct query-string &key last-subject)
105  (:documentation "The entry-point for the parsing of a {} statement.")
106  (:method ((construct SPARQL-Query) (query-string String)
107            &key (last-subject nil))
108    (declare (type (or Null SPARQL-Triple-Elem) last-subject))
109    (let ((trimmed-str (cut-comment query-string)))
110      (cond ((string-starts-with trimmed-str "BASE")
111             (parse-base construct (string-after trimmed-str "BASE")
112                         #'(lambda(constr query-str)
113                             (parse-group constr query-str
114                                          :last-subject last-subject))))
115            ((string-starts-with trimmed-str "{")
116             (error (make-sparql-parser-condition
117                     trimmed-str (original-query construct)
118                     "FILTER, BASE, or triple. Grouping is currently no implemented.")))
119            ((string-starts-with trimmed-str "FILTER")
120             (parse-filter construct (string-after trimmed-str "FILTER")))
121            ((string-starts-with trimmed-str "OPTIONAL")
122             (error (make-sparql-parser-condition
123                     trimmed-str (original-query construct)
124                     "FILTER, BASE, or triple. Grouping is currently no implemented.")))
125            ((string-starts-with trimmed-str "UNION")
126             (error (make-sparql-parser-condition
127                     trimmed-str (original-query construct)
128                     "FILTER, BASE, or triple. Grouping is currently no implemented.")))
129            ((string-starts-with trimmed-str "}") ;ending of this group
130             (subseq trimmed-str 1))
131            (t
132             (parse-triple construct trimmed-str :last-subject last-subject))))))
133
134
135(defgeneric parse-triple-elem (construct query-string &key literal-allowed)
136  (:documentation "A helper function to parse a subject or predicate of an RDF triple.")
137  (:method ((construct SPARQL-Query) (query-string String)
138            &key (literal-allowed nil))
139    (declare (Boolean literal-allowed))
140    (let ((trimmed-str (cut-comment query-string)))
141      (cond ((string-starts-with trimmed-str "a ") ;;rdf:type
142             (list :next-query (cut-comment (subseq trimmed-str 1))
143                   :value (make-instance 'SPARQL-Triple-Elem
144                                         :elem-type 'IRI
145                                         :value *type-psi*)))
146            ((string-starts-with trimmed-str "<")
147             (parse-base-suffix-pair construct trimmed-str))
148            ((or (string-starts-with trimmed-str "?")
149                 (string-starts-with trimmed-str "$"))
150             (let ((result
151                    (parse-variable-name construct trimmed-str
152                                         :additional-delimiters (list "}"))))
153               (list :next-query (cut-comment (getf result :next-query))
154                     :value (make-instance 'SPARQL-Triple-Elem
155                                           :elem-type 'VARIABLE
156                                           :value (getf result :value)))))
157            (t
158             (if (or (string-starts-with-digit trimmed-str)
159                     (string-starts-with trimmed-str "\"")
160                     (string-starts-with trimmed-str "true")
161                     (string-starts-with trimmed-str "false")
162                     (string-starts-with trimmed-str "'"))
163                 (progn
164                   (unless literal-allowed
165                     (error (make-sparql-parser-condition
166                             trimmed-str (original-query construct)
167                             "an IRI of the form prefix:suffix or <iri> but found a literal.")))
168                   (parse-literal-elem construct trimmed-str))
169                 (parse-prefix-suffix-pair construct trimmed-str)))))))
170
171
172(defgeneric parse-literal-elem (construct query-string)
173  (:documentation "A helper-function that returns a literal vaue of the form
174                   (:value (:value object :literal-type string :literal-lang
175                   string :type <'LITERAL>) :next-query string).")
176  (:method ((construct SPARQL-Query) (query-string String))
177    (let* ((trimmed-str (cut-comment query-string))
178           (value-type-lang-query
179            (cond ((or (string-starts-with trimmed-str "\"")
180                       (string-starts-with trimmed-str "'"))
181                   (parse-literal-string-value construct trimmed-str))
182                  ((string-starts-with trimmed-str "true")
183                   (list :value t :type *xml-boolean*
184                         :next-query (subseq trimmed-str (length "true"))))
185                  ((string-starts-with trimmed-str "false")
186                   (list :value nil :type *xml-boolean*
187                         :next-query (subseq trimmed-str (length "false"))))
188                  ((string-starts-with-digit trimmed-str)
189                   (parse-literal-number-value construct trimmed-str)))))
190      (list :next-query (getf value-type-lang-query :next-query)
191            :value (make-instance
192                    'SPARQL-Triple-Elem
193                    :elem-type 'LITERAL
194                    :value (getf value-type-lang-query :value)
195                    :literal-lang (getf value-type-lang-query :lang)
196                    :literal-datatype (getf value-type-lang-query :type))))))
197 
198 
199(defgeneric parse-literal-string-value (construct query-string)
200  (:documentation "A helper function that parses a string that is a literal.
201                   The return value is of the form
202                   (list :value object :type string :lang string
203                   :next-query string).")
204  (:method ((construct SPARQL-Query) (query-string String))
205    (let* ((trimmed-str (cut-comment query-string))
206           (result-1 (separate-literal-value construct trimmed-str))
207           (after-literal-value (getf result-1 :next-query))
208           (l-value (getf result-1 :literal))
209           (result-2 (separate-literal-lang-or-type
210                      construct after-literal-value))
211           (l-type (if (getf result-2 :type)
212                       (getf result-2 :type)
213                       *xml-string*))
214           (l-lang (getf result-2 :lang))
215           (next-query (getf result-2 :next-query)))
216      (list :next-query next-query :lang l-lang :type l-type
217            :value (cast-literal l-value l-type)))))
218
219
220(defgeneric separate-literal-lang-or-type (construct query-string)
221  (:documentation "A helper function that returns (:next-query string
222                   :lang string :type string). Only one of :lang and
223                   :type can be set, the other element is set to nil.
224                   The query string must be the string direct after
225                   the closing literal bounding.")
226  (:method ((construct SPARQL-Query) (query-string String))
227    (let ((delimiters-1 (list "." ";" "}" " " (string #\tab)
228                              (string #\newline)))
229          (delimiters-2 (list " ." ". " ";" "}" " " (string #\tab)
230                              (string #\newline)
231                              (concat "." (string #\newline))
232                              (concat "." (string #\tab)))))
233      (cond ((string-starts-with query-string "@")
234             (let ((end-pos (search-first delimiters-1
235                                          (subseq query-string 1))))
236               (unless end-pos
237                 (error (make-sparql-parser-condition
238                         query-string (original-query construct)
239                         "'.', ';', '}', ' ', '\t', or '\n'")))
240               (list :next-query (subseq (subseq query-string 1) end-pos)
241                     :lang (subseq (subseq query-string 1) 0 end-pos)
242                     :type nil)))
243            ((string-starts-with query-string "^^")
244             (let ((end-pos (search-first delimiters-2 (subseq query-string 2))))
245               (unless end-pos
246                 (error (make-sparql-parser-condition
247                         query-string (original-query construct)
248                         "'. ', ,' .', ';', '}', ' ', '\t', or '\n'")))
249               (let* ((type-str (subseq (subseq query-string 2) 0 end-pos))
250                      (next-query (subseq (subseq query-string 2) end-pos))
251                      (final-type (if (get-prefix construct type-str)
252                                      (get-prefix construct type-str)
253                                      type-str)))
254                 (list :next-query (cut-comment next-query)
255                       :type final-type :lang nil))))
256            (t
257             (list :next-query (cut-comment query-string) :type nil :lang nil))))))
258
259
260(defgeneric separate-literal-value (construct query-string)
261  (:documentation "A helper function that returns (:next-query string
262                   :literal string). The literal string contains the
263                   pure literal value.")
264  (:method ((construct SPARQL-Query) (query-string String))
265    (let* ((trimmed-str (cut-comment query-string))
266           (delimiter (cond ((string-starts-with trimmed-str "\"")
267                             "\"")
268                            ((string-starts-with trimmed-str "'''")
269                             "'''")
270                            ((string-starts-with trimmed-str "'")
271                             "'")
272                            (t
273                             (error (make-sparql-parser-condition
274                                     trimmed-str (original-query construct)
275                                     "a literal starting with ', ''', or \"")))))
276           (literal-end (find-literal-end (subseq trimmed-str (length delimiter))
277                                          delimiter 0)))
278      (list :next-query (subseq trimmed-str (+ literal-end (length delimiter)))
279            :literal (subseq trimmed-str (length delimiter) literal-end)))))
280
281
282(defgeneric parse-literal-number-value (construct query-string)
283  (:documentation "A helper function that parses any number that is a literal.
284                   The return value is of the form
285                  (list :value nil :type string :next-query string.")
286  (:method ((construct SPARQL-Query) (query-string String))
287    (let* ((trimmed-str (cut-comment query-string))
288           (triple-delimiters
289            (list ". " ";" " " (string #\tab)
290                  (string #\newline) "}"))
291           (end-pos (search-first triple-delimiters
292                                  trimmed-str)))
293      (unless end-pos
294        (error (make-sparql-parser-condition
295                trimmed-str (original-query construct)
296                "'. ', , ';' ' ', '\\t', '\\n' or '}'")))
297      (let* ((literal-number
298              (read-from-string (subseq trimmed-str 0 end-pos)))
299             (number-type
300              (if (search "." (subseq trimmed-str 0 end-pos))
301                  *xml-double* ;could also be an xml:decimal, since the doucble has
302                               ;a bigger range it shouldn't matter
303                  *xml-integer*)))
304        (unless (numberp literal-number)
305          (error (make-sparql-parser-condition
306                  trimmed-str (original-query construct)
307                  "a valid number of the form '1', '1.3', 1.0e6'")))
308        (list :value literal-number :type number-type
309              :next-query (subseq trimmed-str end-pos))))))
310
311
312(defgeneric parse-base-suffix-pair (construct query-string)
313  (:documentation "A helper function that returns a list of the form
314                  (list :next-query string :value (:value uri :type 'IRI)).")
315  (:method ((construct SPARQL-Query) (query-string String))
316    (let* ((trimmed-str (cut-comment query-string))
317           (result (parse-closed-value trimmed-str construct))
318           (result-uri
319            (if (or (absolute-uri-p (getf result :value))
320                    (not (base-value construct)))
321                (getf result :value)
322                (concatenate-uri (base-value construct)
323                                 (getf result :value))))
324           (next-query (getf result :next-query)))
325      (list :next-query (cut-comment next-query)
326            :value (make-instance 'SPARQL-Triple-Elem
327                                  :elem-type 'IRI
328                                  :value result-uri)))))
329
330
331(defgeneric parse-prefix-suffix-pair(construct query-string)
332  (:documentation "A helper function that returns a list of the form
333                  (list :next-query string :value (:value uri :type 'IRI)).")
334  (:method ((construct SPARQL-Query) (query-string String))
335    (let* ((trimmed-str (cut-comment query-string))
336           (delimiters (list "." ";" "}" "<" " " (string #\newline)
337                             (string #\tab) "#"))
338           (end-pos (search-first delimiters trimmed-str))
339           (elem-str (when end-pos
340                       (subseq trimmed-str 0 end-pos)))
341           (prefix (when elem-str
342                     (string-until elem-str ":")))
343           (suffix (when prefix
344                     (string-after elem-str ":")))
345           (full-url
346            (when (and suffix prefix)
347              (get-prefix construct (concat prefix ":" suffix)))))
348      (unless (and end-pos prefix suffix)
349        (error (make-sparql-parser-condition
350                trimmed-str (original-query construct)
351                "An IRI of the form prefix:suffix")))
352      (unless full-url
353        (error (make-condition
354                'sparql-parser-error
355                :message (format nil "The prefix in \"~a:~a\" is not registered"
356                                 prefix suffix))))
357      (list :next-query (cut-comment
358                         (string-after trimmed-str
359                                       (concat prefix ":" suffix)))
360            :value (make-instance 'SPARQL-Triple-Elem
361                                  :elem-type 'IRI
362                                  :value full-url)))))
363
364
365(defgeneric parse-triple (construct query-string &key last-subject)
366  (:documentation "Parses a triple within a trippel group.")
367  (:method ((construct SPARQL-Query) (query-string String) &key (last-subject nil))
368    (declare (type (or Null SPARQL-Triple-Elem) last-subject))
369    (let* ((trimmed-str (cut-comment query-string))
370           (subject-result (if last-subject ;;is used after a ";"
371                               last-subject
372                               (parse-triple-elem construct trimmed-str)))
373           (predicate-result (parse-triple-elem
374                              construct
375                              (if last-subject
376                                  trimmed-str
377                                  (getf subject-result :next-query))))
378           (object-result (parse-triple-elem construct
379                                             (getf predicate-result :next-query)
380                                             :literal-allowed t)))
381      (add-triple construct
382                  (make-instance 'SPARQL-Triple
383                                 :subject (if last-subject
384                                              last-subject
385                                              (getf subject-result :value))
386                                 :predicate (getf predicate-result :value)
387                                 :object (getf object-result :value)))
388      (let ((tr-str (cut-comment (getf object-result :next-query))))
389        (cond ((string-starts-with tr-str ";")
390               (parse-group construct (subseq tr-str 1)
391                            :last-subject (getf subject-result :value)))
392              ((string-starts-with tr-str ".")
393               (parse-group construct (subseq tr-str 1)))
394              ((string-starts-with tr-str "}")
395               (parse-group construct tr-str)))))))
396
397
398(defgeneric parse-variables (construct query-string)
399  (:documentation "Parses the variables of the SELECT statement
400                   and adds them to the passed construct.")
401  (:method ((construct SPARQL-Query) (query-string String))
402    (let ((trimmed-str (cut-comment query-string)))
403      (if (string-starts-with trimmed-str "WHERE")
404          trimmed-str
405          (if (string-starts-with trimmed-str "*")
406              (progn (add-variable construct "*")
407                     (parse-variables construct (string-after trimmed-str "*")))
408              (let ((result (parse-variable-name construct trimmed-str)))
409                (add-variable construct (getf result :value))
410                (parse-variables construct (getf result :next-query))))))))
411
412
413(defgeneric parse-variable-name (construct query-string &key additional-delimiters)
414  (:documentation "A helper function that parses the first non-whitespace character
415                   in the query. since it must be a variable, it must be prefixed
416                   by a ? or $. The return value is of the form
417                  (:next-query string :value string).")
418  (:method ((construct SPARQL-Query) (query-string String)
419            &key (additional-delimiters))
420    (declare (List additional-delimiters))
421    (let ((trimmed-str (cut-comment query-string))
422          (delimiters (append
423                       (list " " "?" "$" "." (string #\newline) (string #\tab))
424                       additional-delimiters)))
425      (unless (or (string-starts-with trimmed-str "?")
426                  (string-starts-with trimmed-str "$"))
427        (error (make-sparql-parser-condition
428                trimmed-str (original-query construct) "? or $")))
429      (let* ((var-name-end (search-first delimiters (subseq trimmed-str 1)))
430             (var-name
431              (if var-name-end
432                  (subseq trimmed-str 0 (+ 1 var-name-end))
433                  (error (make-sparql-parser-condition
434                          trimmed-str (original-query construct)
435                          "space, newline, tab, ?, ., $ or WHERE"))))
436             (next-query (string-after trimmed-str var-name))
437             (normalized-var-name 
438              (if (<= (length var-name) 1)
439                  (error (make-sparql-parser-condition
440                          next-query (original-query construct)
441                          "a variable name"))
442                  (subseq var-name 1))))
443        (list :next-query next-query :value normalized-var-name)))))
444
445
446(defgeneric parse-base (construct query-string next-fun)
447  (:documentation "Parses the Base statment and sets the corresponding
448                   attribute in the query-construct. Since the BASE statement
449                   may appear in different states the next-fun defines the next
450                   call function that calls the next transitions and states.")
451  (:method ((construct SPARQL-Query) (query-string String) (next-fun Function))
452    (let* ((trimmed-str (cut-comment query-string))
453           (result (parse-closed-value trimmed-str construct)))
454      (setf (base-value construct) (getf result :value))
455      (funcall next-fun construct (getf result :next-query)))))
456
457
458(defgeneric parse-prefixes (construct query-string)
459  (:documentation "Sets the correponding prefix-tuples in the passed object.")
460  (:method ((construct SPARQL-Query) (query-string String))
461    (let ((trimmed-string (cut-comment query-string)))
462      (if (string-starts-with trimmed-string ":")
463          (let ((results
464                 (parse-closed-value (subseq trimmed-string 1) construct)))
465            (add-prefix construct *empty-label* (getf results :value))
466            (parser-start construct (getf results :next-query)))
467          (let* ((label-name
468                  (trim-whitespace-right (string-until trimmed-string ":")))
469                 (next-query-str
470                  (trim-whitespace-left (string-after trimmed-string ":")))
471                 (results (parse-closed-value next-query-str construct)))
472            (when (string= label-name trimmed-string)
473              (error (make-sparql-parser-condition
474                      trimmed-string (original-query construct) ":")))
475            (add-prefix construct label-name (getf results :value))
476            (parser-start construct (getf results :next-query)))))))
Note: See TracBrowser for help on using the repository browser.