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

KindCoveredAll%
expression134912 14.7
branch1678 20.5
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-algebra.lisp")
3
 
4
 (in-package :org.datagraph.spocq.implementation)
5
 
6
 
7
 #+(or)
8
 (with-compilation-unit ()
9
   (load #p"patches/mime-types.lisp")
10
   (load #p"patches/graph-store.lisp")
11
   (load #p"patches/response-functions.lisp")
12
   (load #p"patches/sparql-query-algebra.lisp"))
13
 
14
 (:documentation "generate sparql abstract algebra"
15
  "This implements four operators to print sparql sse exressions as the equivalent abstract algebra expression:
16
  - print-sparql-algebra
17
  - pprint-sparql-algebra
18
  - format-sparql-algebra
19
  - format-sparql-algebra-operator
20
  The first three provide an interface analogous to print/format while the last is the concrete implementation
21
  for the respective form.")
22
 
23
 (eval-when (:compile-toplevel :load-toplevel :execute)
24
   (import '(cl-user::format-sparql-algebra
25
             cl-user::format-sparql-algebra-expression
26
             cl-user::format-sparql-algebra-group-expression
27
             cl-user::format-sparql-algebra-order
28
             cl-user::format-sparql-algebra-term)
29
           *package*))
30
 
31
 (defparameter *aggregation-index* 0)
32
 (defparameter *group-index* 0)
33
 
34
 (defparameter *update-sequence* nil
35
   "Binds the sequence of update operations dynamically to permit the format process
36
  to encode them as nested combinations.")
37
 (defparameter *format-sparql-algebra.string-delimiter* #\')
38
 
39
 (defun print-sparql-algebra (query-expression &optional (stream *standard-output*))
40
   "Format a query sse in the form of the recommendation sparql algebra"
41
   (format-sparql-algebra stream query-expression nil)
42
   query-expression)
43
 
44
 (defun pprint-sparql-algebra (query-expression &optional (stream *standard-output*))
45
   "Format a query sse in the form of the recommendation sparql algebra, with line breaks"
46
   (format-sparql-algebra stream query-expression t)
47
   query-expression)
48
 
49
 (defun query-algebra-graph-term (graph-designator)
50
   (case graph-designator
51
     ((nil :default) |urn:dydra|:|default|)
52
     ((:all t) |urn:dydra|:|all|)
53
     (:named |urn:dydra|:|named|)
54
     (t graph-designator)))
55
 
56
 (defgeneric format-sparql-algebra (stream object &optional colon at)
57
   (:method ((stream stream) (form cons) &optional colon at)
58
     (declare (ignore at))
59
     (if (or *print-pretty* colon)  ;; does not appear necessary to rebind *print-pretty*
60
         (pprint-logical-block (stream form)
61
           (format-sparql-algebra-operator stream (first form) (rest form)))
62
         (format-sparql-algebra-operator stream (first form) (rest form))))
63
   (:method ((form cons) (stream stream) &optional colon at)
64
     (format-sparql-algebra stream form colon at))
65
   (:method ((stream t) (term t) &optional colon at)
66
     (declare (ignore colon at))
67
     (format-sparql-algebra-term stream term)))
68
 
69
 
70
 (defgeneric format-sparql-algebra-term (stream object &optional colon at)
71
   (:method ((stream t) (term symbol) &optional colon (at nil))
72
     (declare (ignore colon))
73
     (cond ((string-equal term "*")
74
            (write-string "*" stream))
75
           ((variable-p term)
76
            (format stream "?~a" term))
77
           ((eq (symbol-package term) *algebra-package*)
78
            (write-string (symbol-name term) stream))
79
           (t
80
            (let ((*expand-literal-values* at))
81
              (encode-turtle-object term stream)))))
82
   (:method ((stream t) (term cons) &optional colon (at nil))
83
     (declare (ignore colon at))
84
     (if (bgp-form-p term)
85
         (format-sparql-algebra stream term)
86
         (error "format-sparql-algebra-term: invalid term expression: ~s" term)))
87
   (:method ((stream t) (term t) &optional colon (at nil))
88
     (declare (ignore colon))
89
     (let ((*expand-literal-values* at))
90
       (encode-turtle-object term stream)))
91
   (:method ((stream t) (term property-path) &optional colon (at nil))
92
     (declare (ignore colon at))
93
     (print-object term stream))
94
   (:method ((stream t) (object string) &optional colon at)
95
     ;; encode strings with single ' delimiters in order that the output can be embedded in json
96
     (declare (ignore colon at))
97
     (write-char *format-sparql-algebra.string-delimiter* stream)
98
     (write-string object stream)
99
     (write-char *format-sparql-algebra.string-delimiter* stream)))
100
     
101
 (defun format-sparql-algebra-group-expression (stream expression &optional (colon nil) (at nil))
102
   (typecase expression
103
     (cons
104
      (if (variable-p (first expression))
105
          (format stream "(~/format-sparql-algebra-term/, ~/format-sparql-algebra-expression/)"
106
                  (first expression) (second expression))
107
          (format-sparql-algebra-expression stream expression colon at)))
108
     (t
109
      (format-sparql-algebra-expression stream expression colon at))))
110
      
111
 (defgeneric format-sparql-algebra-expression (stream expression &optional colon at)
112
   (:method ((stream t) (expression null) &optional colon at)
113
     (declare (ignore colon at))
114
     (format stream "()"))
115
   (:method ((stream t) (term symbol) &optional colon (at nil))
116
     (declare (ignore colon))
117
     (cond ((string-equal term "*")
118
            (write-string "*" stream))
119
           ((variable-p term)
120
            (format stream "?~a" term))
121
           ((eq (symbol-package term) *algebra-package*)
122
            (write-string (symbol-name term) stream))
123
           (t
124
            (let ((*expand-literal-values* at))
125
              (encode-turtle-object term stream)))))
126
   (:method ((stream t) (expression cons) &optional colon at)
127
     (declare (ignore colon at))
128
     (cond ((conditional-sse-form-p expression)
129
            (destructuring-bind (op . arguments) expression
130
              (case op
131
                ((spocq.a:|not| spocq.a:|!|)
132
                 (format stream "! ~/format-sparql-algebra-expression/" (first arguments)))
133
                (t
134
                 (cond ((rest arguments)
135
                        (format stream "~/format-sparql-algebra-expression/ ~a "
136
                                (first arguments)
137
                                (ecase op
138
                                  ((spocq.a:|and| spocq.a:|&&|) "&&")
139
                                  ((spocq.a:|or| spocq.a:\|\|) "||")))
140
                        (format-sparql-algebra-expression stream (cons op (rest arguments))))
141
                       (t
142
                        (format-sparql-algebra-expression stream (first arguments))))))))
143
           ((arithmetic-sse-form-p expression)
144
            (destructuring-bind (op . arguments) expression
145
              (cond ((rest arguments)
146
                     (format stream "(~/format-sparql-algebra-expression/ ~a ~/format-sparql-algebra-expression/)"
147
                                (first arguments) op (second arguments)))
148
                    (t
149
                     (format stream "~a ~/format-sparql-algebra-expression/"
150
                                op (first arguments))))))
151
           ((relational-sse-form-p expression)
152
            (destructuring-bind (op . arguments) expression
153
              (case op
154
                (spocq.a:|in|
155
                 (format stream "in (~{~/format-sparql-algebra-expression/~^, ~})" arguments))
156
                (spocq.a:|notin|
157
                 (format stream "not in (~{~/format-sparql-algebra-expression/~^, ~})" arguments))
158
                (t
159
                 (format stream "(~/format-sparql-algebra-expression/ ~a ~/format-sparql-algebra-expression/)"
160
                         (first arguments) op (second arguments))))))
161
           ((eq (first expression) 'spocq.a:|exprlist|)
162
            (format-sparql-algebra-expression stream `(spocq.a:|&&| ,@(rest expression))))
163
           ((or (built-in-sse-form-p expression) 
164
                (aggregate-expression-p expression))
165
            (destructuring-bind (op . arguments) expression
166
              (format stream "~a(~{~/format-sparql-algebra-expression/~^, ~}) "
167
                      op arguments)))
168
           ((functional-sse-form-p expression)
169
            (destructuring-bind (op . arguments) expression
170
              (format stream "~/format-sparql-algebra-term/(~{~/format-sparql-algebra-expression/~^, ~})"
171
                      op arguments)))
172
           (t
173
            (format stream "(~{~/format-sparql-algebra-expression/~^, ~})" expression))))
174
   (:method ((stream t) (term t) &optional colon (at nil))
175
     (declare (ignore colon))
176
     (let ((*expand-literal-values* at))
177
       (encode-turtle-object term stream))))
178
 
179
 (defgeneric format-sparql-algebra-order (stream expression &optional colon at)
180
   (:method ((stream t) (expression list) &optional colon at)
181
     (declare (ignore colon at))
182
     (if (consp (first expression))
183
       (format stream "~{ ~/format-sparql-algebra-order/~}" expression)
184
       (cond ((variable-p (first expression))
185
              (assert (null (rest expression)) () "Anomalous order expression: ~s" expression)
186
              (format stream "?~a" (first expression)))
187
             ((order-modifier-form-p expression)
188
              (destructuring-bind (modifier expression) expression
189
              (format stream "~a (~/format-sparql-algebra-order/)" modifier expression)))
190
             (t
191
              (format-sparql-algebra-expression stream expression)))))
192
   (:method ((stream t) (expression t) &optional colon at)
193
     (declare (ignore colon at))
194
     (format-sparql-algebra-expression stream expression)))
195
 
196
 
197
 (macrolet ((defformat (operator lambda-list &body body)
198
              `(defmethod format-sparql-algebra-operator ((.stream. t) (operator (eql ',operator)) parameters)
199
                   (destructuring-bind ,lambda-list (cons .stream. parameters)
200
                     ,@body))))
201
 
202
   (defformat spocq.a:|add| (stream from-graph to-graph)
203
     (format stream "OpAdd(~:I~/spocq.i::format-gs/, ~_~/format-sparql-algebra-term/, ~_~/format-sparql-algebra-term/)"
204
             *update-sequence* from-graph to-graph))
205
 
206
   (defformat spocq.a::|aggregatejoin| (stream &rest forms)
207
     (format stream "AggregationJoin(~:I~{~/format-sparql-algebra/~^, ~_~})" forms))
208
 
209
   (defformat spocq.a::|aggregation| (stream expression operator scalar-vars form &optional aggregation-index group-index)
210
     (format stream "Aggregation(~:I~@[??agg~d: ~]~/format-sparql-algebra-expression/, ~:@(~/format-sparql-algebra-term/~), ~_~:[{}~;~:*~_~/format-sparql-algebra-term/~], ~:[G~@[~d~]~;~_G~@[~d~]=~/format-sparql-algebra/~])"
211
             aggregation-index expression operator scalar-vars
212
             form group-index form))
213
   
214
   (defformat spocq.a:|ask| (stream solution-field)
215
     (format stream "Ask(~/format-sparql-algebra/)"
216
             solution-field))
217
   
218
   (defformat spocq.a:|bgp| (stream &rest triples)
219
     (format stream "BGP(~:I~{ ~/format-sparql-algebra/~^ .~_~})" triples))
220
 
221
   (defformat spocq.a:|bindings| (stream values-list variables)
222
     (format stream "ToMultiSet({~:I")
223
     (loop for values-list on values-list
224
       for values = (first values-list)
225
       do (format stream "{~{(~/format-sparql-algebra-term/, ~/format-sparql-algebra-term/)~^, ~}}"
226
                  (loop for value in values for variable in variables
227
                    append (list variable value)))
228
       when (rest values-list)
229
       do (format stream ", ~_"))
230
     (write-string "})" stream))
231
 
232
   (defformat spocq.a:|clear| (stream graph)
233
     (format stream "OpClear(~:I~/spocq.i::format-gs/, ~_~/format-sparql-algebra-term/)"
234
             *update-sequence* (query-algebra-graph-term graph)))
235
 
236
   (defformat spocq.a:|copy| (stream from-graph to-graph)
237
     (format stream "OpCopy(~:I~/spocq.i::format-gs/, ~_~/format-sparql-algebra-term/, ~_~/format-sparql-algebra-term/)"
238
             *update-sequence* from-graph to-graph))
239
 
240
   (defformat spocq.a:|create| (stream graph)
241
     (format stream "OpClear(~:I~/spocq.i::format-gs/, ~_~/format-sparql-algebra-term/)"
242
             *update-sequence* graph))
243
 
244
   (defformat spocq.a:|construct| (stream solution-field triples)
245
     (format stream "Construct(~:I{~{ ~/format-sparql-algebra/~^ . ~_~} }, ~_~/format-sparql-algebra/)"
246
             triples solution-field))
247
 
248
   (defformat spocq.a:|deleteData| (stream data)
249
     (format stream "OpDeleteData(~:I~/spocq.i::format-gs/, {~:I~{~/format-sparql-algebra/~^ . ~_~}})"
250
             *update-sequence* data))
251
 
252
   (defformat spocq.a:|deleteWhere| (stream data)
253
     (format stream "OpDeleteWhere(~:I~/spocq.i::format-gs/, {~:I~{~/format-sparql-algebra/~^ . ~_~}})"
254
             *update-sequence* data))
255
   
256
   (defformat spocq.a:|describe| (stream solution-field subjects)
257
     (format stream "Describe(~:I(~{~/format-sparql-algebra-term/~^, ~})~@[, ~_~/format-sparql-algebra/~])"
258
             subjects solution-field))
259
   
260
   (defformat spocq.a:|diff| (stream solution-field1 solution-field2 test-expression)
261
     (format stream "Diff(~:I~/format-sparql-algebra/, ~_~/format-sparql-algebra/~@[, ~_~/format-sparql-algebra-expression/~])"
262
             solution-field1 solution-field2 test-expression))
263
   
264
   (defformat spocq.a:|distinct| (stream solution-field &rest args)
265
     (declare (ignore args))
266
     (format stream "Distinct(~/format-sparql-algebra/)"
267
             solution-field))
268
 
269
   (defformat spocq.a:|drop| (stream graph)
270
     (format stream "OpClear(~:I~/spocq.i::format-gs/, ~_~/format-sparql-algebra-term/)"
271
             *update-sequence* (query-algebra-graph-term graph)))
272
 
273
   (defformat spocq.a:|extend| (stream solution-field variable expression &rest args)
274
     (declare (ignore args))
275
     (format stream "Extend(~:I~/format-sparql-algebra/, ~_~/format-sparql-algebra-term/, ~_~/format-sparql-algebra-expression/)"
276
             solution-field variable expression))
277
   
278
   (defformat spocq.a:|filter| (stream solution-field test-expression)
279
     (format stream "Filter(~:I~/format-sparql-algebra-expression/, ~_~/format-sparql-algebra/)"
280
             test-expression solution-field))
281
   
282
   (defformat spocq.a:|graph| (stream name group-graph-pattern)
283
     (format stream "Graph(~:I~/format-sparql-algebra-term/, ~_~/format-sparql-algebra/)" name group-graph-pattern))
284
 
285
   (defformat spocq.a::|group| (stream group-expressions solution-field)
286
     (format stream "Group(~:I(~{~/format-sparql-algebra-group-expression/~^, ~_~}), ~_~/format-sparql-algebra/)"
287
             group-expressions solution-field))
288
 
289
   (defformat spocq.a::|having| (stream solution-field test-expression)
290
     (format stream "Filter(~:I~/format-sparql-algebra-expression/, ~_~/format-sparql-algebra/)"
291
             test-expression solution-field))
292
   
293
   (defformat spocq.a:|insertData| (stream data)
294
     (format stream "OpInsertData(~:I~/spocq.i::format-gs/, {~:I~{~/format-sparql-algebra/~^ . ~_~}})"
295
             *update-sequence* data))
296
 
297
   (defformat spocq.a:|join| (stream solution-field1 solution-field2)
298
     (format stream "Join(~:I~/format-sparql-algebra/, ~_~/format-sparql-algebra/)" solution-field1 solution-field2))
299
   
300
   (defformat spocq.a:|leftjoin| (stream solution-field1 solution-field2 &key test)
301
     (format stream "LeftJoin(~:I~/format-sparql-algebra/, ~_~/format-sparql-algebra/~@[, ~_~/format-sparql-algebra-expression/~])"
302
             solution-field1 solution-field2 test))
303
 
304
   (defformat spocq.a:|load| (stream location graph &key verbose)
305
     (declare (ignore verbose))
306
     (format stream "OpLoad(~:I~/spocq.i::format-gs/, ~:I~/format-sparql-algebra-term/~@[, ~_~/format-sparql-algebra-term/~])"
307
             *update-sequence* location graph))
308
 
309
   (defformat spocq.a:|minus| (stream solution-field1 solution-field2)
310
     (format stream "Minus(~:I~/format-sparql-algebra/, ~_~/format-sparql-algebra/)"
311
             solution-field1 solution-field2))
312
 
313
   (defformat spocq.a:|modify| (stream solution-field &rest args &key delete insert with graphs named-graphs)
314
     (declare (ignore delete insert with graphs named-graphs))
315
     (destructuring-bind (expanded-field &key delete insert)
316
                         (apply #'macroexpand-modify solution-field args)
317
       (format stream "OpDeleteInsert(~:I~/spocq.i::format-gs/, {}, {~:I~{~/format-sparql-algebra/~^ . ~_~}},{~:I~{~/format-sparql-algebra/~^ . ~_~}}, ~_~/format-sparql-algebra/)"
318
               *update-sequence* delete insert expanded-field)))
319
 
320
   (defformat spocq.a:|move| (stream from-graph to-graph)
321
     (format stream "OpMove(~:I~/spocq.i::format-gs/, ~_~/format-sparql-algebra-term/, ~_~/format-sparql-algebra-term/)"
322
             *update-sequence* from-graph to-graph))
323
 
324
   (defformat spocq.a:|null| (stream dimensions)
325
     (declare (ignore dimensions))
326
     (format stream "Table()")) ;; or {{}}
327
   
328
   (defformat spocq.a:|order| (stream solution-field order-expression-list)
329
     (format stream "OrderBy(~/format-sparql-algebra/, ~/format-sparql-algebra-order/)"
330
             solution-field order-expression-list))
331
   
332
   (defformat spocq.a:|project| (stream solution-field variables &rest args)
333
     (declare (ignore args))
334
     (if (consp variables)
335
         (format stream "Project(~:I~/format-sparql-algebra/, ~_{~{~/format-sparql-algebra-expression/~^, ~}})"
336
                 solution-field variables)
337
         (format stream "Project(~:I~/format-sparql-algebra/, *)"
338
                 solution-field)))
339
   
340
   (defformat spocq.a:|quad| (stream s p o c)
341
     (format stream "~/format-sparql-algebra-term/ ~/format-sparql-algebra-term/ ~/format-sparql-algebra-term/ ~/format-sparql-algebra-term/"
342
             s p o c))
343
   
344
   (defformat spocq.a:|reduced| (stream solution-field &rest args)
345
     (declare (ignore args))
346
     (format stream "Reduced(~/format-sparql-algebra/)"
347
             solution-field))
348
 
349
   (defformat spocq.a:|revision| (stream name group-graph-pattern &rest args)
350
     (let ((sip-group-graph-pattern (when (consp (first args)) (pop args)))
351
           (location (typecase name
352
                       (t name))))
353
       (if sip-group-graph-pattern
354
           (format stream "Join(~:I~/format-sparql-algebra/, ~_Revision(~:I~/format-sparql-algebra-term/, ~_~/format-sparql-algebra/))"
355
                   sip-group-graph-pattern location group-graph-pattern)
356
           (format stream "Revision(~:I~/format-sparql-algebra-term/, ~_~/format-sparql-algebra/)"
357
                   name group-graph-pattern))))
358
   
359
   (defformat spocq.a:|select| (stream solution-field variables &rest args &key count end offset start distinct reduced order)
360
     (declare (ignore count end offset start))
361
     (let ((having ())
362
           (group-by ()))
363
       (when (consp variables)
364
         (loop (if (keywordp (first variables))
365
                   (ecase (pop variables)
366
                     (:having (setf having (pop variables)))
367
                     (:group-by (setf group-by (pop variables))))
368
                   (return))))
369
       (destructuring-bind (&key start end &allow-other-keys) (apply #'canonicalize-algebra-arguments args)
370
         (let ((form solution-field))
371
           (when (consp variables)
372
             (cond (group-by
373
                    (let ((projection-variables ())
374
                          (group-expressions ())
375
                          (group-variables ())
376
                          (group-index (incf *group-index*)))
377
                      (loop for variable in group-by
378
                        do (typecase variable
379
                             (cons (destructuring-bind (variable expression) variable
380
                                     (push variable group-variables)
381
                                     ;; leave it implicit to the group opertor (setf form `(spocq.a:|extend| ,form ,variable ,expression))
382
                                     (cond ((distinguished-variable-p variable)
383
                                            ;; retain the non-distinguished variable for implicit extend
384
                                            (push (list variable expression) group-expressions))
385
                                           (t
386
                                            ;; otherwise use just the expression
387
                                            (push expression group-expressions)))))
388
                             (t
389
                              (push variable group-variables)
390
                                             (push variable group-expressions))))
391
                      (setf group-expressions (reverse group-expressions))
392
                      (let ((group-form `(spocq.a::|group| ,group-expressions ,form))
393
                            (extend-bindings ())
394
                            (aggregation-index *aggregation-index*)
395
                            (having-index 0)
396
                            (non-aggregate-variables ()))
397
                        ;; generate aggregation forms based on the select clauses, adding implicit samples
398
                        ;; then apply the join to that sequence
399
                        (labels ((agg-variable (index)
400
                                   (intern (concatenate 'string "?agg" (princ-to-string index))  *variable-package*))
401
                                 (non-aggregate-variables (form)
402
                                   (typecase form
403
                                     (symbol
404
                                      (when (and (variable-p form)
405
                                                 (not (member form group-variables))
406
                                                 (not (member form projection-variables)))
407
                                        (pushnew form non-aggregate-variables)))
408
                                     (cons
409
                                      (unless (aggregate-expression-p form)
410
                                        (loop for form in (rest form)
411
                                          do (non-aggregate-variables form)))))))
412
                        (setf form `(spocq.a::|aggregatejoin|
413
                                      ,@(append (loop for expression in variables
414
                                                  do (incf aggregation-index)
415
                                                  collect (typecase expression
416
                                                            (cons
417
                                                             (destructuring-bind (variable expression) expression
418
                                                               (push variable projection-variables)
419
                                                               (push (cons variable (agg-variable aggregation-index)) extend-bindings)
420
                                                               `(spocq.a::|aggregation| ,(second expression) ,(first expression)
421
                                                                          ,(third expression)
422
                                                                          ,(shiftf group-form nil)
423
                                                                          ,aggregation-index ,group-index)))
424
                                                            (t
425
                                                             (push expression projection-variables)
426
                                                             (push (cons expression (agg-variable aggregation-index)) extend-bindings)
427
                                                             `(spocq.a::|aggregation| ,expression spocq.a:|sample| nil 
428
                                                                        ,(shiftf group-form nil) ,aggregation-index ,group-index))))
429
                                                (when having ;; need to generate samples
430
                                                  (loop for expression in group-expressions
431
                                                    do (non-aggregate-variables expression))
432
                                                  (let ((non-agg-map ()))
433
                                                    (append (loop for variable in non-aggregate-variables
434
                                                              do (incf aggregation-index)
435
                                                              do (push (cons variable (agg-variable aggregation-index)) non-agg-map)
436
                                                              collect `(spocq.a::|aggregation| ,variable spocq.a:|sample| nil 
437
                                                                                 ,(shiftf group-form nil) ,aggregation-index ,group-index))
438
                                                            `((spocq.a::|aggregation| ,(sublis non-agg-map having)
439
                                                                        spocq.a::|ebv| nil 
440
                                                                        ,(shiftf group-form nil)
441
                                                                        ,(setf having-index (incf aggregation-index))
442
                                                                        ,group-index))))))))
443
                          (when having
444
                            (setf form `(spocq.a::|filter| ,form ,(agg-variable having-index))))
445
                          (loop for (variable . agg-var) in (reverse extend-bindings)
446
                            do (setf form `(spocq.a:|extend| ,form ,variable ,agg-var)))))
447
                      (setf variables (reverse projection-variables))))
448
                   (t
449
                    (setf variables
450
                          (loop for variable in variables
451
                            collect (typecase variable
452
                                      (cons (destructuring-bind (variable expression) variable
453
                                              (setf form `(spocq.a:|extend| ,form ,variable ,expression))
454
                                              variable))
455
                                      (t
456
                                       variable)))))))
457
             ;;(setf form `(spocq.a::|tolist| ,form))
458
             (when order
459
               (setf form `(spocq.a:|order| ,form ,order)))
460
             (setf form `(spocq.a:|project| ,form ,variables))
461
             (when distinct
462
               (setf form `(spocq.a:|distinct| ,form)))
463
             (when reduced
464
               (setf form `(spocq.a:|reduced| ,form)))
465
             (when (or start end)
466
               (setf form `(spocq.a:|slice| ,form :start ,start :end ,end)))
467
             ;;;(setf form `(spocq.a::|tomultiset| ,form))
468
             (format-sparql-algebra stream form)))))
469
   
470
   (defformat spocq.a:|service| (stream name group-graph-pattern &rest args)
471
     (let ((silent (when (keywordp (first args)) (pop args) (if (pop args) "true" "false")))
472
           (location (typecase name
473
                       ;(resource-reference (resource-api-resource name))
474
                       (t name))))
475
       (format stream "Service(~:I~/format-sparql-algebra-term/, ~_~/format-sparql-algebra/~@[, ~a~])"
476
               location group-graph-pattern silent)))
477
 
478
   (defformat spocq.a:|servicejoin| (stream name group-graph-pattern sip-group-graph-pattern &rest args)
479
     (let ((silent (when (keywordp (first args)) (pop args) (if (pop args) "true" "false")))
480
           (location (typecase name
481
                       ;(resource-reference (resource-api-resource name))
482
                       (t name))))
483
       (format stream "Join(~:I~/format-sparql-algebra/, ~_Service(~:I~/format-sparql-algebra-term/, ~_~/format-sparql-algebra/~@[, ~a~]))"
484
               sip-group-graph-pattern location group-graph-pattern silent)))
485
     
486
   (defformat spocq.a:|slice| (stream solution-field &rest args)
487
     (destructuring-bind (&key start end &allow-other-keys) (apply #'canonicalize-algebra-arguments args)
488
       (format stream "Slice(~:I~/format-sparql-algebra/~@[, ~_~a~]~@[, ~_~a~])"
489
               solution-field
490
               (or start (when end 0))
491
               (when end (- end (or start 0))))))
492
   
493
   (defformat spocq.a:|table| (stream &optional dimensions)
494
     (declare (ignore dimensions))
495
     (write-string "{ }" stream))
496
 
497
   (defformat spocq.a::|tomultiset| (stream solution-field &rest args)
498
     (declare (ignore args))
499
     (format stream "ToMultiset(~/format-sparql-algebra/)"
500
             solution-field))
501
 
502
   (defformat spocq.a::|tolist| (stream solution-field &rest args)
503
     (declare (ignore args))
504
     (format stream "ToList(~/format-sparql-algebra/)"
505
             solution-field))
506
   
507
   (defformat spocq.a:|triple| (stream s p o)
508
     (format stream "~/format-sparql-algebra-term/ ~/format-sparql-algebra-term/ ~/format-sparql-algebra-term/"
509
             s p o))
510
   
511
   (defformat spocq.a:|union| (stream solution-field1 solution-field2)
512
     (format stream "Union(~:I~/format-sparql-algebra/, ~_~/format-sparql-algebra/)"
513
             solution-field1 solution-field2))
514
 
515
   (defformat spocq.a::|update| (stream &rest operations)
516
     (format-GS stream (reverse operations)))
517
   )
518
 
519
 (defgeneric format-gs (stream update-sequence &optional colon at)
520
   (:method ((update-sequence t) (stream stream) &optional (colon nil) (at nil))
521
     (format-gs stream update-sequence colon at))
522
   (:method ((stream stream) (update-sequence cons) &optional (colon nil) (at nil))
523
     (declare (ignore colon at))
524
     (destructuring-bind (update &rest *update-sequence*)
525
                         update-sequence
526
       (format-sparql-algebra stream update)))
527
   (:method ((stream stream) (initial-gs-indicator null) &optional (colon nil) (at nil))
528
     (declare (ignore colon at))
529
     (if *dataset-graphs*
530
         (format stream "Dataset(~:I{~{~/format-sparql-algebra-term/~^ ~}}, ~_{~{~/format-sparql-algebra-term/~^ ~}})"
531
             (dataset-default-graphs *dataset-graphs*) (dataset-named-graphs *dataset-graphs*))
532
         (format stream "Dataset(~:I{~/format-sparql-algebra-term/}, {})"
533
             |urn:dydra|:|default|))))
534
 
535
 
536
 ;;;
537
 ;;; no input
538
 
539
 ;;;
540
 (:documentation "Encoding sparql algebra"
541
   "The algebra encoding operations combine variations in three dimensions
542
   analysis,             projection,                   representation
543
   symbolic expression,  sparql query,                 text/plain + sparql
544
   execution plan,       sparql algebra,               text/plain + algebra
545
   execution trace,      symbolic sparql expression,   vnd.graphviz
546
                         symbolic sparql query,        vnd.graphviz +svg
547
                                                       vnd.graphviz +pdf
548
   in particular ways for each snslysis.
549
 
550
   this is accomplished by implementing analysis-specific operators, each of which
551
   delegates projection and representation to an effective send-response-message
552
   method, which implements a principal representation in the base method and
553
   successively capturing intermediate results in temporary files and applying
554
   the next representation stage until the final result is returned.")
555
 
556
 (defmethod send-response-message ((operation t) (query-expression cons) (stream t) (content-type mime:application/sparql-query-algebra))
557
   "Given a MESSAGE, and a STREAM with mime:application/sparql-query-algebra CONTENT-TYPE, pretty-print the
558
   recommendation's abstract algebra."
559
   (when *encoding-trace-output*
560
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
561
   (let ((*print-right-margin* 80) (*print-miser-width* 40)
562
         (*aggregation-index* 0)
563
         (*group-index* 0))
564
     ;; invoe for pretty printing
565
     (format-sparql-algebra stream query-expression t)
566
     (fresh-line stream)))
567
 
568
 (defmethod send-response-message ((operation t) (query-expression cons) (stream t) (content-type mime:application/sparql-query-execution))
569
   (when *encoding-trace-output*
570
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
571
   (with-task-environment (:task *task*)
572
       (pprint-sse (expand-query query-expression :repository-id (task-repository *task*)
573
                                 :expand-bgps t)
574
                   stream)
575
       (generate-accounting-note :complete)))
576
 
577
 
578
 (defmethod send-response-message ((operation t) (query-expression cons) (stream t) (content-type mime:application/vnd.dydra.sparql-query-algebra))
579
   "Given a MESSAGE, and a STREAM with mime:application/vnd.dydra.sparql-query-algebra CONTENT-TYPE, pretty-print the
580
   recommendation's abstract algebra."
581
   (when *encoding-trace-output*
582
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
583
   (let ((*print-right-margin* 80) (*print-miser-width* 40)
584
         (*aggregation-index* 0)
585
         (*group-index* 0))
586
     ;; invoe for pretty printing
587
     (format-sparql-algebra stream query-expression t)
588
     (fresh-line stream)))
589
 
590
 (defmethod send-response-message ((operation t) (query-expression cons) (stream t) (content-type mime:application/sparql-query-plan))
591
   "Given a MESSAGE, and a STREAM with application/vnd.dydra.sparql-query-plan CONTENT-TYPE, pretty-print the expression.
592
  nb. the -algebra and -plan output is the same, but the latter argument has been expanded.
593
   nb. the vnd.dydra.sparql-query-plan is the polite external designator, while just sparql-query-plan serves here."
594
   (when *encoding-trace-output*
595
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
596
   (let ((*algebra-package* (find-package :spocq.output)))
597
     (pprint-sse query-expression stream)
598
     (fresh-line stream)))
599
 
600
 
601
 (defmethod send-response-message (operation (message solution-generator) (stream stream) (content-type MIME:*/SPARQL-QUERY))
602
   "given the completed solution field, delegate to expression method"
603
   ;; use the task in order to get the 
604
   (send-response-message operation (query-sse-expression *task*) stream content-type))
605
 
606
 (defmethod send-response-message (operation (message task) (stream stream) (content-type MIME:*/SPARQL-QUERY))
607
   "given the task, as the default, delegate to expression method"
608
   (send-response-message operation (query-sse-expression message) stream content-type))
609
 
610
 
611
 
612
 
613
 #+(or)
614
 (progn
615
   (let ((*print-right-margin* 10) (*print-miser-width* 5))
616
     (format-sparql-algebra *trace-output* (parse-sparql "select * where {?s ?p ?o. ?s ?p ?o. ?s ?p ?o}") t))
617
   (let ((*print-right-margin* 20) (*print-miser-width* 5))
618
     (format-sparql-algebra *trace-output* (parse-sparql *sparql-query-prototype*) t))
619
   (send-response-message :algebra
620
                          (parse-sparql "select * where {?s ?p ?o}")
621
                          *trace-output*
622
                          mime:application/sparql-query-algebra)
623
   (parse-sparql "load <http://example.org/data.nt>")
624
 (send-response-message :algebra
625
                          (parse-sparql "load <http://example.org/data.nt>")
626
                          *trace-output*
627
                          mime:application/sparql-query-algebra)
628
 (format-sparql-algebra *trace-output* (parse-sparql "load <http://example.org/data.nt>;
629
 load <http://example.org/data.nt> into graph <http://example.org/graph.nt>") t)
630
 
631
 (expand-query (parse-sparql "select ?s where {?s ?p ?o} group by ?p") :repository-id "james/test")
632
 (expand-query (parse-sparql "select (count (?p) as ?count) where {?s ?p ?o} group by ?p") :repository-id "james/test")
633
 
634
   )
635
 
636
 
637
 ;;; patches
638
 (when (search "patches" (namestring *load-pathname*))
639
 (defun built-in-sse-form-p (form)
640
   (and (consp form)
641
        (member (first form)
642
                '(spocq.a:|abs| spocq.a:|add| spocq.a:|avg|
643
                  spocq.a:|bound| spocq.a:|cardinality| spocq.a:|ceil| spocq.a:|concat| spocq.a:|contains| spocq.a:|count|
644
                  spocq.a:|datatype| spocq.a:|day|
645
                  spocq.a:|encode_for_uri| spocq.a:|exists|
646
                  spocq.a:|floor|
647
                  spocq.a:|group_concat|
648
                  spocq.a:|hours|
649
                  spocq.a:|if| spocq.a:|in| spocq.a:|iri| spocq.a:|isBlank| spocq.a:|isLiteral| spocq.a:|isIRI| spocq.a:|isURI|
650
                  spocq.a:|lang| spocq.a:|langMatches| spocq.a:|lcase|
651
                  spocq.a:|max| spocq.a:|md5| spocq.a:|min| spocq.a:|minutes| spocq.a:|month|
652
                  spocq.a:|not| spocq.a:|notin| spocq.a:|now|
653
                  spocq.a:|or|
654
                  spocq.a:|rand| spocq.a:|regex| spocq.a:|round|
655
                  spocq.a:|sameTerm| spocq.a:|sample| spocq.a:|seconds| spocq.a:|sha1| spocq.a:|sha224| spocq.a:|sha256| spocq.a:|sha384| spocq.a:|sha512|
656
                  spocq.a:|str| spocq.a:|strafter| spocq.a:|strbefore| spocq.a:|strends| spocq.a:|strdt| spocq.a:|strlang| spocq.a:|strlen| spocq.a:|strstarts| spocq.a:|substr| spocq.a:|sum|
657
                  spocq.a:|timezone|
658
                  spocq.a:|ucase| spocq.a:|unbound| spocq.a:|uri|
659
                  spocq.a:|year|
660
                  spocq.a:|+| spocq.a:|!| spocq.a:|-|  spocq.a:|=| spocq.a:|!=| spocq.a:|<| spocq.a:|>| spocq.a:|<=| spocq.a:|>=| spocq.a:|*| spocq.a:|/| spocq.a:|_|
661
                  ))))
662
 
663
 
664
 (defun decode-sparql-content (source media-type &rest args
665
                                      &key (task-id *task-id*) (agent *agent*)
666
                                      (user-id *user-id*)
667
                                      (repository-id *repository-id*)
668
                                      (revision-id *revision-id*)
669
                                      (response-content-type *response-content-type*)
670
                                      (dynamic-bindings *dynamic-bindings*)
671
                                      &allow-other-keys)
672
   (declare (dynamic-extent args))
673
   (multiple-value-bind (operation arguments)
674
                        (apply #'receive-message source media-type args)
675
     (apply #'make-query
676
            :operation operation
677
            :task-id task-id
678
            :user-id user-id
679
            :agent agent
680
            :repository-id repository-id
681
            :revision-id revision-id
682
            :response-content-type response-content-type
683
            :dynamic-bindings dynamic-bindings
684
            :request-routing-key nil
685
            :request-exchange nil
686
             (case *dataset-source* ; nxp-213
687
               (:query arguments)
688
               (t (list* :dataset-graphs *dataset-graphs* arguments))))))
689
 
690
 (defgeneric decode-task (source source-media-type result-media-type &rest args)
691
   (:argument-precedence-order source-media-type result-media-type source)
692
 
693
   (:method ((source pathname) (media-type mime:application/sparql) result-media-type &rest args)
694
     (with-open-file (stream source :direction :input)
695
       (apply #'decode-task stream media-type result-media-type args)))
696
 
697
   (:method ((source stream) (media-type mime:application/sparql) (result-media-type mime::sparql-results) &rest args
698
             &key (response-content-type result-media-type)
699
             &allow-other-keys)
700
     "sparql->results is a process which intends perform some sort of query"
701
     (apply #'decode-sparql-content source media-type :response-content-type response-content-type args))
702
 
703
   (:method ((source string) (media-type mime:application/sparql) (result-media-type mime::sparql-results) &rest args
704
             &key (response-content-type result-media-type)
705
             &allow-other-keys)
706
     "sparql->results is a process which intends perform some sort of query"
707
     (apply #'decode-sparql-content source media-type :response-content-type response-content-type args))
708
 
709
   (:method ((source stream) (media-type mime:application/sparql) (result-media-type mime::query) &rest args
710
             &key (response-content-type result-media-type)
711
             &allow-other-keys)
712
     "sparql -> some query expression is a process which intends to operate on the query expression itself"
713
     (apply #'decode-sparql-content source media-type :response-content-type response-content-type args))
714
 
715
   (:method ((source string) (media-type mime:application/sparql) (result-media-type mime::query) &rest args
716
             &key (response-content-type result-media-type)
717
             &allow-other-keys)
718
     "sparql -> some query expression is a process which intends to operate on the query expression itself"
719
     (apply #'decode-sparql-content source media-type :response-content-type response-content-type args))
720
 
721
   (:method ((source stream) (media-type mime:application/sparql) (result-media-type mime:rdf) &rest args)
722
     "sparql->rdf is a process which intends perform some sort of query"
723
     (apply #'decode-sparql-content source media-type args))
724
 
725
   (:method ((source string) (media-type mime:application/sparql) (result-media-type mime:rdf) &rest args)
726
     "sparql->rdf is a process which intends perform some sort of query"
727
     (apply #'decode-sparql-content source media-type args))
728
 
729
   (:method ((source t) (media-type mime:application/sparql-query+ssl)  (result-media-type mime:application/sparql-results) &rest args)
730
     (multiple-value-bind (operation arguments)
731
                          (apply #'receive-message source media-type args)
732
       (apply #'make-script 
733
              :operation operation
734
              :task-id *task-id*
735
              :user-id *user-id*
736
              :repository-id *repository-id*
737
              :revision-id *revision-id*
738
              :request-content-type media-type
739
              :response-content-type *response-content-type*
740
              :dynamic-bindings *dynamic-bindings*
741
              :request-routing-key nil
742
              :request-exchange nil
743
              arguments)))
744
   )
745
 )
746
 
747
 #+(or)
748
 (progn
749
 (in-package :spocq.si)
750
 (when (search "patches" (namestring *load-pathname*))
751
 (defgeneric repository-view (resource view-name) ;; see store/repository.lisp
752
   (:method ((resource http:resource) (view-name string))
753
     (repository-view (resource-repository resource) view-name))
754
   (:method ((repository string) (view-name string))
755
     (repository-view (repository repository) view-name))
756
   (:method ((repository repository) (view-name string))
757
     (flet ((get-view-definition ()
758
              (let* ((repository-id (dydra:repository-id repository))
759
                     (view-id (concatenate 'string repository-id "/" view-name))
760
                     (process (run-program (spocq.i::admin-print-view-executable-pathname)
761
                                           `(,view-id)
762
                                           :wait t
763
                                           :output :stream)))
764
                (when process
765
                  (unwind-protect
766
                      (let* ((query-stream (run-program-output process))
767
                             (query (spocq.i::read-stream query-stream)))
768
                        (close query-stream)
769
                        (unless (plusp (length query))
770
                          (http:internal-error "stored view retrieval failed: no content."))
771
                        query )
772
                    (run-program-close process))))))
773
     (cond ((get-view-definition))
774
           ((equalp view-name "all")
775
            "select * where { {?s ?p ?o} union { graph ?g {?s ?p ?o} } }")
776
           ((equalp (remove-if-not #'alpha-char-p view-name) "allpaged")
777
            "select * where { {?s ?p ?o} union { graph ?g {?s ?p ?o} } } limit 60"))))))
778
 )
779
 
780
 #|
781
 ;; any public repository
782
 /usr/bin/curl -v "-X" "POST" "--silent" "-H" "Accept: application/sparql-query" \
783
   "--data-binary" "@-" -H "Content-Type: application/sparql-query"  \
784
   'https://stage.dydra.com:81/jhacker/foaf/sparql?user_id=testgrammar' <<EOF
785
 select * where {?s ?p ?o}
786
 EOF
787
 
788
 /usr/bin/curl -v "-X" "POST" "--silent" "-H" "Accept: application/sparql-query-algebra" \
789
   "--data-binary" "@-" -H "Content-Type: application/sparql-query"  \
790
   'https://stage.dydra.com:81/jhacker/foaf/sparql?user_id=testgrammar' <<EOF
791
 select * where {?s ?p ?o}
792
 EOF
793
 
794
 /usr/bin/curl -v "-X" "POST" "--silent" "-H" "Accept: application/vnd.dydra.sparql-query-algebra" \
795
   "--data-binary" "@-" -H "Content-Type: application/sparql-query"  \
796
   'https://stage.dydra.com:81/jhacker/foaf/sparql?user_id=testgrammar' <<EOF
797
 select * where {?s ?p ?o}
798
 EOF
799
 
800
 (pprint-sparql-algebra (parse-sparql "select (count(?o) as ?count) where {?s ?p ?o} group by ?s ?p order by ?p"))
801
 (pprint-sparql-algebra
802
   (parse-sparql "select ?s (count(?o) as ?count) ?k where {?s ?p ?o} group by ((?s + ?p) as ?k) abs(?o) ?o having (avg(?o) > 0)"))
803
 (pprint-sparql-algebra
804
   (parse-sparql "select (count(?o) as ?count) where {?s ?p ?o} group by (?s + ?p)"))
805
 (pprint-sparql-algebra
806
   (parse-sparql "select ?s (count(?o) as ?count) ?k where {?s ?p ?o} group by ((?s + ?p) as ?k) abs(?o) ?o having (avg(?o) > 0) (?p = ?p)"))
807
 
808
 (run-sparql-internal "select ?s (count(?o) as ?count) ?k where {?s ?p ?o} group by ((?s + ?p) as ?k) abs(?o) ?o having (avg(?o) > 0) (?p = ?p)"
809
   :repository-id "james/test")
810
 
811
 (run-sparql-internal "select (sample(?s) as ?ss) (count(?o) as ?count) ?k where {?s ?p ?o} group by ((?s + ?p) as ?k) abs(?o) ?o order by ?count"
812
   :repository-id "james/test")
813
 (run-sparql-internal "select (sample(?s) as ?ss) (count(?o) as ?count) where {?s ?p ?o} group by ((?s + ?p) as ?k) abs(?o) ?o order by ?k"
814
   :repository-id "james/test")
815
 (expand-query "select (sample(?s) as ?ss) (count(?o) as ?count) where {?s ?p ?o} group by ((?s + ?p) as ?k) abs(?o) ?o order by ?k"
816
   :repository-id "james/test")
817
 
818
 |#