visualize dependencies in the quicklisp systems

qldot-systems.lisp

(quicklisp:quickload '(#:anaphora #:iterate #:cl-ppcre))

(defpackage #:qldot
  (:use #:cl #:iterate #:anaphora #:ppcre))

(in-package #:qldot)

(defparameter *font* "Courier New")

(defmacro portname (sys &optional prj)
  (if prj
      `(format nil "~S:p_~A" ,prj #1=(regex-replace-all "\\W" ,sys "_"))
    `(format nil "p_~A" #1#)))

(defun format-node (stream prj systems)
  (format stream "  ~S [label = \"<~A> \\<~A\\>~{|<~A> ~A~}\"];~%"
	  prj (portname prj) prj
	  (mapcan #'(lambda (sys) (list (portname sys) sys))
		  (reverse (remove prj systems :test 'equal)))))

(defun make-dot (sysfile dotfile)
  (let ((projects #1=(make-hash-table :test 'equal))
	(systems #1#))

    (with-open-file (is sysfile :direction :input)
      (read-line is)
      (iterate (while (listen is))
	       (for (prj _ sys . dependency) next (split " +" (read-line is)))
	       (push sys (gethash prj projects))
	       (setf (gethash sys systems) (list* prj sys dependency))))

    (with-open-file (os dotfile :direction :output
			:if-exists :supersede
			:if-does-not-exist :create)
      (format os "digraph quicklisp_systems {~%")
      (format os "  graph [rankdir = LR];~%")
      (format os "  node [shape = record, fontname = ~S];~%" *font*)
      (maphash #'(lambda (p s) (format-node os p s)) projects)
      (iterate (for (k  (p s . ds)) in-hashtable systems)
	       (awhen (loop for d in (set-difference ds (gethash p projects) :test 'equal)
			for (dp ds . dd)  = (gethash d systems)
			if dp collect (portname ds dp)
			else do  (warn "system:~A not found" d))
		 (format os "  ~A -> {~{~A~^ ~}};~%" (portname s p) it)))
      (format os "}~%"))))


(make-dot
  (merge-pathnames "quicklisp/dists/quicklisp/systems.txt"
		   (user-homedir-pathname))
 "quicklisp-systems.dot")


;;; `dot -Tsvg -O quicklisp-systems.dot`

stderr.txt

WARNING: system:clpython.lib not found
WARNING: system:tinaa not found