Coverage report: /development/source/library/org/datagraph/spocq-shard/src/algebra/operators/sparql-update-operators.lisp

Kind	Covered	All	%
expression	333	668	49.9
branch	21	68	30.9

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 "This file defines the standard SPARQL update operators for the 'org.datagraph.spocq' RDF engine."

6

7

(copyright

8

9

10

(long-description

11

   "The file defines the update operators for the Dydra Sparql Algebra Engine from the 'SPARQL 1.1 Update'[1]

12

specification.

13

14

As with the query operators, each is defined in two aspects. A macro in the specification package

15

  (spocq.a) implements any control and evaluation order transformations and rewrites the expression in terms

16

  of an operator in the evaluation package (spocq.e). That function implements the operation either directly -

17

  for immediate data operations like insert-data and delete-data, or as a construct which streams intermediate

18

results from a select phrase to a modify phrase.

19

---

20

[1]: http://www.w3.org/TR/sparql11-update"))

21

22

23

(defmacro spocq.a:|add| (from-graph to-graph &key verbose)

24

"Add the contents of from-graph of the current task's repository to that if its to to-graph.

25

Each may be either an iri or the keyword :default."

26

`(spocq.e::add-graph ,from-graph ,to-graph ,@(if verbose '(:if-does-not-exist :error))))

27

28

(defun spocq.e:add-graph (from-graph to-graph &rest args &key if-does-not-exist)

29

"Add the contents of from-graph of the current task's repository to that if its to-graph.

30

Each may be either an iri or the keyword :default."

31

(declare (dynamic-extent args)

32

(ignore if-does-not-exist))

33

(apply #'repository-add-graph *transaction* from-graph to-graph args)

34

spocq.a:|true|)

35

36

37

(defmacro spocq.a:|clear| (graph &key verbose)

38

"Clear the content of the given graph in the current task's repository. The graphs value may be

39

either an iri or one of the keywords

40

:default : to clear the repository's default graph

41

:all : to clear all of the repository's graphs

42

:named : to clear all of the repository's named graphs"

43

(setf (variable-opacity (expression-variables graph)) :transparent)

44

`(spocq.e:clear-graph ,graph ,@(if verbose '(:if-does-not-exist :error))))

45

46

(defun spocq.e:clear-graph (graph-designator &rest args &key if-does-not-exist)

47

(declare (dynamic-extent args)

48

(ignore if-does-not-exist))

49

(apply #'repository-clear-graph *transaction* graph-designator args)

50

spocq.a:|true|)

51

52

53

(defmacro spocq.a:|copy| (from-graph to-graph &key verbose)

54

`(spocq.e:copy-graph ,from-graph ,to-graph ,@(if verbose '(:if-does-not-exist :error))))

55

56

(defun spocq.e:copy-graph (from-graph to-graph &rest args &key if-does-not-exist)

57

(declare (dynamic-extent args)

58

(ignore if-does-not-exist))

59

(apply #'repository-copy-graph *transaction* from-graph to-graph args)

60

spocq.a:|true|)

61

62

63

(defmacro spocq.a:|create| (graph &key verbose)

64

(setf (variable-opacity (expression-variables graph)) :transparent)

65

`(spocq.e:create-graph ,graph ,@(if verbose '(:if-exists :error))))

66

67

(defun spocq.e:create-graph (graph-designator &rest args &key if-exists)

68

"Check for existence and optionally signal an error if the count is non-zero.

69

If no statements are found or silent, return true to indicate 'success'.

70

If statements are found and non-silent, signal an error."

71

(declare (dynamic-extent args)

72

(ignore if-exists))

73

(apply #'repository-create-graph *transaction* graph-designator args)

74

spocq.a:|true|)

75

76

77

(defmacro spocq.a:|deleteData| (quad-or-triple-data)

78

;; data is intended to be constant

79

(validate-quad-data quad-or-triple-data :delete)

80

`(spocq.e:delete-data (quote ,quad-or-triple-data)))

81

82

(defgeneric spocq.e:delete-data (quad-or-triple-field)

83

(:method ((null-field null))

84

spocq.a:|true|)

85

86

(:method ((quad-or-triple-data list))

87

(spocq.e:delete-data (intern-quad-or-triple-data *repository* quad-or-triple-data)))

88

89

(:method ((fields vector))

90

(loop for field across fields

91

unless (equalp spocq.a:|true| (spocq.e:delete-data field))

92

return spocq.a:|false|

93

finally (return spocq.a:|true|)))

94

95

(:method ((term-field array))

96

(repository-delete-field *repository* term-field)

97

spocq.a:|true|)

98

99

(:method ((source pathname))

100

(let ((type (pathname-type source)))

101

(cond ((or (string-equal type "nq") (string-equal type "nt"))

102

(spocq.e:delete-data (parse-nquads-to-cspo source)))

103

((string-equal type "cspo")

104

(spocq.e:delete-data (parse-nquads source)))

105

(t

106

(error "spocq.e:delete-data: RDF encoding not supported: ~a" type))))))

107

108

109

(defmacro spocq.a:|deleteWhere| (quad-pattern)

110

"Given a list of quad patterns, use them both to match against the store and to construct the

111

statements to be deleted."

112

(macroexpand-delete-where quad-pattern))

113

114

115

(defun macroexpand-delete-where (quad-pattern)

116

"Generate a modify form by rewriting the quad-pattern, which is a list of bgp triple templates

117

and/or graph forms, into a valid group graph pattern for the modify's where argument with

118

the original quad pattern passed as the :delete clause."

119

120

(labels ((rewrite-quad-pattern (expression)

121

(if (consp (first expression))

122

(if (eq 'spocq.a:|triple| (caar expression))

123

                  (let* ((pattern-rest (member 'spocq.a:|triple| expression :test-not #'eq :key #'first))

124

(bgp-triples (ldiff expression pattern-rest ))

125

(bgp `(spocq.a:|bgp| ,@(copy-tree bgp-triples))))

126

(if pattern-rest

127

`(spocq.a:|join| ,bgp ,(rewrite-quad-pattern pattern-rest))

128

bgp))

129

(if (rest expression)

130

`(spocq.a:|join| ,(rewrite-quad-pattern (first expression))

131

,(rewrite-quad-pattern (rest expression)))

132

(rewrite-quad-pattern (first expression))))

133

(ecase (first expression)

134

(spocq.a:|graph| (destructuring-bind (graph triples) (cdr expression)

135

                                     `(spocq.a:|bgp| (spocq.a:|graph| ,graph) ,@(copy-tree triples))))

136

(spocq.a:|bgp| (copy-tree expression))))))

137

`(spocq.a:|modify| ,(rewrite-quad-pattern quad-pattern) :delete ,quad-pattern)))

138

139

140

(defmacro spocq.a:|drop| (graph &key verbose)

141

(setf (variable-opacity (expression-variables graph)) :transparent)

142

`(spocq.e:drop-graph ,graph ,@(if verbose '(:if-does-not-exist :error))))

143

144

(defun spocq.e:drop-graph (graph-designator &rest args &key if-does-not-exist)

145

(declare (dynamic-extent args)

146

(ignore if-does-not-exist))

147

(apply #'repository-delete-graph *transaction* graph-designator args)

148

spocq.a:|true|)

149

150

151

(defmacro spocq.a:|insertData| (quad-or-triple-data)

152

;; data is intended to be constant

153

(validate-quad-data quad-or-triple-data :insert)

154

`(spocq.e:insert-data (quote ,quad-or-triple-data)))

155

156

(defgeneric spocq.e:insert-data (quad-data)

157

(:method ((null-field null))

158

spocq.a:|true|)

159

160

(:method ((quad-or-triple-data cons))

161

(spocq.e:insert-data (intern-quad-or-triple-data *repository* quad-or-triple-data)))

162

163

(:method ((fields vector))

164

(loop for field across fields

165

unless (equalp spocq.a:|true| (spocq.e:insert-data field))

166

return spocq.a:|false|

167

finally (return spocq.a:|true|)))

168

169

(:method ((term-field array))

170

(repository-insert-field *repository* term-field)

171

spocq.a:|true|)

172

173

(:method ((source pathname))

174

(let ((type (pathname-type source)))

175

(cond ((or (string-equal type "nq") (string-equal type "nt"))

176

(spocq.e:insert-data (parse-nquads-to-cspo source)))

177

((string-equal type "cspo")

178

(spocq.e:insert-data (parse-nquads source)))

179

(t

180

(error "spocq.e:insert-data: RDF encoding not supported: ~a" type))))))

181

182

183

(defmacro spocq.a:|load| (from-location graph-designator &rest args &key verbose)

184

(declare (ignore verbose))

185

(setf (variable-opacity (expression-variables from-location)) :transparent)

186

(setf (variable-opacity (expression-variables graph-designator)) :transparent)

187

`(spocq.e:load-graph ,from-location ,graph-designator ,@args))

188

189

(defmethod spocq.e:load-graph (from-location (graph-designator t) &key (verbose t))

190

(when *transaction* ; record provenance detail

191

(let ((to-graph-term-number (repository-graph-term-number *transaction* graph-designator :allow-all t)))

192

(if (repository-pattern-match-p *transaction* nil nil nil graph-designator)

193

(setf (transaction-graph-id-modified *transaction* to-graph-term-number) t)

194

(setf (transaction-graph-id-created *transaction* to-graph-term-number) t))))

195

(if verbose

196

(repository-load-graph *transaction* from-location graph-designator)

197

(ignore-errors (repository-load-graph *transaction* from-location graph-designator)))

198

spocq.a:|true|)

199

200

201

(defmacro spocq.a:|modify| (field-expression &rest args &key delete insert with graphs named-graphs

202

&environment env)

203

(declare (ignore delete insert with graphs named-graphs))

204

(apply #'macroexpand-modify field-expression :environment env args))

205

206

(defun macroexpand-modify (field-expression &key delete insert with graphs named-graphs environment)

207

(declare (ignore environment))

208

(flet ((augment-bgps (expression graphs named-graphs)

209

(flet ((augment-bgp (expression)

210

(typecase expression

211

(cons (case (first expression)

212

(spocq.a:|bgp| `(spocq.a:|bgp|

213

                                                ,@(when (and named-graphs (not (assoc 'spocq.a:|from-named| (rest expression))))

214

                                                    `((spocq.a:|from-named| ,@named-graphs)))

215

                                                ,@(when (and graphs (not (assoc 'spocq.a:|from| (rest expression))))

216

                                                    `((spocq.a:|from| ,@graphs)))

217

,@(rest expression)))

218

                               (spocq.a:|graph| `(spocq.a:|graph| ,@(rest expression)))

219

(t expression)))

220

(t expression))))

221

(declare (dynamic-extent #'augment-bgp))

222

(map-tree #'augment-bgp expression)))

223

(augment-triples (expressions graph)

224

(loop for expression in expressions

225

collect (if (triple-form-p expression)

226

`(spocq.a:|quad| ,@(rest expression) ,graph)

227

expression))))

228

     ;; as per the 1.1 modify description [http://www.w3.org/TR/sparql11-update/#deleteInsert], the from/from-named

229

     ;; apply to the retrieval caluse while the with applies to both, whereby the from/from-named take precedence in the

230

;; retrieval caluse

231

(when (or graphs named-graphs)

232

(setf field-expression (augment-bgps field-expression graphs named-graphs)))

233

#|

234

     ;; this would allows for only those constructors which include nothing additional in their where clause

235

;; and would not allow for recursive consequences

236

;; see map-modified-resources

237

(setf delete (compute-entailed-pattern (task-repository *task*) delete (query-entailment-method *task*)

238

                                                                    environment

239

                                                                    :class <spin:constructor>))

240

(setf insert (compute-entailed-pattern (task-repository *task*) insert (query-entailment-method *task*)

241

                                                                    environment

242

                                                                    :class <spin:constructor>))

243

|#

244

(when with

245

(setf field-expression (augment-bgps field-expression (list with) nil))

246

(setf delete (augment-triples delete with))

247

(setf insert (augment-triples insert with)))

248

     `(spocq.e::modify ,(if (select-form-p field-expression) field-expression `(spocq.a:|select| ,field-expression *))

249

,@(when delete `(:delete ',delete))

250

,@(when insert `(:insert ',insert)))))

251

252

(defgeneric spocq.e:modify (solution-field &key delete insert)

253

(:documentation "Accept a solution field, together with patterns for deletion and insertion,

254

iterate over the solutions, projecting each onto first the deletion pattern and then the insertion

255

pattern and effecting each modification in turn.

256

nb. http://www.w3.org/TR/sparql11-update/#def_deleteinsertoperation indicates that the deletion

257

  and insertion stages are distinct. that is, all deletion operations are performed prior to the insertions.

258

no WITH clause is supported, since it must already have been apparent in the solution-field result,

259

the DELETE and INSERT clauses are handled symmetrically by the macro-expansion.")

260

261

(:method ((field agp) &rest args)

262

(declare (dynamic-extent args))

263

(apply #'spocq.e::modify (agp-generator field) args))

264

265

(:method ((solution-field solution-generator) &rest args)

266

(declare (dynamic-extent args))

267

;; double-check access configuration

268

(assert (api-authorized-p *api-access-mode* |acl|:|Write|) ()

269

"Write access not permitted.")

270

(apply #'spocq.e:stream-modify solution-field args)))

271

272

(defun spocq.e:stream-modify (field-generator &rest args &key delete insert)

273

(declare (ignore delete insert))

274

(let* ((base-dimensions (solution-generator-dimensions field-generator))

275

(result-channel (make-unit-table-channel :name (list 'spocq.a:|modify| (task-id *query*)))))

276

(labels ((run-modify-thread (result-channel field-generator)

277

(let ((base-channel (solution-generator-channel field-generator))

278

(base-expression (solution-generator-expression field-generator))

279

(*thread-operations* (cons (list* 'spocq.a:|modify| (task-id *task*)

280

                                                        base-dimensions

281

args)

282

*thread-operations*)))

283

(push 'spocq.a:|modify| (channel-name base-channel))

284

;; delegate the base operation to another thread, but

285

(query-run-in-thread *query* base-expression)

286

;; keep the modify aspect in this one

287

(apply #'process-modify result-channel base-channel

288

base-dimensions

289

args)

290

'spocq.a:|modify|)))

291

;; return the binding function to the combination operator

292

(make-boolean-generator :expression (list #'run-modify-thread result-channel field-generator)

293

:channel result-channel))))

294

295

(defparameter *update-cache-limit* 1024)

296

297

(defun process-modify (destination base-source base-dimensions &key delete insert)

298

(incf-stat *algebra-operations*)

299

(trace-algebra process-modify base-source base-dimensions delete insert)

300

301

302

(validate-quad-pattern delete :delete)

303

(validate-quad-pattern insert :insert)

304

(multiple-value-bind (solution-cached-p delete-constructor delete-length delete-width

305

                                           insert-constructor insert-length insert-width)

306

(compute-modify-operators base-dimensions delete insert)

307

(let* ((pattern-page nil)

308

(pattern-page-width 0)

309

(pattern-page-length 0)

310

(pattern-page-index 0)

311

(solution-pages ())

312

(base-cache (make-term-id-cache :single-thread t))

313

(result-count 0)

314

(solution-count 0))

315

(labels ((delete-processor (base-page)

316

(trace-algebra process-modify.delete base-page (term-value-field base-page))

317

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

318

(unless (funcall solution-cached-p base-page base-index base-cache)

319

(unless (= (array-dimension pattern-page 0) delete-length)

320

(setf pattern-page (make-page delete-length delete-width)))

321

(setf pattern-page-index 0)

322

(funcall delete-constructor #'collector base-page base-index)

323

(when (plusp pattern-page-index)

324

(unless (= pattern-page-index delete-length)

325

(setf pattern-page

326

                                (adjust-array pattern-page (list pattern-page-index delete-width))))

327

(repository-delete-field (task-repository *query*) pattern-page)))))

328

(insert-processor (base-page)

329

(trace-algebra process-modify.insert base-page (term-value-field base-page))

330

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

331

(unless (funcall solution-cached-p base-page base-index base-cache)

332

(unless (= (array-dimension pattern-page 0) insert-length)

333

(setf pattern-page (make-page insert-length insert-width)))

334

(setf pattern-page-index 0)

335

(funcall insert-constructor #'collector base-page base-index)

336

(when (plusp pattern-page-index)

337

(unless (= pattern-page-index insert-length)

338

(setf pattern-page

339

                                (adjust-array pattern-page (list pattern-page-index insert-width))))

340

(repository-insert-field (task-repository *query*) pattern-page)))))

341

(collector (&rest term-id-list)

342

(declare (dynamic-extent term-id-list))

343

(assert (< pattern-page-index pattern-page-length) ()

344

"Pattern page length exceeded.")

345

(trace-algebra process-modify.collector pattern-page-index term-id-list)

346

(loop for i from 0 below pattern-page-width

347

for id in term-id-list

348

do (if (= id +null-term-id+)

349

                               (return-from collector)  ;; the default graph == +null-term-id+

350

(setf (aref pattern-page pattern-page-index i) id)))

351

(incf pattern-page-index)))

352

(declare (dynamic-extent #'collector))

353

         ;; if deletion was specified, that happens first with a running cache for the base field

354

(when delete-constructor

355

(setf pattern-page (make-page delete-length delete-width))

356

(setf pattern-page-width delete-width

357

pattern-page-length delete-length)

358

(do-pages (solution-page base-source)

359

(push (copy-page solution-page) solution-pages)

360

(delete-processor solution-page)

361

(when (> (hash-table-count base-cache) *update-cache-limit*)

362

(clrhash base-cache))

363

(incf solution-count (array-dimension solution-page 0))))

364

(when insert-constructor

365

(clrhash base-cache)

366

(setf pattern-page (make-page insert-length insert-width))

367

(setf pattern-page-width insert-width

368

pattern-page-length insert-length)

369

(if delete-constructor

370

;; reuse the cached field

371

(loop for solution-page in (reverse solution-pages)

372

do (progn (check-query-status *query*)

373

(insert-processor solution-page)

374

(when (> (hash-table-count base-cache) *update-cache-limit*)

375

(clrhash base-cache))

376

(incf solution-count (array-dimension solution-page 0))))

377

;; process the base field from the source

378

(do-pages (solution-page base-source)

379

(check-query-status *query*)

380

(insert-processor solution-page)

381

(incf solution-count (array-dimension solution-page 0))))))

382

(put-field-page destination (unit-table))

383

(complete-field destination)

384

(incf-stat *solutions-processed* solution-count)

385

(incf-stat *solutions-constructed* result-count)

386

(values solution-count result-count))))

387

388

(defun compute-modify-operators (base-dimensions delete-pattern insert-pattern)

389

(multiple-value-bind (delete-constructor delete-length delete-width)

390

                        (when delete-pattern (compute-insert-pattern-constructor base-dimensions delete-pattern))

391

(multiple-value-bind (insert-constructor insert-length insert-width)

392

                            (when insert-pattern (compute-insert-pattern-constructor base-dimensions insert-pattern))

393

(values (compute-flag-cache-op base-dimensions)

394

delete-constructor delete-length delete-width

395

insert-constructor insert-length insert-width))))

396

397

398

(defmacro spocq.a:|move| (from-graph to-graph &key verbose)

399

`(spocq.e:move-graph ,from-graph ,to-graph ,@(when verbose '(:if-does-not-exist :error))))

400

401

(defun spocq.e:move-graph (from-graph to-graph &rest args &key if-does-not-exist)

402

(declare (dynamic-extent args)

403

(ignore if-does-not-exist))

404

(apply #'repository-move-graph *transaction* from-graph to-graph args)

405

spocq.a:|true|)

406

407

408

(defmacro spocq.a::|update| (&rest operations)

409

(apply #'macroexpand-update operations))

410

411

#+(or) ;; the originl version would have initiated any modifies in parallel

412

(defun macroexpand-update (&rest operations)

413

`(spocq.e:update ,@(loop for operation in operations

414

for (operator . nil) = operation

415

                        ;; delay all executionn until the transaction context is established

416

collect `(lambda () ,operation))))

417

418

(defun macroexpand-update (&rest operations)

419

`(spocq.e:update ,@(loop for operation in operations

420

for (operator . nil) = operation

421

collect `(lambda () ,operation))))

422

423

(defun spocq.e:update (&rest results-and-generators)

424

(trace-algebra update results-and-generators)

425

;; double-check access

426

(assert (api-authorized-p *api-access-mode* |acl|:|Write|) ()

427

"Write access not permitted.")

428

(let ((result-channel (make-unit-table-channel :name (list 'spocq.a::|update| (task-id *query*)))))

429

(make-boolean-generator :expression (list #'run-update-thread result-channel results-and-generators)

430

:channel result-channel)))

431

432

(defun run-update-thread (result-channel results-and-generators)

433

(labels ((fail ()

434

(trace-algebra update.fail)

435

(complete-field result-channel)

436

spocq.a:|false|)

437

(succeed ()

438

(trace-algebra update.succeed)

439

(put-field-page result-channel (unit-table))

440

(complete-field result-channel)

441

spocq.a:|true|)

442

(test-update-result (result)

443

(trace-algebra update.test result)

444

(etypecase result

445

(spocq:boolean

446

(equalp spocq.a:|true| result))

447

(abstract-field-generator

448

;; invoke the generator form directly, rather than delegating to another

449

;; thread in order to keep the same transaction context and to serialize

450

;; multiple clauses.

451

(let ((base-channel (abstract-field-generator-channel result))

452

(expression (abstract-field-generator-expression result)))

453

(when expression

454

(trace-algebra run-update-thread :update expression)

455

(apply (first expression) (rest expression)))

456

(not (null (get-field-page base-channel)))))

457

(function

458

                 ;; initiate deferred execution to ensure the order and the transaction context

459

(test-update-result (funcall result))))))

460

;; nb. this is the only location which as a matter of course should specify to commit

461

;; this is the only thread which should write and everyplace else should close with :continue

462

(if (spocq.e::with-transaction (:normal-disposition :commit)

463

(loop for result in results-and-generators

464

unless (test-update-result result)

465

do (abort-transaction "update step failed: ~a." result)

466

finally (let* ((view-name (task-commit-constraint *query*)))

467

(when (stringp view-name)

468

                         (let ((test-text (or (authorized-repository-view *repository* view-name (task-agent *query*))

469

                                              (spocq.e:resource-not-found-error :identifier view-name))))

470

(unless (run-precommit-test test-text *repository*)

471

                             (abort-transaction "commit constraint failed: ~a." view-name)

472

(return nil))))

473

(return t))))

474

(succeed)

475

(fail))

476

'spocq.e:update))

477

478

;;; (trace run-update-thread )