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

KindCoveredAll%
expression53472 11.2
branch452 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
 #|
6
 note that the identifiers are lower case.
7
 in particular, contrary to the original technincal report [1] and the wikipedia page[2],
8
 the xml schema[3] stipilates 'trix'. 
9
 
10
 [1] https://www.hpl.hp.com/techreports/2004/HPL-2004-56.html
11
 [2] https://en.wikipedia.org/wiki/TriX_(serialization_format)
12
 [3] https://www.w3.org/2004/03/trix/trix-1/trix-1.0.xsd
13
 |#
14
 
15
 ;;; results as trix; serializer only
16
 
17
 ;;; writing sparql results and terms
18
 
19
 (defgeneric write-rdf-trix (results stream)
20
   (:documentation "Encode the result field to the stream as trix.
21
  The results must have three or four dimensions - if four, then treat the elemnents as quads.
22
  Allow the first element to be a list of dimensions.
23
  The remaining entries aer solutions sets. if a variable is unbound, the solution element is etf:nil.")
24
   
25
   (:method ((results t) (stream stream))
26
     (error "Invalid ntriples/nquads field: ~s ..." results))
27
 
28
   (:method ((results list-solution-field) (stream stream))
29
     (write-rdf-trix (cons (solution-field-dimensions results)
30
                             (solution-field-solutions results))
31
                       stream))
32
 
33
   (:method ((results cons) (stream stream))
34
     (let* ((variables (if (every #'variable-p (first results))
35
                         (first results)))
36
            (solutions (if (eq variables (first results)) (rest results) results))
37
            (index 0)
38
            (start (or (response-offset) 0))
39
            (end (response-end)))
40
       (if variables
41
         (unless (typep (length variables) '(integer 3 4))
42
           (spocq.e:request-error "Invalid trix field: ~s ..." variables))
43
         (setf variables
44
               (case (length (first solutions))
45
                 (4 (quad-dimensions))
46
                 (t (triple-dimensions)))))
47
       (when (plusp start)
48
         (setf solutions (nthcdr start solutions))
49
         (if end
50
           (decf end start)))
51
       (format stream "<trix xmlns='http://www.w3.org/2004/03/trix/trix-1/'>")
52
       (loop for statement in solutions
53
         with current-graph = nil
54
         if (and end (>= index end))
55
         do (return)
56
         else do (destructuring-bind (subject predicate object &optional (graph |urn:dydra|:|default|)) statement
57
                   (when (and subject predicate object)
58
                     (unless (equalp graph current-graph)
59
                       (when current-graph
60
                         (format stream "~% </graph>"))
61
                       (format stream "~% <graph>")
62
                       (setf current-graph graph)
63
                       (unless (eq current-graph |urn:dydra|:|default|)
64
                         (format stream "~%  <uri>~/format-trix-object/</uri>" current-graph)))
65
                     (format stream "~%  <triple>~%   ~/format-trix-object/~%   ~/format-trix-object/~%   ~/format-trix-object/~%  </triple>"
66
                             subject predicate object)
67
                     (incf index)))
68
         finally (progn
69
                   (when current-graph
70
                     (format stream "~% </graph>"))
71
                   (format stream "~%</trix>")
72
                   (terpri stream)))
73
       (incf-stat *statements-returned* index)
74
       index))
75
   
76
   (:method ((results solution-generator) (stream stream))
77
     (let* ((dimensions (solution-generator-dimensions results))
78
            (channel (solution-generator-channel results))
79
            (base-width (length dimensions))
80
            (index 0)
81
            (start (or (response-offset) 0))
82
            (end (response-end))
83
            (current-graph nil))
84
       (unless (typep (length dimensions) '(integer 3 4))
85
         (spocq.e:request-error "Invalid trix field: ~s ..." dimensions))
86
       (format stream "<trix xmlns='http://www.w3.org/2004/03/trix/trix-1/'>")
87
       (do-pages (page channel)
88
         (when (and end (>= index end))
89
           (return))
90
         (if (>= (+ index (array-dimension page 0)) start)
91
             (cond ((= base-width (array-dimension page 1))
92
                    (trace-data write-rdf-trix dimensions (term-value-field page))
93
                    (multiple-value-setq (index current-graph)
94
                      (write-rdf-field-trix page stream index start end current-graph)))
95
                   (t
96
                    (log-warn "field width mismatch: ~s : ~s."
97
                              dimensions (array-dimension page 1))
98
                    (incf index (array-dimension page 0))))
99
             ; otherwise skip the entire page
100
             (incf index (array-dimension page 0))))
101
       (when current-graph
102
         (format stream "~% </graph>"))
103
       (format stream "~%</trix>")
104
       (terpri stream)
105
       (incf-stat *statements-returned* index)
106
       index)))
107
 
108
 (defun write-rdf-field-trix (page stream &optional (index 0) (start 0) end current-graph)
109
   (assert (= (length (array-dimensions page)) 2) () "invalid result array dimensions: ~a" (array-dimensions page))
110
   (flet ((term-aspect-encoder (term-type term-literal term-language-tag term-datatype)
111
            (encode-trix-term-aspects term-type term-literal term-language-tag term-datatype stream)))
112
     (declare (dynamic-extent #'term-aspect-encoder))
113
     (let ((term-deconstructor (repository-term-deconstructor *transaction*))
114
           (width (array-dimension page 1)))
115
       (flet ((emit (term-id)
116
                (case term-id
117
                  (-1 (write-string "urn:dydra:default" stream))
118
                  (-2 (write-string "urn:dydra:named" stream))
119
                  (t (funcall term-deconstructor #'term-aspect-encoder *transaction* term-id)))))
120
         (dotimes (page-index (array-dimension page 0))
121
           (when (>= index start)
122
             (when (and end (>= index end))
123
               (return))
124
             (let ((subject (aref page page-index 0))
125
                   (predicate (aref page page-index 1))
126
                   (object (aref page page-index 2))
127
                   (graph (if (= width 4) (aref page page-index 3) -1)))
128
               (when (not (zerop (* subject predicate object)))
129
                 (unless (eql graph current-graph)
130
                   (when current-graph
131
                     (format stream "~% </graph>"))
132
                   (format stream "~% <graph>")
133
                   (setf current-graph graph)
134
                   (unless (eq current-graph |urn:dydra|:|default|)
135
                     (format stream "~%  <uri>")
136
                     (emit graph)
137
                     (format stream "</uri>")))
138
                 (format stream "~%  <triple>~%   ")
139
                 (emit subject)
140
                 (format stream "~%   ")
141
                 (emit predicate)
142
                 (format stream "~%   ")
143
                 (emit object)
144
                 (format stream "~%  </triple>")
145
                 (incf index))))))))
146
   (values index current-graph))
147
 
148
 (defun cl-user::format-trix-object (stream object &rest args)
149
   (declare (ignore args))
150
   (encode-trix-object object stream))
151
 
152
 (defgeneric encode-trix-object (object stream)
153
   (:method ((object function) stream)
154
     (funcall object stream))
155
 
156
   (:method ((object t) (stream t))
157
     (error "no encoding defined for object '~a' of type ~a for application/trix."
158
            object (type-of object)))
159
 
160
   (:method ((object spocq:iri) stream)
161
     (format stream "<uri>~/format-turtle-iri-namestring/</uri>" (iri-lexical-form object)))
162
 
163
   (:method ((object spocq:date) stream)
164
     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#date\">~/format-turtle-character-data/</typedLiteral>"
165
             (term-lexical-form object)))
166
 
167
   (:method ((object spocq:date-time) stream)
168
     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#dateTime\">~/format-turtle-character-data/</typedLiteral>"
169
             (term-lexical-form object)))
170
 
171
   (:method ((object spocq:time) stream)
172
     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#time\">~/format-turtle-character-data/</typedLiteral>"
173
             (term-lexical-form object)))
174
 
175
   (:method ((object spocq:day-time-duration) stream)
176
     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#dayTimeDuration\">~/format-turtle-character-data/</typedLiteral>"
177
             (term-lexical-form object)))
178
 
179
   (:method ((object spocq:year-month-duration) stream)
180
     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#yearMonthDuration\">~/format-turtle-character-data/</typedLiteral>"
181
             (term-lexical-form object)))
182
 
183
   (:method ((object spocq:blank-node) stream)
184
     (format stream "<id>~@[~a_~]~/format-turtle-character-data/</id>"
185
             (blank-node-prefix) (spocq:blank-node-label object)))
186
 
187
   (:method ((object symbol) stream)
188
     (let ((uri-namestring (symbol-uri-namestring object)))
189
       (cond (uri-namestring
190
              (format stream "<uri>~/format-turtle-iri-namestring/</uri>" uri-namestring))
191
             (*encode-turtle-object-as-variable-p*
192
              (if (variable-p object)
193
                (format stream "<id>?~a<id>" object)
194
                (format stream "<~a/>" object)))
195
             (t
196
              (call-next-method)))))
197
 
198
   (:method ((object spocq:plain-literal) stream)
199
     (format stream "<plainLiteral xml:lang=\"~a\">~/format-turtle-character-data/</plainLiteral>"
200
             (spocq:plain-literal-language-tag object)
201
             (spocq:literal-lexical-form object)))
202
 
203
   (:method ((object string) stream)
204
     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#string\">~/format-turtle-character-data/</typedLiteral>"
205
             object))
206
 
207
   (:method ((object spocq:unbound-variable) stream)
208
     (call-next-method))
209
 
210
   (:method ((object spocq:atomic-typed-literal) stream)
211
     (format stream "<typedLiteral datatype=\"~/format-turtle-iri-namestring/\">~/format-turtle-character-data/</typedLiteral>"
212
             (spocq:literal-datatype-uri object)
213
             (spocq:literal-lexical-form object)))
214
     
215
   (:method ((object spocq:unsupported-typed-literal) stream)
216
     (format stream "<typedLiteral datatype=\"~/format-turtle-iri-namestring/\">~/format-turtle-character-data/</typedLiteral>"
217
             (spocq:unsupported-typed-literal-datatype-uri object)
218
             (spocq:literal-lexical-form object)))
219
 
220
   (:method ((object integer) stream)
221
      (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#integer\">~d</typedLiteral>"
222
                object))
223
 
224
   (:method ((object double-float) stream)
225
    (if (or (eql object double-float-nan)
226
            (eql object double-float-positive-infinity)
227
            (eql object double-float-negative-infinity))
228
      (call-next-method)
229
      (let ((*read-default-float-format* 'double-float))
230
        (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#double\">~f</typedLiteral>"
231
                object))))
232
 
233
   (:method ((object single-float) stream)
234
    (if (or (eql object nan) (eql object +inf) (eql object -inf))
235
      (call-next-method)
236
      (let ((*read-default-float-format* 'single-float))
237
       (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#float\">~f</typedLiteral>"
238
                object))))
239
 
240
   (:method ((object rational) stream)
241
     (let ((*read-default-float-format* 'single-float))
242
       (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#decimal\">~f</typedLiteral>"
243
               (float object 1.0s0)))))
244
 
245
 (defun encode-trix-term-aspects (term-type term-literal term-language-tag term-datatype stream)
246
   (ecase term-type
247
     (:none 
248
      ;; (write-string "0" stream)
249
      )
250
     (:node                            ; encode a blank node
251
      (format stream "<id>~@[~a_~]" (blank-node-prefix))
252
      (stream-write-turtle-external-utf8-string stream term-literal)
253
      (write-string "</id>" stream))
254
     (:literal                         ; encode a typed or language-tagged literal
255
      (cond ((not (cffi:null-pointer-p term-language-tag))
256
             (format stream "<plainLiteral xml:lang\"~/format-turtle-external-utf8-string/\">~/format-turtle-external-utf8-string/</plainLiteral>"
257
                     term-language-tag term-literal))
258
            ((not (cffi:null-pointer-p term-datatype))
259
             ;; in order to encode tsv, this would need to be extended to abbreviate numbers
260
             ;; that requires getting enough of the datatype iri to differentiate...
261
             (format stream "<typedLiteral datatype=\"~/format-turtle-external-utf8-iri-namestring/\">~/format-turtle-external-utf8-string/</typedLiteral>"
262
                     term-datatype term-literal))
263
            (t
264
             (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#string\">~/format-turtle-external-utf8-string/</typedLiteral>"
265
                     term-literal))))
266
     (:uri                             ; encode a uri
267
      (format stream "<uri>~/format-turtle-external-utf8-iri-namestring/</uri>" term-literal))))
268
 
269
 ;;;
270
 
271
 (defmethod send-response-message (operation (message t) (stream t) (content-type mime:application/trix))
272
   "Given a MESSAGE, and a STREAM with the text/plain CONTENT-TYPE, encode as ntriples"
273
   (when *encoding-trace-output*
274
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
275
   (let ((*package* *spocq-reader-package*))
276
     (write-rdf-trix message stream)))
277
 
278