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

KindCoveredAll%
expression79195 40.5
branch514 35.7
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
 ;;; (load "patches/sparql-execution-graphviz.lisp")
3
 
4
 (in-package :org.datagraph.spocq.implementation)
5
 
6
 ;;; query execution graphviz serializer
7
 
8
 (eval-when (:compile-toplevel :load-toplevel :execute)
9
   (import '(cl-user::format-sparql-execution+graphviz)
10
           *package*))
11
 
12
 (defgeneric format-sparql-execution+graphviz (stream object &optional colon at)
13
   (:method ((object t) (stream stream) &optional colon at)
14
     (format-sparql-execution+graphviz stream object colon at))
15
 
16
   (:method ((stream stream) (object t) &optional colon at)
17
     (declare (ignore at))
18
     (encode-graph object stream mime:text/vnd.dydra.sparql-results-execution+graphviz
19
                   :pretty (not (null colon)))))             
20
 
21
 
22
 ;;; graph generation from an execution record
23
 
24
 (defmethod context-encode-graph-as ((context t) (object t) (as mime:*/vnd.dydra.sparql-results-execution+graphviz))
25
   (context-encode-graph-as context (compute-sparql-execution-record object) as))
26
 
27
 (defmethod context-encode-graph-as ((context t) (object cons) (as mime:*/vnd.dydra.sparql-results-execution+graphviz))
28
   (context-graph-execution-record context object))
29
 
30
 
31
 (defun context-graph-execution-record (context record)
32
   "generate graphviz specification given an execution record and its type"
33
   (context-graph-execution-record-type context (json-type record) record))
34
 
35
 
36
 (macrolet ((defgraphmethod (type (context-var object-var &rest member-names) &body body)
37
              `(defmethod context-graph-execution-record-type ((,context-var t) (type (eql ',type)) ,object-var)
38
                 (json-bind ,member-names ,object-var
39
                     ,@body))))
40
 
41
   (defgraphmethod nil (context object expression)
42
     (declare (ignore expression))
43
     0)
44
 
45
   (defgraphmethod query (context object expression channel dimensions generator (q-id @id) id)
46
     (declare (ignore expression))
47
     (dot:context-put-node context q-id :label id :shape "box")
48
     (let ((g-id (context-graph-execution-record context generator)))
49
       (dot:context-put-edge context g-id q-id
50
                             :label (format nil "<<table><tr><th>~a</th></tr><tr><td>~/format-json-table/</td></tr></table>>"
51
                                            dimensions
52
                                            channel)))
53
     q-id)
54
 
55
   (defgraphmethod generator (context object op dimensions channel splices constituents (g-id @id))
56
     (dot:context-put-node context g-id :label (string op))
57
     (when splices
58
       (dot:context-put-node context (json-id channel) :shape "point" :color "red")
59
       (loop for spliced across splices
60
         do (dot:context-put-edge context (json-id channel) (json-id spliced)
61
                                  :style "dashed" :color "red" :dir "none"))
62
       (dot:context-put-edge context g-id channel
63
                               :label (format nil "<<table><tr><th>~a</th></tr><tr><td>~/format-json-table/</td></tr></table>>"
64
                                              dimensions
65
                                              channel)
66
                               :dir "none"))
67
       (loop for constituent across constituents
68
         for constituent-id = (context-graph-execution-record context constituent)
69
         for constituent-channel = (json-member-value constituent :channel)
70
         ;; the base field gets a box for a left join
71
         for arrow-head = (if (eq op 'spocq.a:|leftjoin|)
72
                              (if (eq constituent (elt constituents 0))
73
                                  "normal" "odot")
74
                              "normal")
75
         if (json-member-value constituent-channel :channels)
76
         do (dot:context-put-edge context (json-id constituent-channel) g-id :arrowhead arrow-head)
77
         else do (dot:context-put-edge context constituent-id g-id
78
                                       :label (format nil "<<table><tr><th>~a</th></tr><tr><td>~/format-json-table/</td></tr></table>>"
79
                                                      (json-member-value constituent :dimensions)
80
                                                      constituent-channel)
81
                                       :arrowhead arrow-head))
82
     g-id)
83
 
84
   (defgraphmethod bgp-generator (context generator (b-id @id) base-channel pattern)
85
     (when base-channel
86
       (dot:context-put-node context (json-id base-channel) ; :shape "point"
87
                             :style "dashed"
88
                             :label (format nil "~/format-json-table/" base-channel))
89
       (dot:context-put-edge context base-channel b-id :style "dashed" :color "red"))
90
     (dot:context-put-node context b-id :label (format nil "bgp~{\\n~a~}"
91
                                                       (loop for statement-pattern across pattern
92
                                                         for statement = (map 'list #'identity statement-pattern)
93
                                                         when (member (first statement)
94
                                                                      '(spocq.a:|graph| spocq.a:|filter|))
95
                                                         collect (graph-expression-string statement)
96
                                                         when (eq (first statement) 'spocq.a:|triple|)
97
                                                         collect (apply #'graph-triple-string (rest statement))
98
                                                         when (eq (first statement) 'spocq.a:|sum|)
99
                                                         collect (format nil "(sum~{ ~a~^\\n~})"
100
                                                                         (loop for statement in (rest statement)
101
                                                                           collect (apply #'graph-triple-string (rest statement))))))
102
                           :shape "box")
103
     b-id)
104
   )
105
 
106
 
107
 ;;; message processing
108
 ;;; abstracted into graph.lisp
109
 
110
 #+(or)
111
 (defmethod send-response-message ((operation t) (message t) (stream t) (content-type mime:*/vnd.dydra.sparql-results-execution+graphviz))
112
   "Given any result, graph the consolidated execution statistics.
113
    This permits queries and generators, which are presumed to have been executed,
114
    from which the statistics are extraced and then graphed,
115
    as well as statistics themselves as with property lists or json objects."
116
   (when *encoding-trace-output*
117
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
118
   (write-sparql-execution+graphviz message :stream stream
119
                                    :name (format nil "~a: ~a: execution statistics"
120
                                                  (site-name)
121
                                                  (task-id *task*))))
122
 
123
 #|
124
 (encode-graph
125
   (make-query :sse-expression (parse-sparql "select * where { {?s ?p ?o} union { graph ?g {?s ?p ?o} } }")
126
                :repository-id "james/test")
127
   *standard-output*
128
   mime:text/vnd.dydra.sparql-results-trace+graphviz
129
   :pretty nil  :name "test")
130
 
131
 (write-sparql-execution+graphviz
132
   (make-query :sse-expression (parse-sparql "select * where { {?s ?p ?o} union { graph ?g {?s ?p ?o} } }")
133
                :repository-id "james/test")
134
   *standard-output*
135
   mime:text/vnd.dydra.sparql-results-execution+graphviz
136
   :pretty nil :name "test")
137
 |#