diff options
-rw-r--r-- | Graphviz.hs | 14 |
1 files changed, 9 insertions, 5 deletions
diff --git a/Graphviz.hs b/Graphviz.hs index d3a599e..d13e386 100644 --- a/Graphviz.hs +++ b/Graphviz.hs @@ -63,18 +63,22 @@ genGraph ls = digraph (Str "debug-me") $ do ] showactivity rejstyle $ ActivityEntered (ar, hr) - edge (display hr) (display h) rejstyle + link hr h rejstyle _ -> return () - chain s a h + linkprev s a h showactivity s (ActivityEntered { activityEntered = (a, h) }) = do node (display h) $ s ++ [ textLabel $ display $ activity a , shape Circle ] - chain s a h - chain s a h = case prevActivity a of + linkprev s a h + linkprev s a h = case prevActivity a of Nothing -> return () - Just p -> edge (display p) (display h) s + Just p -> link p h s + link a b s = edge (display a) (display b) $ s ++ + [ textLabel (shorthash a) + ] + shorthash h = display $ Val $ B.take 5 $ val $ hashValue h xcolor :: X11Color -> Attribute xcolor c = Color [toWC $ X11Color c] |