source: trunk/src/TM-SPARQL/sparql_parser.lisp

Last change on this file was 977, checked in by lgiessmann, 13 years ago

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