From 362d3a437c16c10d221caeac21e9f685d7ddf3e6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 22 Apr 2017 11:41:54 -0400
Subject: stream the log

avoid processing it in memory, and allow parse errors at end to not
prevent displaying part of it
---
 Graphviz.hs | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'Graphviz.hs')

diff --git a/Graphviz.hs b/Graphviz.hs
index 59f3bf9..96ad92a 100644
--- a/Graphviz.hs
+++ b/Graphviz.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}
 
 module Graphviz (graphviz) where
 
@@ -22,7 +22,7 @@ import Data.Text.Encoding.Error
 
 graphviz :: GraphvizOpts -> IO ()
 graphviz opts = do
-	l <- loadLog (graphvizLogFile opts)
+	l <- streamLog (graphvizLogFile opts)
 	let g = genGraph opts l
 	f <- createImage (graphvizLogFile opts) Png g
 	putStrLn ("Generated " ++ f)
@@ -30,13 +30,16 @@ graphviz opts = do
 createImage :: PrintDotRepr dg n => FilePath -> GraphvizOutput -> dg n -> IO FilePath
 createImage f o g = Data.GraphViz.addExtension (runGraphvizCommand Dot g) o f
 
-genGraph :: GraphvizOpts -> [Log] -> G.DotGraph T.Text
+genGraph :: GraphvizOpts -> [Either String Log] -> G.DotGraph T.Text
 genGraph opts ls = digraph (Str "debug-me") $ do
 	nodeAttrs [style filled]
 	forM_ ls $
 		showlog [ xcolor Green ]
   where
-	showlog s l = case (loggedMessage l, loggedHash l) of
+	showlog s (Right l) = showactivity s l
+	showlog _ (Left l) = node (display l) [xcolor Red, shape DiamondShape]
+
+	showactivity s l = case (loggedMessage l, loggedHash l) of
 		(User (ActivityMessage a), Just h) -> do
 			node (display h) $ s ++
 				[ textLabel $ prettyDisplay $ activity a
@@ -64,7 +67,7 @@ genGraph opts ls = digraph (Str "debug-me") $ do
 			[ textLabel "Rejected"
 			, shape BoxShape
 			]
-		showlog rejstyle $ Log
+		showactivity rejstyle $ Log
 			{ loggedMessage = Developer (ActivityMessage ar)
 			, loggedHash = Just hr
 			, loggedTimestamp = loggedTimestamp l
@@ -102,6 +105,9 @@ instance Display T.Text where
 		leadingws (c:_) = isSpace c
 		leadingws _ = False
 
+instance Display String where
+	display = display . T.pack
+
 instance Display Val where
 	display (Val b) = T.decodeUtf8With lenientDecode (L.fromStrict b)
 
-- 
cgit v1.2.3