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

Kind	Covered	All	%
expression	233	390	59.7
branch	11	34	32.4

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 as trix; serializer only

6

7

;;; writing sparql results and terms

8

9

(defmethod write-rdf-trix :around ((results solution-generator) (stream stream))

10

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

11

(call-next-method)))

12

13

14

(defun write-rdf-field-trix (page stream &optional (index 0) (start 0) end current-graph)

15

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

16

(let ((width (array-dimension page 1)))

17

(flet ((emit (term-id)

18

(case term-id

19

(-1 (write-string "urn:dydra:default" stream))

20

(-2 (write-string "urn:dydra:named" stream))

21

(t (encode-trix-term-number term-id stream)))))

22

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

23

(when (>= index start)

24

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

25

(return))

26

(let ((subject (aref page page-index 0))

27

(predicate (aref page page-index 1))

28

(object (aref page page-index 2))

29

(graph (if (= width 4) (aref page page-index 3) -1)))

30

(when (not (zerop (* subject predicate object)))

31

(unless (eql graph current-graph)

32

(when current-graph

33

(format stream "~% </graph>"))

34

(format stream "~% <graph>")

35

(setf current-graph graph)

36

(unless (eq current-graph |urn:dydra|:|default|)

37

(format stream "~% <uri>")

38

(emit graph)

39

(format stream "</uri>")))

40

(format stream "~% <triple>~% ")

41

(emit subject)

42

(format stream "~% ")

43

(emit predicate)

44

(format stream "~% ")

45

(emit object)

46

(format stream "~% </triple>")

47

(incf index)))))))

48

(values index current-graph))

49

50

51

(defun encode-trix-term-number (term-number stream)

52

(declare (type fixnum term-number))

53

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

54

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

55

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

56

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

57

(type symbol term-type)

58

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

59

(ecase term-type

60

(:node

61

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

62

(:node-genid

63

(format stream "<id>~@[~a_~]genid~d</id>"

64

(blank-node-prefix)

65

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

66

(:node-gensym

67

(format stream "<id>~@[~a_~]~V/%format-turtle-string/~d</id>"

68

(blank-node-prefix)

69

                   ;; need a byte-count limited version of stream-write-turtle-external-utf8-string

70

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

71

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

72

(:node-short

73

(format stream "<id>~@[~a_~]~V/%format-turtle-string/</id>"

74

(blank-node-prefix)

75

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

76

((:node-long :none)

77

(format stream "<id>~@[~a_~]~/format-turtle-string-id/</id>"

78

(blank-node-prefix)

79

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

80

(:uri

81

(format stream "<uri>~/format-turtle-iri-string-id/</uri>"

82

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

83

(:string

84

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

85

(:string-short

86

           (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#string\">~V/%format-xml-character-data/</typedLiteral>"

87

8 %term-data))

88

(:string-long

89

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

90

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

91

(if (plusp language-id)

92

                 (format stream "<plainLiteral xml:lang=\"~/format-xml-character-data-id/\">~/format-xml-character-data-id/<plainLiteral>" language-id string-id)

93

                 (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#string\">~/format-xml-character-data-id/</typedLiteral>" string-id))))))

94

95

(:literal

96

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

97

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

98

;; also strings are typed

99

          (format stream "<typedLiteral datatype=\"~/format-turtle-string-id/\">~/format-turtle-iri-string-id/</typedLiteral>"

100

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

101

(:boolean

102

        (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#boolean\">~:[false~;true~]</typedLiteral>"

103

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

104

(:integer

105

(encode-trix-object (rlmdb:%shard-term-data-integer %term-data) stream))

106

107

(:decimal

108

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

109

(:decimal-scaled

110

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

111

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

112

(scale (ash options -1))

113

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

114

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

115

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

116

(setf value

117

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

118

#-sbcl (/ value scale))

119

(encode-trix-object value stream)))

120

((:broken :none)

121

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

122

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

123

(if (typep 1/3 *expand-literal-values*)

124

                 (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#decimal\">~d.~d</typedLiteral>" integer fraction)

125

                 (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#decimal\">~d.~d</typedLiteral>" integer fraction))))))

126

127

(:float

128

(encode-trix-object (rlmdb:%shard-term-data-float %term-data) stream))

129

(:double

130

(encode-trix-object (rlmdb:%shard-term-data-double %term-data) stream))

131

(:datetime

132

(encode-trix-object (timeline-location-date-time (rlmdb:%shard-term-data-time %term-data)) stream))

133

(:date

134

(encode-trix-object (timeline-location-date (rlmdb:%shard-term-data-time %term-data)) stream))

135

(:time

136

(encode-trix-object (timeline-location-time (rlmdb:%shard-term-data-time %term-data)) stream))

137

(:none

138

nil))))

139

140

141

(defgeneric encode-trix-object (object stream)

142

(:method ((object function) stream)

143

(funcall object stream))

144

145

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

146

(error "no encoding defined for object '~a' of type ~a for application/trix."

147

object (type-of object)))

148

149

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

150

     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#date\">~/format-turtle-character-data/</typedLiteral>"

151

(term-lexical-form object)))

152

153

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

154

     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#dateTime\">~/format-turtle-character-data/</typedLiteral>"

155

(term-lexical-form object)))

156

157

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

158

     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#time\">~/format-turtle-character-data/</typedLiteral>"

159

(term-lexical-form object)))

160

161

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

162

     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#dayTimeDuration\">~/format-turtle-character-data/</typedLiteral>"

163

(term-lexical-form object)))

164

165

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

166

     (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#yearMonthDuration\">~/format-turtle-character-data/</typedLiteral>"

167

(term-lexical-form object)))

168

169

170

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

171

(call-next-method))

172

173

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

174

     (format stream "<typedLiteral datatype=\"~/format-turtle-iri-namestring/\">~/format-turtle-character-data/</typedLiteral>"

175

(spocq:literal-datatype-uri object)

176

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

177

178

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

179

     (format stream "<typedLiteral datatype=\"~/format-turtle-iri-namestring/\">~/format-turtle-character-data/</typedLiteral>"

180

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

181

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

182

183

(:method ((object integer) stream)

184

(format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#integer\">~d</typedLiteral>"

185

object))

186

187

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

188

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

189

(eql object double-float-positive-infinity)

190

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

191

(call-next-method)

192

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

193

(format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#double\">~f</typedLiteral>"

194

object))))

195

196

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

197

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

198

(call-next-method)

199

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

200

(format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#float\">~f</typedLiteral>"

201

object))))

202

203

(:method ((object rational) stream)

204

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

205

(format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#decimal\">~f</typedLiteral>"

206

(float object 1.0s0)))))

207

208

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

209

(ecase term-type

210

(:none

211

;; (write-string "0" stream)

212

)

213

(:node ; encode a blank node

214

(format stream "<id>~@[~a_~]" (blank-node-prefix))

215

(stream-write-turtle-external-utf8-string stream term-literal)

216

(write-string "</id>" stream))

217

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

218

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

219

             (format stream "<plainLiteral xml:lang\"~/format-turtle-external-utf8-string/\">~/format-turtle-external-utf8-string/</plainLiteral>"

220

term-language-tag term-literal))

221

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

222

;; in order to encode tsv, this would need to be extended to abbreviate numbers

223

;; that requires getting enough of the datatype iri to differentiate...

224

             (format stream "<typedLiteral datatype=\"~/format-turtle-external-utf8-iri-namestring/\">~/format-turtle-external-utf8-string/</typedLiteral>"

225

term-datatype term-literal))

226

(t

227

             (format stream "<typedLiteral datatype=\"http://www.w3.org/2001/XMLSchema#string\">~/format-turtle-external-utf8-string/</typedLiteral>"

228

term-literal))))

229

(:uri ; encode a uri

230

(format stream "<uri>~/format-turtle-external-utf8-iri-namestring/</uri>" term-literal))))

231

232

;;;

233

234

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

235

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

236

(when *encoding-trace-output*

237

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

238

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

239

(write-rdf-trix message stream)))

240

241