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

KindCoveredAll%
expression0772 0.0
branch062 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
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 ;;; manipulate json-encoded sparql queries
6
 ;;;
7
 ;;; indicated by the media type application/sparql-query+json
8
 ;;; - write-sparql-query+json, encodes a parsed query sse
9
 ;;; - parse-sparql-query+json, parse a json string and translate it into a query sse
10
 ;;;
11
 ;;; this suffices for documentation and permits some interface generation
12
 ;;; in order to use it more, this generator will need to add metadata for
13
 ;;; - intended query parameters for use to control input constraints
14
 ;;; - variable type information
15
 ;;;
16
 ;;; alternative are
17
 ;;; - include it in-line with the variable occurrences
18
 ;;; - add fields to the toplevel object
19
 ;;; in either case, it will require state additional to the sse for
20
 ;;; - "$"-variables
21
 ;;; - predicate range
22
 
23
 (:documentation "generate sparql encoded as json"
24
  "This implements for operators to pring sparql sse exressions as the equivalent abstract algebra \"expression\":
25
  - print-sparql-json
26
  - pprint-sparql-json
27
  - format-sparql-json
28
  - format-sparql-json-operator
29
  The first three provide an interface analogous to print/format while the last is the concrete implementation
30
  for the respective form.")
31
 
32
 (eval-when (:compile-toplevel :load-toplevel :execute)
33
   (import '(cl-user::format-sparql-json
34
             cl-user::format-sparql-json-expression
35
             cl-user::format-sparql-json-group-expression
36
             cl-user::format-sparql-json-order-condition
37
             cl-user::format-sparql-json-term)
38
           *package*))
39
 
40
 ;;; parameters reused from sparql algebra encoding
41
 
42
 (defparameter *format-sparql-json.string-delimiter* #\')
43
 
44
 (defun print-sparql-json (query-expression &optional (stream *standard-output*))
45
   "Format a query sse in the form of a json form"
46
   (format-sparql-json stream query-expression nil)
47
   query-expression)
48
 
49
 (defun pprint-sparql-json (query-expression &optional (stream *standard-output*))
50
   "Format a query sse in the form of the recommendation sparql algebra, with line breaks"
51
   (format-sparql-json stream query-expression t)
52
   query-expression)
53
 
54
 (defgeneric format-sparql-json (stream object &optional colon at)
55
   (:method ((stream stream) (form cons) &optional colon at)
56
     (declare (ignore colon at))
57
     (format-sparql-json-operator stream (first form) (rest form)))
58
   (:method ((form cons) (stream stream) &optional colon at)
59
     (format-sparql-json stream form colon at))
60
   (:method ((stream t) (term t) &optional colon at)
61
     (declare (ignore colon at))
62
     (format-sparql-json-term stream term)))
63
 
64
 
65
 (defgeneric format-sparql-json-term (stream object &optional colon at)
66
   (:method ((stream t) (term symbol) &optional colon (at nil))
67
     (declare (ignore colon))
68
     (cond ((string-equal term "*")
69
             (format stream "{\"termType\": \"Wildcard\", \"value\": \"*\"}"))
70
           ((variable-p term)
71
            (format stream "{\"termType\": \"Variable\", \"value\": \"~a\"}" term))
72
           ((iri-p term)
73
            (format stream "{\"termType\": \"NamedNode\", \"value\": \"~a\"}" (iri-lexical-form term)))
74
           ((eq (symbol-package term) *algebra-package*)
75
            (write-string (symbol-name term) stream))
76
           (t
77
            (let ((*expand-literal-values* at))
78
              (encode-turtle-object term stream)))))
79
   (:method ((stream t) (term cons) &optional colon (at nil))
80
     (declare (ignore colon at))
81
     (if (bgp-form-p term)
82
         (format-sparql-json stream term)
83
         (error "format-sparql-json-term: invalid term expression: ~s" term)))
84
   (:method ((stream t) (term spocq:iri) &optional colon (at nil))
85
     (declare (ignore colon at))
86
     (format stream "{\"termType\": \"NamedNode\", \"value\": \"~a\"}" (iri-lexical-form 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 (eql t)) &optional colon (at nil))
92
     (declare (ignore colon at))
93
     (write-string "true" stream))
94
   (:method ((stream t) (term (eql nil)) &optional colon (at nil))
95
     (declare (ignore colon at))
96
     (write-string "false" stream))
97
   (:method ((stream t) (term spocq:boolean) &optional colon (at nil))
98
     (declare (ignore colon at))
99
     (write-string (term-lexical-form term) stream))
100
   (:method ((stream t) (term property-path) &optional colon (at nil))
101
     (declare (ignore colon at))
102
     (format stream "{\"termType\": \"NamedNode\", \"value\": \"~a\"}" term))
103
   (:method ((stream t) (object string) &optional colon at)
104
     ;; encode strings with single ' delimiters in order that the output can be embedded in json
105
     (declare (ignore colon at))
106
     (write-char *format-sparql-json.string-delimiter* stream)
107
     (write-string object stream)
108
     (write-char *format-sparql-json.string-delimiter* stream)))
109
     
110
 (defun format-sparql-json-group-expression (stream expression &optional (colon nil) (at nil))
111
   (typecase expression
112
     (cons
113
      (if (variable-p (first expression))
114
          (format stream "[~/format-sparql-json-term/, ~/format-sparql-json-expression/]"
115
                  (first expression) (second expression))
116
          (format-sparql-json-expression stream expression colon at)))
117
     (t
118
      (format-sparql-json-expression stream expression colon at))))
119
      
120
 (defun format-json-operation (stream operator &rest args)
121
   (format stream "{\"type\": \"~a\", \"args\": [~{~/format-sparql-json-expression/~^ ~}]}"
122
           operator args))
123
 
124
 (defgeneric format-sparql-json-expression (stream expression &optional colon at)
125
   (:method ((stream t) (expression null) &optional colon at)
126
     (declare (ignore colon at))
127
     (format stream "{}"))
128
   (:method ((stream t) (term symbol) &optional colon (at nil))
129
     (declare (ignore colon at))
130
     (format-sparql-json-term stream term))
131
   (:method ((stream t) (expression cons) &optional colon at)
132
     (declare (ignore colon at))
133
     (cond ((conditional-sse-form-p expression)
134
            (destructuring-bind (op . arguments) expression
135
              (case op
136
                ((spocq.a:|not| spocq.a:|!|)
137
                 (format stream "! ~/format-sparql-json-expression/" (first arguments)))
138
                (t
139
                 (cond ((rest arguments)
140
                        (format stream "~/format-sparql-json-expression/ ~a "
141
                                (first arguments)
142
                                (ecase op
143
                                  ((spocq.a:|and| spocq.a:|&&|) "&&")
144
                                  ((spocq.a:|or| spocq.a:\|\|) "||")))
145
                        (format-sparql-json-expression stream (cons op (rest arguments))))
146
                       (t
147
                        (format-sparql-json-expression stream (first arguments))))))))
148
           ((arithmetic-sse-form-p expression)
149
            (destructuring-bind (op . arguments) expression
150
              (cond ((rest arguments)
151
                     (format stream "(~/format-sparql-json-expression/ ~a ~/format-sparql-json-expression/)"
152
                                (first arguments) op (second arguments)))
153
                    (t
154
                     (format stream "~a ~/format-sparql-json-expression/"
155
                                op (first arguments))))))
156
           ((relational-sse-form-p expression)
157
            (destructuring-bind (op . arguments) expression
158
              (case op
159
                (spocq.a:|in|
160
                 (format stream "in (~{~/format-sparql-json-expression/~^, ~})" arguments))
161
                (spocq.a:|notin|
162
                 (format stream "not in (~{~/format-sparql-json-expression/~^, ~})" arguments))
163
                (t
164
                 (format stream "(~/format-sparql-json-expression/ ~a ~/format-sparql-json-expression/)"
165
                         (first arguments) op (second arguments))))))
166
           ((eq (first expression) 'spocq.a:|exprlist|)
167
            (format-sparql-json-expression stream `(spocq.a:|&&| ,@(rest expression))))
168
           ((or (built-in-sse-form-p expression) 
169
                (aggregate-expression-p expression))
170
            (destructuring-bind (op . arguments) expression
171
              (format stream "~a(~{~/format-sparql-json-expression/~^, ~}) "
172
                      op arguments)))
173
           ((functional-sse-form-p expression)
174
            (destructuring-bind (op . arguments) expression
175
              (format stream "~/format-sparql-json-term/(~{~/format-sparql-json-expression/~^, ~})"
176
                      op arguments)))
177
           (t
178
            (format stream "(~{~/format-sparql-json-expression/~^, ~})" expression))))
179
   (:method ((stream t) (term t) &optional colon (at nil))
180
     (declare (ignore colon))
181
     (let ((*expand-literal-values* at))
182
       (encode-turtle-object term stream))))
183
 
184
 (defgeneric format-sparql-json-order-condition (stream expression &optional colon at)
185
   (:method ((stream t) (condition t) &optional colon at)
186
     (declare (ignore colon at))
187
     (format-sparql-json-term stream condition))
188
   (:method ((stream t) (condition cons) &optional colon at)
189
     (declare (ignore colon at))
190
     (if (order-modifier-form-p condition)
191
         (destructuring-bind (modifier expression) condition
192
           (format stream "{\"type\": \"condition\", \"modifier\": \"~a\", \"expression\": ~/format-sparql-json-expression/}"
193
                   (case modifier
194
                     (spocq.a::|desc| "descending")
195
                     (spocq.a::|asc| "ascending")
196
                     (t modifier))
197
                     expression))
198
         (format stream "{\"type\": \"condition\", \"expression\": ~/format-sparql-json-expression/}"
199
                 condition))))
200
 
201
 
202
 (macrolet ((defformat (operator lambda-list &body body)
203
              `(defmethod format-sparql-json-operator ((.stream. t) (operator (eql ',operator)) parameters)
204
                   (destructuring-bind ,lambda-list (cons .stream. parameters)
205
                     ,@body))))
206
 
207
   (defformat spocq.a:|add| (stream from-graph to-graph)
208
     (format stream "{\"type\": \"OpAdd\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"from\": ~/format-sparql-json-term/, \"to\": ~/format-sparql-json-term/}"
209
             *update-sequence* from-graph to-graph))
210
 
211
   (defformat spocq.a::|aggregatejoin| (stream &rest forms)
212
     (format stream "{\"type\": \"AggregationJoin\", \"patterns\": [~{~/format-sparql-json/~^, ~}]}"
213
             forms))
214
 
215
   (defformat spocq.a::|aggregation| (stream expression operator scalar-vars form &optional aggregation-index group-index)
216
     (let ((v1 (when aggregation-index (format nil "g~d" aggregation-index)))
217
           (v2 (when group-index (format nil "g~d" group-index))))
218
       (format stream "{ \"variable\": {\"termType\": \"Variable\", \"value\": \"~a\"}"
219
               (or v1 v2))
220
       (format stream ",\"expression\": {\"expression\": ~/format-sparql-json-expression/, \"type\": \"aggregate\", \"aggregation\": \"~a\", \"~a\": ~/format-sparql-json/}}"
221
               expression operator scalar-vars form
222
               )))
223
   
224
   (defformat spocq.a:|ask| (stream solution-field)
225
     (format stream "{\"type\": \"Ask\", \"where\": [ ~/format-sparql-json/ ]}"
226
             solution-field))
227
   
228
   (defformat spocq.a:|bgp| (stream &rest triples)
229
     (format stream "{\"type\": \"Bgp\", \"triples\": [~{ ~/format-sparql-json/~^, ~}]}" triples))
230
 
231
   (defformat spocq.a:|bindings| (stream values-list variables)
232
     (format stream "{\"type\": \"ToMultiSet\", \"values\": [")
233
     (loop for values-list on values-list
234
       for values = (first values-list)
235
       do (format stream "~{{\"variable\": ~/format-sparql-json-term/, \"value\": ~/format-sparql-json-term/}~^, ~}"
236
                  (loop for value in values for variable in variables
237
                    append (list variable value)))
238
       when (rest values-list)
239
       do (format stream ", "))
240
     (write-string "]}" stream))
241
 
242
   (defformat spocq.a:|clear| (stream graph)
243
     (format stream "{type \"OpClear\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"graph\": ~/format-sparql-json-term/}"
244
             *update-sequence* (query-algebra-graph-term graph)))
245
 
246
   (defformat spocq.a:|copy| (stream from-graph to-graph)
247
     (format stream "{\"type\": \"OpCopy\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"from\": ~/format-sparql-json-term/, \"to\": ~/format-sparql-json-term/}"
248
             *update-sequence* from-graph to-graph))
249
 
250
   (defformat spocq.a:|create| (stream graph)
251
     (format stream "{\"type\": \"OpClear\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"graph\": ~/format-sparql-json-term/}"
252
             *update-sequence* graph))
253
 
254
   (defformat spocq.a:|construct| (stream solution-field triples)
255
     (format stream "{\"type\": \"Construct\", \"template\": [~{ ~/format-sparql-json/~^ . ~}], \"pattern\": ~/format-sparql-json/}"
256
             triples solution-field))
257
 
258
   (defformat spocq.a:|deleteData| (stream data)
259
     (format stream "{\"type\": \"OpDeleteData\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"data\": [~{~/format-sparql-json/~^ . ~}]}"
260
             *update-sequence* data))
261
 
262
   (defformat spocq.a:|deleteWhere| (stream data)
263
     (format stream "{\"type\": \"OpDeleteWhere\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"pattern\": [~{~/format-sparql-json/~^ . ~}]}"
264
             *update-sequence* data))
265
   
266
   (defformat spocq.a:|describe| (stream solution-field subjects)
267
     (format stream "{\"type\": \"Describe\", subjects_ [~{~/format-sparql-json-term/~^, ~}]~@[, \"pattern\": ~/format-sparql-json/~]}"
268
             subjects solution-field))
269
   
270
   (defformat spocq.a:|diff| (stream solution-field1 solution-field2 test-expression)
271
     (format stream "{\"type\": \"Diff\", \"patterns\": [~/format-sparql-json/, ~/format-sparql-json/]~@[, \"test\": ~/format-sparql-json-expression/~]}"
272
             solution-field1 solution-field2 test-expression))
273
   
274
   (defformat spocq.a:|distinct| (stream solution-field &rest args)
275
     (declare (ignore args))
276
     (format stream "{\"type\": \"Distinct\", \"pattern\": ~/format-sparql-json/}"
277
             solution-field))
278
 
279
   (defformat spocq.a:|drop| (stream graph)
280
     (format stream "{\"type\": \"OpClear\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"graph\": ~/format-sparql-json-term/}"
281
             *update-sequence* (query-algebra-graph-term graph)))
282
 
283
   (defformat spocq.a:|extend| (stream solution-field variable expression &rest args)
284
     (declare (ignore args))
285
     (format stream "{\"type\": \"Extend\", \"pattern\": ~/format-sparql-json/, \"variable\": ~/format-sparql-json-term/, \"expression\": ~/format-sparql-json-expression/}"
286
             solution-field variable expression))
287
   
288
   (defformat spocq.a:|filter| (stream solution-field test-expression)
289
     (format stream "{\"type\": \"Filter\", \"test\": ~/format-sparql-json-expression/, \"pattern\": ~/format-sparql-json/}"
290
             test-expression solution-field))
291
   
292
   (defformat spocq.a:|graph| (stream name group-graph-pattern)
293
     (format stream "{\"type\": \"Graph\", \"name\": ~/format-sparql-json-term/, \"pattern\": ~/format-sparql-json/}"
294
             name group-graph-pattern))
295
 
296
   (defformat spocq.a::|group| (stream group-expressions solution-field)
297
     ;;; !!! this is not according to sparqljs
298
     ;;; !!! that bundles these into a select form, which is out of reach of the group specifications
299
     (format stream "{\"type\": \"Group\", \"expressions\": [~{~/format-sparql-json-group-expression/~^, ~}], \"pattern\": ~/format-sparql-json/}"
300
             group-expressions solution-field))
301
 
302
   (defformat spocq.a::|having| (stream solution-field test-expression)
303
     (format stream "{\"type\": \"Filter\", \"test\": ~/format-sparql-json-expression/, \"pattern\": ~/format-sparql-json/}"
304
             test-expression solution-field))
305
   
306
   (defformat spocq.a:|insertData| (stream data)
307
     (format stream "{\"type\": \"OpInsertData\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"data\": [~{~/format-sparql-json/~^ . ~}]}"
308
             *update-sequence* data))
309
 
310
   (defformat spocq.a:|join| (stream solution-field1 solution-field2)
311
     (format stream "{\"type\": \"Join\", \"patterns\": [~/format-sparql-json/, ~/format-sparql-json/]}"
312
             solution-field1 solution-field2))
313
   
314
   (defformat spocq.a:|leftjoin| (stream solution-field1 solution-field2 &key test)
315
     (format stream "{\"type\": \"LeftJoin\", \"patterns\": [~/format-sparql-json/, ~/format-sparql-json/]~@[, \"test\": ~/format-sparql-json-expression/~]}"
316
             solution-field1 solution-field2 test))
317
 
318
   (defformat spocq.a:|load| (stream location graph &key verbose)
319
     (declare (ignore verbose))
320
     (format stream "{\"type\": \"OpLoad\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"location\": ~/format-sparql-json-term/~@[, \"graph\": ~/format-sparql-json-term/~]}"
321
             *update-sequence* location graph))
322
 
323
   (defformat spocq.a:|minus| (stream solution-field1 solution-field2)
324
     (format stream "{\"type\": \"Minus\", \"patterns\": [~/format-sparql-json/, ~/format-sparql-json/]}"
325
             solution-field1 solution-field2))
326
 
327
   (defformat spocq.a:|modify| (stream solution-field &rest args &key delete insert with graphs named-graphs)
328
     (declare (ignore delete insert with graphs named-graphs))
329
     (destructuring-bind (expanded-field &key delete insert)
330
                         (apply #'macroexpand-modify solution-field args)
331
       (format stream "{\"type\": OpDeleteInsert, \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"delete\": [~{~/format-sparql-json/~^ . ~}], \"insert\": [~{~/format-sparql-json/~^ . ~}], \"pattern\": ~/format-sparql-json/}"
332
               *update-sequence* delete insert expanded-field)))
333
 
334
   (defformat spocq.a:|move| (stream from-graph to-graph)
335
     (format stream "{\"type\": \"OpMove\", \"sequence\": ~/spocq.i::format-sparql-update-sequence-json/, \"from\": ~/format-sparql-json-term/, \"to\": ~/format-sparql-json-term/}"
336
             *update-sequence* from-graph to-graph))
337
 
338
   (defformat spocq.a:|null| (stream dimensions)
339
     (declare (ignore dimensions))
340
     (format-sparql-json stream '(spocq.a:|table|)))
341
   
342
   (defformat spocq.a:|order| (stream solution-field order-expression-list)
343
     (format stream "{\"type\": \"OrderBy\", \"pattern\": ~/format-sparql-json/, \"exprlist\": [~{~/format-sparql-json-order-condition/~^, ~}]}"
344
             solution-field order-expression-list))
345
   
346
   (defformat spocq.a:|project| (stream solution-field variables &rest args)
347
     (declare (ignore args))
348
     (if (consp variables)
349
         (format stream "{\"type\": \"Project\", \"pattern\": ~/format-sparql-json/, \"variables\": [~{~/format-sparql-json-expression/~^, ~}]}"
350
                 solution-field variables)
351
         (format stream "{\"type\": \"Project\", \"pattern\": ~/format-sparql-json/, \"variables\": *}"
352
                 solution-field)))
353
   
354
   (defformat spocq.a:|quad| (stream s p o c)
355
     (format stream "{\"type\": \"Quad\", \"subject\": ~/format-sparql-json-term/, \"predicate\": ~/format-sparql-json-term/, \"object\": ~/format-sparql-json-term/, \"graph\": ~/format-sparql-json-term/}"
356
             s p o c))
357
   
358
   (defformat spocq.a:|reduced| (stream solution-field &rest args)
359
     (declare (ignore args))
360
     (format stream "{\"type\": \"Reduced\", \"pattern\": ~/format-sparql-json/}"
361
             solution-field))
362
   
363
   (defformat spocq.a:|select| (stream solution-field variables &rest args &key count end offset start distinct reduced order)
364
     (declare (ignore count end offset start))
365
     (let ((having ())
366
           (group-by ()))
367
       (when (consp variables)
368
         (loop (if (keywordp (first variables))
369
                   (ecase (pop variables)
370
                     (:having (setf having (pop variables)))
371
                     (:group-by (setf group-by (pop variables))))
372
                   (return))))
373
       (destructuring-bind (&key start end &allow-other-keys) (apply #'canonicalize-algebra-arguments args)
374
         (let ((form solution-field))
375
           (when (consp variables)
376
             (cond (group-by
377
                    (let ((projection-variables ())
378
                          (group-expressions ())
379
                          (group-variables ())
380
                          (group-index (incf *group-index*)))
381
                      (loop for variable in group-by
382
                        do (typecase variable
383
                             (cons (destructuring-bind (variable expression) variable
384
                                     (push variable group-variables)
385
                                     ;; leave it implicit to the group opertor (setf form `(spocq.a:|extend| ,form ,variable ,expression))
386
                                     (cond ((distinguished-variable-p variable)
387
                                            ;; retain the non-distinguished variable for implicit extend
388
                                            (push (list variable expression) group-expressions))
389
                                           (t
390
                                            ;; otherwise use just the expression
391
                                            (push expression group-expressions)))))
392
                             (t
393
                              (push variable group-variables)
394
                              (push variable group-expressions))))
395
                      (setf group-expressions (reverse group-expressions))
396
                      (let ((group-form `(spocq.a::|group| ,group-expressions ,form))
397
                            (extend-bindings ())
398
                            (aggregation-index *aggregation-index*)
399
                            (having-index 0)
400
                            (non-aggregate-variables ()))
401
                        ;; generate aggregation forms based on the select clauses, adding implicit samples
402
                        ;; then apply the join to that sequence
403
                        (labels ((agg-variable (index)
404
                                   (intern (concatenate 'string "?agg" (princ-to-string index))  *variable-package*))
405
                                 (non-aggregate-variables (form)
406
                                   (typecase form
407
                                     (symbol
408
                                      (when (and (variable-p form)
409
                                                 (not (member form group-variables))
410
                                                 (not (member form projection-variables)))
411
                                        (pushnew form non-aggregate-variables)))
412
                                     (cons
413
                                      (unless (aggregate-expression-p form)
414
                                        (loop for form in (rest form)
415
                                          do (non-aggregate-variables form)))))))
416
                        (setf form `(spocq.a::|aggregatejoin|
417
                                      ,@(append (loop for expression in variables
418
                                                  do (incf aggregation-index)
419
                                                  collect (typecase expression
420
                                                            (cons
421
                                                             (destructuring-bind (variable expression) expression
422
                                                               (push variable projection-variables)
423
                                                               (push (cons variable (agg-variable aggregation-index)) extend-bindings)
424
                                                               `(spocq.a::|aggregation| ,(second expression) ,(first expression)
425
                                                                          ,(third expression)
426
                                                                          ,(shiftf group-form nil)
427
                                                                          ,aggregation-index ,group-index)))
428
                                                            (t
429
                                                             (push expression projection-variables)
430
                                                             (push (cons expression (agg-variable aggregation-index)) extend-bindings)
431
                                                             `(spocq.a::|aggregation| ,expression spocq.a:|sample| nil 
432
                                                                        ,(shiftf group-form nil) ,aggregation-index ,group-index))))
433
                                                (when having ;; need to generate samples
434
                                                  (loop for expression in group-expressions
435
                                                    do (non-aggregate-variables expression))
436
                                                  (let ((non-agg-map ()))
437
                                                    (append (loop for variable in non-aggregate-variables
438
                                                              do (incf aggregation-index)
439
                                                              do (push (cons variable (agg-variable aggregation-index)) non-agg-map)
440
                                                              collect `(spocq.a::|aggregation| ,variable spocq.a:|sample| nil 
441
                                                                                 ,(shiftf group-form nil) ,aggregation-index ,group-index))
442
                                                            `((spocq.a::|aggregation| ,(sublis non-agg-map having)
443
                                                                        spocq.a::|ebv| nil 
444
                                                                        ,(shiftf group-form nil)
445
                                                                        ,(setf having-index (incf aggregation-index))
446
                                                                        ,group-index))))))))
447
                          (when having
448
                            (setf form `(spocq.a::|filter| ,form ,(agg-variable having-index))))
449
                          (loop for (variable . agg-var) in (reverse extend-bindings)
450
                            do (setf form `(spocq.a:|extend| ,form ,variable ,agg-var)))))
451
                      (setf variables (reverse projection-variables))))
452
                   (t
453
                    (setf variables
454
                          (loop for variable in variables
455
                            collect (typecase variable
456
                                      (cons (destructuring-bind (variable expression) variable
457
                                              (setf form `(spocq.a:|extend| ,form ,variable ,expression))
458
                                              variable))
459
                                      (t
460
                                       variable)))))))
461
             ;;(setf form `(spocq.a::|tolist| ,form))
462
             (when order
463
               (setf form `(spocq.a:|order| ,form ,order)))
464
             (setf form `(spocq.a:|project| ,form ,variables))
465
             (when distinct
466
               (setf form `(spocq.a:|distinct| ,form)))
467
             (when reduced
468
               (setf form `(spocq.a:|reduced| ,form)))
469
             (when (or start end)
470
               (setf form `(spocq.a:|slice| ,form :start ,start :end ,end)))
471
             (format-sparql-json stream form)))))
472
   
473
   (defformat spocq.a:|service| (stream name group-graph-pattern &rest args)
474
     (let ((silent (when (keywordp (first args)) (pop args) (if (pop args) "true" "false")))
475
           (location (typecase name
476
                       ;(resource-reference (resource-api-resource name))
477
                       (t name))))
478
       (format stream "{\"type\": \"Service\", \"location\": ~/format-sparql-json-term/, \"pattern\": ~/format-sparql-json/, \"silent\": ~:[false~;true~]}"
479
               location group-graph-pattern silent)))
480
 
481
   (defformat spocq.a:|servicejoin| (stream name group-graph-pattern sip-group-graph-pattern &rest args)
482
     (let ((silent (when (keywordp (first args)) (pop args) (if (pop args) "true" "false")))
483
           (location (typecase name
484
                       (t name))))
485
       (format stream "{\"type\": \"Join\", \"patterns\": [~/format-sparql-json/: \"Service\", \"location\": ~/format-sparql-json-term/, \"pattern\": ~/format-sparql-json/, \"silent\": ~:[false~;true~]}]}"
486
               sip-group-graph-pattern location group-graph-pattern silent)))
487
     
488
   (defformat spocq.a:|slice| (stream solution-field &rest args)
489
     (destructuring-bind (&key start end &allow-other-keys) (apply #'canonicalize-algebra-arguments args)
490
       (format stream "{\"type\": \"Slice\", \"pattern\": ~/format-sparql-json/~@[, \"start\": ~a~]~@[, \"length\": ~a~]}"
491
               solution-field
492
               (or start (when end 0))
493
               (when end (- end (or start 0))))))
494
   
495
   (defformat spocq.a:|table| (stream &optional dimensions)
496
     (declare (ignore dimensions))
497
     (write-string "{\"type\": \"Table\"}" stream))
498
 
499
   (defformat spocq.a::|tomultiset| (stream solution-field &rest args)
500
     (declare (ignore args))
501
     (format stream "{\"type\": \"ToMultiset\", \"sequence\": ~/format-sparql-json/}"
502
             solution-field))
503
 
504
   (defformat spocq.a::|tolist| (stream solution-field &rest args)
505
     (declare (ignore args))
506
     (format stream "{\"type\": \"ToList\", \"multiset\": ~/format-sparql-json/}"
507
             solution-field))
508
   
509
   (defformat spocq.a:|triple| (stream s p o)
510
     (format stream "{\"type\": \"Triple\", \"subject\": ~/format-sparql-json-term/, \"predicate\": ~/format-sparql-json-term/, \"object\": ~/format-sparql-json-term/}"
511
             s p o))
512
   
513
   (defformat spocq.a:|union| (stream solution-field1 solution-field2)
514
     (format stream "{\"type\": \"Union\", \"patterns\": [~/format-sparql-json/, ~/format-sparql-json/]}"
515
             solution-field1 solution-field2))
516
 
517
   (defformat spocq.a::|update| (stream &rest operations)
518
     (format-sparql-update-sequence-json stream (reverse operations)))
519
   )
520
 
521
 (defgeneric format-sparql-update-sequence-json (stream update-sequence &optional colon at)
522
   (:method ((update-sequence t) (stream stream) &optional (colon nil) (at nil))
523
     (format-sparql-update-sequence-json stream update-sequence colon at))
524
   (:method ((stream stream) (update-sequence cons) &optional (colon nil) (at nil))
525
     (declare (ignore colon at))
526
     (destructuring-bind (update &rest *update-sequence*)
527
                         update-sequence
528
       (format-sparql-json stream update)))
529
   (:method ((stream stream) (initial-gs-indicator null) &optional (colon nil) (at nil))
530
     (declare (ignore colon at))
531
     (if *dataset-graphs*
532
         (format stream "{\"type\": \"dataset\", [[~{~/format-sparql-json-term/~^, ~}], [{~{~/format-sparql-json-term/~^, ~}])}"
533
             (dataset-default-graphs *dataset-graphs*) (dataset-named-graphs *dataset-graphs*))
534
         (format stream "{\"type\": \"dataset\", [[~/format-sparql-json-term/], []]}"
535
             |urn:dydra|:|default|))))
536
 
537
 
538
 
539
 ;;; sparql processor interface
540
 
541
 ;;; !!! the json which this yields is not an sse, but instead the nested association list
542
 ;;; !!! which represents the query with the javascript sparql library model.
543
 (defmethod receive-message ((stream t) (type mime:application/sparql-query+json) &key)
544
   ;;(parse-json-sparql-results (parse-json stream)))
545
   (parse-json stream))
546
 
547
 (defmethod send-response-message ((operation t) (query-expression cons) (stream stream) (content-type mime:application/sparql-query+json))
548
   "Given a QUERY, and a STREAM with the application/sparql-query+json CONTENT-TYPE, encode the query as json"
549
   (when *encoding-trace-output*
550
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
551
   (let ((*print-right-margin* 40) (*print-miser-width* 30)
552
         (*aggregation-index* 0)
553
         (*group-index* 0))
554
     (format-sparql-json stream query-expression t)
555
     (fresh-line stream)))
556
 
557
 ;;; (send-response-message :quary (parse-sparql *q*) *trace-output* mime:application/sparql-query+json)