separate out a midi event hook in midi-dump.hs

2 files changed, 14 insertions, 8 deletions

diff --git a/AlsaSeq.hs b/AlsaSeq.hs
index 22208bd..1c53b18 100644
--- a/AlsaSeq.hs
+++ b/AlsaSeq.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE NondecreasingIndentation #-}
 module AlsaSeq (withAlsaInit, parseAlsaEvents, forwardNoteEvent,
 cmdlineAlsaConnect, printChordLn, showChord, pitchList, showPitch,
-unPitch, unChannel) where
+unPitch, unChannel, MidiHook) where
 import qualified Sound.ALSA.Exception as AlsaExc
 import qualified Sound.ALSA.Sequencer.Address as Addr
 import qualified Sound.ALSA.Sequencer as SndSeq
@@ -162,6 +162,9 @@ parseAlsaEvents h keysDown immediate = loop keysDown
              loop (Set.delete (Event.noteChannel n, Event.noteNote n) keysDown)
            _ -> loop keysDown
 
+type MidiHook = Event.T -> IO ()
+
+forwardNoteEvent :: SndSeq.AllowOutput mode => SndSeq.T mode -> Queue.T -> Addr.T -> MidiHook
 forwardNoteEvent h q publicAddr ev = do
 --let immediate = \a b c -> do { Event.output h $ mkEv $ a b c; _ <- Event.drainOutput h; return (); }
 
@@ -169,3 +172,4 @@ forwardNoteEvent h q publicAddr ev = do
 
   let (Event.Cons highPriority tag _ time _ _ body) = ev in Event.output h (Event.Cons highPriority tag q time publicAddr Addr.subscribers body)
   Event.drainOutput h
+  return ()
diff --git a/midi-dump.hs b/midi-dump.hs
index aa19def..0f714ed 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -1,18 +1,19 @@
-{-# LANGUAGE NondecreasingIndentation #-}
 import AlsaSeq
 import Control.Concurrent (threadDelay)
 import qualified Sound.ALSA.Exception as AlsaExc
 import qualified Data.Set as Set
 
-main = (do
+main = main' `AlsaExc.catch` handler
+  where
+  handler e = putStrLn $ "alsa_exception: " ++ AlsaExc.show e
 
-  withAlsaInit $ \h public private q publicAddr privateAddr -> do
+main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
   cmdlineAlsaConnect h public
 
   let
     forwardNOW = forwardNoteEvent h q publicAddr
     go keysDown = do
-      keysDown' <- parseAlsaEvents h keysDown forwardNOW
+      keysDown' <- parseAlsaEvents h keysDown (\ev -> do forwardNOW ev; hook ev)
       if (keysDown == keysDown') then
         threadDelay 15000 -- 15ms.  Seems like a lot, but it sounds OK.  Cuts CPU down to 2%.
       else do
@@ -20,6 +21,7 @@ main = (do
       go keysDown'
 
   putStrLn "Rock on!"
-  go Set.empty)
-     `AlsaExc.catch` \e ->
-       putStrLn $ "alsa_exception: " ++ AlsaExc.show e
+  go Set.empty
+
+hook :: MidiHook
+hook ev = return ()