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

Kind	Covered	All	%
expression	173	585	29.6
branch	7	48	14.6

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

(:documentation "application/json serializer (sort of)"

6

"see http://www.ietf.org/rfc/rfc4627.txt

7

the web-ui depends on the application/json encoding in various places

8

- sparql results

9

- query, transaction, and import list

10

- various side-panel updates

11

12

in most cases, the compact, standard json encoding is expected. that is, each

13

member is just the name:value sequence.

14

in the case of sparql results, however, the client javascript expects something

15

sort of like application/sparql-results+json. a header indicates the dimension

16

names and the objects are just values, without names.

17

18

in order to accomplish this the encoding implementation function,

19

write-sparql-results-application+json, distinguishes between fields which are

20

lists and those which a given as a generator or a matrix.

21

in the first case, it emits compact json with named values. in the second, it

22

emits a header with unnamed, but typed values.

23

24

json decoding is handled in json.lisp")

25

26

27

;;; writing - either boolean or bindings

28

29

(defgeneric write-sparql-results-application+json (results stream)

30

   (:documentation "Encode the result field to the stream as a sequence of primitive json object w/o any correlation.

31

This is invoked directly from application/json encoding, which subsumes as well application/rdf+json.

32

It should not be invoked for application/ld+json as that is iteself specialized.")

33

34

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

35

(format stream "{\"boolean\": ~a}"

36

(spocq.e:boolean result))

37

(incf-stat *statements-returned*))

38

39

(:method ((results list-solution-field) (stream t))

40

(write-sparql-results-application+json (cons (list-solution-field-dimensions results)

41

                                                  (list-solution-field-solutions results))

42

stream))

43

44

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

45

(let* ((variables (first results))

46

(solutions (rest results))

47

(index 0)

48

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

49

(end (response-end)))

50

(format stream "[")

51

(dolist (result solutions)

52

(when (>= index start)

53

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

54

(return))

55

(format stream "~:[~;,~% ~] { " (> index start))

56

(loop for name in variables for value in result

57

with first = t

58

do (typecase value

59

;; emit non-null values and enable commas

60

((or null spocq:unbound-variable (member etf:nil)))

61

(t (format stream "~:[, ~;~]\"~a\": " first name)

62

(setf first nil)

63

(encode-json-term-compact value stream))))

64

(format stream " }"))

65

(incf index))

66

(format stream " ]~%")

67

(incf-stat *statements-returned* index)

68

index))

69

70

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

71

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

72

(format stream "{\"boolean\": ~a}"

73

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

74

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

75

76

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

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

(*expand-literal-values* nil) ;; don't expand any literals

84

;(*expand-literal-values* 'number)

85

)

86

(rlmdb::with-string-database (sdb)

87

(format stream "[")

88

(do-pages (page channel)

89

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

90

(return)

91

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

92

(cond ((= base-width (array-dimension page 1))

93

                                  (trace-data write-sparql-results-application+json dimensions (term-value-field page))

94

                                  (setf index (write-transaction-sparql-results-application+json *transaction* page dimensions stream index start end)))

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

(format stream " ]~:[~;~%~]" *print-pretty*)

102

(incf-stat *statements-returned* index)

103

index)))

104

105

(:method ((result-field true-matrix-field) (stream t))

106

(format stream "~a" (spocq:literal-lexical-form spocq.a:|true|))

107

(incf-stat *statements-returned*))

108

109

(:method ((result-field false-matrix-field) (stream t))

110

(format stream "~a" (spocq:literal-lexical-form spocq.a:|false|))

111

(incf-stat *statements-returned*))

112

113

(:method ((result-field matrix-field) (stream t))

114

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

115

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

116

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

117

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

118

(let* ((dimensions (solution-field-dimensions result-field))

119

(base-width (length dimensions))

120

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

121

(end (response-end))

122

(result-count 0)

123

(first t))

124

(with-input-fields (result-field)

125

(remove-if-not #'distinguished-variable-p dimensions)

126

(format stream "[")

127

(let ((%source-data (cffi::null-pointer))

128

(source-row 0))

129

(setf (values %source-data source-row) (first-field-row result-field))

130

(loop until (and end (>= result-count (the fixnum end)))

131

until (cffi:null-pointer-p %source-data)

132

do (progn

133

                      (trace-matrix "~& write-sparql-results-application+json.next ~@{~a ~}" :source-row source-row)

134

(when (> (incf result-count) start)

135

                        (format stream "~:[,~;~]~:[~;~%~]     " (shiftf first nil) *print-pretty*)

136

(write-string " {" stream)

137

(loop with first = t

138

for term-offset from (* base-width source-row)

139

for name in dimensions

140

when (distinguished-variable-p name)

141

                          do (let ((term-id (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)

142

                                                                 (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+) term-offset)))))

143

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

144

                                 (if (shiftf first nil) (write-char #\space stream) (format stream ", "))

145

(format stream "\"~a\": " name)

146

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

147

(write-string " }" stream))

148

                      (setf (values %source-data source-row) (next-field-row result-field)))))

149

(incf-stat *statements-returned* (- result-count start))

150

(format stream " ]~:[~;~%~]" *print-pretty*)

151

result-count)))))

152

153

#+(or) ;; this, the compact json encoding breaks the web-ui result display

154

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

155

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

156

(channel (solution-generator-channel results))

157

(base-width (length dimensions))

158

(index 0)

159

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

160

(end (response-end)))

161

(format stream "[")

162

(do-pages (page channel)

163

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

164

(return)

165

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

166

(cond ((= base-width (array-dimension page 1))

167

(trace-data write-sparql-results+json dimensions (term-value-field page))

168

                    (setf index (write-sparql-results-field+json-compact page dimensions stream index start end)))

169

(t

170

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

171

dimensions (array-dimension page 1))

172

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

173

; otherwise skip the entire page

174

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

175

(format stream " ]~%")

176

(incf-stat *statements-returned* index)

177

index))

178

179

#+(or) ;; this, the compact json encoding breaks the web-ui result display

180

(:method ((result-field matrix-field) (stream t))

181

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

182

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

183

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

184

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

185

(let* ((dimensions (solution-field-dimensions result-field))

186

(base-width (length dimensions))

187

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

188

(end (response-end))

189

(result-count 0)

190

(first t))

191

(with-input-fields (result-field)

192

(format stream "[")

193

(let ((%source-data (cffi::null-pointer))

194

(source-row 0))

195

(setf (values %source-data source-row) (first-field-row result-field))

196

(loop until (and end (>= result-count (the fixnum end)))

197

until (cffi:null-pointer-p %source-data)

198

do (progn

199

                          (trace-matrix "~& write-sparql-results+json.next ~@{~a ~}" :source-row source-row)

200

(when (> (incf result-count) start)

201

(format stream "~:[,~;~]~% " (shiftf first nil))

202

(loop with first = t

203

for term-offset from (* base-width source-row)

204

for name in dimensions

205

when (distinguished-variable-p name)

206

                                  do (let ((term-id (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)

207

                                                     (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+) term-offset)))))

208

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

209

                                         (if (shiftf first nil) (write-char #\space stream) (format stream ", "))

210

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

211

                          (setf (values %source-data source-row) (next-field-row result-field)))))

212

(incf-stat *statements-returned* (- result-count start))

213

(write-string " ]" stream)

214

(terpri stream))

215

result-count)))))

216

217

(defun write-sparql-results-field+json-compact (page variables stream &optional (index 0) (start 0) end)

218

   (assert (= (length (array-dimensions page)) 2) () "invalid result array dimensions: ~a" (array-dimensions page))

219

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

220

            ;;(encode-json-term-aspects-compact term-type term-literal term-language-tag term-datatype stream)))

221

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

222

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

223

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

224

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

225

(when (>= index start)

226

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

227

(return))

228

(when (> index start)

229

(write-char #\, stream))

230

(format stream "~:[~;~%~] {" *print-pretty*)

231

(loop for value-index from 0

232

with first = t

233

for name in variables

234

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

235

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

236

                        (if first (write-char #\space stream) (format stream ",~:[~;~%~]     " *print-pretty*))

237

(setf first nil)

238

(format stream "\"~a\": " name)

239

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

240

(write-string " }" stream))

241

(incf index))))

242

index)

243

244

(defgeneric encode-json-term-compact (term stream)

245

(:method ((object function) stream)

246

(funcall object stream))

247

248

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

249

(write-string "null" stream))

250

251

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

252

(format stream "\"~/format-json-iri-namestring/\"" object))

253

254

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

255

(format stream "\"~a\"" (term-lexical-form object)))

256

257

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

258

(format stream "\"~a\"" (term-lexical-form object)))

259

260

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

261

(format stream "\"~a\"" (term-lexical-form object)))

262

263

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

264

(format stream "\"~a\"" (term-lexical-form object)))

265

266

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

267

(format stream "\"~a\"" (term-lexical-form object)))

268

269

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

270

(format stream "\"~@[~a_~]~a\"" (blank-node-prefix) (spocq:blank-node-label object)))

271

272

(:method ((object symbol) stream)

273

(case object

274

(spocq.a:|true|

275

(write-string (spocq:literal-lexical-form spocq.a:|true|) stream))

276

(spocq.a:|false|

277

(write-string (spocq:literal-lexical-form spocq.a:|false|) stream))

278

(:|null|

279

(write-string "null" stream))

280

(t

281

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

282

(cond (uri-namestring

283

(format stream "\"~/format-json-iri-namestring/\"" uri-namestring))

284

((eq object +null-term+)

285

(write-string "null" stream))

286

(t

287

(error "encoding error: invalid value: ~s." object)))))))

288

289

(:method ((object spocq:boolean) stream)

290

(write-string (spocq:literal-lexical-form object) stream))

291

(:method ((object (eql t)) stream)

292

(write-string "true" stream))

293

(:method ((object (eql :|true|)) stream)

294

(write-string "true" stream))

295

(:method ((object null) stream)

296

(write-string "false" stream))

297

(:method ((object (eql :|false|)) stream)

298

(write-string "false" stream))

299

300

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

301

#+(or)

302

(format stream "{\"type\":\"literal\", \"xml:lang\":\"~a\", \"value\":\"~/format-json-character-data/\"}"

303

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

304

(spocq:literal-lexical-form object))

305

(format stream "\"~/format-json-character-data/\"" (spocq:literal-lexical-form object)))

306

307

(:method ((object string) stream)

308

(format stream "\"~/format-json-character-data/\"" object))

309

310

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

311

(write-string "null" stream))

312

313

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

314

(format stream "\"~/format-json-character-data/\"" (spocq:literal-lexical-form object)))

315

316

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

317

(format stream "\"~/format-json-character-data/\"" (spocq:literal-lexical-form object)))

318

319

(:method ((object integer) stream)

320

(format stream "~a" object))

321

322

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

323

(if (or (eql object double-float-nan)

324

(eql object double-float-positive-infinity)

325

(eql object double-float-negative-infinity))

326

(error "encoding error: invalid float value: ~a" object)

327

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

328

(format stream "~f" object))))

329

330

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

331

(if (or (eql object nan) (eql object +inf) (eql object -inf))

332

(error "Invalid float value: ~a" object)

333

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

334

(format stream "~f" object))))

335

336

(:method ((object rational) stream)

337

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

338

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

339

340

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

341

(ecase term-type

342

(:none (write-string "{}" stream))

343

(:node ; encode a blank node

344

(format stream "\"~@[~a_~]" (blank-node-prefix))

345

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

346

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

347

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

348

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

349

(write-string "{\"type\":\"literal\", \"xml:lang\":\"" stream)

350

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

351

(write-string "\", \"value\":\"" stream)

352

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

353

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

354

((or (cffi:null-pointer-p term-datatype)

355

(%string-equal term-datatype (|%http://www.w3.org/2001/XMLSchema#string|)))

356

(cond ((typep "" *expand-literal-values*)

357

(cond ((typep "" *encode-json-term.type-members*)

358

                           (write-string "{\"type\":\"literal\", \"datatype\":\"http://www.w3.org/2001/XMLSchema#string\", \"value\":\"" stream)

359

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

360

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

361

(t

362

(write-string "{\"type\":\"literal\", \"value\":\"" stream)

363

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

364

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

365

(t

366

(write-char #\" stream)

367

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

368

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

369

(t

370

(write-string "{\"type\":\"literal\", \"datatype\":\"" stream)

371

(stream-write-external-utf8-string-as-json stream term-datatype)

372

(write-string "\", \"value\":\"" stream)

373

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

374

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

375

(:uri ; encode a uri

376

(write-char #\" stream)

377

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

378

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

379

;;;

380

;;;

381

382

383

(defmethod send-error-message ((body t) (stream t) (content-type mime:application/json))

384

"Send an error response encoded as xml"

385

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

386

387

388

(defmethod send-response-message ((operation t) (message t) (stream t) (content-type mime:application/json))

389

"Given a MESSAGE, and a STREAM with the application/json CONTENT-TYPE, encode as json.

390

This is intended to subsume application/rdf+json as well."

391

(when *encoding-trace-output*

392

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

393

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

394

(write-sparql-results-application+json message stream)))

395

396

#|

397

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

398

*trace-output*)

399

|#