retry after alsa inputPending exceptions

1 files changed, 13 insertions, 1 deletions

diff --git a/AlsaSeq.hs b/AlsaSeq.hs
index 8f7bea3..1926712 100644
--- a/AlsaSeq.hs
+++ b/AlsaSeq.hs
@@ -23,6 +23,8 @@ import Control.Monad (when, forM_, forM)
 import qualified Data.Set as Set
 import Data.List (group, sort)
 import Haskore.Basic.Pitch
+import Foreign.C.Error (Errno(Errno))
+import Control.Exception.Base (try)
 
 printChordLn set = printWords $ pitchWords set
 
@@ -112,10 +114,20 @@ cmdlineAlsaConnect h public = do
         IO.hPutStrLn IO.stderr "need arguments: input-port output-port"
         Exit.exitFailure
 
+inputPendingLoop h b = do
+  mres <- try (Event.inputPending h b >>= return)
+  case mres of
+    (Left e) -> do
+      putStrLn $ "alsa_exception: " ++ AlsaExc.show e -- TODO: log this to a file
+      case e of
+        (AlsaExc.Cons _ _ (Errno 4)) -> inputPendingLoop h b >>= return -- axis: AlsaException.Cons "inputPending" "Interrupted system call" (Errno 4)
+        (AlsaExc.Cons location _ code) -> AlsaExc.throw location code
+    (Right result) -> return result
+
 parseAlsaEvents h keysDown immediate = loop keysDown
   where
     loop keysDown = do
-      pending <- Event.inputPending h True
+      pending <- inputPendingLoop h True
       if (pending == 0) then
         return keysDown
       else do