add command "exit"

1 files changed, 13 insertions, 10 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
index 09da6b6..c77ef00 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -18,7 +18,7 @@ import           Database.SQLite.Simple
 import           Database.SQLite.Simple.FromRow ()
 
 import           BasePrelude                    hiding (loop)
-import           Control.Concurrent.Chan
+import           Control.Concurrent.Chan        ()
 import           Prelude                        hiding (id, (.))
 
 import qualified Sound.ALSA.Sequencer
@@ -43,11 +43,14 @@ getTS (MidiEvent ts _) = ts
 getTS (Silence ts) = ts
 
 data LoopState = LoopState {
+  _wantExit    :: Bool,
   keysDown     :: MidiPitchSet,
   inputHistory :: [EVENT],
   lastTick     :: TimeSpec
 }
 
+emptyLoopState = LoopState False Set.empty []
+
 data LoopEnv = LoopEnv {
   _saver         :: Chan (Int64, Int64, [EVENT]),
   _sqlite        :: Connection,
@@ -69,8 +72,6 @@ getAbsTime = do
   now <- liftIO $ getTime Monotonic
   return $ now - startTime + startTimeReal
 
-emptyLoopState = LoopState Set.empty []
-
 main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
   cmdlineAlsaConnect h public
 
@@ -89,16 +90,20 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
 
   (_, ()) <- execRWST loop env (emptyLoopState startTime)
   return ()
+  where
+    loop = do
+      maybeReadLine >>= maybe processMidi processCommand
+      wantExit <- gets _wantExit
+      unless wantExit loop
 
-loop = do
-  startTime <- asks _startTime
-  startTimeReal <- asks _startTimeReal
+processCommand "exit" = modify $ \s -> s { _wantExit = True }
+processCommand str = liftIO $ putStrLn $ "Unknown command: " ++ str
+
+processMidi = do
   h <- asks _h
   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,8 +133,6 @@ loop = do
       when doSave $ gets inputHistory >>= saveMidi >> return ()
       modify $ \s -> s { inputHistory = [] }
 
-  loop
-
 maybeReadLine = asks _lineReader >>= liftIO . tryTakeMVar
 startLineReader = do
   mv <- liftIO newEmptyMVar