(in-package :u02s03)

(defvar *config* "
edge [ fontsize=8 ];
node [ fontsize=12 ];")

(defun make-graph (stream)
  (princ "digraph {" stream)
  (terpri stream)
  (princ *config* stream)
  (terpri stream)
  (princ "subgraph cluster0 {" stream)
  (terpri stream)
  (loop
     for node in (select-dao 'entry-query)
     do (format stream "~s [shape=box fontname=\"Courier New\"]~%"
		(slot-value node 'pattern)))
  (format stream "label = \"entry nodes\"~%color = black~%}~%")
  (loop for node in (select-dao 'entry-query)
     do (format stream "~s -> ~s~%"
		(slot-value node 'pattern)
		(slot-value (get-dao 'node (slot-value node 'entry-node)) 'question)))
  (loop
     for node in (select-dao 'node)
     for children = (ignore-errors (string->nodes (slot-value node 'values)))
     do (format stream "~s~%" (slot-value node 'question))
     do (if (null children)
	    (format stream "~s [shape=box]~%" (slot-value node 'question))
	    (loop for (question . next-node) in children
	       do (format stream "~s -> ~s[label=~s];~%"
			  (slot-value node 'question)
			  (slot-value next-node 'question)
			  question))))
  (princ "}" stream)
  (terpri stream))

(defun write-graph ()
  (with-open-file (s "/tmp/graph.graphviz" :if-exists :supersede :direction :output)
    (make-graph s)))

(defun graphviz ()
  (write-graph)
  (external-program:start "/usr/local/bin/dot"
			  '("-Tsvg" "/tmp/graph.graphviz" "-o" "/tmp/graph.svg"))
  (with-open-file (s "/tmp/graph.svg")
    (let ((string (make-string (file-length s))))
      (read-sequence string s)
      string)))

(define-easy-handler (graphviz-graph :uri "/graph") ()
  (setf (content-type*) "image/svg+xml")
  (graphviz))
