(defun dot-name (exp)
	(substitute-if #\_ (complement #'alphanumericp) (prin1-to-string exp)))

;; A node in DOT format can only contain letters, digits, and the underscore
;; So here we are replacing any forbidden characters to underscores

;; example 
;; (substitute-if #\e #'digit-char-p "I'm a l33t hack3r!")
;; >> "I'm a leet hacker!"
;; This says, if a char of the string is also a number, sub

;; By passing (complement) above, we are basically saying:
;; If char is not alphanumeric, replace with "_"

(defparameter *max-label-length* 30)

(defun dot-label (exp)
	(if exp
		(let ((s (write-to-string exp :pretty nil)))
			(if (> (length s) *max-label-length*)
				(concatenate 'string (subseq s 0 (- *max-label-length* 3)) "...")
				s))
		""))

;; max-label-length is our max chars for our label
;; if node label is larger than the limit, it gets cropped and an ... is added
;; (write-to_string) is similar to (prin1-to-string) as it writes an expression
;; to a string.

;; :pretty parameter is a keyword parameter that tells lisp not to alter the
;; string to make it pretty. Without this, lisp would place new lines or tabs
;; into our converted string to make it look more pleasing to the eye
;; by setting :pretty to nil, we tell lisp to output the expression without 
;; any decorations (having new lines in a label can confuse Graphviz)

(defun nodes->dot (nodes)
	(mapc (lambda (node)
					(fresh-line)
					(princ (dot-name (car node)))
					(princ "[label=\"")
					(princ (dot-label node))
					(princ "\"];"))
				nodes))

;; here we use mapc to go hrough eveyr node in the list of nodes
;; princ prints each node in the DOT format directly to screen
;; mapc is a slightly more efficient variant of mapcar;
;; The difference is that it does not returne the transformed list
;; The nodes->dot function uses the (dot-name) and (dot-label) to convert data

(defun edges->dot (edges)
	(mapc (lambda (node)
					(mapc (lambda (edge)
											 (fresh-line)
											 (princ (dot-name (car node)))
											 (princ "->")
											 (princ (dot-name (car edge)))
											 (princ "[label=\"")
											 (princ (dot-label (cdr edge)))
											 (princ "\"];"))
								(cdr node)))
				edges))

(defun graph->dot (nodes edges)
	(princ "digraph{")
	(nodes->dot nodes)
	(edges->dot edges)
	(princ "}"))

(defun dot->png (fname thunk)
	(with-open-file (*standard-output*
										fname
										:direction :output
										:if-exists :supersede)
		(funcall thunk))
	(ext:shell (concatenate 'string "dot -Tpng -O " fname)))

;; To keep this dot->png function reusale, the graph->dot function isn't
;; called directly, instead we write it to accept a thunk

;; In this scenairo, a function without arguments is commonly called a thunk
;; or suspension. In this caes, the thunk our function needs would be a
;; function that, when called, prints a DOT file to the console.

;; Why is a thunk useful?
;; the easiest way for us to write and debug graph->dot and other DOT
;; file functions is to have them print their results directly to
;; the console.  When we call graph->dot, it doesn't return
;; its results as a value, but instead, prints them at the console
;; as a side effect. Therefore we can't just pass the value
;; of graph->dot to dot->png.
;; instead we pass in graph->dot as a thunk. then dot->png is responsible for 
;; calling graph->dot, caputring the results, and sending them to a file

;; this technique is used a lot
;; First we print stuff to the console; next we wrap it in a thunk;
;; Finally we redirect the results to some other location

;; Writing to a file

;; The function with-open-file enables dot->png to write information to a file
;; for clarity, here's an example
;;(with-open-file (my-stream
;;									"testfile.txt"
;;									:direction :output
;;									:if-exists :supersede)
;;	(princ "Hello File!" my-stream))

;; :direction is set to :output (we are only writing, no reading)
;; :if-exists :supersede (if a file with that name exists, overwrite)

;; putting a colon in front of a symbol means that symbol always means itself
;; so :cigar can only be a constant named :CIGAR

;; Basicaly, this just says that a symbol has its own meaning.

;; so back to (dot->png) How does it save to file, and not just go to the console?

;; Aparently with-open-file is analogous to using (let) to create a variable. 
;; Hence, it usually leads to the creation of a lexical (local) stream variable.

;; However, if a dynamic variable already existsw with the same name,
;; (let) will temporarily override the value of the dynamic variable to the
;; The new value.

;; *standard-output* is such a dynamic variable
;; This means that we can temporarily override the value of *standard-output*
;; to a new value by passing it into our (with-open-file) command

;; In the body, where we call our thunk, any values printed to the console,
;; will now be automagically routed to our file instead.

;; Well, that is interesting. Everything that normally goes to
;; *standard-output*, will instead go to our file within this function

;; Alright, let's wrap this up

(defun graph->png (fname nodes edges)
	(dot->png fname
						(lambda ()
							(graph->dot nodes edges))))

;; This function takes the name of a DOT file (as the variable fname)
;; as well as the graph's nodes and edges and uses them to
;; generate the graph

;; It calls dot->png and creates the appropriate thunk, a lambda function
;; as is usual for a thunk, it takes no parameters.

;; The graph->dot function is called inside the thunk as a
;; delayed computation. Specifically if we called graph->dot directly,
;; its output would just show up in the console. However, when inside the thunk
;; it will be called at the leisure of the dot->png function, and the output
;; will generate the dot file with the filename passed in as the first param
;; to graph->png

;; Cool, now we can make a directional graph with this:
;; (graph->png "wizard.dot" *nodes* *edges*)

;; Now let's make a graph that's non-directional.

(defun uedges->dot (edges)
	(maplist (lambda (lst)
						 (mapc (lambda (edge)
										 (unless (assoc (car edge) (cdr lst))
											 (fresh-line)
											 (princ (dot-name (caar lst)))
											 (princ "--")
											 (princ (dot-name (car edge)))
											 (princ "[label=\"")
											 (princ (dot-label (cdr edge)))
											 (princ "\"];")))
									 (cdar lst)))
					 edges))

(defun ugraph->dot (nodes edges)
	(princ "graph{")
	(nodes->dot nodes)
	(uedges->dot edges)
	(princ "}"))

(defun ugraph->png (fname nodes edges)
	(dot->png fname
						(lambda ()
							(ugraph->dot nodes edges))))

;; (maplist) is like (mapcar) except that the function inside it
;; receives the entire remainder of the list, not just the
;; current item in the list

;; (maplist) sends the print function everything in the list from 
;; the current item until the end

;; uedges->dot then uses the information about future nodes it gets
;; from maplist to check whether the destination of the node appears
;; later in the edge list

;; The actual checking is done with (assoc) looking for the current edge
;; in the list of remaining edges calculated as (cdr lst)
;; In this case it skips the edge so that only one of any pair of edgs will be
;; printed

;; (ugraph->dot) is similar to (graph->dot) except that it describes
;; the graph as just a graph when making DOT data instead of digraph

;; (ugraph->png) is almost the same as (graph->png) except that it calls
;; (ugraph->dot) instead of (graph->dot)

;; Test (ugraph->png "uwizard.dot" *nodes* *edges*)