From 1d18dcbe796820b30e0c8c1db241da95ee7566cb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Apr 2017 13:04:16 -0400 Subject: improve types Including adding a timestamp to logs --- Graphviz.hs | 43 +++++++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 18 deletions(-) (limited to 'Graphviz.hs') diff --git a/Graphviz.hs b/Graphviz.hs index 9d508c8..c6ce8a9 100644 --- a/Graphviz.hs +++ b/Graphviz.hs @@ -50,29 +50,36 @@ genGraph opts ls = digraph (Str "debug-me") $ do forM_ ls $ showactivity [ xcolor Green ] where - showactivity s (ActivitySeen { activitySeen = (a, h) }) = do - node (display h) $ s ++ - [ textLabel $ prettyDisplay $ 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) - link hr h rejstyle - _ -> return () - linkprev s a h - showactivity s (ActivityEntered { activityEntered = (a, h) }) = do + showactivity s l = case loggedActivity l of + ActivitySeen a -> do + node (display h) $ s ++ + [ textLabel $ prettyDisplay $ activity a + , shape BoxShape + ] + case activity a of + Rejected ar -> do + let hr = hash ar + let rejstyle = + [ xcolor Red + , Style [dashed, filled] + ] + showactivity rejstyle $ + ActivityLog + { loggedActivity = ActivityEntered ar + , loggedHash = hr + , loggedTimestamp = loggedTimestamp l + } + link hr h rejstyle + _ -> return () + linkprev s a h + ActivityEntered a -> do node (display h) $ s ++ [ textLabel $ prettyDisplay $ activity a , shape Circle ] linkprev s a h + where + h = loggedHash l linkprev s a h = case prevActivity a of Nothing -> return () Just p -> link p h s -- cgit v1.2.3