├── .gitignore ├── .travis.yml ├── CHANGES.md ├── CONTRIBUTING.md ├── README.md ├── dev-resources ├── person-swagger.png ├── person.png └── schema.png ├── project.clj ├── src └── schema_viz │ └── core.clj └── test └── schema_viz └── core_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | doc 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | language: clojure 3 | lein: lein2 4 | script: lein2 compile 5 | jdk: 6 | - openjdk6 7 | - openjdk7 8 | - oraclejdk8 -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## Unreleased 2 | 3 | * updated dependencies: 4 | 5 | ```clj 6 | [prismatic/schema "1.1.3"] is available but we use "1.1.0" 7 | [rhizome "0.2.7"] is available but we use "0.2.5" 8 | ``` 9 | 10 | ## 0.1.1 (30.3.2016) 11 | 12 | - Arrowhead on correct side of the relation, fixes [#7](https://github.com/metosin/schema-viz/issues/7) by [Christoph Frick](https://github.com/christoph-frick). 13 | - Sub-schemas are composed, while referenced schemas are aggregated, related to [#7](https://github.com/metosin/schema-viz/issues/7) by [Christoph Frick](https://github.com/christoph-frick). 14 | 15 | - update dependencies: 16 | 17 | ```clj 18 | [prismatic/schema "1.1.0"] is available but we use "1.0.5" 19 | ``` 20 | 21 | ## 0.1.0 (22.3.2016) 22 | 23 | - New public api: 24 | - `schema-viz.core/visualize-schemas` 25 | - `schema-viz.core/save-schemas` 26 | 27 | - update dependencies: 28 | 29 | ```clj 30 | [metosin/schema-tools "0.9.0"] is available but we use "0.7.0" 31 | ``` 32 | 33 | ## 0.0.1 (10.3.2016) 34 | 35 | Initial version. 36 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # How to contribute 2 | 3 | Contributions are welcome. 4 | 5 | Please file bug reports and feature requests to https://github.com/metosin/schema-viz/issues. 6 | 7 | ## Making changes 8 | 9 | * Fork the repository on Github 10 | * Create a topic branch from where you want to base your work (usually the master branch) 11 | * Check the formatting rules from existing code (no trailing whitepace, mostly default indentation) 12 | * Ensure any new code is well-tested, and if possible, any issue fixed is covered by one or more new tests 13 | * Verify that all tests pass using `lein test` 14 | * Push your code to your fork of the repository 15 | * Make a Pull Request 16 | 17 | ## Commit messages 18 | 19 | 1. Separate subject from body with a blank line 20 | 2. Limit the subject line to 50 characters 21 | 3. Capitalize the subject line 22 | 4. Do not end the subject line with a period 23 | 5. Use the imperative mood in the subject line 24 | - "Add x", "Fix y", "Support z", "Remove x" 25 | 6. Wrap the body at 72 characters 26 | 7. Use the body to explain what and why vs. how 27 | 28 | For comprehensive explanation read this [post by Chris Beams](http://chris.beams.io/posts/git-commit/#seven-rules). 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Schema-viz [![Build Status](https://travis-ci.org/metosin/schema-viz.svg?branch=master)](https://travis-ci.org/metosin/schema-viz) [![Dependencies Status](https://jarkeeper.com/metosin/schema-viz/status.svg)](https://jarkeeper.com/metosin/schema-viz) 2 | 3 | Plumatic [Schema](https://github.com/plumatic/schema) visualization using Graphviz. 4 | 5 | [![Clojars Project](http://clojars.org/metosin/schema-viz/latest-version.svg)](http://clojars.org/metosin/schema-viz) 6 | 7 | ## Prerequisites 8 | 9 | Install [Graphviz](http://www.graphviz.org/). 10 | 11 | ## Usage 12 | 13 | Public functions in `schema-viz.core`: 14 | * `visualize-schemas` displays schemas from a namespace in a window. 15 | * `save-schemas` saves schema visualization in a file. 16 | 17 | Both take an optional options-map to configure the rendering process. 18 | See docs for details. 19 | 20 | ```clj 21 | (require '[schema-viz.core :as svc]) 22 | (require '[schema.core :as s]) 23 | 24 | (s/defschema Country 25 | {:name (s/enum :FI :PO) 26 | :neighbors [(s/recursive #'Country)]}) 27 | 28 | (s/defschema Burger 29 | {:name s/Str 30 | (s/optional-key :description) s/Str 31 | :origin (s/maybe Country) 32 | :price (s/constrained s/Int pos?) 33 | s/Keyword s/Any}) 34 | 35 | (s/defschema OrderLine 36 | {:burger Burger 37 | :amount s/Int}) 38 | 39 | (s/defschema Order 40 | {:lines [OrderLine] 41 | :delivery {:delivered s/Bool 42 | :address {:street s/Str 43 | :zip s/Int 44 | :country Country}}}) 45 | 46 | (svc/visualize-schemas) 47 | ``` 48 | 49 | Produces the following: 50 | 51 | ![Schema](dev-resources/schema.png) 52 | 53 | ## License 54 | 55 | Copyright © 2015-2016 [Metosin Oy](http://www.metosin.fi) 56 | 57 | Distributed under the Eclipse Public License, the same as Clojure. 58 | -------------------------------------------------------------------------------- /dev-resources/person-swagger.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metosin/schema-viz/5f24045a7c4f7f1bac77ed069130922feee60866/dev-resources/person-swagger.png -------------------------------------------------------------------------------- /dev-resources/person.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metosin/schema-viz/5f24045a7c4f7f1bac77ed069130922feee60866/dev-resources/person.png -------------------------------------------------------------------------------- /dev-resources/schema.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metosin/schema-viz/5f24045a7c4f7f1bac77ed069130922feee60866/dev-resources/schema.png -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject metosin/schema-viz "0.1.1" 2 | :description "Schema visualization using graphviz" 3 | :url "https://github.com/metosin/schema-viz" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html" 6 | :distribution :repo 7 | :comments "same as Clojure"} 8 | :dependencies [[prismatic/schema "1.1.3"] 9 | [metosin/schema-tools "0.9.0"] 10 | [rhizome "0.2.7"]] 11 | :plugins [[funcool/codeina "0.4.0"]] 12 | 13 | :codeina {:target "doc" 14 | :src-uri "http://github.com/metosin/schema-viz/blob/master/" 15 | :src-uri-prefix "#L"} 16 | 17 | :profiles {:dev {:plugins [[jonase/eastwood "0.2.3"]] 18 | :dependencies [[criterium "0.4.4"] 19 | [org.clojure/clojure "1.8.0"]]} 20 | :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]}} 21 | :aliases {"all" ["with-profile" "dev:dev,1.7"] 22 | "test-clj" ["all" "do" ["test"] ["check"]]}) 23 | -------------------------------------------------------------------------------- /src/schema_viz/core.clj: -------------------------------------------------------------------------------- 1 | (ns schema-viz.core 2 | (:require [clojure.string :as str] 3 | [schema.core :as s] 4 | [schema-tools.walk :as stw] 5 | [schema-tools.core :as st] 6 | [rhizome.viz :as viz])) 7 | 8 | ;; 9 | ;; Definitions 10 | ;; 11 | 12 | (defrecord SchemaDefinition [schema fields relations]) 13 | 14 | (defrecord SchemaReference [schema] 15 | s/Schema 16 | (spec [_] 17 | (s/spec schema)) 18 | (explain [_] 19 | (s/schema-name schema)) 20 | clojure.lang.IDeref 21 | (deref [this] 22 | this) 23 | stw/WalkableSchema 24 | (-walk [this inner outer] 25 | (outer (with-meta (->SchemaReference (inner (:schema this))) (meta this))))) 26 | 27 | ;; 28 | ;; Walkers 29 | ;; 30 | 31 | (defn- deref? [x] 32 | (instance? clojure.lang.IDeref x)) 33 | 34 | (defn- get-name [x] 35 | (name (or (s/schema-name x) x))) 36 | 37 | (defn- full-name [path] 38 | (->> path (map get-name) (map str/capitalize) (apply str) symbol)) 39 | 40 | (defn- plain-map? [x] 41 | (and (map? x) (and (not (record? x))))) 42 | 43 | ; supporting Clojure 1.7 44 | (defn- -map-entry? [x] 45 | (instance? java.util.Map$Entry x)) 46 | 47 | (defn- named-subschemas [schema] 48 | (letfn [(-named-subschemas [path schema] 49 | (stw/walk 50 | (fn [x] 51 | (cond 52 | (-map-entry? x) (let [[k v] x 53 | name (s/schema-name (st/schema-value v))] 54 | [k (-named-subschemas 55 | (if name [name] 56 | (into path 57 | [:$ 58 | (if (s/specific-key? k) 59 | (s/explicit-schema-key k) 60 | (gensym (pr-str k)))])) v)]) 61 | (s/schema-name x) (-named-subschemas [x] x) 62 | :else (-named-subschemas path x))) 63 | (fn [x] 64 | (if (and (plain-map? x) (not (s/schema-name x))) 65 | (with-meta x {:name (full-name path) 66 | :ns (s/schema-ns (first path)) 67 | ::sub-schema? true}) 68 | x)) 69 | schema))] 70 | (-named-subschemas [schema] schema))) 71 | 72 | (defn- with-sub-schemas-references [schemas] 73 | (->> schemas 74 | (stw/postwalk 75 | (fn [x] 76 | (if (s/schema-name x) 77 | (->SchemaReference x) 78 | x))) 79 | (mapv :schema))) 80 | 81 | (defn- collect-schemas [schemas] 82 | (let [name->schema (atom {})] 83 | (stw/prewalk 84 | (fn [schema] 85 | (when-let [name (s/schema-name schema)] 86 | (swap! 87 | name->schema update-in [name] 88 | (fn [x] (conj (or x #{}) schema)))) 89 | schema) 90 | schemas) 91 | ;; TODO: handle duplicate names here 92 | (->> @name->schema vals (map first)))) 93 | 94 | ;; TODO: currently just looks for a first schema, support multiple schemas: s/cond-pre & friends 95 | (defn- peek-schema [schema f] 96 | (let [peeked (atom nil)] 97 | (->> schema 98 | (stw/prewalk 99 | (fn [x] 100 | (let [naked (if (deref? x) @x x)] 101 | (if (and (plain-map? naked) (f naked)) 102 | (do (if-not @peeked (reset! peeked naked)) x) 103 | x))))) 104 | @peeked)) 105 | 106 | ;; 107 | ;; Models 108 | ;; 109 | 110 | (defn- extract-schema-var [x] 111 | (and (var? x) (s/schema-name @x) @x)) 112 | 113 | (defn- schema-definition [schema] 114 | (when (s/schema-name schema) 115 | (let [fields (for [[k v] (peek-schema schema identity) 116 | :let [peeked (peek-schema v s/schema-name)]] 117 | [k v peeked])] 118 | (->SchemaDefinition 119 | schema 120 | (->> fields (map butlast)) 121 | (->> fields (keep last) set))))) 122 | 123 | (defn- extract-relations [{:keys [schema relations]}] 124 | (map (fn [r] [schema r]) relations)) 125 | 126 | (defn- explainable [explanation] 127 | (reify s/Schema (explain [_] explanation))) 128 | 129 | (defn- safe-explain [schema] 130 | (try 131 | (s/explain 132 | ;; replace Schemas with ones producing cleaner explanation 133 | (stw/postwalk 134 | (fn [x] 135 | (if (instance? schema.core.Recursive x) 136 | (explainable (list 'recursive (s/explain (st/schema-value x)))) 137 | x)) 138 | schema)) 139 | (catch Exception _ schema))) 140 | 141 | (defn- explain-key [key] 142 | (if (s/specific-key? key) 143 | (str 144 | (s/explicit-schema-key key) 145 | (if (s/optional-key? key) "(?)")) 146 | (safe-explain key))) 147 | 148 | (defn- explain-value [value] 149 | (str (or (s/schema-name value) (safe-explain value)))) 150 | 151 | (defn- schema-definitions [ns] 152 | (->> ns 153 | ns-publics 154 | vals 155 | (keep extract-schema-var) 156 | (map named-subschemas) 157 | with-sub-schemas-references 158 | collect-schemas 159 | (mapv schema-definition))) 160 | 161 | ;; 162 | ;; DOT 163 | ;; 164 | 165 | (defn- wrap-quotes [x] (str "\"" x "\"")) 166 | 167 | (defn- wrap-escapes [x] (str/escape x {\> ">", \< "<", \" "\\\""})) 168 | 169 | (defn- dot-relation [[from to]] 170 | (str (wrap-quotes (s/schema-name from)) " -> " (wrap-quotes (s/schema-name to)) 171 | "[arrowtail=" (if (-> to meta ::sub-schema?) "diamond" "odiamond") "]")) 172 | 173 | (defn- dot-node [node data] 174 | (str node " [" (str/join ", " (map (fn [[k v]] (str (name k) "=" (pr-str v))) data)) "]")) 175 | 176 | (defn- dot-class [{:keys [fields?]} {:keys [schema fields]}] 177 | (let [{name :name sub-schema? ::sub-schema?} (meta schema) 178 | fields (for [[k v] fields] (str "+ " (explain-key k) " " (-> v explain-value wrap-escapes)))] 179 | (str (wrap-quotes name) " [label = \"{" name 180 | (if fields? (str "|" (str/join "\\l" fields))) "\\l}\"" 181 | (if sub-schema? ", fillcolor=\"#e6caab\"") "]"))) 182 | 183 | (defn- dot-graph [data] 184 | (str "digraph {\n" (str/join "\n" (apply concat data)) "\n}")) 185 | 186 | (defn- dot-package [options definitions] 187 | (let [relations (mapcat extract-relations definitions)] 188 | (dot-graph 189 | [[(dot-node "node" {:fontname "Bitstream Vera Sans" 190 | :fontsize 12 191 | :shape "record" 192 | :style "filled" 193 | :fillcolor "#fff0cd" 194 | :color "#000000"}) 195 | (dot-node "edge" {:dir "back" 196 | :arrowtail "none"})] 197 | (mapv (partial dot-class options) definitions) 198 | (mapv dot-relation relations)]))) 199 | 200 | ;; 201 | ;; Visualization 202 | ;; 203 | 204 | (def ^:private +defaults+ {:fields? true}) 205 | 206 | (defn- process-schemas 207 | [f options] 208 | (let [options (merge {:ns *ns*} +defaults+ options) 209 | ns (:ns options)] 210 | (when-not (= ns *ns*) 211 | (require ns)) 212 | (->> ns 213 | schema-definitions 214 | (dot-package options) 215 | viz/dot->image 216 | f))) 217 | 218 | ;; 219 | ;; Public API 220 | ;; 221 | 222 | (defn visualize-schemas 223 | "Displays a schema visualization in an window. Takes an optional 224 | options map: 225 | 226 | :ns - namespace symbol to be visualized (default *ns*) 227 | :fields? - boolean, wether to show schema fields (default true)" 228 | ([] (visualize-schemas {})) 229 | ([options] (process-schemas viz/view-image options))) 230 | 231 | (defn save-schemas 232 | "Same as visualize-schemas, but saves the result into a file." 233 | ([file] (save-schemas file {})) 234 | ([file options] (process-schemas #(viz/save-image % file) options))) 235 | -------------------------------------------------------------------------------- /test/schema_viz/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns schema-viz.core-test 2 | (:require [schema-viz.core :as svc] 3 | [schema.core :as s])) 4 | 5 | (s/defschema Country 6 | {:name (s/enum :FI :PO) 7 | :neighbors [(s/recursive #'Country)]}) 8 | 9 | (s/defschema Burger 10 | {:name s/Str 11 | (s/optional-key :description) s/Str 12 | :origin (s/maybe Country) 13 | :price (s/constrained s/Int pos?) 14 | s/Keyword s/Any}) 15 | 16 | (s/defschema OrderLine 17 | {:burger Burger 18 | :amount s/Int}) 19 | 20 | (s/defschema Order 21 | {:lines [OrderLine] 22 | :delivery {:delivered s/Bool 23 | :address {:street s/Str 24 | :zip s/Int 25 | :country Country}}}) 26 | 27 | (comment 28 | 29 | (svc/visualize-schemas) 30 | 31 | (svc/save-schemas "schema.png")) 32 | --------------------------------------------------------------------------------