From ca51fa47fd9d03ac25460dbea7619f79212a912f Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 17 Apr 2017 15:33:11 -0400
Subject: beep on Rejected

---
 debug-me.hs | 43 +++++++++++++++++++++++++------------------
 1 file changed, 25 insertions(+), 18 deletions(-)

(limited to 'debug-me.hs')

diff --git a/debug-me.hs b/debug-me.hs
index 07ff05b..2625ecc 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -107,27 +107,34 @@ sendTtyOutput :: TChan (Activity Seen) -> TVar DeveloperState -> IO ()
 sendTtyOutput ochan devstate = go
   where
 	go = do
-		v <- atomically get
+		v <- atomically $ processOutput ochan devstate
 		case v of
-			Left e -> protocolError e
-			Right (Just b) -> do
+			ProtocolError e -> protocolError e
+			TtyOutput b -> do
 				B.hPut stdout b
 				hFlush stdout
 				go
-			Right Nothing -> go
-	get = do
-		act <- readTChan ochan
-		ds <- readTVar devstate
-		let (legal, ds') = isLegalSeen act ds
-		if legal
-			then case act of
-				Activity (Proto (Seen (Val b))) _ _ -> do
-					writeTVar devstate ds'
-					return $ Right $ Just b
-				Activity (Rejected _) _ _ -> do
- 					writeTVar devstate ds'
-					return $ Right Nothing
-			else return $ Left $ "Illegal Seen value: " ++ show (act, hash act) ++ "\n" ++ show ds
+			Beep -> do
+				B.hPut stdout "\a"
+				hFlush stdout
+				go
+
+data Output = TtyOutput B.ByteString | Beep | ProtocolError String
+
+processOutput :: TChan (Activity Seen) -> TVar DeveloperState -> STM Output
+processOutput ochan devstate = do
+	act <- readTChan ochan
+	ds <- readTVar devstate
+	let (legal, ds') = isLegalSeen act ds
+	if legal
+		then case act of
+			Activity (Proto (Seen (Val b))) _ _ -> do
+				writeTVar devstate ds'
+				return $ TtyOutput b
+			Activity (Rejected _) _ _ -> do
+ 				writeTVar devstate ds'
+				return Beep
+		else return $ ProtocolError $ "Illegal Seen value: " ++ show (act, hash act) ++ "\n" ++ show ds
 
 -- | Check if the Seen activity is legal, and returns an updated
 -- DeveloperState.
@@ -160,7 +167,7 @@ isLegalSeen act@(Activity p (Just hp) sig) ds
 		Nothing -> (False, ds)
 		Just i -> case p of
 			Rejected _ -> yesrej
-			Proto (Seen (Val b)) ->
+			Proto (Seen (Val _)) ->
 				let ss = sentSince ds
 				    es = enteredSince ds
 				    ss' = drop (i+1) ss
-- 
cgit v1.2.3