add a log from developer's perspective

1 files changed, 17 insertions, 13 deletions

diff --git a/debug-me.hs b/debug-me.hs
index 53ee545..9332270 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -50,8 +50,9 @@ networkDelay :: IO ()
 networkDelay = threadDelay 800000 -- 150000 -- 800000
 
 developer :: TChan (Activity Entered) -> TChan (Activity Seen) -> IO ()
-developer ichan ochan = do
+developer ichan ochan = withLogger "debug-me-developer.log" $ \logger -> do
 	startact <- atomically $ readTChan ochan
+	logger $ ActivitySeen (startact, hash startact)
 	case startact of
 		Activity (Proto (Seen (Val b))) Nothing sig -> do
 			B.hPut stdout b
@@ -63,8 +64,8 @@ developer ichan ochan = do
 		, enteredSince = mempty
 		, lastActivity = hash startact
 		}
-	_ <- sendTtyInput ichan devstate
-		`concurrently` sendTtyOutput ochan devstate
+	_ <- sendTtyInput ichan devstate logger
+		`concurrently` sendTtyOutput ochan devstate logger
 	return ()
 
 data DeveloperState = DeveloperState
@@ -76,8 +77,8 @@ data DeveloperState = DeveloperState
 	deriving (Show)
 
 -- | Read things typed by the developer, and forward them to the TChan.
-sendTtyInput :: TChan (Activity Entered) -> TVar DeveloperState -> IO ()
-sendTtyInput ichan devstate = go
+sendTtyInput :: TChan (Activity Entered) -> TVar DeveloperState -> Logger -> IO ()
+sendTtyInput ichan devstate logger = go
   where
 	go = do
 		b <- B.hGetSome stdin 1024
@@ -85,7 +86,7 @@ sendTtyInput ichan devstate = go
 			then return ()
 			else send b
 	send b = do
-		atomically $ do
+		act <- atomically $ do
 			ds <- readTVar devstate
 			let ed = if lastActivity ds == lastSeen ds
 				then B.concat $ sentSince ds
@@ -105,14 +106,17 @@ sendTtyInput ichan devstate = go
 				, lastActivity = acth
 				}
 			writeTVar devstate ds'
+			return act
+		logger $ ActivityEntered (act, hash act)
 		go
 
 -- | Read activity from the TChan and display it to the developer.
-sendTtyOutput :: TChan (Activity Seen) -> TVar DeveloperState -> IO ()
-sendTtyOutput ochan devstate = go
+sendTtyOutput :: TChan (Activity Seen) -> TVar DeveloperState -> Logger -> IO ()
+sendTtyOutput ochan devstate logger = go
   where
 	go = do
-		v <- atomically $ processOutput ochan devstate
+		(v, act) <- atomically $ processOutput ochan devstate
+		logger $ ActivitySeen (act, hash act)
 		case v of
 			ProtocolError e -> protocolError e
 			TtyOutput b -> do
@@ -126,7 +130,7 @@ sendTtyOutput ochan devstate = go
 
 data Output = TtyOutput B.ByteString | Beep | ProtocolError String
 
-processOutput :: TChan (Activity Seen) -> TVar DeveloperState -> STM Output
+processOutput :: TChan (Activity Seen) -> TVar DeveloperState -> STM (Output, Activity Seen)
 processOutput ochan devstate = do
 	act <- readTChan ochan
 	ds <- readTVar devstate
@@ -135,11 +139,11 @@ processOutput ochan devstate = do
 		then case act of
 			Activity (Proto (Seen (Val b))) _ _ -> do
 				writeTVar devstate ds'
-				return $ TtyOutput b
+				return (TtyOutput b, act)
 			Activity (Rejected _) _ _ -> do
  				writeTVar devstate ds'
-				return Beep
-		else return $ ProtocolError $ "Illegal Seen value: " ++ show (act, hash act) ++ "\n" ++ show ds
+				return (Beep, act)
+		else return (ProtocolError $ "Illegal Seen value: " ++ show (act, hash act) ++ "\n" ++ show ds, act)
 
 -- | Check if the Seen activity is legal, and returns an updated
 -- DeveloperState.