Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/encoding/sparql-query.lisp

KindCoveredAll%
expression3605 0.5
branch048 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 ;;; (load #p"patches/sparql-query.lisp")
3
 ;;; (load #p"LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-query.lisp")
4
 
5
 (in-package :org.datagraph.spocq.implementation)
6
 
7
 (:documentation "sse manipulation"
8
  "- generate a sparql request text from the sse for a query
9
     a simple recursive descent sparql text generator based on the sse operators
10
   - read sse expressions in jena encoding")
11
 
12
 (eval-when (:compile-toplevel :load-toplevel :execute)
13
   (import '(cl-user::format-sparql
14
             cl-user::format-sparql-expression
15
             cl-user::format-sparql-order-condition
16
             cl-user::format-sparql-term)
17
           *package*))
18
 
19
 (defparameter *format-sparql.string-delimiter* #\')
20
 
21
 (defun print-sparql (query-expression &optional (stream *standard-output*))
22
   "translate a query sse into a sparql text"
23
   (format-sparql stream query-expression))
24
 
25
 (defun pprint-sparql (query-expression &optional (stream *standard-output*))
26
   "Format a query sse into a sparql text, with line breaks"
27
   (format-sparql stream query-expression t))
28
 
29
 (defgeneric format-sparql (stream object &optional colon at)
30
   (:method ((stream t) (form cons) &optional colon at)
31
     (declare (ignore at))
32
     (if (or *print-pretty* colon)  ;; does not appear necessary to rebind *print-pretty*
33
         (pprint-logical-block (stream form)
34
           (format-sparql-operator stream (first form) (rest form)))
35
         (format-sparql-operator stream (first form) (rest form))))
36
   (:method ((stream t) (term t) &optional colon at)
37
     (declare (ignore colon at))
38
     (format-sparql-term stream term)))
39
 
40
 (defun format-sparql-sse (stream object &rest args)
41
   (apply #'format-sparql stream object args))
42
 
43
 
44
 (defgeneric format-sparql-term (stream object &optional colon at)
45
   (:method ((stream t) (object symbol) &optional colon at)
46
     (declare (ignore colon at))
47
     (if (variable-p object)
48
         (if (undistinguished-variable-p object)
49
             (format stream "_:node~a" (subseq (symbol-name object) 1))
50
             (format stream "?~a" object))
51
         (call-next-method)))
52
   (:method ((stream t) (term cons) &optional colon (at nil))
53
     (declare (ignore colon at))
54
     (if (bgp-form-p term)
55
         (format-sparql stream term)
56
         (error "format-sparql-algebra-term: invalid term expression: ~s" term)))
57
   (:method ((stream t) (object t) &optional colon at)
58
     (declare (ignore colon at))
59
     (let ((*expand-literal-values* nil))
60
       (encode-turtle-object object stream)))
61
   (:method ((stream t) (term property-path) &optional colon at)
62
     (declare (ignore colon at))
63
     (print-object term stream))
64
   (:method ((stream t) (object string) &optional colon at)
65
     ;; encode strings with single ' delimiters in order that the output can be embedded in json
66
     (declare (ignore colon at))
67
     (write-char *format-sparql.string-delimiter* stream)
68
     (write-string object stream)
69
     (write-char *format-sparql.string-delimiter* stream)))
70
 
71
 (defun format-sparql-sse-term (stream object &rest args)
72
   (apply #'format-sparql-term stream object args))
73
 
74
 
75
 (defgeneric format-sparql-expression (stream expression &optional colon at)
76
   (:method ((stream t) (expression null) &optional colon at)
77
     (declare (ignore colon at))
78
     (format stream "()"))
79
   (:method ((stream t) (term symbol) &optional colon at)
80
     (declare (ignore colon at))
81
     (format-sparql-term stream term))
82
   (:method ((stream t) (expression cons) &optional colon at)
83
     (declare (ignore colon at))
84
     (cond ((relational-sse-form-p expression)
85
            (destructuring-bind (op . arguments) expression
86
              (case op
87
                (spocq.a:|in|
88
                 (format stream "in (~{~/format-sparql-expression/~^, ~})" arguments))
89
                (spocq.a:|notin|
90
                 (format stream "not in (~{~/format-sparql-expression/~^, ~})" arguments))
91
                (t
92
                 (format stream "(~/format-sparql-expression/ ~a ~/format-sparql-expression/)"
93
                         (first arguments) op (second arguments))))))
94
           ((conditional-sse-form-p expression)
95
            (destructuring-bind (op . arguments) expression
96
              (case op
97
                ((spocq.a:|not| spocq.a:|!|)
98
                 (format stream "! ~/format-sparql-expression/" (first arguments)))
99
                (t
100
                 ;; permit multiple arguments by unrolling into binary comparisons
101
                 (cond ((rest arguments)
102
                        (format stream "~/format-sparql-expression/ ~a "
103
                                (first arguments)
104
                                (ecase op
105
                                  ((spocq.a:|and| spocq.a:|&&|) "&&")
106
                                  ((spocq.a:|or| spocq.a:\|\|) "||")))
107
                        (format-sparql-expression stream (cons op (rest arguments))))
108
                       (t
109
                        (format-sparql-expression stream (first arguments))))))))
110
           ((arithmetic-sse-form-p expression)
111
            (destructuring-bind (op . arguments) expression
112
              (cond ((rest arguments)
113
                     (format stream "(~/format-sparql-expression/ ~a ~/format-sparql-expression/)"
114
                                (first arguments) op (second arguments)))
115
                    (t
116
                     (format stream "~a ~/format-sparql-expression/"
117
                                op (first arguments))))))
118
           ((eq (first expression) 'spocq.a:|exprlist|)
119
            (format-sparql-expression stream `(spocq.a:|&&| ,@(rest expression))))
120
           ((built-in-sse-form-p expression)
121
            (destructuring-bind (op . arguments) expression
122
              (format stream "( ~a(~{~/format-sparql-expression/~^, ~}))"
123
                      op arguments)))
124
           ((functional-sse-form-p expression)
125
            (destructuring-bind (op . arguments) expression
126
              (format stream "( ~/format-sparql-term/(~{~/format-sparql-expression/~^, ~}))"
127
                      op arguments)))
128
           (t
129
            (format stream "(~{~/format-sparql-expression/~^, ~})" expression))))
130
   (:method ((stream t) (term t) &optional colon at)
131
     (format-sparql-term stream term colon at)))
132
 ;;; (format-sparql-expression *trace-output* '(spocq.a:|and| (spocq.a:= 1 2) (spocq.a:|=| 3 4)))
133
 
134
 (defun format-sparql-sse-expression (stream object &rest args)
135
   (apply #'format-sparql-expression stream object args))
136
 
137
 
138
 (defgeneric format-sparql-order-condition (stream condition &optional colon at)
139
   (:method ((stream t) (condition t) &optional colon at)
140
     (declare (ignore colon at))
141
     (format-sparql-term stream condition))
142
   (:method ((stream t) (condition cons) &optional colon at)
143
     (declare (ignore colon at))
144
     (if (order-modifier-form-p condition)
145
         (destructuring-bind (modifier expression) condition
146
           (format stream "~a (~/format-sparql-expression/)" modifier expression))
147
         (format-sparql-expression stream condition))))
148
 
149
 
150
 (defun select-form-operator-p (operator)
151
   (get operator 'spocq.a:|select|))
152
 
153
 (defun (setf select-form-operator-p) (value operator)
154
   (setf (get operator 'spocq.a:|select|) value))
155
 (setf (select-form-operator-p 'spocq.a:|distinct|) t)
156
 (setf (select-form-operator-p 'spocq.a:|order|) t)
157
 (setf (select-form-operator-p 'spocq.a:|project|) t)
158
 (setf (select-form-operator-p 'spocq.a:|reduced|) t)
159
 (setf (select-form-operator-p 'spocq.a:|select|) t)
160
 (setf (select-form-operator-p 'spocq.a:|slice|) t)
161
 
162
 
163
 
164
 (macrolet ((def-format-method (operator lambda-list &body body)
165
              `(defmethod format-sparql-operator ((.stream. t) (operator (eql ',operator)) parameters)
166
                 (destructuring-bind ,lambda-list (cons .stream. parameters)
167
                   ,@body))))
168
 
169
   (def-format-method spocq.a:|ask| (stream solution-field)
170
     (format stream "ASK ~/format-sparql/  "
171
             solution-field))
172
   
173
   
174
   (def-format-method spocq.a:|bgp| (stream &rest triples)
175
     (format stream "{~:I~{ ~/format-sparql/~^ .~_~} }" triples))
176
 
177
   (def-format-method spocq.a:|bindings| (stream values variables)
178
     (format stream "VALUES ~:I(")
179
     (loop for variable in variables
180
               do (progn (write-char #\space stream)
181
                         (format-sparql-term stream variable)))
182
     (format stream ")~_ {~:I~{(~{~/format-sparql-term/~^ ~})~^ ~_~}}" values))
183
   
184
   (def-format-method spocq.a:|construct| (stream solution-field triples)
185
     (format stream "CONSTRUCT {~:I~{ ~/format-sparql/~^ . ~_~} }~_ ~/format-sparql/"
186
             triples solution-field))
187
   
188
   (def-format-method spocq.a:|describe| (stream solution-field subjects)
189
     (format stream "DESCRIBE ~:I~{ ~/format-sparql-term/~^ ~_~}~@[ ~_~/format-sparql/~]"
190
             subjects solution-field))
191
   
192
   (def-format-method spocq.a:|diff| (stream solution-field1 solution-field2 test-expression)
193
     (format stream "{ ~:I~/format-sparql/ ~_DIFF ~_~/format-sparql/~@{ ~_~/format-sparql-expression/~} }"
194
             solution-field1 solution-field2 test-expression))
195
   
196
   (def-format-method spocq.a:|distinct| (stream solution-field &rest args)
197
     (if (select-form-operator-p (first solution-field))
198
       (format-sparql stream (append solution-field '(:distinct t) args))
199
       (format-sparql stream `(spocq.a:|select| ,solution-field * :distinct t ,@args))))
200
 
201
   (def-format-method spocq.a:|extend| (stream field-expression variable value-expression)
202
     (format stream "~/format-sparql/ ~_BIND (~/format-sparql-expression/) AS"
203
             field-expression value-expression)
204
     (format-sparql-term stream variable)
205
     (write-char #\) stream))
206
   
207
   (def-format-method spocq.a:|filter| (stream solution-field test-expression)
208
     (case (first test-expression)
209
       (spocq.a:|exprlist| (format stream "{ ~:I~/format-sparql/ ~{~_FILTER ~:I~/format-sparql-expression/ . ~}}"
210
                                   solution-field (rest test-expression)))
211
       (t (format stream "{ ~:I~/format-sparql/ FILTER ~_~/format-sparql-expression/ }"
212
                  solution-field test-expression))))
213
   
214
   (def-format-method spocq.a:|graph| (stream name group-graph-pattern)
215
     (format stream "GRAPH ~:I~/format-sparql-term/ ~/format-sparql/" name group-graph-pattern))
216
   
217
   (def-format-method spocq.a:|join| (stream solution-field1 solution-field2)
218
     (format stream "{ ~:I~/format-sparql/ ~_~/format-sparql/ }" solution-field1 solution-field2))
219
   
220
   (def-format-method spocq.a:|leftjoin| (stream solution-field1 solution-field2 &key test)
221
     (format stream "{ ~:I~/format-sparql/ ~_OPTIONAL ~_~/format-sparql/ }" solution-field1 solution-field2)
222
     (when test 
223
       (format stream "~_FILTER ~:I~/format-sparql-expression/" test))
224
     (write-string "}" stream))
225
 
226
   (def-format-method spocq.a:|minus| (stream solution-field1 solution-field2)
227
     (format stream "{ ~:I~/format-sparql/ ~_MINUS ~_~/format-sparql/ }" solution-field1 solution-field2))
228
 
229
   (def-format-method spocq.a:|null| (stream dimensions)
230
     (declare (ignore dimensions))
231
     (format stream "{ }"))
232
   
233
   (def-format-method spocq.a:|order| (stream solution-field order-expression-list)
234
     (if (select-form-operator-p (first solution-field))
235
       (format-sparql stream (append solution-field `(:order ,order-expression-list)))
236
       (format-sparql stream `(spocq.a:|select| ,solution-field * :order ,order-expression-list))))
237
   
238
   (def-format-method spocq.a:|project| (stream solution-field variables &rest args)
239
     (if (select-form-operator-p (first solution-field))
240
       (format-sparql stream (append solution-field args))
241
       (format-sparql stream `(spocq.a:|select| ,solution-field ,variables ,@args))))
242
   
243
   (def-format-method spocq.a:|quad| (stream s p o c)
244
     (format stream "~/format-sparql-term/ ~/format-sparql-term/ ~/format-sparql-term/ ~/format-sparql-term/"
245
             s p o c))
246
   
247
   (def-format-method spocq.a:|reduced| (stream solution-field &rest args)
248
     (if (select-form-operator-p (first solution-field))
249
       (format-sparql stream (append solution-field '(:reduced t) args))
250
       (format-sparql stream `(spocq.a:|select| ,solution-field * :reduced t ,@args))))
251
 
252
   (def-format-method spocq.a:|revision| (stream name group-graph-pattern &rest args)
253
     (let ((sip-group-graph-pattern (when (consp (first args)) (pop args)))
254
           (location (typecase name
255
                       (t name))))
256
       (if sip-group-graph-pattern
257
           (format stream "{~:I~/format-sparql/} ~_REVISION ~:I~/format-sparql-term/~_ ~/format-sparql/"
258
                   sip-group-graph-pattern
259
                   location group-graph-pattern)
260
           (format stream "REVISION ~:I~/format-sparql-term/~_ ~/format-sparql/"
261
                   location group-graph-pattern))))
262
   
263
   (def-format-method spocq.a:|select| (stream solution-field variables &rest args &key count end offset start distinct reduced order)
264
     (declare (ignore count end offset start))
265
     (let ((having ())
266
           (group-by ()))
267
       (when (consp variables)
268
         (loop (if (keywordp (first variables))
269
                   (ecase (pop variables)
270
                     (:having (setf having (pop variables)))
271
                     (:group-by (setf group-by (pop variables))))
272
                   (return))))
273
       (flet ((format-variables (variables)
274
                (loop for variable in variables
275
                  do (progn (write-char #\space stream)
276
                       (typecase variable
277
                         (cons (destructuring-bind (variable expression) variable
278
                                 (format stream "(~/format-sparql-expression/ as ~/format-sparql-term/)"
279
                                         expression variable)))
280
                         (t (format-sparql-term stream variable)))))))
281
       (destructuring-bind (&key start end &allow-other-keys) (apply #'canonicalize-algebra-arguments
282
                                                                     :allow-other-keys t
283
                                                                     args)
284
         (format stream "~:ISELECT~:[~; DISTINCT~]~:[~; REDUCED~]"
285
                 distinct reduced)
286
         (if (consp variables)
287
             (format-variables variables)
288
             (format stream " *"))
289
         (if (bgp-form-p solution-field)
290
             (format stream "~_ WHERE ~/format-sparql/" solution-field)
291
             (format stream "~_ WHERE { ~/format-sparql/}" solution-field))
292
         (when group-by (format stream " ~_GROUP BY ") (format-variables group-by))
293
         (when having (format stream "~_ HAVING ~/format-sparql-expression/" having))
294
         (when order (format stream "~_ ORDER BY ~{~/format-sparql-order-condition/~^ ~}" order))
295
         (when start (format stream "~_ OFFSET ~s" start))
296
         (when end (format stream "~_ LIMIT ~s" (if start (- end start) end)))))))
297
   
298
   (def-format-method spocq.a:|service| (stream name group-graph-pattern &rest args)
299
     (let ((sip-group-graph-pattern (when (consp (first args)) (pop args)))
300
           (location (typecase name
301
                       ;(resource-reference (resource-api-resource name))
302
                       (t name))))
303
       (destructuring-bind (&key silent query-text &allow-other-keys) args
304
         (declare (ignore query-text))
305
         (if sip-group-graph-pattern
306
             (format stream "{~:I~/format-sparql/} ~_SERVICE~:[~; silent~] ~:I~/format-sparql-term/~_ ~/format-sparql/"
307
                     sip-group-graph-pattern
308
                     silent location group-graph-pattern)
309
             (format stream "SERVICE~:[~; silent~] ~:I~/format-sparql-term/~_ ~/format-sparql/"
310
                     silent location group-graph-pattern)))))
311
   
312
   (def-format-method spocq.a:|slice| (stream solution-field &rest args)
313
     (if (select-form-operator-p (first solution-field))
314
       (format-sparql stream (append  solution-field args))
315
       (format-sparql stream `(spocq.a:|select| ,solution-field * ,@args))))
316
   
317
   (def-format-method spocq.a:|table| (stream &optional dimensions)
318
     (declare (ignore dimensions))
319
     (write-string "{ }" stream))
320
   
321
   (def-format-method spocq.a:|triple| (stream s p o)
322
     (format stream "~/format-sparql-term/ ~/format-sparql-term/ ~/format-sparql-term/"
323
             s p o))
324
   
325
   (def-format-method spocq.a:|union| (stream solution-field1 solution-field2)
326
     (format stream "{ ~:I ~/format-sparql/ ~_UNION ~/format-sparql/}"
327
             solution-field1 solution-field2))
328
   )
329
 
330
 
331
 ;;; input
332
 
333
 (defmethod receive-message ((stream stream) (content-type mime:application/sparql-query+sse) &key)
334
   (log-debug "receive-message : (~s ~s)" stream content-type)
335
   (parse-sparql-sse stream))
336
 
337
 (defmethod receive-message ((stream stream) (content-type mime:application/vnd.dydra.sparql-query-algebra) &key)
338
   "Given a STREAM with application/vnd.dydra.sparql-query-algebra CONTENT-TYPE, read a query
339
  as an s-expression."
340
   
341
   (log-debug "receive-message : (~s ~s)" stream content-type)
342
   (parse-sparql-sse stream))
343
 
344
 (defun parse-sparql-sse (stream)
345
   (let* ((*package* *algebra-package*)
346
          (*readtable* *sse-readtable*))
347
     (flet ((guarded-op (function)
348
              (handler-case (funcall function)
349
                (error (condition)
350
                       (log-error "invalid sparql message body: ~a" condition)
351
                       (spocq.e::message-syntax-error :expression nil
352
                                                      :condition condition)))))
353
       (let ((sse-expression
354
              (guarded-op #'(lambda ()
355
                              (labels ((algebra-symbol-p (symbol)
356
                                         (or (eq (nth-value 1 (find-symbol (symbol-name symbol) *algebra-package*))
357
                                                 :external)
358
                                             (eq (symbol-package symbol) *variable-package*)))
359
                                       (validate (form)
360
                                         (typecase form
361
                                           (symbol (assert (algebra-symbol-p form) ()
362
                                                           "Invalid algebra term: ~s" form)
363
                                                   form)
364
                                           (cons (map nil #'validate form) form)
365
                                           (t form))))
366
                                (validate (read stream)))))))
367
         (values (first sse-expression) ; operation
368
                 (list :query-expression nil
369
                       :sse-expression sse-expression))))))
370
 ;;;
371
 ;;; various sparql encodings
372
 
373
 
374
 (defmethod send-response-message ((operation t) (message-body cons) (stream t) (content-type mime:application/sparql-query))
375
   "Given a MESSAGE, and a STREAM with application/sparql-query CONTENT-TYPE, encode as a sparql request"
376
   (when *encoding-trace-output*
377
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
378
   (let ((*print-right-margin* 80) (*print-miser-width* 5))
379
     (format-sparql stream message-body))
380
   (fresh-line stream))
381
 
382
 (defmethod send-response-message (operation (message-body solution-generator) (stream stream) (content-type mime:application/sparql-query))
383
   "given the (possibly completed) solution generator, delegate to the symbolic expression method"
384
   (send-response-message operation (query-sse-expression *task*) stream content-type))
385
 
386
 
387
 #|
388
 (format-sparql *trace-output* (parse-sparql "select * where {?s ?p ?o}"))
389
 (format-sparql *trace-output* (parse-sparql "select * where {?s ?p ?o filter (?o = 1)}"))
390
 ;;; any public repository
391
 ;;; lines split according to length
392
 ;;; many
393
 /usr/bin/curl -v "-X" "POST" "--silent" "-H" "Accept: application/sparql-query" \
394
   "--data-binary" "@-" -H "Content-Type: application/sparql-query"  \
395
   'https://stage.dydra.com:81/jhacker/foaf/sparql?user_id=testgrammar' <<EOF
396
 select * where {?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o}
397
 EOF
398
 
399
 ;;; two
400
 /usr/bin/curl -v "-X" "POST" "--silent" "-H" "Accept: application/sparql-query" \
401
   "--data-binary" "@-" -H "Content-Type: application/sparql-query"  \
402
   'https://stage.dydra.com:81/jhacker/foaf/sparql?user_id=testgrammar' <<EOF
403
 select * where {?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o}
404
 EOF
405
 
406
 ;;; one
407
 /usr/bin/curl -v "-X" "POST" "--silent" "-H" "Accept: application/sparql-query" \
408
   "--data-binary" "@-" -H "Content-Type: application/sparql-query"  \
409
   'https://stage.dydra.com:81/jhacker/foaf/sparql?user_id=testgrammar' <<EOF
410
 select * where {?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o . ?s ?p ?o}
411
 EOF
412
 
413
 (pprint-sparql (parse-sparql "select (count(?o) as ?count) where {?s ?p ?o} group by ?s ?p order by ?p"))
414
 |#