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

Kind	Covered	All	%
expression	10	624	1.6
branch	0	70	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

;;; csv serializer as streamed columns.

6

;;; each solution is (at least) one line, with the first containing the dimensions

7

;;; see http://www.w3.org/TR/sparql11-results-csv-tsv/

8

9

;;; no reading

10

11

12

;;; writing - either boolean or bindings

13

14

(defun csv-eol (stream)

15

(write-string (load-time-value (coerce #(#\return #\linefeed) 'string)) stream))

16

17

(defgeneric write-sparql-results+csv (results stream)

18

(:documentation "Encode the result field to the stream as text/csv.

19

The results are one solutions per line with commas between each term.

20

The first element is a header, which specifies the variable names.

21

The remaining entries are solutions sets. if a variable is unbound, there is no output.

22

If a string is blank, a pair of double quotes appears.")

23

24

(:method ((result symbol) (stream t))

25

(format stream "result")

26

(csv-eol stream)

27

(encode-csv-object result stream)

28

(csv-eol stream)

29

(incf-stat *statements-returned*))

30

31

(:method ((results cons) (stream t))

32

(let* ((dimensions (first results))

33

(solutions (rest results))

34

(index 0)

35

(start (or (response-offset) 0))

36

(end (response-end)))

37

(format stream "~{~a~^,~}" dimensions)

38

(csv-eol stream)

39

(dolist (result solutions)

40

(when (>= index start)

41

(when (and end (>= index end))

42

(return))

43

(loop for value in result

44

for first = t then nil

45

do (progn (unless first (write-string ", " stream))

46

(encode-csv-object value stream))))

47

(incf index)

48

(csv-eol stream))

49

(incf-stat *statements-returned* index)))

50

51

(:method ((results boolean-generator) (stream t))

52

(let* ((channel (boolean-generator-channel results)))

53

(format stream "result")

54

(csv-eol stream)

55

       (write-string (spocq:literal-lexical-form (if (get-field-page channel) spocq.a:|true| spocq.a:|false|)) stream)

56

(csv-eol stream)

57

(incf-stat *statements-returned*)))

58

59

(:method ((results solution-generator) (stream t))

60

(let* ((dimensions (solution-generator-dimensions results))

61

(channel (solution-generator-channel results))

62

(variable-count (length dimensions))

63

(index 0)

64

(start (or (response-offset) 0))

65

(end (response-end)))

66

(flet ((term-aspect-encoder (term-type term-literal term-language-tag term-datatype)

67

                (encode-csv-term-aspects term-type term-literal term-language-tag term-datatype stream)))

68

(declare (dynamic-extent #'term-aspect-encoder))

69

(let ((term-deconstructor (repository-term-deconstructor *transaction*)))

70

(format stream "~{~a~^,~}" dimensions)

71

(csv-eol stream)

72

(do-pages (page channel)

73

(if (and end (>= index end))

74

(return)

75

(if (>= (+ index (array-dimension page 0)) start)

76

(cond ((= variable-count (array-dimension page 1))

77

(dotimes (page-index (array-dimension page 0))

78

(when (>= index start)

79

(when (and end (>= index end))

80

(return))

81

(loop for value-index from 0 below variable-count

82

                                  do (progn (unless (zerop value-index) (write-char #\, stream))

83

                                            (let ((term-id (aref page page-index value-index)))

84

                                              (cond ((= term-id +null-term-id+))

85

(t

86

                                                     (funcall term-deconstructor #'term-aspect-encoder *transaction* term-id))))))

87

(csv-eol stream))

88

(incf index)))

89

(t

90

(log-warn "field width mismatch: ~s : ~s."

91

dimensions (array-dimension page 1))

92

(incf index (array-dimension page 0))))

93

; otherwise skip the entire page

94

(incf index (array-dimension page 0)))))))

95

(incf-stat *statements-returned* index))))

96

97

;;;;;;;

98

99

100

(defgeneric cl-user::format-csv-iri-namestring (stream term &optional option arg)

101

(:method (stream (object string) &optional option arg)

102

(declare (ignore option arg))

103

(cl-user::format-csv-character-data stream object))

104

105

(:method (stream (object spocq:iri) &optional option arg)

106

(declare (ignore option arg))

107

(cl-user::format-csv-character-data stream (spocq:iri-lexical-form object)))

108

109

(:method (stream (object symbol) &optional option arg)

110

(declare (ignore option arg))

111

;; vocabulary iri should not require escaping

112

(write-string (symbol-uri-namestring object) stream)))

113

114

115

(defun csv-textdata-char-p (c)

116

(let ((code (char-code c)))

117

(and (>= code #x20) (<= code #x7e)

118

(aref (load-time-value (let ((array (make-array (1+ #x7e) :initial-element nil)))

119

(loop for i from 0 to #x7e

120

do (setf (aref array i)

121

                                                  (or (= i #x21)  ;; exclude #\space

122

                                                      (and (>= i #x23) (<= i #x2B))

123

                                                      (and (>= i #x2D) (<= i #x7E)))))

124

array))

125

code))))

126

127

(defun csv-textdata-p (string)

128

(and (plusp (length string)) (every #'csv-textdata-char-p string)))

129

130

(defun cl-user::format-csv-character-data (stream string &optional option arg)

131

(declare (ignore option arg))

132

(cond ((csv-textdata-p string)

133

(write-string string stream))

134

(t

135

(write-char #\" stream)

136

(loop for char across string

137

do (case char

138

(#\" (write-string "\"\"" stream))

139

(#\backspace (write-string "\\b" stream))

140

(#\page (write-string "\\f" stream))

141

(#\linefeed (write-string "\\n" stream))

142

(#\return (write-string "\\r" stream))

143

(#\tab (write-string "\\t" stream))

144

(t (let ((code (char-code char)))

145

                          (if (or (<= code #x1f)      ; C0 control : http://en.wikipedia.org/wiki/Control_character

146

                                  (and (<= #x80 code) (<= code #x9f)))        ; C1 control

147

(format stream "\\u~4,'0x" code)

148

(write-char char stream))))))

149

(write-char #\" stream))))

150

151

 ;;; (format *trace-output* ">~/format-csv-character-data/<" (concatenate 'string "asdf.\"." `(,(code-char 31)) ".qwer"))

152

153

(defgeneric stream-write-external-utf8-string-as-csv (stream %string)

154

(:method ((stream amqp:channel) %string)

155

(macrolet ((emit (byte) `(amqp.i::amqp-stream-write-byte stream ,byte)))

156

(flet ((emit-non-zero (byte)

157

(if (zerop byte)

158

(return-from stream-write-external-utf8-string-as-csv)

159

(emit byte))))

160

(let ((i 0))

161

;; as per rfc4627

162

;; All Unicode characters may be placed within the

163

;; quotation marks except for the characters that must be escaped:

164

;; quotation mark, reverse solidus, and the control characters (U+0000

165

;; through U+001F).

166

(loop (let ((byte (cffi:mem-ref %string :uint8 i)))

167

(declare (type (integer 0 255) byte))

168

(when (zerop byte) (return))

169

(cond ((= 0 (logand #x80 byte))

170

(cond ((<= byte #x1f)

171

(format stream "\\u~4,'0x" byte))

172

((= byte #.(char-code #\"))

173

(emit #.(char-code #\\))

174

(emit #.(char-code #\")))

175

((= byte #.(char-code #\\))

176

(emit #.(char-code #\\))

177

(emit #.(char-code #\\)))

178

(t

179

(emit byte)))

180

(incf i))

181

((= #xc0 (logand #xe0 byte))

182

(emit byte)

183

(emit-non-zero (cffi:mem-ref %string :uint8 (incf i)))

184

(incf i))

185

((= #xe0 (logand #xf0 byte))

186

(emit byte)

187

(emit-non-zero (cffi:mem-ref %string :uint8 (incf i)))

188

(emit-non-zero (cffi:mem-ref %string :uint8 (incf i)))

189

(incf i))

190

((= #xf0 (logand #xf8 byte))

191

(emit byte)

192

(emit-non-zero (cffi:mem-ref %string :uint8 (incf i)))

193

(emit-non-zero (cffi:mem-ref %string :uint8 (incf i)))

194

(emit-non-zero (cffi:mem-ref %string :uint8 (incf i)))

195

(incf i))

196

(t

197

(log-error "Illegal UTF-8 data: x~2,'0x." byte)

198

                          (dsu:simple-encoding-error :datum byte :expected-type '(or (eql #xc0) (eql #xe0) (eql #xf0))

199

                                                     :encoding :utf-8)))))))))

200

(:method ((stream stream) %string)

201

(cl-user::format-csv-character-data stream (cffi:foreign-string-to-lisp %string))))

202

203

204

205

(defgeneric encode-csv-object (term stream)

206

(:method ((object function) stream)

207

(funcall object stream))

208

209

(:method ((object null) (stream t))

210

)

211

212

(:method ((object spocq:iri) stream)

213

(cl-user::format-csv-iri-namestring stream object))

214

215

(:method ((object spocq:date) stream)

216

(write-string (term-lexical-form object) stream))

217

218

(:method ((object spocq:date-time) stream)

219

(write-string (term-lexical-form object) stream))

220

221

(:method ((object spocq:time) stream)

222

(write-string (term-lexical-form object) stream))

223

224

(:method ((object spocq:day-time-duration) stream)

225

(write-string (term-lexical-form object) stream))

226

227

(:method ((object spocq:year-month-duration) stream)

228

(write-string (term-lexical-form object) stream))

229

230

(:method ((object spocq:blank-node) stream)

231

(format stream "_:~@[~a_~]~a"

232

(blank-node-prefix)

233

(spocq:blank-node-label object)))

234

235

(:method ((object symbol) stream)

236

(let ((uri-namestring (symbol-uri-namestring object)))

237

(cond (uri-namestring

238

(cl-user::format-csv-iri-namestring stream uri-namestring))

239

((eq object +null-term+)

240

)

241

(t

242

              (dsu:simple-encoding-error :datum object :expected-type 'spocq:iri :encoding 'mime:text/csv)))))

243

244

(:method ((object spocq:plain-literal) stream)

245

(format stream "~/format-csv-character-data/~@[@~a~]"

246

(spocq:literal-lexical-form object)

247

(spocq:plain-literal-language-tag object)))

248

249

(:method ((object string) stream)

250

(cl-user::format-csv-character-data stream object))

251

252

(:method ((object spocq:unbound-variable) stream)

253

)

254

255

(:method ((object spocq:atomic-typed-literal) stream)

256

(cl-user::format-csv-character-data stream (spocq:literal-lexical-form object)))

257

258

(:method ((object spocq:unsupported-typed-literal) stream)

259

(cl-user::format-csv-character-data stream (spocq:literal-lexical-form object)))

260

261

(:method ((object integer) stream)

262

(format stream "~a" object))

263

264

(:method ((object double-float) stream)

265

(let ((*read-default-float-format* 'double-float))

266

(format stream "~f" object)))

267

268

(:method ((object single-float) stream)

269

(let ((*read-default-float-format* 'single-float))

270

(format stream "~f" object)))

271

272

(:method ((object rational) stream)

273

(let ((*read-default-float-format* 'single-float))

274

(format stream "~f" (float object 1.0s0)))))

275

276

(defun encode-csv-term-id (term-number stream)

277

(flet ((term-aspect-encoder (term-type term-literal term-language-tag term-datatype)

278

(encode-csv-term-aspects term-type term-literal term-language-tag term-datatype stream)))

279

(declare (dynamic-extent #'term-aspect-encoder))

280

(repository-call-with-numbered-term-aspects #'term-aspect-encoder *transaction* term-number)))

281

282

283

(defun encode-csv-term (%term stream)

284

(encode-csv-term-aspects (cffi:foreign-slot-value %term 'rdfcache::term 'rdfcache::type)

285

                             (cffi:foreign-slot-value %term 'rdfcache::term 'rdfcache::value)

286

                             (cffi:foreign-slot-value %term 'rdfcache::term 'rdfcache::language)

287

                             (cffi:foreign-slot-value %term 'rdfcache::term 'rdfcache::datatype)

288

stream))

289

290

(defun encode-csv-term-aspects (term-type term-literal term-language-tag term-datatype stream)

291

(declare (ignore term-datatype))

292

(ecase term-type

293

(:none )

294

(:node ; encode a blank node

295

(write-string "_:" stream)

296

(when (blank-node-prefix)

297

(write-string (blank-node-prefix) stream)

298

(write-char #\_ stream))

299

(stream-write-external-utf8-string-as-csv stream term-literal))

300

(:literal ; encode a typed or language-tagged literal

301

(cond ((not (cffi:null-pointer-p term-language-tag))

302

(stream-write-external-utf8-string-as-csv stream term-literal)

303

(write-char #\@ stream)

304

(stream-write-external-utf8-string-as-csv stream term-language-tag))

305

(t

306

(stream-write-external-utf8-string-as-csv stream term-literal))))

307

(:uri ; encode a uri

308

(stream-write-external-utf8-string-as-csv stream term-literal))))

309

310

311

;;; reading results

312

313

(defun parse-csv-term (string)

314

(let ((length (length string)))

315

(if (plusp length)

316

(cond ((or (string-equal "http://" string :end2 (min length #.(length "http://")))

317

(string-equal "https://" string :end2 (min length #.(length "https://")))

318

(string-equal "urn:" string :end2 (min length #.(length "urn:"))))

319

(intern-iri string))

320

((eql (char string 0) #\")

321

(subseq string 1 (1- length)))

322

;; problematic ... handle the specific cases which may apply

323

;; ((ignore-errors (parse-term string)))

324

((is-blank_node string)

325

(intern-blank-node (subseq string 2)))

326

((is-float-string string)

327

(spocq.e:double string))

328

((is-decimal-string string)

329

(spocq.e:decimal string))

330

((is-integer-string string)

331

(spocq.e:integer string))

332

(t string))

333

nil)))

334

335

(defgeneric read-sparql-results+csv (stream)

336

(:method ((location spocq:iri))

337

(read-sparql-results+csv (with-http-request-stream (request-stream response-stream location

338

                                                                        :accept "text/csv")

339

(declare (ignore request-stream))

340

(read-stream response-stream))))

341

(:method ((source pathname))

342

(with-open-file (stream source :direction :input)

343

(read-sparql-results+csv source)))

344

(:method ((source string))

345

(with-input-from-string (stream source)

346

(read-sparql-results+csv stream)))

347

(:method ((result-stream stream))

348

(labels ((parse-dimensions (line)

349

(loop for column in (split-string line ",")

350

collect (if (eql (char column 0) #\")

351

                              (intern (subseq column 1 (1- (length column))) *variable-package*)

352

(intern column *variable-package*))))

353

(parse-sparql-query-solution (line)

354

(mapcar #'parse-csv-term

355

                        (spocq.i::parse-csv line :start-name 'odcsv::|recordfields| :separator #\,)))

356

(read-csv-line (stream)

357

(let ((line (read-line stream nil nil)))

358

(when line

359

(string-trim #(#\return #\newline #\space) line)))))

360

(let* ((header (read-csv-line result-stream))

361

(dimensions (parse-dimensions header))

362

(count 0))

363

(values (loop for line = (read-csv-line result-stream)

364

until (null line)

365

collect (parse-sparql-query-solution line)

366

do (incf count))

367

dimensions

368

count)))))

369

370

371

;;; message communication api

372

373

(defmethod receive-message ((source t) (content-type mime:text/csv) &key)

374

(read-sparql-results+csv source))

375

376

377

(defmethod send-error-message ((body t) (stream t) (content-type mime:text/csv))

378

"Send an error response encoded as sse"

379

(send-error-message body stream mime:application/sparql-query+sse))

380

381

382

(defmethod send-response-message (operation (message-body t) (stream t)

383

(content-type mime:text/csv))

384

"Given a MESSAGE, and a STREAM with the text/csv CONTENT-TYPE, encode as csv, streamed"

385

(when *encoding-trace-output*

386

(setf stream (make-broadcast-stream *encoding-trace-output* stream)))

387

(let ((*package* *spocq-reader-package*))

388

(write-sparql-results+csv message-body stream)))

389

390

391

#|

392

393

 (write-sparql-results+csv '((?::a ?::s ?::z) (1 2 3) (<http://example/1> <http://example/2> <http://example/3>))

394

*trace-output*)

395

(write-sparql-results+csv '((?::a ?::s ?::z)

396

(1 2 3)

397

(<http://example/1> <http://example/2> "asdf qwer, t")

398

(<http://example/1> <http://example/2> <http://example/3>))

399

*trace-output*)

400

401

(write-sparql-results+csv 'spocq.a:|true| *trace-output*)

402

403

(send-response-message :test

404

                        '((?::a ?::s ?::z) (1 2 3) (<http://example/1> <http://example/2> <http://example/3>))

405

*trace-output*

406

mime:text/csv)

407

|#