From 74499ceb9decf47709304c5923cefab6b0b99cef Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 17 Apr 2017 16:01:30 -0400
Subject: improve display of Rejected

---
 Graphviz.hs | 41 ++++++++++++++++++++++++++---------------
 1 file changed, 26 insertions(+), 15 deletions(-)

(limited to 'Graphviz.hs')

diff --git a/Graphviz.hs b/Graphviz.hs
index 26b7563..d3a599e 100644
--- a/Graphviz.hs
+++ b/Graphviz.hs
@@ -3,6 +3,7 @@
 module Graphviz (graphviz) where
 
 import Types
+import Hash
 
 import Data.Aeson
 import Data.Char
@@ -45,25 +46,35 @@ createImage f o g = Data.GraphViz.addExtension (runGraphvizCommand Dot g) o f
 genGraph :: [ActivityLog] -> G.DotGraph T.Text
 genGraph ls = digraph (Str "debug-me") $ do
 	nodeAttrs [style filled]
-	forM_ ls $ \l -> case l of
-		ActivitySeen { activitySeen = (a, h) } -> do
-			node (display h)
-				[ textLabel $ display $ activity a
-				, shape BoxShape
-				, xcolor Green
-				]
-			chain a h
-		ActivityEntered { activityEntered = (a, h) } -> do
-			node (display h)
+	forM_ ls $
+		showactivity [ xcolor Green ]
+  where
+	showactivity s (ActivitySeen { activitySeen = (a, h) }) = do
+		node (display h) $ s ++
+			[ textLabel $ display $ activity a
+			, shape BoxShape
+			]
+		case activity a of
+			Rejected ar -> do
+				let hr = hash ar
+				let rejstyle =
+					[ xcolor Red
+					, Style [dashed, filled]
+					]
+				showactivity rejstyle $
+					ActivityEntered (ar, hr)
+				edge (display hr) (display h) rejstyle
+			_ -> return ()
+		chain s a h
+	showactivity s (ActivityEntered { activityEntered = (a, h) }) = do
+			node (display h) $ s ++
 				[ textLabel $ display $ activity a
 				, shape Circle
-				, xcolor Green
 				]
-			chain a h
-  where
-	chain a h = case prevActivity a of
+			chain s a h
+	chain s a h = case prevActivity a of
 		Nothing -> return ()
-		Just p -> display p --> display h
+		Just p -> edge (display p) (display h) s
 
 xcolor :: X11Color -> Attribute
 xcolor c = Color [toWC $ X11Color c]
-- 
cgit v1.2.3