Coverage report: /development/source/library/org/datagraph/spocq-shard/src/api/api.lisp

Kind	Covered	All	%
expression	31	118	26.3
branch	0	6	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

(:documentation "dydra lisp api"

6

)

7

8

(defparameter *sparql-readtable* (copy-readtable *readtable*))

9

(setf (readtable-case *sparql-readtable*) :preserve)

10

(eval-when (:load-toplevel :compile-toplevel :execute)

11

(import 'spocq.i::read-iri-or-blank-node :spocq.a))

12

13

 #+(or)                                  ; does not work to mix options and query form

14

(defun read-query (stream char1 char2)

15

(declare (ignore char1 char2))

16

(let* ((source-package *package*)

17

(*package* (find-package :spocq.a))

18

(source-readtable *readtable*)

19

(*readtable* *sparql-readtable*)

20

(expression (read stream t nil t)))

21

(labels ((reread (datum)

22

(typecase datum

23

(null nil)

24

(keyword (cons-symbol (symbol-package datum) (symbol-name datum)))

25

(symbol (cons-symbol source-package (symbol-name datum)))

26

(cons (mapcar #'reread datum))

27

(t datum))))

28

(cond ((stringp expression)

29

(setf expression (spocq.i::parse-sparql expression)))

30

((stringp (first expression))

31

(setf expression (cons (spocq.i::parse-sparql (first expression))

32

(rest expression)))))

33

(let* ((options (member-if #'keywordp expression))

34

(parsed-expression (ldiff expression options)))

35

`(sparql ,parsed-expression

36

;; re-read the keywords to get the intended case

37

,@(let ((*readtable* source-readtable))

38

(reread options)))))))

39

40

41

(defun read-query (stream char1 char2)

42

(declare (ignore char1 char2))

43

(let* ((*package* (find-package :spocq.a))

44

(*readtable* *sparql-readtable*)

45

(reader (get-macro-character #\`)))

46

(funcall reader stream #\`)))

47

48

(defun pipe-sparql (from to &rest args)

49

(declare (dynamic-extent args))

50

(apply #'pipe-query-toplevel from to args))

51

52

(defmacro sparql (form &rest options &key output-stream

53

task-id

54

&allow-other-keys &environment env)

55

(let* ((dimensions (spocq.i::expression-dimensions form))

56

(dynamic-bindings (loop for variable in dimensions

57

                                  for source-variable = (cons-symbol *package* (string variable))

58

                                  for information = (variable-information source-variable env)

59

when information

60

collect (list variable source-variable))))

61

(when output-stream

62

(setf options (copy-list options))

63

(remf options :output-stream))

64

;; do _not_ quote the form as it shuld be read by a reader-macro which implicitly quasi-quotes

65

`(pipe-sparql ,form ,output-stream

66

,@(when task-id `(:task-id ,task-id))

67

,@(when dynamic-bindings

68

`(:dynamic-bindings (list ',(mapcar #'first dynamic-bindings)

69

                                                  ,@(mapcar #'second dynamic-bindings))))

70

,@options)))

71

72

73

(set-packaged-dispatch-macro-character #\# #\? 'read-query)

74

75

;;; algebra

76

77

78

;;; carefully expand sparql:bgp and sparql:graph such that the subsequent graph rewriting succeeds

79

80

(defmacro sparql:bgp (&rest statement-patterns)

81

`(spocq.a:|bgp| ,@(loop for pattern in statement-patterns

82

collect (case (first pattern)

83

(spocq.a:|triple| pattern)

84

                                     (rdf:triple `(spocq.a:|triple| ,@(rest pattern)))

85

(t `(spocq.a:|triple| ,@pattern))))))

86

87

(defmacro sparql:graph (graph field &environment env)

88

`(spocq.a:|graph| ,graph

89

;; transform what should be the sparql:bgp form

90

,(macroexpand-1 field env)))

91

92

#+digitool (setf (ccl:assq 'sparql:graph ccl:*fred-special-indent-alist*) 1)

93

94

95

(defmacro sparql:leftjoin (&rest fields)

96

(cond ((rest fields)

97

(reduce #'(lambda (left right) `(spocq.a:|leftjoin| ,left ,right)) fields :from-end t))

98

(fields

99

(first fields))

100

(t

101

'(spocq.a:|null|))))

102

103

(defmacro sparql:select (field projection)

104

`(spocq.a:|select| ,field ,projection))

105

106

107

;;; runtime operations

108

109

(defun dydra:agent ()

110

spocq.i::*agent*)

111

112

(defun dydra:sparql-query (query &rest args &key

113

repository

114

                                  (repository-id (or repository (error "repository is required.")))

115

(agent spocq.i::*agent*))

116

(apply #'spocq.i:run-sparql query

117

:repository-id repository-id

118

:agent agent

119

(spocq.i::plist-difference args '(:repository))))

120

121

122

(defgeneric dydra:configuration (subject)

123

(:documentation "Return the metdata stripping the context to leave just s-p-o")

124

125

#+(or)

126

(:method ((resource account))

127

(let ((identifier (account-identifier resource))

128

(configuration (instance-metadata-statements resource)))

129

(loop for statement in configuration

130

;; emit just the statements from the repository-id graph as those

131

;; are local to the account

132

when (equalp (first statement) identifier)

133

;; and string the context

134

collect (rest statement))))

135

136

(:method ((resource account))

137

(let ((identifier (account-identifier resource))

138

(configuration (instance-metadata-statements resource)))

139

(loop for statement in configuration

140

;; emit just the statements from the repository-id graph as those

141

;; are local to the account

142

when (equalp (first statement) identifier)

143

;; and string the context

144

collect (rest statement))))

145

146

(:method ((repository repository))

147

(let ((repository-identifier (repository-identifier repository))

148

(configuration (instance-metadata-statements repository)))

149

(loop for statement in configuration

150

;; emit just the statements from the repository-id graph as those

151

;; are local to the account

152

when (equalp (first statement) repository-identifier)

153

;; and string the context

154

collect (rest statement)))))

155

156

157

(defgeneric (setf dydra::configuration) (configuration subject)

158

(:documentation

159

"Replace the metadata. First, delete the content of the respective graph,

160

then add the context to the given s-p-o and save the new configuration as the

161

repository's metadata graph.")

162

163

(:method ((configuration null) (repository repository))

164

;; reinitialize by asserting just the repository aspect of the initial metadata

165

(destructuring-bind (&key system account)

166

(compute-initial-repository-metadata repository)

167

(declare (ignore system))

168

(setf (dydra::configuration repository) account)))

169

170

(:method ((configuration cons) (repository repository))

171

(let* ((repository-identifier (repository-identifier repository))

172

(field (loop for statement in configuration

173

collect (cons repository-identifier statement))))

174

(repository-clear-graph *transaction* repository-identifier :if-does-not-exist nil)

175

(repository-insert-field *transaction* field))))

176

177