diff options
Diffstat (limited to 'Graphviz.hs')
| -rw-r--r-- | Graphviz.hs | 31 |
1 files changed, 15 insertions, 16 deletions
diff --git a/Graphviz.hs b/Graphviz.hs index 59dba7f..f8f165c 100644 --- a/Graphviz.hs +++ b/Graphviz.hs @@ -8,7 +8,6 @@ module Graphviz (graphviz) where import Types -import Hash import CmdLine import Log @@ -57,37 +56,37 @@ genGraph opts ls = digraph (Str "debug-me") $ do , shape Circle ] linkprev s a h - (User (ControlMessage c), Nothing) -> showcontrol c l - (Developer (ControlMessage c), Nothing) -> showcontrol c l + (User (ControlMessage c), Nothing) -> showcontrol c + (Developer (ControlMessage c), Nothing) -> showcontrol c _ -> return () - showcontrol (Control (Rejected ar) _) l = do - let hr = hash ar + showcontrol (Control (EnteredRejected hr _) _) = do let rejstyle = [ xcolor Red , Style [dashed, filled] ] - let nodename = display $ "Rejected " <> display hr + let nodename = display $ "Rejected: " <> display hr node nodename $ rejstyle ++ [ textLabel "Rejected" , shape BoxShape ] - showactivity rejstyle $ Log - { loggedMessage = Developer (ActivityMessage ar) - , loggedHash = Just hr - , loggedTimestamp = loggedTimestamp l - } edge nodename (display hr) rejstyle - showcontrol _ _ = return () - - linkprev s a h = case prevActivity a of - Nothing -> return () - Just p -> link p h s + showcontrol _ = return () + + linkprev s a h = do + case prevActivity a of + Nothing -> return () + Just p -> link p h s + case prevEntered a of + Nothing -> return () + Just p -> link p h (s ++ enteredpointerstyle) link a b s = edge (display a) (display b) $ s ++ if graphvizShowHashes opts then [ textLabel (prettyDisplay a) ] else [] + enteredpointerstyle = [ xcolor Gray ] + xcolor :: X11Color -> Attribute xcolor c = Color [toWC $ X11Color c] |