Coverage report: /development/source/library/org/datagraph/spocq-shard/src/extensions/graphql/ssf-graphql.lisp

Kind	Covered	All	%
expression	0	427	0.0
branch	0	22	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.sparql-1-0-4; -*-

2

3

;;; (load "patches/ssf-graphql.lisp")

4

5

(in-package :org.datagraph.spocq.implementation)

6

7

(defpackage :org.datagraph.spocq.graphql

8

(:nicknames :graphql)

9

(:import-from :common-lisp nil)

10

(:export common-lisp:nil))

11

12

(defpackage :org.datagraph.spocq.graphql.s

13

(:use )

14

(:nicknames :graphql.s))

15

16

(defpackage :org.datagraph.spocq.graphql-0-0-1

17

(:use :common-lisp)

18

(:nicknames :graphql-0-0-1))

19

20

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

21

(loop for name in (append (mapcar #'string (coerce ",:={}()[]@$!" 'list))

22

'("..."

23

"false"

24

"fragment"

25

"implements"

26

"input"

27

"interface"

28

"mutation"

29

"on"

30

"query"

31

"type"

32

"true"))

33

do (intern name :org.datagraph.spocq.graphql)

34

do (export (intern name :org.datagraph.spocq.graphql.s)

35

:org.datagraph.spocq.graphql.s)))

36

37

(let ((graphql-id-pattern (cl-ppcre:parse-string "[a-zA-Z]\\w*")))

38

(setf (cl-ppcre:parse-tree-synonym 'graphql-id-pattern) graphql-id-pattern))

39

40

(defparameter *graphql-scanner*

41

(cl-ppcre:create-scanner '(:ALTERNATION

42

                               (:register (:ALTERNATION (:CHAR-CLASS #\, #\: #\= #\{ #\} #\( #\) #\[ #\] #\@ #\$ #\! )

43

                                                       (:sequence #\" (:GREEDY-REPETITION 0 NIL

44

                                                                                          (:alternation (:sequence #\\ #\")

45

                                                                                                        (:INVERTED-CHAR-CLASS #\")))

46

                                                                  #\")

47

                                                       json-float-pattern

48

                                                       json-integer-pattern

49

                                                       graphql-id-pattern

50

                                                       (:ALTERNATION "..."

51

                                                                     "false"

52

                                                                     "fragment"

53

                                                                     "implements"

54

                                                                     "input"

55

                                                                     "interface"

56

                                                                     "mutation"

57

                                                                     "on"

58

                                                                     "query"

59

                                                                     "type"

60

                                                                     "true")))

61

(:GREEDY-REPETITION 1 NIL :WHITESPACE-CHAR-CLASS))))

62

63

(defun graphql-0-0-1::is-number (x)

64

(numberp x))

65

66

(defun graphql-0-0-1::is-string (x)

67

(stringp x))

68

69

(defun graphql-0-0-1::is-id (x)

70

(and (stringp x) (> (length x) 0)

71

(alpha-char-p (char x 0))

72

(loop for i from 1 below (length x) unless (graphic-char-p (char x i)) do (return nil)

73

finally (return t))))

74

75

(defun tokenize-graphql (graphql-string &key (start 0) (end (length graphql-string)))

76

"deconstructuct the string into a sequence of grapahq.s tokens and atomic term values."

77

(let (tokens)

78

     (cl-ppcre:do-matches-as-strings (match *graphql-scanner* graphql-string (make-array (length tokens) :initial-contents (nreverse tokens))

79

:start start :end end)

80

(let* ((initial (char match 0))

81

(token (cond ((eql initial #\")

82

(subseq match 1 (1- (length match))))

83

((find initial "+-0123456789")

84

(read-from-string match))

85

((find-symbol match :org.datagraph.spocq.graphql))

86

((every #'cl-ppcre::whitespacep match)

87

nil)

88

((stringp match)

89

match)

90

(t

91

(warn "tokenize-graphql: invalid token: ~s" match)

92

nil))))

93

(when token (push token tokens))))))

94

95

96

(defun graphql-0-0-1::|boolean_value-Constructor| (value)

97

value)

98

99

(defun graphql-0-0-1::|NUMBER-Constructor| (number)

100

(assert (numberp number) () "|NUMBER-Constructor|: invalid number: ~s." number)

101

number)

102

103

(defun graphql-0-0-1::|ID-Constructor| (id)

104

id)

105

106

107

(defun graphql-0-0-1::|STRING-Constructor| (string)

108

(assert (stringp string) () "|STRING-Constructor|: invalid string: ~s." string)

109

string)

110

111

112

113

(defun graphql-0-0-1::|graphqlFile-Constructor| (definition*)

114

(cons 'graphql::|graphqlFile| definition*))

115

116

117

118

(defun graphql-0-0-1::|definition-Constructor| (fragment_definition operation_definition type_definition)

119

(list 'graphql::|definition| type_definition operation_definition fragment_definition))

120

121

(defun graphql-0-0-1::|type_definition-Constructor| (field_definitions interfaces? named_type type_category)

122

(list 'graphql::|type_definition| type_category named_type interfaces? field_definitions))

123

124

(defun graphql-0-0-1::|type_category-Constructor| (category)

125

(list 'graphql::|type_category| category))

126

127

(defun graphql-0-0-1::|interfaces-Constructor| (named_type)

128

(list 'graphql::|interfaces| named_type))

129

130

(defun graphql-0-0-1::|field_definition_list-Constructor| (field_definition field_definition_list)

131

(cons field_definition field_definition_list))

132

133

(defun graphql-0-0-1::|field_definitions-Constructor| (field_definition_list)

134

(cons 'graphql::|field_definitions| field_definition_list))

135

136

(defun graphql-0-0-1::|field_definition-Constructor| (argument_definitions? field_name type_ref)

137

(list 'graphql::|field_definition| field_name argument_definitions? type_ref))

138

139

(defun graphql-0-0-1::|argument_definition_list-Constructor| (argument_definition argument_definition_list)

140

(cons argument_definition argument_definition_list))

141

142

(defun graphql-0-0-1::|argument_definitions-Constructor| (argument_definition_list)

143

(cons 'graphql::|argument_definitions| argument_definition_list))

144

145

(defun graphql-0-0-1::|argument_definition-Constructor| (argument_name type_ref)

146

(list 'graphql::|argument_definition| argument_name type_ref))

147

148

 (defun graphql-0-0-1::|operation_definition-Constructor| (directive? operation_name? operation_type selection_set variable_definitions?)

149

(if (or operation_type operation_name? variable_definitions? directive? selection_set)

150

       (list 'graphql::|operation_definition| operation_type operation_name? variable_definitions? directive? selection_set)

151

(list 'graphql::|operation_definition| selection_set)))

152

153

(defun graphql-0-0-1::|operation_name-Constructor| (ID)

154

(list 'graphql::|operation_name| ID))

155

156

(defun graphql-0-0-1::|operation_type-Constructor| (item)

157

(list 'graphql::|operation_type| item))

158

159

(defun graphql-0-0-1::|selection_set_list-Constructor| (selection selection_set_list)

160

(cons selection selection_set_list))

161

162

(defun graphql-0-0-1::|selection_set-Constructor| (selection_set_list)

163

(cons 'graphql::|selection_set| selection_set_list))

164

165

(defun graphql-0-0-1::|selection-Constructor| (field fragment_spread inline_fragment)

166

(list 'graphql::|selection| (or field fragment_spread inline_fragment)))

167

168

(defun graphql-0-0-1::|field-Constructor| (alias? arguments? directives? field_name selection_set?)

169

(list 'graphql::|field| alias? field_name arguments? directives? selection_set?))

170

171

(defun graphql-0-0-1::|field_name-Constructor| (name)

172

(list 'graphql::|field_name| name))

173

174

(defun graphql-0-0-1::|arguments-Constructor| (argument_list)

175

(cons 'graphql::|arguments-Constructor| argument_list))

176

177

(defun graphql-0-0-1::|argument_list-Constructor| (argument argument_list)

178

(cons argument argument_list))

179

180

(defun graphql-0-0-1::|argument-Constructor| (argument_name argument_value)

181

(list 'graphql::|argument| argument_name argument_value))

182

183

(defun graphql-0-0-1::|argument_name-Constructor| (item)

184

(list 'graphql::|argument_name| item))

185

186

(defun graphql-0-0-1::|argument_value-Constructor| (value)

187

(list 'graphql::|argument_value| value))

188

189

(defun graphql-0-0-1::|alias-Constructor| (alias_name)

190

(list 'graphql::|alias| alias_name))

191

192

(defun graphql-0-0-1::|alias_name-Constructor| (ID)

193

(list 'graphql::|alias_name| ID))

194

195

(defun graphql-0-0-1::|fragment_spread-Constructor| (directives? fragment_name)

196

(list 'graphql::|fragment_spread| fragment_name directives?))

197

198

(defun graphql-0-0-1::|fragment_definition-Constructor| (directives? fragment_name? type_condition selection_set)

199

(list 'graphql::|fragment_definition| fragment_name? type_condition directives? selection_set))

200

201

(defun graphql-0-0-1::|fragment_name-Constructor| (ID)

202

(list 'graphql::|fragment_name| ID))

203

204

(defun graphql-0-0-1::|inline_fragment-Constructor| (directives? selection_set type_condition?)

205

(list 'graphql::|inline_fragment| type_condition? directives? selection_set))

206

207

(defun graphql-0-0-1::|type_condition-Constructor| (named_type)

208

(list 'graphql::|type_condition| named_type))

209

210

 (defun graphql-0-0-1::|value-Constructor| (variable NUMBER string_value boolean_value enum_value list_value object_value)

211

(or boolean_value enum_value list_value NUMBER object_value variable string_value))

212

213

(defun graphql-0-0-1::|string_value-Constructor| (STRING)

214

STRING)

215

216

;; (defun graphql-0-0-1::|boolean_value-Constructor| ('true' | 'false')

217

218

(defun graphql-0-0-1::|enum_value-Constructor| (STRING)

219

(list 'graphql::|enum_value| STRING))

220

221

(defun graphql-0-0-1::|list_value-Constructor| (value_list)

222

(list 'graphql::|list_value| value_list))

223

224

(defun graphql-0-0-1::|list_value_list-Constructor| (list_value_list value)

225

(cons value list_value_list))

226

227

(defun graphql-0-0-1::|value*-Constructor| (value value*)

228

(cons value value*))

229

230

(defun graphql-0-0-1::|object_value-Constructor| (object_field*)

231

(list* 'graphql::|object_value| object_field*))

232

233

(defun graphql-0-0-1::|object_field-Constructor| (field_name value)

234

(list 'graphql::|object_field| field_name value))

235

236

(defun graphql-0-0-1::|variable_definition_list-Constructor| (variable_definition variable_definition_list)

237

(cons variable_definition variable_definition_list))

238

239

(defun graphql-0-0-1::|variable_definitions-Constructor| (variable_definition_list)

240

(cons 'graphql::|variable_definitions| variable_definition_list))

241

242

(defun graphql-0-0-1::|variable_definition-Constructor| (default_value? type_ref variable)

243

(list 'graphql::|variable_definition| variable type_ref default_value?))

244

245

(defun graphql-0-0-1::|variable-Constructor| (var_name)

246

(list 'graphql::|variable| var_name))

247

248

(defun graphql-0-0-1::|var_name-Constructor| (ID keywords)

249

(list 'graphql::|var_name| keywords ID))

250

251

(defun graphql-0-0-1::|default_value-Constructor| (value)

252

(list 'graphql::|default_value| value))

253

254

(defun graphql-0-0-1::|type_ref-Constructor| (list_type named_type)

255

(list 'graphql::|type_ref| (or list_type named_type)))

256

257

(defun graphql-0-0-1::|list_type-Constructor| (type_ref)

258

(list 'graphql::|list_type| type_ref))

259

260

(defun graphql-0-0-1::|named_type-Constructor| (ID)

261

(list 'graphql::|named_type| ID))

262

263

(defun graphql-0-0-1::|directives-Constructor| (directive*)

264

(list 'graphql::|directives| directive*))

265

266

(defun graphql-0-0-1::|directive-Constructor| (arguments? directive_name)

267

(list 'graphql::|directive| directive_name arguments?))

268

269

(defun graphql-0-0-1::|directive_name-Constructor| (ID)

270

(list 'graphql::|directive_name| ID))

271

272

273

;;;

274

275

(defparameter graphql::*max-input-index* 0)

276

277

(defun graphql-0-0-1::input-reference (index)

278

(when (< index (length atnp::*ATN-INPUT))

279

(setf graphql::*max-input-index* (max graphql::*max-input-index* index))

280

(aref atnp::*ATN-INPUT index)))

281

282

(defun graphql-0-0-1::input-eof? (index)

283

(>= index (length atnp::*ATN-INPUT)))

284

285

286

(defgeneric parse-graphql (source &key start end start-name accept)

287

(:method ((location spocq:iri) &rest args &key (accept "application/graphql") start end start-name)

288

(declare (ignore start end start-name))

289

(declare (dynamic-extent args))

290

     (apply #'parse-graphql (with-http-request-stream (request-stream response-stream location :accept accept)

291

(declare (ignore request-stream))

292

(read-stream response-stream))

293

args))

294

295

   (:method ((string string) &key (start 0) (end (length string)) (start-name 'graphql-0-0-1::|graphqlFile|) accept)

296

(declare (ignore accept))

297

(let ((tokens (remove nil (tokenize-graphql string :start start :end end)))

298

(graphql::*max-input-index* 0))

299

(when tokens

300

(multiple-value-bind (result index success)

301

                              (funcall 'graphql-0-0-1::|graphqlFile-Parser| tokens :start-name start-name)

302

(if success

303

(values result tokens index)

304

(flet ((_aref (array index)

305

                      (when (and (integerp index) (< -1 index (length array))) (aref array index))))

306

(spocq.e::message-syntax-error :expression string

307

                                              :token (loop for i from (max 0 (- graphql::*max-input-index* 5))

308

                                                       below (+ graphql::*max-input-index* 5)

309

                                                       collect (_aref tokens i))

310

                                              :token-offset graphql::*max-input-index*)))))))

311

312

(:method ((location pathname) &rest args)

313

(declare (dynamic-extent args))

314

(apply #'parse-graphql (read-file location) args)))

315

316

(defmethod receive-message ((stream stream) (content-type mime:application/graphql) &rest args)

317

"transform the stream into a string and delegate.

318

if the stream is empty, cause an eof to be signaled"

319

(apply #'receive-message (read-stream stream :eof-p t) content-type args))

320

321

(defmethod receive-message ((message string) (content-type mime:application/graphql) &rest args)

322

"Parse a graphql message and return

323

- the root operator

324

- a list with the parsed sse and the graphql text string as query initialization arguments."

325

(declare (ignore args))

326

(let ((sse (parse-graphql message)))

327

(values (first sse)

328

(list :query-expression message

329

:sse-expression sse))))

330

331

332

333

#|

334

;; there are three packages

335

 ;; graphql : the abstract algebra package, which contains the operator names for the expressions into which the surface syntax is trsnslated

336

;; graphql-001 : the source code package for generated constructors

337

;; graphql.s : the "surface syntax" token package, in which lexical tokens are present

338

;;

339

;; now a packaged macro : (set-macro-character #\{ nil t)

340

 (bnfp:compile-atn-system  (read-file "/development/source/library/org/datagraph/spocq/src/extensions/graphql/GraphQL.bnf")

341

:execute t :compile nil

342

:token-package (find-package :org.datagraph.spocq.graphql)

343

                           :source-package (find-package :org.datagraph.spocq.graphql-0-0-1)

344

                           :source-pathname #p"/development/source/library/org/datagraph/spocq/src/extensions/graphql/graphql-grammar.lisp"

345

:input-function 'graphql-0-0-1::input-reference

346

:input-eof-function 'graphql-0-0-1::input-eof?

347

:ambiguous nil

348

:trace nil)

349

350

;;; to compile the parser state machine manually

351

(load (compile-file #p"LIBRARY:org;datagraph;spocq;src;core;encoding;graphql.lisp"))

352

|#

353

354