From 74003096f8018827dde28b5746a19c1e325bc68f Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 14 Apr 2017 19:39:23 -0400
Subject: add --graphviz mode

This commit was sponsored by Shane-o on Patreon.
---
 debug-me.hs | 27 ++++++++++++++++++---------
 1 file changed, 18 insertions(+), 9 deletions(-)

(limited to 'debug-me.hs')

diff --git a/debug-me.hs b/debug-me.hs
index 162ca1b..075ca17 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -5,6 +5,8 @@ module Main where
 import Types
 import Hash
 import Pty
+import CmdLine
+import Graphviz
 
 import Control.Concurrent
 import Control.Concurrent.Async
@@ -20,6 +22,13 @@ import Data.Aeson
 
 main :: IO ()
 main = do
+	c <- getCmdLine
+	case mode c of
+		Test -> test
+		Graphviz logfile -> graphviz logfile
+ 
+test :: IO ()
+test = do
 	exitstatus <- go ">>> debug-me session starting"
 	putStrLn ""
 	putStrLn ">>> debug-me session is done"
@@ -53,7 +62,7 @@ developer ichan ochan = do
 	return ()
 
 data DeveloperState = DeveloperState
-	{ lastSeen :: HashPointer
+	{ lastSeen :: Hash
 	, sentSince :: B.ByteString
 	}
 	deriving (Show)
@@ -112,7 +121,7 @@ sendTtyOutput ochan devstate = go
 user :: B.ByteString -> Pty -> TChan (Activity Entered) -> TChan (Activity Seen) -> IO ()
 user startmsg p ichan ochan = withLogger "debug-me.log" $ \logger -> do
 	let startact = Activity (Seen (Val (startmsg <> "\r\n"))) Nothing dummySignature
-	logger (ActivitySeen startact)
+	logger $ ActivitySeen (startact, hash startact)
 	atomically $ writeTChan ochan startact
 	backlog <- newTVarIO $ Backlog ((hash startact, startact) :| [])
 	_ <- sendPtyOutput p ochan backlog logger
@@ -120,7 +129,7 @@ user startmsg p ichan ochan = withLogger "debug-me.log" $ \logger -> do
 	return ()
 
 -- | Log of recent output, with the most recent output first.
-data Backlog = Backlog (NonEmpty (HashPointer, Activity Seen))
+data Backlog = Backlog (NonEmpty (Hash, Activity Seen))
 	deriving (Show)
 
 type Logger = ActivityLog -> IO ()
@@ -129,8 +138,8 @@ withLogger :: FilePath -> (Logger -> IO a) -> IO a
 withLogger logfile a = withFile logfile WriteMode (a . mkLogger)
 
 mkLogger :: Handle -> Logger
-mkLogger h l = do
-	L.hPut h (encode l)
+mkLogger h a = do
+	L.hPut h (encode a)
 	hPutStr h "\n"
 	hFlush h
 
@@ -147,7 +156,7 @@ sendPtyOutput p ochan backlog logger = go
 			writeTChan ochan act
 			writeTVar backlog (Backlog ((hash act, act) :| toList bl))
 			return act
-		logger (ActivitySeen act)
+		logger $ ActivitySeen (act, hash act)
 		go
 
 -- | Read things to be entered from the TChan, verify if they're legal,
@@ -171,11 +180,11 @@ sendPtyInput ichan p backlog logger = go
 					return (Left (newact, bl'))
 		case v of
 			Right entered -> do
-				logger (ActivityEntered entered True)
+				logger $ ActivityEntered True (entered, hash entered)
 				writePty p (val (enteredData (activity entered)))
 				go
 			Left (illegalentered, _bl) -> do
-				logger (ActivityEntered illegalentered False)
+				logger $ ActivityEntered False (illegalentered, hash illegalentered)
 				-- print bl
 				go
 
@@ -199,7 +208,7 @@ truncateBacklog (Backlog (b :| l)) (Activity _ hp _)
 -- the current state of the system before manipulating it.
 --
 -- To support typeahead on slow links, some echoData may be provided
--- in the Entered activity. If the HashPointer in the activity points
+-- in the Entered activity. If the prevActivity points
 -- to an older Seen activity, then the echoData must match the
 -- concatenation of all activities after that one, up to the most recent
 -- Seen activity.
-- 
cgit v1.2.3