dot-visualisation

project.clj

@@ -18,7 +18,8 @@
                   :exclusions [commons-codec]]
 
                  [clj-time "0.15.1"]
-                 [markdown-clj "1.0.6"]]
+                 [markdown-clj "1.0.6"]
+                 [dorothy "0.0.7"]]
 
   :profiles {:dev {:dependencies [[javax.servlet/servlet-api "2.5"]
                                   [ring/ring-mock "0.3.2"]]

resources/app/stylesheets/app.less

@@ -44,6 +44,10 @@ em {
     font-weight: bold;
 }
 
+img {
+    max-width: 100%;
+}
+
 .thin-border {
     border: @border-stack;
 }

src/wanijo/instance/domain.clj

@@ -155,6 +155,22 @@
        (neo4j/exec-query! outgoing-links
                           {:uuid uuid})))
 
+(neo4j/defquery incoming-links
+  "MATCH (i:instance {uuid:{uuid}}),
+         (i)<-[:link_to]-(l:link),
+         (l)-[:link_from]->(source:instance),
+         (source)-[:of]->(schema:schema)
+   RETURN i, l, source, schema
+   ORDER BY schema.name, source.name, source.created_at")
+
+(defn incoming-links! [uuid]
+  (map (fn [row]
+         {:link (:l row)
+          :source (:source row)
+          :schema (:schema row)})
+       (neo4j/exec-query! incoming-links
+                          {:uuid uuid})))
+
 (neo4j/defquery delete-link
   "MATCH (l:link {uuid:{uuid}}),
          (l)-[r]-()

src/wanijo/instance/routes.clj

@@ -6,7 +6,8 @@
             [wanijo.instance
              [view :as view]
              [domain :as domain]
-             [forms :as forms-inst]]
+             [forms :as forms-inst]
+             [viz :as viz]]
             [wanijo.schema
              [domain :as domain-schema]
              [middleware :as middleware-schema]]
@@ -43,7 +44,9 @@
          :properties
          (domain/find-properties! uuid)
          :links-out
-         (domain/outgoing-links! uuid)))
+         (domain/outgoing-links! uuid)
+         :links-in
+         (domain/incoming-links! uuid)))
 
 (defn show! [uuid req]
   (view/show! (instance! uuid) req))
@@ -122,6 +125,11 @@
   (DELETE (register! :instance-delete "/instance/:uuid")
           [uuid :as req]
           (delete! uuid req))
+  (GET (register! :instance-link-viz
+                  "/instance/:uuid/link/viz")
+       [uuid :as req]
+       {:body (viz/as-svg (instance! uuid))
+        :headers {"Content-Type" "image/svg+xml"}})
   (GET (register! :instance-link-selection
                   "/instance/:uuid/link/:schema-uuid")
        [uuid schema-uuid :as req]

src/wanijo/instance/view.clj

@@ -89,7 +89,13 @@
             [:td [:a {:href (path :instance-list
                                   {:schema-uuid (:uuid schema)})}
                   (h (:name schema))]]
-            [:td (prettify-dt (:created_at link))]])]]])]))
+            [:td (prettify-dt (:created_at link))]])]]])
+    (when (or (not (empty? (:links-out instance)))
+               (not (empty? (:links-in instance))))
+      [:section.visualisation
+       [:h2 "Visualisation"]
+       [:image {:src (path :instance-link-viz instance)
+                :alt "SVG Visualisation"}]])]))
 
 (defn edit! [instance form form-data schemas req]
   (view/layout!

src/wanijo/instance/viz.clj

@@ -0,0 +1,26 @@
+(ns wanijo.instance.viz
+  (:require [dorothy
+             [core :as dot]
+             [jvm :as doro-jvm]]))
+
+(defn as-svg [instance]
+  (let [out-nodes (map #(vector (-> % :target :uuid)
+                                {:label (-> % :target :name)})
+                       (:links-out instance))
+        in-nodes (map #(vector (-> % :source :uuid)
+                               {:label (-> % :source :name)})
+                      (:links-in instance))
+        relationships-out (map (fn [{:keys [link target schema]}]
+                                 [(:uuid instance) :> (:uuid target)])
+                               (:links-out instance))
+        relationships-in (map (fn [{:keys [link source schema]}]
+                                [(:uuid source) :> (:uuid instance)])
+                              (:links-in instance))]
+    (-> [[(:uuid instance) {:label (:name instance)}]]
+        (into out-nodes)
+        (into in-nodes)
+        (into relationships-out)
+        (into relationships-in)
+        dot/digraph
+        dot/dot
+        (doro-jvm/render {:format :svg}))))