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

KindCoveredAll%
expression0372 0.0
branch038 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
 ;;; results+json-columns serializer
6
 ;;; ideosyncratic to dydra
7
 
8
 ;;; no reading
9
 
10
 
11
 ;;; writing - either boolean or bindings                             
12
 
13
 (defgeneric write-sparql-results+json-columns (results stream)
14
   (:documentation "Encode the result field to the stream as results+json-columns.
15
  The results are a list of lists. The first element is a header, which specifies the variable names.
16
  The remaining entries are solutions sets. if a variable is unbound, the solution element is etf:nil.")
17
   
18
   (:method ((result symbol) (stream t))
19
     (format stream "{\"columns\": [\"result\"], \"rows\": [ [")
20
     (encode-json-term result stream)
21
     (format stream "] ], \"total\": 1}~%")
22
     (incf-stat *statements-returned*))
23
   
24
   (:method ((results cons) (stream t))
25
     (let* ((variables (first results))
26
            (solutions (rest results))
27
            (index 0)
28
            (start (or (response-offset) 0))
29
            (end (response-end)))
30
       (format stream "{\"columns\": [~{\"~a\"~^, ~}]," variables)
31
       (format stream "~% \"rows\": [")
32
       (dolist (result solutions)
33
         (when (>= index start)
34
           (when (and end (>= index end))
35
             (return))
36
           (unless (= index start)
37
             (write-char #\, stream)
38
             (terpri stream))
39
           (write-string "    [" stream)
40
           (loop for value in result
41
                 with first = t
42
                 do (progn (unless (shiftf first nil) (write-string ", " stream))
43
                           (encode-json-term value stream)))
44
           (write-string "]" stream))
45
         (incf index))
46
       (format stream " ],~% \"total\": ~d}~%" index)
47
       (incf-stat *statements-returned* index)))
48
   
49
   (:method ((results boolean-generator) (stream t))
50
     (let* ((channel (boolean-generator-channel results)))
51
       (write-string  "{\"columns\": [\"result\"], \"rows\": [ [" stream)
52
       (write-string (spocq:literal-lexical-form (if (get-field-page channel) spocq.a:|true| spocq.a:|false|)) stream)
53
       (write-string "] ], \"total\": 1}" stream)
54
       (incf-stat *statements-returned*)))
55
   
56
   (:method ((results solution-generator) (stream t))
57
     (let* ((dimensions (solution-generator-dimensions results))
58
            (channel (solution-generator-channel results))
59
            (variable-count (length dimensions))
60
            (index 0)
61
            (start (or (response-offset) 0))
62
            (end (response-end)))
63
       (format stream "{\"columns\": [~{\"~a\"~^, ~}]," dimensions)
64
       (format stream "~%   \"rows\": [")
65
       (do-pages (page channel)
66
         (if (and end (>= index end))
67
           (return)
68
           (if (>= (+ index (array-dimension page 0)) start)
69
             (cond ((= variable-count (array-dimension page 1))
70
                    (trace-data write-sparql-results+json-columns dimensions (term-value-field page))
71
                    (setf index (write-sparql-results-field+json-columns page stream index start end)))
72
                   (t
73
                    (log-warn "field width mismatch: ~s : ~s."
74
                              dimensions (array-dimension page 1))
75
                    (incf index (array-dimension page 0))))
76
             ; otherwise skip the entire page
77
             (incf index (array-dimension page 0)))))
78
       (format stream " ],~%   \"total\": ~d}~%" index)
79
       (incf-stat *statements-returned* index)))
80
 
81
     (:method ((result-field true-matrix-field) (stream t))
82
       (format stream  "{\"columns\": [\"result\"], \"rows\": [ [ ~a ] ], \"total\": 1}"
83
               (spocq:literal-lexical-form spocq.a:|true|))
84
       (incf-stat *statements-returned*))
85
 
86
     (:method ((result-field false-matrix-field) (stream t))
87
       (format stream  "{\"columns\": [\"result\"], \"rows\": [ [ ~a ] ], \"total\": 1}"
88
               (spocq:literal-lexical-form spocq.a:|false|))
89
       (incf-stat *statements-returned*))
90
 
91
     (:method ((result-field matrix-field) (stream t))
92
       (flet ((term-aspect-encoder (term-type term-literal term-language-tag term-datatype)
93
                (encode-json-term-aspects term-type term-literal term-language-tag term-datatype stream)))
94
         (declare (dynamic-extent #'term-aspect-encoder))
95
         (let ((term-deconstructor (repository-term-deconstructor *transaction*)))
96
           (let* ((dimensions (solution-field-dimensions result-field))
97
                  (base-width (length dimensions))
98
                  (start (or (response-offset) 0))
99
                  (end (response-end))
100
                  (result-count 0)
101
                  (first t))
102
             (with-input-fields (result-field)
103
               (format stream "{\"columns\": [~{\"~a\"~^, ~}]," (remove-if-not #'distinguished-variable-p dimensions))
104
               (format stream "~%   \"rows\": [")
105
               (let ((%source-data (cffi::null-pointer))
106
                     (source-row 0))
107
                 (setf (values %source-data source-row) (first-field-row result-field))
108
                 (loop until (and end (>= result-count (the fixnum end)))
109
                       until (cffi:null-pointer-p %source-data)
110
                       do (progn
111
                            (trace-matrix "~& write-sparql-results+json-columns.next ~@{~a ~}" :source-row source-row)
112
                            (when (> (incf result-count) start)
113
                              (format stream "~:[,~;~]~%     " (shiftf first nil))
114
                              (write-string " [" stream)
115
                              (loop with first = t
116
                                    for term-offset from (* base-width source-row)
117
                                    for name in dimensions
118
                                    when (distinguished-variable-p name)
119
                                    do (let ((term-id (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)
120
                                                       (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+) term-offset)))))
121
                                         (if (shiftf first nil) (write-char #\space stream) (format stream ", "))
122
                                         (cond ((= term-id +null-term-id+)
123
                                                (write-string "{}" stream))
124
                                               (t
125
                                                (funcall term-deconstructor #'term-aspect-encoder *transaction* term-id)))))
126
                              (write-string " ]" stream))
127
                            (setf (values %source-data source-row) (next-field-row result-field)))))
128
               (incf-stat *statements-returned* (- result-count start))
129
               (format stream " ],~%   \"total\": ~d}~%" (- result-count start))
130
               (terpri stream))
131
            (incf-stat *statements-returned* (- result-count start))))))
132
 
133
     )
134
 
135
 
136
 
137
 
138
 (defun write-sparql-results-field+json-columns (page stream &optional (index 0) (start 0) end)
139
   (assert (= (length (array-dimensions page)) 2) () "invalid result array dimensions: ~a" (array-dimensions page))
140
   (flet ((term-aspect-encoder (term-type term-literal term-language-tag term-datatype)
141
            (encode-json-term-aspects term-type term-literal term-language-tag term-datatype stream)))
142
     (declare (dynamic-extent #'term-aspect-encoder))
143
     (let ((term-deconstructor (repository-term-deconstructor *transaction*)))
144
       (let ((variable-count (array-dimension page 1)))
145
         (dotimes (page-index (array-dimension page 0))
146
           (when (>= index start)
147
             (when (and end (>= index end))
148
               (return))
149
             (unless (= index start)
150
               (write-char #\, stream)
151
               (terpri stream))
152
             (write-string " [" stream)
153
             (loop for value-index from 0 below variable-count
154
                   do (let ((term-id (aref page page-index value-index)))
155
                        (unless (zerop value-index)
156
                          (write-string ", " stream)
157
                          (terpri stream))
158
                        (cond ((= term-id +null-term-id+)
159
                               (write-string "{}" stream))
160
                              (t
161
                               (funcall term-deconstructor #'term-aspect-encoder *transaction* term-id)))))
162
             (write-string "]" stream))
163
           (incf index)))))
164
   index)
165
 
166
 
167
 (defmethod send-error-message ((body t) (stream t) (content-type mime:application/sparql-results+json-columns))
168
   "Send an error response encoded as xml"
169
   (send-error-message body stream mime:application/sparql-query+sse))
170
 
171
 
172
 (defmethod send-response-message (operation (message-body t) (stream t)
173
                                             (content-type mime:application/sparql-results+json-columns))
174
   "Given a MESSAGE, and a STREAM with the application/sparql-results+json-columns CONTENT-TYPE, encode as json"
175
   (flet ((do-send ()
176
            (let ((*package* *spocq-reader-package*))
177
              (write-sparql-results+json-columns message-body stream))))
178
     (typecase *encoding-trace-output*
179
       (null
180
        (do-send))
181
       (pathname
182
        (with-open-file (log *encoding-trace-output* :if-does-not-exist :create :if-exists :supersede :direction :output)
183
          (setf stream (make-broadcast-stream log stream))
184
          (do-send)))
185
       (stream
186
        (setf stream (make-broadcast-stream *encoding-trace-output* stream))
187
        (do-send)))))
188
 
189
   
190
 
191
 #|
192
 (setq *encoding-trace-output* #p"/tmp/rabbit-log.json")
193
 
194
 (write-sparql-results+json-columns '((?::a ?::s ?::z) (1 2 3) (<http://example/1> <http://example/2> <http://example/3>))
195
                                    *trace-output*)
196
 
197
 (write-sparql-results+json-columns 'spocq.a:|true| *trace-output*)
198
 
199
 (send-response-message :test
200
                        '((?::a ?::s ?::z) (1 2 3) (<http://example/1> <http://example/2> <http://example/3>))
201
                        *trace-output*
202
                        mime:application/sparql-results+json-columns)
203
 |#