Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/encoding/sparql-trace-json.lisp

Kind	Covered	All	%
expression	0	119	0.0
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

6

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

7

(import '(cl-user::format-sparql-trace+json)

8

*package*))

9

10

11

(defparameter *trace-print-level* 0)

12

(defparameter *write-sparql-trace+json.sparql-query-media-type*

13

'mime:application/sparql-query)

14

15

(defgeneric format-sparql-trace+json (stream entry &optional colon at)

16

(:method ((entry t) (stream stream) &optional colon at)

17

(format-sparql-trace+json stream entry colon at))

18

19

(:method ((stream stream) (entry t) &optional colon at)

20

(declare (ignore at))

21

(write-sparql-trace+json entry :stream stream :pretty (not (null colon)))))

22

23

#+(or) ;; specific json encoding

24

(destructuring-bind (&key form time count distinct-count children error) entry

25

(write-char #\{ stream)

26

(format stream "\"form\": \"~/format-sparql/\"},~%" form)

27

(cond (error

28

(format stream "\"error\": \"~a\"" error)

29

)

30

(t

31

          (format stream "\"time\": ~a, \"count\": ~a, \"distinctCount\": ~a~@[, \"children\": ~{~/format-sparql-trace+json/~^, ~}~]"

32

time count distinct-count children)))

33

(write-char #\} stream))

34

35

(defgeneric write-sparql-trace+json (results &key stream pretty)

36

(:documentation "Encode a trace record as json.

37

Given a query, compute its trace records and continue with that.")

38

39

(:method ((query query) &rest args)

40

(declare (dynamic-extent args))

41

(apply #'write-sparql-trace+json (compute-sparql-trace-record query) args)

42

query)

43

44

(:method ((entry null) &key (stream *standard-output*) pretty)

45

(declare (ignore pretty))

46

(write-string "{}" stream)

47

entry)

48

49

(:method ((entry cons) &key (stream *standard-output*) ((:pretty *print-pretty*) *print-pretty*))

50

(etypecase (first entry)

51

(keyword ;; explicit p-list encoding saved for reference

52

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

53

(*trace-print-level* (1+ *trace-print-level*))

54

(*print-pretty* nil))

55

(destructuring-bind (&key form time count distinct-count children condition operator) entry

56

(declare (ignore operator))

57

(format stream "~vt{" *trace-print-level*)

58

(ecase *write-sparql-trace+json.sparql-query-media-type*

59

              (mime:application/vnd.dydra.sparql-query-algebra (format stream "\"form\": \"~/format-sparql-sse/\"," form))

60

(mime:application/sparql-query (format stream "\"form\": \"~/format-sparql/\"," form)))

61

(cond (condition

62

(format stream " \"error\": \"~a\"" condition)

63

)

64

(t

65

(format stream "~%~vt\"time\": ~a, \"count\": ~a, \"distinctCount\": ~a"

66

(1+ *trace-print-level*) time count distinct-count)

67

(when children

68

(format stream ", \"children\": [")

69

(loop with *trace-print-level* = (1+ *trace-print-level*)

70

for child in children

71

for first = t then nil

72

do (progn

73

(unless first (write-char #\, stream))

74

(fresh-line stream)

75

(write-sparql-trace+json child :stream stream)))

76

(format stream "]"))))

77

(write-char #\} stream))))

78

(cons (let ((*encode-json-term.type-literals* nil))

79

(format-json stream entry *print-pretty*)

80

(when *print-pretty* (fresh-line stream)))))

81

entry))

82

83

84

(defgeneric compute-sparql-trace-record (object)

85

(:documentation "Given a query, execute it incrementally to trace its execution

86

properties and then convert that to a json-compatible a-list")

87

(:method ((task task))

88

"Given a task, trace its execution"

89

(compute-sparql-trace-record (run-deconstructed-query task (task-repository task))))

90

(:method ((entry cons))

91

"Given a trace record as a p-list, convert it to a json-compatible a-list"

92

(destructuring-bind (&key operator form time count distinct-count children condition) entry

93

(assert (and operator (numberp time) (numberp count) (numberp distinct-count)) ()

94

"Invalid trace record: ~s" entry)

95

`((:operator . ,operator)

96

(:time . ,time)

97

(:count . ,count)

98

(:distinct-count . ,distinct-count)

99

,@(when condition `((:condition . ,condition)))

100

,@(when children `((:children . ,(map 'vector #'compute-sparql-trace-record children))))

101

(:form . ,(with-output-to-string (stream)

102

(ecase *write-sparql-trace+json.sparql-query-media-type*

103

(mime:application/vnd.dydra.sparql-query-algebra

104

(format-sparql-sse stream form))

105

(mime:application/sparql-query

106

(format-sparql stream form)))))))))

107

108

;;;

109

;;;

110

111

112

 (defmethod send-response-message ((operation t) (message t) (stream t) (content-type mime:application/vnd.dydra.sparql-results-trace+json))

113

   "Given a trace result tree, and a STREAM with the application/sparql-trace+json CONTENT-TYPE, encode as json"

114

(when *encoding-trace-output*

115

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

116

(write-sparql-trace+json message :stream stream))

117

118

119

#|

120

(compute-sparql-trace-record

121

    (make-query :sse-expression (parse-sparql "select * where { {?s ?p ?o} union { graph ?g {?s ?p ?o} } }")

122

:repository-id "james/test"))

123

124

(write-sparql-trace+json

125

   (make-query :sse-expression (parse-sparql "select * where { {?s ?p ?o} union { graph ?g {?s ?p ?o} } }")

126

:repository-id "james/test")

127

:stream *standard-output*

128

:pretty nil)

129

|#