diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-17 15:33:11 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-17 15:33:11 -0400 |
commit | ca51fa47fd9d03ac25460dbea7619f79212a912f (patch) | |
tree | 626a09334ddbf0e33376c034e9d8f7a5e13442c9 /debug-me.hs | |
parent | 88ece0f7a670c0e90c9bb2e0259a9ab37b5c5327 (diff) | |
download | debug-me-ca51fa47fd9d03ac25460dbea7619f79212a912f.tar.gz |
beep on Rejected
Diffstat (limited to 'debug-me.hs')
-rw-r--r-- | debug-me.hs | 43 |
1 files changed, 25 insertions, 18 deletions
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 |