/
clojure_classes.clj
167 lines (146 loc) · 6.06 KB
/
clojure_classes.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
; clojure-classes.clj - produces graphviz dot graph for Clojure Java classes
; Copyright (c) Chris Houser, Dec 2008. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file epl-v10.html at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.
(ns net.n01se.clojure-classes
(:use [clojure.java.shell :only (sh)])
(:import (javax.swing JFrame JLabel JScrollPane ImageIcon)
(clojure.lang PersistentQueue)))
(def srcpath "/home/chouser/proj/clojure/src/jvm/clojure/lang/")
(defmacro str-for [& for-stuff]
`(apply str (for ~@for-stuff)))
(def colors ["#d70000" "#d7009e" "#b300d7" "#5a00d7" "#0061d7" "#00d0d7"
"#00d764" "#76d700" "#d78100"])
; Some lighter colors:
; "#ff817f" "#ff7fea" "#b47fff" "#7fa5ff" "#7ffffb" "#a8ff7f" "#ffd97f"
(def preds '{ISeq seq?, IPersistentMap map?, IPersistentVector vector?,
Symbol symbol?, Keyword keyword?, Var var?,
IPersistentCollection coll?, IPersistentList list?,
IPersistentSet set?, Number number?, IFn ifn?,
Associative associative?, Sequential sequential?,
Sorted sorted?, Reversible reversible?, Ratio ratio?
Fn fn?, Delay delay?, Class class?, BigDecimal decimal?,
String string?})
(def ctors '{IteratorSeq iterator-seq PersistentList list ISeq seq
EnumerationSeq enumeration-seq Var "intern, with-local-vars"
LazilyPersistentVector "vector, vec"
PersistentHashMap hash-map PersistentHashSet "hash-set, set"
PersistentArrayMap array-map
PersistentTreeMap "sorted-map, sorted-map-by"
PersistentTreeSet sorted-set
PersistentStructMap$Def create-struct
PersistentStructMap "struct-map, struct"
LazyCons lazy-cons Range range FnSeq fnseq
MultiFn defmulti Keyword keyword Symbol "symbol, gensym"})
(def clusters '#{})
(def badges
'{IMeta M Iterable T Counted 1 Streamable S Serializable Z
Reversible R Named N Comparable =})
(def color-override '{PersistentList "#76d700" PersistentQueue "#0061d7"
LazySeq "#d78100"})
(def aliases '{core$future_call$reify__5684 "(future)"})
(def extra-seed-classes [clojure.core$future_call$reify__5684])
(defn class-filter [cls]
(let [package (-> cls .getPackage .getName)]
(or (= package "clojure.lang")
(and (.startsWith package "java") (.isInterface cls)))))
(defn choose-shape [cls]
(cond
(not (-> cls .getPackage .getName (.startsWith "clojure"))) "diamond"
(.isInterface cls) "octagon"
:else "oval"))
(defn class-name [cls]
(symbol (.getSimpleName cls)))
(defn class-label [cls]
(let [clsname (class-name cls)
a (aliases clsname (str clsname))
pred (preds clsname)
ctor (ctors clsname)
anc (set (map class-name (ancestors cls)))]
(str a
;(when ctor (str (when-not (empty? a) "\\n") ctor))
(when pred (str \\ \n pred))
(when-let [badge (seq (filter identity (map badges (map anc (keys badges)))))]
(str "\\n[" (apply str badge) "]")))))
(defn class-color [cls]
(color-override (class-name cls)
(nth colors (rem (Math/abs (hash (str cls))) (count colors)))))
(def graph
(loop [found {}
work (into
(into PersistentQueue/EMPTY extra-seed-classes)
(filter #(and % (some class-filter (bases %)))
(for [file (.listFiles (java.io.File. srcpath))]
(let [[cname ext] (.split (.getName file) "\\.")]
(when (= ext "java")
(Class/forName (str "clojure.lang." cname)))))))]
(if (empty? work)
found
(let [cls (peek work)
kids (seq (filter class-filter (bases cls)))]
(recur (assoc found cls kids)
(into (pop work) (remove found kids)))))))
(def classes (sort-by #(.getSimpleName %) (keys graph)))
(def dotstr
(str
"digraph {\n"
" rankdir=LR;\n"
" dpi=55;\n"
" nodesep=0.10;\n"
" ranksep=1.2;\n"
" mclimit=2500.0;\n"
;" splines=true;\n"
;" overlap=scale;\n"
" node[ fontname=Helvetica shape=box ];\n"
"
subgraph cluster_legend {
label=\"Legend\"
fontname=\"Helvetica Bold\"
fontsize=19
bgcolor=\"#dddddd\"
\"Clojure Interface\" [ shape=octagon fillcolor=\"#ffffff\" style=filled ];
\"Java Interface\" [ shape=diamond fillcolor=\"#ffffff\" style=filled ];
\"Clojure class\" [ shape=oval fillcolor=\"#ffffff\" style=filled ];
"
(when (seq badges)
(str "
badges [
shape=record
style=filled
fillcolor=\"#ffffff\"
label=\"{{"
(apply str (interpose "|" (vals badges)))
"}|{"
(apply str (interpose "|" (keys badges)))
"}}\"
]"))
"
}
"
(str-for [cls classes]
(when-not (badges (class-name cls))
(let [color (class-color cls)
node (str " \"" cls "\" [ label=\"" (class-label cls) "\" "
"color=\"" color "\" "
"shape=\"" (choose-shape cls) "\"];\n")
cluster (some #(clusters (class-name %))
(cons cls (ancestors cls)))]
(str (when cluster (str "subgraph cluster_" cluster " {\n"))
node
(when cluster "}\n")
(str-for [sub (graph cls)]
(when-not (badges (class-name sub))
(str " \"" cls "\" -> \"" sub "\""
" [ color=\"" color "\" ];\n")))))))
"}\n"))
(spit "graph.dot" dotstr)
(doto (JFrame. "Clojure Classes")
(.add (-> (sh "dot" "-Tpng" :in dotstr :out-enc :bytes) :out ImageIcon.
JLabel. JScrollPane.))
(.setSize 600 400)
(.setDefaultCloseOperation javax.swing.WindowConstants/DISPOSE_ON_CLOSE)
(.setVisible true))