add thread to read lines from stdin

1 files changed, 14 insertions, 2 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
index b9911c8..dd97d69 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -61,7 +61,8 @@ data LoopEnv = LoopEnv {
   q :: Sound.ALSA.Sequencer.Queue.T,
   publicAddr :: Sound.ALSA.Sequencer.Address.T,
   privateAddr :: Sound.ALSA.Sequencer.Address.T,
-  doSave :: Bool
+  doSave :: Bool,
+  lineReader :: MVar (String)
 }
 
 getAbsTime = do
@@ -83,10 +84,11 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
   sqlite <- open "test.db"
   execute_ sqlite "CREATE TABLE IF NOT EXISTS chunks (id INTEGER PRIMARY KEY, sec INTEGER, nsec INTEGER, midi BLOB)"
   saver <- startSaver sqlite
+  lineReader <- startLineReader
 
   doSave <- isJust <$> lookupEnv "SAVE_MIDI"
 
-  let env = LoopEnv saver sqlite startTime startTimeReal h public private q publicAddr privateAddr doSave
+  let env = LoopEnv saver sqlite startTime startTimeReal h public private q publicAddr privateAddr doSave lineReader
 
   (_, ()) <- execRWST loop env (emptyLoopState startTime)
   return ()
@@ -98,6 +100,8 @@ loop = do
   q <- asks q
   publicAddr <- asks publicAddr
 
+  mapM_ (liftIO . putStrLn . ("got line: " ++)) =<< maybeReadLine
+
   oldKeys <- gets keysDown
   let forwardNOW = forwardNoteEvent h q publicAddr
   (events, newKeys) <- liftIO $ parseAlsaEvents' h oldKeys forwardNOW
@@ -128,6 +132,13 @@ loop = do
 
   loop
 
+maybeReadLine = asks lineReader >>= liftIO . tryTakeMVar
+startLineReader = do
+  mv <- liftIO $ newEmptyMVar
+  thread <- liftIO $ forkIO (forever $ getLine >>= putMVar mv)
+  return mv
+
+
 data Chunk = Chunk Int64 Int64 BS.ByteString
 instance FromRow Chunk where
   fromRow = Chunk <$> field <*> field <*> field
@@ -150,6 +161,7 @@ startSaver sqlite = do
       liftIO $ execute sqlite "INSERT INTO chunks (sec, nsec, midi) VALUES (?,?,?)" (Chunk s ns bytes)
       return ()
 
+
 getMidiDesc :: EVENT -> Maybe String
 getMidiDesc (MidiEvent _ (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOn  ev))) = return $ ("on:" ++)  $ showPitch $ unPitch $ Event.noteNote ev
 getMidiDesc (MidiEvent _ (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOff ev))) = return $ ("off:" ++) $ showPitch $ unPitch $ Event.noteNote ev