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

KindCoveredAll%
expression80131 61.1
branch36 50.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-execution+json)
8
           *package*))
9
 
10
 
11
 (defgeneric format-sparql-execution+json (stream entry &optional colon at)
12
   (:method ((entry t) (stream stream) &optional colon at)
13
     (format-sparql-execution+json stream entry colon at))
14
 
15
   (:method ((stream stream) (entry t) &optional colon at)
16
     (declare (ignore at))
17
     (write-sparql-execution+json entry :stream stream :pretty (not (null colon)))))
18
 
19
 (defgeneric write-sparql-execution+json (generator &key stream pretty)
20
   (:documentation "Walk the generator graph to encode the state of each node and
21
    its relation to its constituents.")
22
 
23
   (:method ((query query) &rest args)
24
     (declare (dynamic-extent args))
25
     (apply #'write-sparql-execution+json (compute-sparql-execution-record query) args)
26
     query)
27
   (:method ((generator abstract-field-generator) &rest args)
28
     (declare (dynamic-extent args))
29
     (apply #'write-sparql-execution+json (compute-sparql-execution-record generator) args)
30
     generator)
31
   (:method ((entry null) &key (stream *standard-output*) pretty)
32
     (declare (ignore pretty))
33
     (write-string "{}" stream)
34
     entry)
35
   (:method ((description cons) &key (stream *standard-output*) ((:pretty *print-pretty*) *print-pretty*))
36
     (format-json stream description *print-pretty*)
37
     (when *print-pretty* (fresh-line stream))
38
     description))
39
 
40
 (defgeneric compute-sparql-execution-record (object)
41
   (:method ((query query))
42
     (let* ((generator (task-result-generator query)))
43
       `((@type . query)
44
         (@id . ,(json-object-id query))
45
         (expression . ,(task-request-content query))
46
         (id . ,(task-id query))
47
         (dimensions . ,(map 'vector #'identity (solution-generator-dimensions generator)))
48
         (generator . ,(compute-sparql-execution-record generator)))))
49
   
50
   (:method ((generator abstract-field-generator))
51
     #+(or)  ;; need to add the execution information for the node similar to trace
52
 
53
     (destructuring-bind (&key form time count distinct-count children condition) entry
54
            (format stream "~vt{" *trace-print-level*)
55
            (ecase *write-sparql-trace+json.sparql-query-media-type*
56
              (mime:application/vnd.dydra.sparql-query-algebra (format stream "\"form\": \"~/format-sparql-sse/\"," form))
57
              (mime:application/sparql-query (format stream "\"form\": \"~/format-sparql/\"," form)))
58
            (cond (condition
59
                   (format stream " \"error\": \"~a\"" condition)
60
                   )
61
                  (t
62
                   (format stream "~%~vt\"time\": ~a, \"count\": ~a, \"distinctCount\": ~a"
63
                           (1+ *trace-print-level*) time count distinct-count)
64
                   (when children
65
                     (format stream ", \"children\": [")
66
                     (loop with *trace-print-level* = (1+ *trace-print-level*)
67
                       for child in children
68
                       for first = t then nil
69
                       do (progn
70
                            (unless first (write-char #\, stream))
71
                            (fresh-line stream)
72
                            (write-sparql-trace+json child stream)))
73
                     (format stream "]"))))
74
            (write-char #\} stream))
75
 
76
     (let* ((op (or (abstract-field-generator-concrete-operator generator)
77
                    (abstract-field-generator-operator generator)))
78
            (channel (abstract-field-generator-channel generator))
79
            (splices (channel-channels channel)))
80
       `((@type . generator)
81
         (@id . ,(json-object-id generator))
82
         (op . ,op)
83
         (dimensions . ,(map 'vector #'identity (solution-generator-dimensions generator)))
84
         (constituents . ,(map 'vector #'compute-sparql-execution-record (abstract-field-generator-constituents generator)))
85
         (channel . ,(compute-sparql-execution-record channel))
86
         ,@(when splices `((splices . ,(map 'vector #'(lambda (spliced) `((type . channel) (id . ,(json-object-id spliced)))) splices)))))))
87
 
88
   (:method ((channel channel))
89
     ;; convert to milliseconds
90
     (let* ((start (channel-start-timestamp channel)))
91
       (when (zerop start) (setf start (get-timeline-location)))
92
       (setf start (floor (/ start 1000)))
93
       (let* ((elapsed (floor (/ (- (channel-end-thread-time channel) (channel-start-thread-time channel)) 1000000)))
94
              (end (+ start elapsed)))
95
         `((@type . ,(type-of channel))
96
           (@id . ,(json-object-id channel))
97
           (name . ,(with-output-to-string (stream) (pprint-sse (channel-name channel) stream)))
98
           (state . ,(channel-state channel))
99
           (time . ,(vector start end elapsed))))))
100
   (:method ((channel abstract-page-channel))
101
     (append (call-next-method)
102
             `((length . ,(channel-page-length channel))
103
               (width . ,(channel-page-width channel)))))
104
   (:method ((object page-channel))
105
     (append (call-next-method)
106
             `((size . ,(bound-slot-value object 'size))
107
               (free-count . ,(bound-slot-value object 'free-count))
108
               (bound-count . ,(bound-slot-value object 'bound-count))
109
               (write-count . ,(bound-slot-value object 'write-count))
110
               (read-count . ,(bound-slot-value object 'read-count))
111
               (page-count . ,(bound-slot-value object 'page-count))
112
               (solution-count . ,(bound-slot-value object 'solution-count)))))
113
   (:method ((object page-ring))
114
     (call-next-method))
115
   (:method ((object page-mailbox))
116
     (call-next-method))
117
   (:method ((object paged-buffer))
118
      (append (call-next-method) 
119
              `((active-page-count . ,(paged-buffer-active-page-count object)))))
120
 
121
   (:method ((generator bgp-generator))
122
     (let ((base-channel (agp-base-channel (bgp-generator-pattern generator)))
123
           (channel (bgp-generator-channel generator)))
124
       `((@type . bgp-generator)
125
         (@id . ,(json-object-id generator))
126
         (op . "bgp")
127
         (dimensions . ,(map 'vector #'identity (solution-generator-dimensions generator)))
128
         (pattern . ,(map 'vector #'(lambda (stmt)
129
                                      (vector (statement-subject stmt)
130
                                              (statement-predicate stmt)
131
                                              (statement-object stmt)))
132
                          (agp-statements (bgp-generator-pattern generator))))
133
         (channel . ,(compute-sparql-execution-record channel))
134
         ,@(when base-channel
135
             `((base-channel ,base-channel))))))
136
   )
137
 
138
 (defun json-object-id (object)
139
   (write-to-string (sb-kernel:get-lisp-obj-address object) :radix nil :base 16))
140
 
141
 (defmethod send-response-message ((operation t) (message t) (stream t) (content-type mime:application/vnd.dydra.sparql-results-execution+json))
142
   "Given a a model graph the operator tree"
143
   (when *encoding-trace-output*
144
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
145
   (write-sparql-execution+json message :stream stream))
146
 
147
 (defmethod send-response-message ((operation t) (generator abstract-field-generator) (stream t) (content-type mime:application/vnd.dydra.sparql-results-execution+json))
148
   "Given a generator, let the medi type determine whether to execute it.
149
    if so, discard the results.
150
    in either case generate the execution operator tree and encode that"
151
   (when *encoding-trace-output*
152
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
153
   (cond ((mime-type-profile-p content-type |urn:dydra|:|run_time|)
154
          (let ((channel (solution-generator-channel generator)))
155
            ;; consume the results
156
            (do-pages (page channel) )))
157
         ((mime-type-profile-p content-type |urn:dydra|:|algebra_operations|)
158
          ;; do nothing - as for no profile
159
          ))
160
   (write-sparql-execution+json generator :stream stream))
161
 
162
 
163
 
164
 #|
165
 (compute-sparql-execution-record (nth-value 2 (run-sparql "select count(*) where {?s ?p ?o}" :repository-id "james/test")))
166
 (write-sparql-execution+json (compute-sparql-execution-record *query*))
167
 (mime-type "application/vnd.dydra.sparql-results-execution+json")
168
 
169
 (mime-type "application/vnd.dydra.sparql-results-execution+json;profile=urn:dydra:run_time")
170
 
171
 |#