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

Kind	Covered	All	%
expression	329	693	47.5
branch	12	32	37.5

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

#| value compaction:

6

(https://www.w3.org/2018/jsonld-cg-reports/json-ld-api/#value-compaction)

7

8

 This algorithm has four required inputs: an active context, an inverse context, an active property, and a value to be compacted.

9

10

Initialize number members to the number of members value contains.

11

 If value has an @index member and the container mapping associated to active property includes @index, decrease number members by 1.

12

If number members is greater than 2, return value as it cannot be compacted.

13

If value has an @id member:

14

 If number members is 1 and the type mapping of active property is set to @id, return the result of using the IRI compaction algorithm, passing active context, inverse context, and the value of the @id member for var.

15

 Otherwise, if number members is 1 and the type mapping of active property is set to @vocab, return the result of using the IRI compaction algorithm, passing active context, inverse context, the value of the @id member for var, and true for vocab.

16

Otherwise, return value as is.

17

 Otherwise, if value has an @type member whose value matches the type mapping of active property, return the value associated with the @value member of value.

18

 Otherwise, if value has an @language member whose value matches the language mapping of active property, return the value associated with the @value member of value.

19

 Otherwise, if number members equals 1 and either the value of the @value member is not a string, or the active context has no default language, or the language mapping of active property is set to null,, return the value associated with the @value member.

20

Otherwise, return value as is.

21

|#

22

23

(defmethod encode-frame-objects :around ((frame json-ld:frame) stream)

24

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

25

(call-next-method)))

26

27

(defmethod encode-json-ld-id ((term-number integer) stream)

28

(let* ((%term (or (rlmdb:shard-term-fetch term-number)

29

(error "encode-json-ld-id: unknown term: ~s" term-number)))

30

(term-type (rlmdb:%shard-term-type %term))

31

(%term-data (rlmdb:%shard-term-data %term)))

32

(declare (type cffi:foreign-pointer %term)

33

(type symbol term-type)

34

(type cffi:foreign-pointer %term-data))

35

(case term-type

36

(:node

37

(let ((label (case (rlmdb:%shard-term-subtype-node-subtype %term)

38

(:node-genid

39

                          (format nil "genid~d" (rlmdb:%shard-term-data-node-genid %term-data)))

40

(:node-gensym

41

(format nil "~a~d"

42

                                  (rlmdb:foreign-nstring-to-lisp (rlmdb:%shard-term-data-node-gensym-prefix %term-data) 4)

43

                                  (rlmdb:%shard-term-data-node-gensym-suffix %term-data)))

44

(:node-short

45

                          (rlmdb:foreign-nstring-to-lisp (rlmdb:%shard-term-data-node-label %term-data) 8))

46

((:node-long :none)

47

                          (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-node-label-offset %term-data))))))

48

(encode-json-ld-blank-node label stream)))

49

(:uri

50

          (let ((lexical-form (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-uri-string-offset %term-data))))

51

(encode-json-ld-iri-or-qname lexical-form stream)))

52

(t

53

(log-warn "encode-json-ld-id: Invalid json-ld id type: ~s: ~s" term-number term-type)

54

;; fake the id

55

(encode-json-ld-iri-or-qname (format nil "urn:dydra:~a:~s" term-type term-number) stream)))))

56

57

58

(defun encode-json-ld-iri-id-or-qname-compact (string-id stream)

59

"Given an rdf db string id, retrieve the external data and write it

60

to the stream as json in utf8."

61

(flet ((%write-string-data (k raw-value)

62

(declare (ignore k))

63

(let* ((%data (rlmdb.i::%mdb-val-data raw-value)))

64

;; no size. the iri strings are null-terminated

65

(let ((data (cffi:foreign-string-to-lisp %data)))

66

(encode-json-ld-iri-or-qname-compact data stream)))

67

t))

68

(declare (dynamic-extent #'%write-string-data))

69

(rlmdb::call-with-shard-string string-id #'%write-string-data)))

70

71

72

(defgeneric encode-json-ld-string (term stream)

73

(:method ((term-number integer) stream)

74

(let* ((%term (or (rlmdb:shard-term-fetch term-number)

75

                       (error "encode-json-ld-string-compact unknown term: ~s" term-number)))

76

(term-type (rlmdb:%shard-term-type %term))

77

(%term-data (rlmdb:%shard-term-data %term)))

78

(declare (type cffi:foreign-pointer %term)

79

(type symbol term-type)

80

(type cffi:foreign-pointer %term-data))

81

(case term-type

82

(:string

83

(ecase (rlmdb:%shard-term-subtype-string-subtype %term)

84

(:string-short

85

(format stream "\"~V/%format-json-string/\"" 8 %term-data))

86

(:string-long

87

(let* ((string-offset (rlmdb:%shard-term-data-string-value-offset %term-data)))

88

(format stream "\"~/format-json-string-id/\""

89

string-offset)))

90

(:none

91

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

92

(:literal

93

(let* ((lexical-form-id (rlmdb:%shard-term-data-literal-value-offset %term-data))

94

(datatype-string-id (rlmdb:%shard-term-data-literal-datatype-offset %term-data)))

95

;; (print (list :literal datatype-string-id datatype-lexical-form))

96

(cond ((or (eql datatype-string-id (symbol-string-id |xsd|:|string|))

97

(eql datatype-string-id (symbol-string-id |rdf|:|langString|)))

98

(format stream "\"~/format-json-string-id/\"" lexical-form-id))

99

(t

100

                   (log-warn "encode-json-ld-string: Invalid json-ld string id type: ~s: ~s" term-number term-type)

101

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

102

103

(t

104

           (log-warn "encode-json-ld-string: Invalid json-ld string id type: ~s: ~s" term-number term-type)

105

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

106

(:method ((literal string) stream)

107

;; encode just the literal string

108

(write-char #\" stream)

109

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

110

(write-char #\" stream))

111

(:method ((%literal sb-sys:system-area-pointer) stream)

112

(write-char #\" stream)

113

(stream-write-external-utf8-string-json-bytes stream %literal)

114

(write-char #\" stream)))

115

116

(defun encode-json-ld-string-compact (term stream)

117

(encode-json-ld-string term stream))

118

119

120

(defun encode-json-ld-term-number-compact (term-number stream frame term-definition)

121

"encode a term for json-ld in compact form. the character data encoding follows json, but in most

122

cases an atomic value appears rather than a dictionary.

123

strictly according to 6.5.2p5, were a term definition present which did not match

124

the type of a native value, this should emit an expanded dictionary. it does not."

125

(let* ((%term (rlmdb:shard-term-fetch term-number))

126

(term-type (rlmdb:%shard-term-type %term))

127

(%term-data (rlmdb:%shard-term-data %term)))

128

(declare (type cffi:foreign-pointer %term)

129

(type symbol term-type)

130

(type cffi:foreign-pointer %term-data))

131

(ecase term-type

132

(:none

133

(write-string "{}" stream))

134

(:node

135

(ecase (rlmdb:%shard-term-subtype-node-subtype %term)

136

(:node-genid

137

(format stream "\"~@[~a_~]genid~d\""

138

(blank-node-prefix)

139

(rlmdb:%shard-term-data-node-genid %term-data)))

140

(:node-gensym

141

(format stream "\"~@[~a_~]~V/%format-json-string/~d\""

142

(blank-node-prefix)

143

4 (rlmdb:%shard-term-data-node-gensym-prefix %term-data)

144

(rlmdb:%shard-term-data-node-gensym-suffix %term-data)))

145

(:node-short

146

(format stream "\"~@[~a_~]~V/%format-json-string/\""

147

(blank-node-prefix)

148

8 (rlmdb:%shard-term-data-node-label %term-data)))

149

((:node-long :none)

150

(format stream "\"~@[~a_~]~/format-json-string-id/\""

151

(blank-node-prefix)

152

(rlmdb:%shard-term-data-node-label-offset %term-data)))))

153

(:uri

154

        (encode-json-ld-iri-id-or-qname-compact (rlmdb:%shard-term-data-uri-string-offset %term-data) stream))

155

(:string

156

(ecase (rlmdb:%shard-term-subtype-string-subtype %term)

157

(:string-short

158

(format stream "\"~V/%format-json-string/\"" 8 %term-data))

159

(:string-long

160

(let* ((string-offset (rlmdb:%shard-term-data-string-value-offset %term-data))

161

(language-offset (rlmdb:%shard-term-data-string-language-offset %term-data))

162

(context-language (cond (term-definition

163

                                           (json-ld:term-definition-language term-definition))

164

(frame

165

(json-ld:context-language frame))

166

(t

167

nil))))

168

(if (plusp language-offset)

169

(let ((language (rlmdb:shard-string-fetch language-offset)))

170

(cond ((and context-language (string-equal language context-language))

171

(format stream "\"~/format-json-string-id/\""

172

string-offset))

173

(t

174

                          (format stream "{\"@language\":\"~/format-json-character-data/\", \"@value\":\"~/format-json-string-id/\"}"

175

language string-offset))))

176

(if (null context-language)

177

(format stream "\"~/format-json-string-id/\"" string-offset)

178

                     ;; 6.5.2p7 requires to return the dictionary. it does not say to add the language

179

                     (format stream "{\"@value\":\"~/format-json-string-id/\"}" string-offset)))))

180

(:none

181

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

182

(:literal

183

#+(or) ;; compact by type instead

184

(let* ((lexical-form-id (rlmdb:%shard-term-data-literal-value-offset %term-data))

185

(datatype-string-id (rlmdb:%shard-term-data-literal-datatype-offset %term-data))

186

(datatype-lexical-form (rlmdb:shard-string-fetch datatype-string-id))

187

               (definition-type (and term-definition (json-ld:term-definition-type term-definition))))

188

;; (print (list :literal datatype-string-id datatype-lexical-form))

189

(cond ((and definition-type (iri-equal datatype-lexical-form definition-type))

190

(format stream "\"~/format-json-string-id/\"" lexical-form-id))

191

((equalp datatype-lexical-form (symbol-uri-namestring |xsd|:|string|))

192

(format stream "\"~/format-json-string-id/\"" lexical-form-id))

193

;;; ;; allow anything which purports to be a native type

194

;;; ((string-begins-equal datatype-lexical-form "http://www.w3.org/2001/XMLSchema")

195

;;; (format stream "\"~/format-json-string-id/\"" lexical-form-id))

196

(t

197

                 ;; 6.5.2 - 5, absent a definition or with a datatype which did not match the definition

198

                 ;; the paragraph# is no longer accurate, but the section on compaction still limits elision to known types

199

                 (format stream "{\"@type\":\"~/format-json-string-id/\", \"@value\":\"~/format-json-string-id/\"}"

200

datatype-string-id lexical-form-id))))

201

(let* ((lexical-form-id (rlmdb:%shard-term-data-literal-value-offset %term-data))

202

(datatype-string-id (rlmdb:%shard-term-data-literal-datatype-offset %term-data))

203

(datatype-lexical-form (rlmdb:shard-string-fetch datatype-string-id))

204

               (definition-type (and term-definition (json-ld:term-definition-type term-definition))))

205

(cond ((and definition-type (iri-equal datatype-lexical-form definition-type))

206

;; if the term is known and it includes a type, then compact

207

(format stream "\"~/format-json-string-id/\"" lexical-form-id))

208

(t

209

                 (encode-json-ld-literal-form-id-compact lexical-form-id datatype-string-id stream)))))

210

(:boolean

211

;; must return it directly to avoid anomolous appearances

212

(format stream "~:[false~;true~]" (rlmdb:%shard-term-data-boolean %term-data)))

213

(:integer

214

(encode-json-term-compact (rlmdb:%shard-term-data-integer %term-data) stream))

215

(:decimal

216

(ecase (rlmdb:%shard-term-subtype-decimal-subtype %term)

217

(:decimal-scaled

218

(let* ((options (rlmdb:%shard-term-options %term))

219

(minusp (zerop (logand options #x01)))

220

(scale (ash options -1))

221

(value (rlmdb:%shard-term-data-integer %term-data)))

222

(when minusp (setf value (- value)))

223

(setf scale (if (zerop value) 1 (expt 10 scale)))

224

(setf value

225

#+sbcl (sb-kernel::%make-ratio value scale)

226

#-sbcl (/ value scale))

227

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

228

((:broken :none)

229

(let* ((integer (rlmdb:%shard-term-data-decimal-integer %term-data))

230

                  (fraction (if (zerop integer) 1 (rlmdb:%shard-term-data-decimal-fraction %term-data))))

231

;; short-cut compact encoding

232

(format stream "~d.~d" integer fraction)))))

233

(:float

234

(encode-json-term-compact (rlmdb:%shard-term-data-float %term-data) stream))

235

(:double

236

(encode-json-term-compact (rlmdb:%shard-term-data-double %term-data) stream))

237

(:datetime

238

        (encode-json-term-compact (timeline-location-date-time (rlmdb:%shard-term-data-time %term-data)) stream))

239

(:date

240

(encode-json-term-compact (timeline-location-date (rlmdb:%shard-term-data-time %term-data)) stream))

241

(:time

242

(encode-json-term-compact (timeline-location-time (rlmdb:%shard-term-data-time %term-data)) stream))

243

)))

244

245

(defparameter *ensure-encode-json-ld-literal-form-id-compact.operators* nil)

246

247

(defgeneric encode-json-ld-literal-form-id-compact (lexical-form-id datatype-string-id stream)

248

(:documentation

249

     "Encode a json-ld value for the given (lexical-form-id x (datatype-term-id + datatype-string-id)) combination.

250

     For literals which are immediate types, but somehow represented as expanded literlas, compact them.

251

     For literals with 'known' types, proceed as if there was a context which included their definition amd compact them as well.

252

Emit the expanded form for all others.")

253

(:argument-precedence-order datatype-string-id lexical-form-id stream)

254

(:method ((lexical-form-id t) (datatype-string-id t) stream)

255

"The default method, to be used when nothing is defined for the given datatype id.

256

first, check that the specializations have been defined.

257

if so, use the generic logic to encode the term in expanded form.

258

if they have not been, define them and try again."

259

(cond (*ensure-encode-json-ld-literal-form-id-compact.operators*

260

            (format stream "{\"@type\":\"~/format-json-string-id/\", \"@value\":\"~/format-json-string-id/\"}"

261

datatype-string-id lexical-form-id))

262

(t

263

(ensure-encode-json-ld-literal-form-id-compact-operators)

264

(encode-json-ld-literal-form-id-compact lexical-form-id datatype-string-id stream)))))

265

266

(defun ensure-encode-json-ld-literal-form-id-compact-operators ()

267

(unless *ensure-encode-json-ld-literal-form-id-compact.operators*

268

(define-encode-json-ld-literal-form-id.compact-operators)

269

(setq *ensure-encode-json-ld-literal-form-id-compact.operators* t)))

270

271

(defun define-encode-json-ld-literal-form-id.compact-operators ()

272

"Define encoding operators for both term number of the type iri

273

and the string id of the type iri lexical form"

274

(macrolet ((defnumerics (&rest names)

275

`(progn ,@(loop for type in names

276

                             collect `(defmethod encode-json-ld-literal-form-id-compact (lexical-form-id (datatype-term-number (eql (symbol-term-id ',type))) stream)

277

                                        ;; encode just the literal as an immediate value

278

                                        (format stream "~/format-json-string-id/" lexical-form-id))

279

collect `(defmethod encode-json-ld-literal-form-id-compact

280

(lexical-form-id

281

                                                  (datatype-string-id (eql (rlmdb::string-dictionary-get (iri-lexical-form ',type))))

282

stream)

283

                                        ;; encode just the literal as an immediate value

284

                                        (format stream "~/format-json-string-id/" lexical-form-id)))))

285

(deftemporals (&rest names)

286

`(progn ,@(loop for type in names

287

                             collect `(defmethod encode-json-ld-literal-form-id-compact (lexical-form-id (datatype-term-number (eql (symbol-term-id ',type))) stream)

288

                                        ;; encode just the literal as a quoted value

289

                                        (format stream "\"~/format-json-string-id/\"" lexical-form-id))

290

collect `(defmethod encode-json-ld-literal-form-id-compact

291

(lexical-form-id

292

                                                  (datatype-string-id (eql (rlmdb::string-dictionary-get (iri-lexical-form ',type))))

293

stream)

294

                                        ;; encode just the literal as a quoted value

295

                                        (format stream "\"~/format-json-string-id/\"" lexical-form-id)))))

296

(defstrings (&rest names)

297

`(progn ,@(loop for type in names

298

                             collect `(defmethod encode-json-ld-literal-form-id-compact (lexical-form-id (datatype-term-number (eql (symbol-term-id ',type))) stream)

299

;; encode just the literal string

300

                                        (format stream "\"~/format-json-string-id/\"" lexical-form-id))

301

collect `(defmethod encode-json-ld-literal-form-id-compact

302

(lexical-form-id

303

                                                  (datatype-string-id (eql (rlmdb::string-dictionary-get (iri-lexical-form ',type))))

304

stream)

305

;; encode just the literal string

306

                                        (format stream "\"~/format-json-string-id/\"" lexical-form-id))))))

307

(defnumerics

308

|http://www.w3.org/2001/XMLSchema|:|boolean|

309

|http://www.w3.org/2001/XMLSchema|:|byte|

310

|http://www.w3.org/2001/XMLSchema|:|decimal|

311

|http://www.w3.org/2001/XMLSchema|:|double|

312

|http://www.w3.org/2001/XMLSchema|:|float|

313

|http://www.w3.org/2001/XMLSchema|:|int|

314

|http://www.w3.org/2001/XMLSchema|:|integer|

315

|http://www.w3.org/2001/XMLSchema|:|long|

316

|http://www.w3.org/2001/XMLSchema|:|nonNegativeInteger|

317

|http://www.w3.org/2001/XMLSchema|:|nonPositiveInteger|

318

|http://www.w3.org/2001/XMLSchema|:|negativeInteger|

319

|http://www.w3.org/2001/XMLSchema|:|positiveInteger|

320

|http://www.w3.org/2001/XMLSchema|:|short|

321

|http://www.w3.org/2001/XMLSchema|:|unsignedByte|

322

|http://www.w3.org/2001/XMLSchema|:|unsignedInt|

323

|http://www.w3.org/2001/XMLSchema|:|unsignedLong|

324

|http://www.w3.org/2001/XMLSchema|:|unsignedShort|)

325

     ;; https://www.w3.org/TR/json-ld11-api/#algorithm-8 10.1: drop the language as well as the object wrapper

326

(defstrings

327

;; this is compacted without regard to language as the term can include

328

;; either a type or a language, but not both

329

|rdf|:|langString|

330

;; handle the cases where the datatype is present, although it should not be

331

|xsd|:|string|

332

)

333

(deftemporals

334

|http://www.w3.org/2001/XMLSchema|:|date|

335

|http://www.w3.org/2001/XMLSchema|:|dateTime|

336

|http://www.w3.org/2001/XMLSchema|:|time|)))

337

338

339

;;; (ensure-encode-json-ld-literal-form-id-compact-operators)

340

341

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

342

(:method ((object function) stream)

343

(funcall object stream))

344

345

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

346

(write-string "{}" stream))

347

348

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

349

(format stream "{\"@id\":\"~/format-json-iri-namestring/\"}" object))

350

351

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

352

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#dateTime\", \"@value\":\"")

353

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

354

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

355

356

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

357

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#date\", \"@value\":\"")

358

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

359

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

360

361

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

362

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#time\", \"@value\":\"")

363

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

364

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

365

366

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

367

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#dayTimeDuration\", \"@value\":\"")

368

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

369

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

370

371

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

372

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#yearMonthDuration\", \"@value\":\"")

373

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

374

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

375

376

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

377

(format stream "{\"@id\":\"~@[~a_~]~a\"}"

378

(blank-node-prefix)

379

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

380

381

(:method ((object symbol) stream)

382

(case object

383

((spocq.a:|true| spocq.a:|false|)

384

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#boolean\", \"@value\":~a}"

385

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

386

(t

387

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

388

(cond (uri-namestring

389

(format stream "{\"@id\":\"~/format-json-iri-namestring/\"}"

390

uri-namestring))

391

((eq object +null-term+)

392

(write-string "{}" stream))

393

(t

394

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

395

396

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

397

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

398

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

399

(write-string "true" stream))

400

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

401

(write-string "true" stream))

402

(:method ((object null) stream)

403

(write-string "false" stream))

404

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

405

(write-string "false" stream))

406

407

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

408

     (format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#langString\", \"@language\":\"~a\", \"@value\":\"~/format-json-character-data/\"}"

409

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

410

(spocq:literal-lexical-form object)))

411

412

(:method ((object string) stream)

413

     (format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#string\", \"@value\":\"~/format-json-character-data/\"}"

414

object))

415

416

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

417

(write-string "{}" stream))

418

419

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

420

     (format stream "{\"@type\":\"~/format-json-iri-namestring/\", \"@value\":\"~/format-json-character-data/\"}"

421

(spocq:literal-datatype-uri object)

422

(spocq:literal-lexical-form object)))

423

424

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

425

     (format stream "{\"@type\":\"~/format-json-iri-namestring/\", \"@value\":\"~/format-json-character-data/\"}"

426

(spocq:unsupported-typed-literal-datatype-uri object)

427

(spocq:literal-lexical-form object)))

428

429

(:method ((object integer) stream)

430

(format stream "{\"@type\":\"~a\", \"@value\":\"~a\"}"

431

(if *encode-object-subtypes*

432

(typecase object

433

((signed-byte 16) "http://www.w3.org/2001/XMLSchema#short")

434

(t "http://www.w3.org/2001/XMLSchema#integer"))

435

"http://www.w3.org/2001/XMLSchema#integer")

436

object))

437

438

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

439

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

440

(eql object double-float-positive-infinity)

441

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

442

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

443

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

444

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#double\", \"@value\":\"~f\"}"

445

object))))

446

447

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

448

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

449

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

450

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

451

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#float\", \"@value\":\"~f\"}"

452

object))))

453

454

(:method ((object rational) stream)

455

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

456

(format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#decimal\", \"@value\":\"~f\"}"

457

(float object 1.0s0)))))

458

459

460

(defun encode-json-ld-term-number-expanded (term-number stream frame term-definition)

461

"encode a term for json-ld in expanded form. the character data encoding follows json, but in most

462

cases an atomic value appears rather than a dictionary."

463

(let* ((%term (rlmdb:shard-term-fetch term-number))

464

(term-type (rlmdb:%shard-term-type %term))

465

(%term-data (rlmdb:%shard-term-data %term))

466

(*encode-json-term.type-literals* t))

467

(declare (type cffi:foreign-pointer %term)

468

(type symbol term-type)

469

(type cffi:foreign-pointer %term-data))

470

(ecase term-type

471

(:none

472

(write-string "{}" stream))

473

(:node

474

(ecase (rlmdb:%shard-term-subtype-node-subtype %term)

475

(:node-genid

476

(format stream "\"~@[~a_~]genid~d\""

477

(blank-node-prefix)

478

(rlmdb:%shard-term-data-node-genid %term-data)))

479

(:node-gensym

480

(format stream "\"~@[~a_~]~V/%format-json-string/~d\""

481

(blank-node-prefix)

482

4 (rlmdb:%shard-term-data-node-gensym-prefix %term-data)

483

(rlmdb:%shard-term-data-node-gensym-suffix %term-data)))

484

(:node-short

485

(format stream "\"~@[~a_~]~V/%format-json-string/\""

486

(blank-node-prefix)

487

8 (rlmdb:%shard-term-data-node-label %term-data)))

488

((:node-long :none)

489

(format stream "\"~@[~a_~]~/format-json-string-id/\""

490

(blank-node-prefix)

491

(rlmdb:%shard-term-data-node-label-offset %term-data)))))

492

(:uri

493

(format stream "{\"@id\": \"~/format-json-string-id/\"}"

494

(rlmdb:%shard-term-data-uri-string-offset %term-data)))

495

(:string

496

;; this should perhaps verify aganst term definitions?

497

(ecase (rlmdb:%shard-term-subtype-string-subtype %term)

498

(:string-short

499

;; write an object w/ value

500

(format stream "{\"@value\":\"~V/%format-json-string/\"}" 8 %term-data))

501

(:string-long

502

(let* ((string-offset (rlmdb:%shard-term-data-string-value-offset %term-data))

503

(language-offset (rlmdb:%shard-term-data-string-language-offset %term-data))

504

(context-language (cond (term-definition

505

                                           (json-ld:term-definition-language term-definition))

506

(frame

507

(json-ld:context-language frame))

508

(t

509

nil))))

510

(if (plusp language-offset)

511

(let ((language (rlmdb:shard-string-fetch language-offset)))

512

(cond ((and context-language (string-equal language context-language))

513

(encode-json-ld-string language stream))

514

(t

515

                          (format stream "{\"@language\":\"~/format-json-character-data/\", \"@value\":\"~/format-json-string-id/\"}"

516

language string-offset))))

517

;; always write an object w/ value

518

(format stream "{\"@value\":\"~/format-json-string-id/\"}" string-offset))))

519

(:none

520

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

521

(:literal

522

(let* ((lexical-form-id (rlmdb:%shard-term-data-literal-value-offset %term-data))

523

(datatype-string-id (rlmdb:%shard-term-data-literal-datatype-offset %term-data))

524

(datatype-lexical-form (rlmdb:shard-string-fetch datatype-string-id))

525

               (definition-type (and term-definition (json-ld:term-definition-type term-definition))))

526

;; (print (list lexical-form-id datatype-string-id datatype-lexical-form definition-type))

527

(cond ((and definition-type (iri-equal datatype-lexical-form definition-type))

528

(format stream "\"~/format-json-string-id/\"" lexical-form-id))

529

((equalp datatype-lexical-form (symbol-uri-namestring |xsd|:|string|))

530

(format stream "{\"@value\":\"~/format-json-string-id/\"}" lexical-form-id))

531

                (t ;; 6.5.2 - 5, absent a definition or with a datatype which did not match the definition

532

                 (format stream "{\"@type\":\"~/format-json-string-id/\", \"@value\":\"~/format-json-string-id/\"}"

533

datatype-string-id lexical-form-id)))))

534

(:boolean

535

        (format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#boolean\", \"@value\":~:[false~;true~]}"

536

(rlmdb:%shard-term-data-boolean %term-data)))

537

(:integer

538

(encode-json-term-expanded (rlmdb:%shard-term-data-integer %term-data) stream))

539

(:decimal

540

(ecase (rlmdb:%shard-term-subtype-decimal-subtype %term)

541

(:decimal-scaled

542

(let* ((options (rlmdb:%shard-term-options %term))

543

(minusp (zerop (logand options #x01)))

544

(scale (ash options -1))

545

(value (rlmdb:%shard-term-data-integer %term-data)))

546

(when minusp (setf value (- value)))

547

(setf scale (if (zerop value) 1 (expt 10 scale)))

548

(setf value

549

#+sbcl (sb-kernel::%make-ratio value scale)

550

#-sbcl (/ value scale))

551

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

552

((:broken :none)

553

(let* ((integer (rlmdb:%shard-term-data-decimal-integer %term-data))

554

                  (fraction (if (zerop integer) 1 (rlmdb:%shard-term-data-decimal-fraction %term-data))))

555

             (format stream "{\"@type\":\"http://www.w3.org/2001/XMLSchema#decimal\", \"@value\":\"~d.~d\"}"

556

integer fraction)))))

557

(:float

558

(encode-json-term-expanded (rlmdb:%shard-term-data-float %term-data) stream))

559

(:double

560

(encode-json-term-expanded (rlmdb:%shard-term-data-double %term-data) stream))

561

(:datetime

562

        (encode-json-term-expanded (timeline-location-date-time (rlmdb:%shard-term-data-time %term-data)) stream))

563

(:date

564

        (encode-json-term-expanded (timeline-location-date (rlmdb:%shard-term-data-time %term-data)) stream))

565

(:time

566

        (encode-json-term-expanded (timeline-location-time (rlmdb:%shard-term-data-time %term-data)) stream))

567

)))

568