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

KindCoveredAll%
expression102162 63.0
branch12 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
 ;;; (load #p"patches/graph.lisp")
3
 
4
 (in-package :org.datagraph.spocq.implementation)
5
 
6
 ;;; (load #p"LIBRARY:org;datagraph;spocq;src;core;encoding;graph.lisp")
7
 
8
 (:documentation "use graphviz to generate a visual from some query-related model."
9
   "This wraps a simple .dot-based generators which walk query expressions,
10
   results, traces, and etc to generate various graph encodings, including the
11
   dot file and its renderings as jpg, pdf, and png.
12
 
13
   The principle interface operator is encode-graph.
14
   It accepts the model, the output destination and a media type, of which the latter
15
   comprises two aspects: the analytical projection and the document reprensetation.
16
   A model may be an sse expressions, a sparql text, a generator from a completed query,
17
   the query object itself, or some intermediate record of processing, such as a trace record.")
18
 
19
 
20
 (defparameter *graph-bgp-mode* :triple-patterns  ; :graph-patterns
21
   "Specifies whether to render a bgp as a single tabular node or as individual nodes,
22
  one for each triple statement.
23
   :graph-patterns renders the patterns a single text label,
24
   :node renders the dimension list as a single text label,
25
   :triple-pattern (default) does the latter.")
26
 
27
 (defparameter *graph-expression-mode* :expression
28
   "Specify whether to expand each operation node.
29
   :expression encodes the operator and arguments
30
   :operator encodes just the operator name")
31
 
32
 (defparameter *graph-anonymize* nil)
33
 
34
 (defparameter *graph-anonymous-map* nil)
35
 
36
 (defmacro encode-sparql-graph-node ((id label) &rest forms)
37
   `(ecase *graph-expression-mode*
38
      (:expression ,@forms)
39
      (:operation (dot:context-put-node context ,id :label ,label))))
40
 
41
 (defgeneric context-encode-graph-as (context graph-model media-type)
42
   (:documentation "Generate a graphiz dot representation for the specified form
43
    of the given graph model."))
44
 
45
 (defgeneric encode-graph (graph-model destination as &key
46
                                       name attributes
47
                                       ((:pretty *print-pretty*))
48
                                       ((:bgp-mode *graph-bgp-mode*))
49
                                       ((:anonymize *graph-anonymize*))
50
                                       ((:namespace-bindings *namespace-bindings*))
51
                                       ((:graph-expression-mode *graph-expression-mode*)))
52
   (:documentation "Write a graph of the model encoded as a dot document to the given destination.
53
    This abstracts over the destination, to resolve it to a stream, creates a graphviz encoding
54
    context and delegates to context-encode-graph-as to resolve the encoding-specific method.")
55
 
56
   (:method ((graph-model t) (stream stream) (as t) &key
57
             (name (or (task-id *task*) "query graph"))
58
             (attributes nil)
59
             ((:pretty *print-pretty*) *print-pretty*)
60
             ((:bgp-mode *graph-bgp-mode*) *graph-bgp-mode*)
61
             ((:anonymize *graph-anonymize*) *graph-anonymize*)
62
             ((:namespace-bindings *namespace-bindings*) *namespace-bindings*)
63
             ((:graph-expression-mode *graph-expression-mode*) *graph-expression-mode*))
64
     
65
     "translate a query to a dot graph"
66
     #+(or) (print (list :context-encode-graph-as graph-model))
67
     (let ((*graph-anonymous-map* (when *graph-anonymize* (make-hash-table :test 'equalp)))
68
           (*gensym-counter* 0)
69
           (setf.dot:*pretty* *print-pretty*))
70
       (flet ((put-graph-model ()
71
                #+(or) (print (list :context-encode-graph-as dot:*context* graph-model))
72
                (context-encode-graph-as dot:*context* graph-model as)))
73
         (destructuring-bind (&key (rankdir "TB") (fontname "courier")
74
                                   (edge '(:fontname "courier"))
75
                                   (node '(:fontname "courier"))
76
                                   &allow-other-keys) attributes
77
           (apply #'dot:context-put-graph (make-instance 'setf.dot:stream :stream stream) name #'put-graph-model
78
                  :rankdir rankdir
79
                  :fontname fontname
80
                  :edge edge
81
                  :node node
82
                  attributes))))
83
     (when *print-pretty*
84
       (fresh-line stream))
85
     graph-model)
86
 
87
   (:method ((query-expression string) (stream stream) as &rest args
88
             &key ((:namespace-bindings *namespace-bindings*) *namespace-bindings*)
89
             &allow-other-keys)
90
     (multiple-value-bind (form options tokens)
91
                          (parse-sparql query-expression)
92
       (declare (ignore tokens))
93
       (destructuring-bind (&key metadata &allow-other-keys)
94
                           options
95
         (apply #'encode-graph form stream as
96
                :namespace-bindings (or (when metadata (metadata-namespace-bindings metadata))
97
                                        *namespace-bindings*)
98
                args))))
99
 
100
   (:method ((graph-model t) (destination pathname) as &rest args)
101
     (declare (dynamic-extent args))
102
     (with-open-file (stream destination :direction :output :if-exists :supersede :if-does-not-exist :create)
103
       (apply #'encode-graph graph-model stream as
104
              args))))
105
 
106
 
107
 (:documentation "The graphviz methods for send-response-message implement logic for the
108
   base .dot document and as its rendered forms. The first is handled by the mime:graphviz, which
109
   delegates to encode-graph, while the second interposes a temporary file for the initial document
110
   and then renders that to an image form depending on the concrete media type.")
111
 
112
 (defmethod send-response-message ((operation t) (content t) (stream t) (content-type mime:graphviz))
113
   "Encode the content into a .dot document to the given stream"
114
   (when *encoding-trace-output*
115
     (setf stream (make-broadcast-stream *encoding-trace-output* stream)))
116
   (encode-graph content stream content-type))
117
 
118
 (defun tmp-response-pathname ()
119
   (if *task*
120
       (let ((repository (task-repository *task*)))
121
         (tmp-export-pathname (account (repository-account repository))
122
                              (repository repository)))
123
       (make-pathname :directory '(:absolute "tmp")
124
                      :name (write-to-string (uuid:make-v1-uuid)))))
125
       
126
 (defmethod send-response-message ((operation t) (content t) (stream t) (content-type mime:graphviz-image))
127
   "First, encode as per the analytic media type, then re-encode the base result,
128
    as an image of the eventual form specified by the concrete image media type"
129
   (let ((pathname (tmp-response-pathname)))
130
     (unwind-protect
131
         (progn (with-open-file (dot-stream pathname :direction :output
132
                                            :if-exists :error
133
                                            :if-does-not-exist :create)
134
                  (when *encoding-trace-output*
135
                    (setf dot-stream (make-broadcast-stream *encoding-trace-output* dot-stream)))
136
                  ;; nb: the precedence list must not change
137
                  (encode-graph content dot-stream content-type))
138
           ;; require encoded content before rendering
139
           (render-graphviz-file pathname stream content-type))
140
       (conditional-delete-file pathname))))
141
 
142
 (defun graphviz-executable-pathname (layout)
143
   (concatenate 'string "/usr/bin/" (string layout)))
144
 
145
 (defgeneric render-graphviz-file (from to media-type &key layout)
146
   (:method ((from pathname) (to stream) (type string) &key (layout "dot"))
147
     (let* ((image-pathname (tmp-response-pathname))
148
           (process (run-program (graphviz-executable-pathname layout)
149
                                 (list (concatenate 'string "-T" type)
150
                                       "-o" (namestring image-pathname) ; "/dev/stdout"
151
                                       (namestring from))
152
                                 :output to
153
                                 :wait t)))
154
       (unwind-protect
155
           (progn (unless (and process (zerop (run-program-exit-code process)))
156
                    (error "render-graphviz-file: image generation failed: ~s" (run-program-exit-code process)))
157
             (run-program-close process)
158
             (finish-output to))
159
         (conditional-delete-file image-pathname))
160
       image-pathname))
161
   #+(or)
162
   (:method ((from pathname) (to stream) (type string) &key (layout "dot"))
163
     (let* ((image-pathname (tmp-response-pathname))
164
           (process (run-program (graphviz-executable-pathname layout)
165
                                 (list (concatenate 'string "-T" type)
166
                                       "-o" (namestring image-pathname) ; "/dev/stdout"
167
                                       (namestring from))
168
                                 :output nil
169
                                 :wait t)))
170
       (unwind-protect
171
           (progn (unless (and process (zerop (run-program-exit-code process)))
172
                    (error "render-graphviz-file: image generation failed: ~s" (run-program-exit-code process)))
173
             (run-program-close process)
174
             (with-open-file (image-stream image-pathname :direction :input :element-type '(unsigned-byte 8))
175
               ;; does not get the element type correct (alexandria:copy-stream image-stream to)
176
               (loop for byte = (stream-read-byte image-stream)
177
                 while byte
178
                 do (stream-write-byte to byte)))
179
             (finish-output to))
180
         (conditional-delete-file image-pathname))
181
       image-pathname))
182
 
183
   (:method ((from t) (to pathname) (type string) &rest args)
184
     (with-open-file (stream to :direction :output)
185
       (apply #'render-graphviz-file from stream type args)))
186
 
187
   (:method ((from t) (to t) (type mime::graphviz-image) &rest args)
188
     (apply #'render-graphviz-file from to (de.setf.utility.implementation::mime-type-file-type type) args)))
189
 
190
 
191
 
192
 #+(or)
193
 (progn
194
   (let ((*graph-bgp-mode* :triple-patterns))
195
     (encode-graph (parse-file #p"P-LIBRARY:org;datagraph;spocq;src;test;rspec;tests;data-sp2b;q7.sparql")
196
                   #p"LIBRARY:org;datagraph;spocq;q7-tp.dot"
197
                   mime:text/vnd.raphviz
198
                   :name "SP2B Q7" ))
199
   
200
   (let ((*graph-bgp-mode* :graph-patterns))
201
     (encode-graph (parse-file #p"P-LIBRARY:org;datagraph;spocq;src;test;rspec;tests;data-sp2b;q7.sparql")
202
                   #p"LIBRARY:org;datagraph;spocq;q7-gp.dot"
203
                   mime:text/vnd.raphviz
204
                   :name "SP2B Q7"))
205
   
206
   (let ((*graph-bgp-mode* :triple-patterns))
207
     (encode-graph (parse-sparql #p"P-LIBRARY:org;datagraph;spocq;doc;heltnormalt;read.rq")
208
                   #p"LIBRARY:org;datagraph;spocq;doc;hn-read.dot"
209
                   mime:text/vnd.raphviz
210
                   :name "hn read"))
211
   
212
   (let ((*graph-bgp-mode* :triple-patterns))
213
     (encode-graph (parse-sparql #p"/home/asdf/imports/heltnormalt/converted/heltnormalt/strip/list.rq")
214
                   #p"LIBRARY:org;datagraph;spocq;doc;hn-read.dot"
215
                   mime:text/vnd.raphviz
216
                   :name "hn read"))
217
   
218
   (encode-graph (parse-sparql #p"/home/asdf/imports/heltnormalt/converted/heltnormalt/strip/list.rq")
219
                 #p"LIBRARY:org;datagraph;spocq;doc;hn-read.dot"
220
                 mime:text/vnd.raphviz
221
                 :name "hn read" 
222
                 :anonymize t
223
                 :bgp-mode :graph-patterns)
224
   
225
   (encode-graph (parse-sparql #p"/home/asdf/imports/heltnormalt/20120116/heltnormalt/strip/read.rq")
226
                 #p"LIBRARY:org;datagraph;spocq;doc;hn-read-2.dot"
227
                 mime:text/vnd.raphviz
228
                 :name "hn read" 
229
                 :anonymize t
230
                 :bgp-mode :graph-patterns))