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

KindCoveredAll%
expression101484 20.9
branch226 7.7
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
 ;;; results+jsonp serializer
6
 ;;; https://en.wikipedia.org/wiki/JSONP
7
 ;;; http://www.ietf.org/rfc/rfc4627.txt
8
 
9
 ;;; no reading
10
 
11
 
12
 ;;; writing - just bindings
13
 ;;; dimensions, solutions rows - in which each term is an index, a term array
14
 
15
 #|
16
 $(function() {
17
     window.renderView({
18
         "type": "tuple",
19
         "columns": ["g", "o", "p", "s"],
20
         "rows": [[0, 1, 2, 3], [0, 4, 5, 6], [0, 7, 8, 6], [0, 3, 9, 6], [0, 10, 11, 7]],
21
         "prefixes": { ... },
22
         "terms": [null, {
23
             "type": "literal",
24
             "value": "depth 1 by blank node"
25
         }, ...
26
         ]
27
     });
28
 });
29
 |#                   
30
 
31
 (defparameter *jsonp-content-function-name* "function")
32
 (defparameter *jsonp-application-function-name* "window.renderView")
33
 
34
 (defun jsonp-operation-datatype (operation)
35
   (case operation
36
     (spocq.a:|ask| "bool")
37
     ((spocq.a:|describe| spocq.a:|construct|) "graph")
38
     (t "tuple")))
39
 
40
 (defun write-sparql-results+jsonp-prologue (stream dimensions operation)
41
   (format stream "$(~a(){~% ~a({~%  \"type\": \"~a\", \"columns\": [~{ \"~a\"~^,~} ],"
42
           *jsonp-content-function-name* *jsonp-application-function-name* (jsonp-operation-datatype operation) dimensions))
43
 
44
 (defun write-sparql-results+jsonp-epilogue (stream namespace-bindings operation)
45
   (format stream "~%  \"type\": \"tuple\",")
46
   (format stream "~%  \"prefixes\": {")
47
   (loop for (prefix . namespace-name) in namespace-bindings
48
     with first = t
49
     do (progn (if first 
50
                   (setf first nil)
51
                   (write-string ", " stream))
52
          (format stream "\"~a\": \"~a\"" prefix namespace-name)))
53
   (write-string "}" stream)
54
   (when *task*
55
     (format stream ",~%  \"query\": \"~/format-json-character-data/\"" (query-sparql-expression *task*)))
56
   (format stream "});
57
     $('#download .dropdown-menu li.~a').show();
58
     $('#download .dropdown-menu li:not(.~:*~a)').hide();
59
     });" (jsonp-operation-datatype operation)))
60
 
61
 (defgeneric write-sparql-results+jsonp (results stream &key operation)
62
   (:documentation "Encode the result field to the stream as a javascript form which evaluates.
63
  The results are a list of lists. The first element is a header, which specifies the variable names.
64
  The remaining entries aer solutions sets. if a variable is unbound, the solution element is etf:nil.
65
  the toplevel object has the fields
66
   type : tuple, graph, or bool
67
   rows : the solutions
68
   terms : the term index to value map")
69
   
70
   (:method ((results list-solution-field) (stream t) &rest args)
71
     (apply #'write-sparql-results+json (cons (list-solution-field-dimensions results)
72
                                              (list-solution-field-solutions results))
73
            stream
74
            args))
75
   
76
   (:method ((results cons) (stream t) &key operation)
77
     (let* ((dimensions (first results))
78
            (solutions (rest results))
79
            (index 0)
80
            (start (or (response-offset) 0))
81
            (end (response-end))
82
            (terms (make-hash-table :test #'equalp)))
83
       (setf (gethash nil terms) 0)
84
       (write-sparql-results+jsonp-prologue stream dimensions operation)
85
       (format stream "~%  \"rows\": [")
86
       (flet ((term-index (term)
87
                (or (gethash term terms)
88
                    (let ((index (hash-table-count terms)))
89
                      (setf (gethash term terms) index)
90
                      index))))
91
         (dolist (result solutions)
92
           (when (>= index start)
93
             (when (and end (>= index end))
94
               (return))
95
             (format stream "~:[~;, ~][" (> index start))
96
             (loop for value in result
97
               with first = t
98
               do (progn (if first 
99
                             (setf first nil)
100
                             (write-char #\, stream))
101
                    (typecase value
102
                      ((or null spocq:unbound-variable)
103
                       (write-string "0" stream))
104
                      (t (princ (term-index value) stream)))))
105
             (write-string "]" stream))
106
           (incf index))
107
         (write-string "]," stream)
108
         ;; emit the remainder of the wrapper: type, prefixes and terms        "columns": ["g", "o", "p", "s"],
109
         (format stream "~%  \"terms\": [null")
110
         (loop for (index . term-id) in (sort (loop for term being each hash-key of terms
111
                                                  using (hash-value index)
112
                                                  collect (cons index term))
113
                                                  #'<
114
                                               :key #'first)
115
           for comma = nil then (write-string ", " stream)
116
           do (case term-id
117
                    (-1 (write-string "{\"type\":\"uri\", \"value\":\"urn:dydra:default\"}" stream))
118
                    (0 (write-string "null" stream))
119
                    (t
120
                     (encode-json-term-id term-id stream))))
121
         (write-string "]," stream))
122
       (write-sparql-results+jsonp-epilogue stream *namespace-bindings* operation)
123
       (terpri stream)
124
       (incf-stat *statements-returned* index)
125
       index))
126
 
127
   (:method ((results boolean-generator) (stream t) &key operation)
128
     ;;;!!! return results+json as a place holder
129
     (let* (;(dimensions (boolean-generator-dimensions results))
130
            (channel (boolean-generator-channel results)))
131
       (write-sparql-results+jsonp-prologue stream '(?::|boolean|) operation)
132
       (format stream "~%  \"rows\": [ [ ")
133
       (write-string (if (get-field-page channel) "1" "2") stream)
134
       (write-string " ] ]," stream)
135
       (format stream "~%  \"terms\": [null,
136
        {\"type\": \"literal\", \"datatype\": \"http://www.w3.org/2001/XMLSchema#boolean\", \"value\": \"true\" },
137
        {\"type\": \"literal\", \"datatype\": \"http://www.w3.org/2001/XMLSchema#boolean\", \"value\": \"false\" }],")
138
       (write-sparql-results+jsonp-epilogue stream *namespace-bindings* operation)
139
       (terpri stream)
140
       (incf-stat *statements-returned*)))
141
 
142
   (:method ((results solution-generator) (stream t) &key operation)
143
     (let* ((dimensions (solution-generator-dimensions results))
144
            (channel (solution-generator-channel results))
145
            (base-width (length dimensions))
146
            (index 0)
147
            (start (or (response-offset) 0))
148
            (end (response-end))
149
            (terms (make-hash-table :test #'equalp)))
150
       (setf (gethash 0 terms) 0)
151
       (write-sparql-results+jsonp-prologue stream dimensions operation)
152
       (format stream "~%  \"rows\": [")
153
       (do-pages (page channel)
154
         (if (and end (>= index end))
155
             (return)
156
             (if (>= (+ index (array-dimension page 0)) start)
157
                 (cond ((= base-width (array-dimension page 1))
158
                        (setf index (write-sparql-results-field+jsonp page dimensions stream terms index start end)))
159
                       (t
160
                        (log-warn "field width mismatch: ~s : ~s."
161
                                  dimensions (array-dimension page 1))
162
                        (incf index (array-dimension page 0))))
163
                 ; otherwise skip the entire page
164
                 (incf index (array-dimension page 0)))))
165
       (write-string "]," stream)
166
       ;; emit the remainder of the wrapper: type, prefixes and terms        "columns": ["g", "o", "p", "s"],
167
       (flet ((term-aspect-encoder (term-type term-literal term-language-tag term-datatype)
168
                (encode-json-term-aspects term-type term-literal term-language-tag term-datatype stream)))
169
         (declare (dynamic-extent #'term-aspect-encoder))
170
         (let ((term-deconstructor (repository-term-deconstructor *transaction*)))
171
           (format stream "~%  \"terms\": [")
172
           (loop for (index . term-id) in (sort (loop for term being each hash-key of terms
173
                                                  using (hash-value index)
174
                                                  collect (cons index term))
175
                                                  #'<
176
                                               :key #'first)
177
               for comma = nil then (write-string ", " stream)
178
               do (case term-id
179
                    (-1 (write-string "{\"type\":\"uri\", \"value\":\"urn:dydra:default\"}" stream))
180
                    (0 (write-string "null" stream))
181
                    (t
182
                     (funcall term-deconstructor #'term-aspect-encoder *transaction* term-id))))))
183
       (write-string "]," stream)
184
       (write-sparql-results+jsonp-epilogue stream *namespace-bindings* operation)
185
       (terpri stream)
186
       (incf-stat *statements-returned* index)
187
       index))
188
 
189
   (:method ((result-field matrix-field) (stream t) &key operation)
190
     (let* ((dimensions (solution-field-dimensions result-field))
191
            (base-width (length dimensions))
192
            (result-count 0)
193
            (first t)
194
            (start (or (response-offset) 0))
195
            (end (response-end))
196
            (terms (make-hash-table :test #'equalp)))
197
       (setf (gethash 0 terms) 0)
198
       (write-sparql-results+jsonp-prologue stream dimensions operation)
199
       (format stream "~%  \"rows\": [")
200
       (flet ((term-index (term)
201
                (or (gethash term terms)
202
                    (let ((index (hash-table-count terms)))
203
                      (setf (gethash term terms) index)
204
                      index))))
205
         (with-input-fields (result-field)
206
           (let ((%source-data (cffi::null-pointer))
207
                 (source-row 0))
208
             (setf (values %source-data source-row) (first-field-row result-field))
209
             (loop until (and end (>= result-count (the fixnum end)))
210
               until (cffi:null-pointer-p %source-data)
211
               do (progn
212
                    (when (> (incf result-count) start)
213
                      (format stream "~:[, ~;~][" (shiftf first nil))
214
                      (loop with first = t
215
                        for term-offset from (* base-width source-row)
216
                        for name in dimensions
217
                        when (distinguished-variable-p name)
218
                        do (let ((term-id (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)
219
                                                               (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+) term-offset)))))
220
                             (if (shiftf first nil) (write-char #\space stream) (format stream ", "))
221
                             (princ (term-index term-id) stream)))
222
                      (write-string "]" stream))
223
                    (setf (values %source-data source-row) (next-field-row result-field))))))
224
         (incf-stat *statements-returned* (- result-count start))
225
         (write-string "]," stream)
226
         (format stream "~%  \"terms\": [null")
227
         (loop for (index . term-id) in (sort (loop for term being each hash-key of terms
228
                                                using (hash-value index)
229
                                                collect (cons index term))
230
                                              #'<
231
                                              :key #'first)
232
           for comma = nil then (write-string ", " stream)
233
           do (case term-id
234
                    (-1 (write-string "{\"type\":\"uri\", \"value\":\"urn:dydra:default\"}" stream))
235
                    (0 (write-string "null" stream))
236
                    (t
237
                     (encode-json-term-id term-id stream))))
238
         (write-sparql-results+jsonp-epilogue stream *namespace-bindings* operation)
239
         (terpri stream)
240
         (incf-stat *statements-returned* result-count)
241
         result-count))))
242
 
243
 
244
 (defun write-sparql-results-field+jsonp (page variables stream terms &optional (index 0) (start 0) end)
245
   (assert (= (length (array-dimensions page)) 2) () "invalid result array dimensions: ~a" (array-dimensions page))
246
   (flet ((term-index (term)
247
            (or (gethash term terms)
248
                (let ((index (hash-table-count terms)))
249
                  (setf (gethash term terms) index)
250
                  index))))
251
     (dotimes (page-index (array-dimension page 0))
252
       (when (>= index start)
253
         (when (and end (>= index end))
254
           (return))
255
         (format stream "~:[~;, ~][" (> index start))
256
         (loop for value-index from 0
257
           with first = t
258
           for name in variables
259
           do (let* ((term-id (aref page page-index value-index))
260
                     (term-index (term-index term-id)))
261
                (if first (setf first nil) (write-string ", " stream))
262
                (princ term-index stream)))
263
         (write-string "]" stream))
264
       (incf index)))
265
   index)
266
 
267
 ;;;
268
 ;;;
269
 
270
 (defmethod send-response-message ((operation t) (message t) (stream stream) (content-type mime:application/javascript))
271
   "Given a request for application/javascript, encode similar to json, but use indexed into a cache vector."
272
   (when *encoding-trace-output*
273
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
274
   (let ((*package* *spocq-reader-package*))
275
     (write-sparql-results+jsonp message stream :operation operation)))
276
 
277
 #|
278
 (write-sparql-results+jsonp '((?::a ?::s ?::z) (1 2 3) (<http://example/1> <http://example/2> <http://example/3>))
279
                            *trace-output*)
280
 |#