Fix some lint errors, fix formatting, etc.

(No semantic changes.)

1 files changed, 64 insertions, 90 deletions

diff --git a/AlsaSeq.hs b/AlsaSeq.hs
index 0512c80..33680b1 100644
--- a/AlsaSeq.hs
+++ b/AlsaSeq.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE NondecreasingIndentation #-}
-module AlsaSeq (withAlsaInit, parseAlsaEvents, parseAlsaEvents', parseAlsaEvents'', forwardNoteEvent,
+module AlsaSeq (withAlsaInit, parseAlsaEvents, parseAlsaEvents'', forwardNoteEvent,
 cmdlineAlsaConnect, printChordLn, printChordLn', showChord, pitchList, showPitch,
 unPitch, unChannel, MidiHook, MidiPitchSet, MidiPitchMap) where
 import qualified Sound.ALSA.Exception as AlsaExc
@@ -10,17 +9,17 @@ import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo
 import qualified Sound.ALSA.Sequencer.Port.Info as PortInfo
 import qualified Sound.ALSA.Sequencer.Connect as Connect
 import qualified Sound.ALSA.Sequencer.Event as Event
-import qualified Sound.ALSA.Sequencer.Event.RemoveMonad as Remove
+-- import qualified Sound.ALSA.Sequencer.Event.RemoveMonad as Remove
 import qualified Sound.ALSA.Sequencer.Port as Port
 import qualified Sound.ALSA.Sequencer.Port.InfoMonad as PortInfoM
 import qualified Sound.ALSA.Sequencer.Queue as Queue
-import qualified Sound.ALSA.Sequencer.RealTime as RealTime
-import qualified Sound.ALSA.Sequencer.Time as Time
+-- import qualified Sound.ALSA.Sequencer.RealTime as RealTime
+-- import qualified Sound.ALSA.Sequencer.Time as Time
 import qualified System.Exit as Exit
 import qualified System.IO as IO
 import System.Environment (getArgs, )
 import Text.Printf
-import Control.Monad (when, forM_, forM)
+import Control.Monad
 
 import qualified Data.Set as Set
 import qualified Data.Map.Strict as Map
@@ -48,7 +47,7 @@ showPitch x =
   in Haskore.Basic.Pitch.classFormat pitch (show octave)
 
 pitchWords set = map showPitch $ pitchList set
-pitchList set = map Event.unPitch $ map (\ (c, n) -> n) $ Set.toList set
+pitchList set = map (Event.unPitch . snd) (Set.toList set)
 pitchLists set = map (\ (c, n) -> (Event.unChannel c, Event.unPitch n)) $ Set.toList set
 
 prettyNote :: Event.Note -> String
@@ -65,82 +64,76 @@ showAlsaPorts h = do
   putStrLn ""
   printf "%15s   %s\n" "Ports" "Names"
   printf "%15s   %s\n" "=====" "====="
-  forM c (\(name, ports) -> printf "%15s   %s\n" (showPorts ports) name)
+  forM_ c (\(name, ports) -> printf "%15s   %s\n" (showPorts ports) name)
   putStrLn ""
 
-alsaClients h = do
-  portsNames <- ClientInfo.queryLoop h $ \cinfo -> do
+alsaClients h =
+  ClientInfo.queryLoop h $ \cinfo -> do
     ports <- alsaClientPorts h cinfo
     name <- ClientInfo.getName cinfo
     return (name, ports)
-  return portsNames
 
 alsaClientPorts h cinfo = do
   client <- ClientInfo.getClient cinfo
-  ports <- PortInfo.queryLoop h client $ \pinfo -> do
-    c <- PortInfo.getClient pinfo
-    let (Client.Cons p) = c in
-      return p
-  return ports
+  PortInfo.queryLoop h client $ \pinfo -> do
+    (Client.Cons ports) <- PortInfo.getClient pinfo
+    return ports
 
-withAlsaInit k = do
+withAlsaInit k =
   SndSeq.withDefault SndSeq.Nonblock $ \h -> do
-
-  Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell Beats" -- In imperative language MIDI sequencer, you rock beat.  In Haskell language MIDI sequencer, rock beat you!
-
-  Port.withSimple h "inout"
-     (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite, Port.capSubsWrite])
-     (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \public -> do
-  Port.withSimple h "private"
-     (Port.caps [Port.capRead, Port.capWrite])
-     (Port.types [Port.typeMidiGeneric]) $ \private -> do
-  Queue.with h $ \q -> do
-
-  PortInfoM.modify h public $ do
-     PortInfoM.setTimestamping True
-     PortInfoM.setTimestampReal True
-     PortInfoM.setTimestampQueue q
-
-  c <- Client.getId h
-  let publicAddr  = Addr.Cons c public
-      privateAddr = Addr.Cons c private
-
-  Queue.control h q Event.QueueStart Nothing
-
-  k h public private q publicAddr privateAddr
+    Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell Beats"
+    -- In imperative language MIDI sequencer, you rock beat. In Haskell language MIDI sequencer, rock
+    -- beat you!
+    Port.withSimple h "inout" inout_caps inout_types $ \public ->
+      Port.withSimple h "private" private_caps private_types $ \private -> Queue.with h $ \q -> do
+        PortInfoM.modify h public $ do
+          PortInfoM.setTimestamping True
+          PortInfoM.setTimestampReal True
+          PortInfoM.setTimestampQueue q
+
+        c <- Client.getId h
+        let publicAddr = Addr.Cons c public
+            privateAddr = Addr.Cons c private
+
+        Queue.control h q Event.QueueStart Nothing
+
+        k h public private q publicAddr privateAddr
+  where
+    inout_caps = Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite, Port.capSubsWrite]
+    inout_types = Port.types [Port.typeMidiGeneric, Port.typeApplication]
+    private_caps = Port.caps [Port.capRead, Port.capWrite]
+    private_types = Port.types [Port.typeMidiGeneric]
 
 cmdlineAlsaConnect h public = do
   args <- getArgs
   case args of
+    ["0"] ->
+      return ()
 
-     ["0"] -> do
-       return ()
-
-     ["0", output] -> do
-        (Connect.createTo   h public =<< Addr.parse h output)
-        return ()
+    ["0", output] ->
+      void $ Connect.createTo h public =<< Addr.parse h output
 
-     [input] -> do
-       (Connect.createFrom h public =<< Addr.parse h input)
-       return ()
+    [input] ->
+      void $ Connect.createFrom h public =<< Addr.parse h input
 
-     [input, output] -> do
-        (Connect.createFrom h public =<< Addr.parse h input)
-        (Connect.createTo   h public =<< Addr.parse h output)
-        return ()
+    [input, output] -> do
+      void $ Connect.createFrom h public =<< Addr.parse h input
+      void $ Connect.createTo h public =<< Addr.parse h output
 
-     _ -> do
-        showAlsaPorts h
-        IO.hPutStrLn IO.stderr "need arguments: <input-port> [output-port]"
-        IO.hPutStrLn IO.stderr "  (use port 0 for no input)"
-        Exit.exitFailure
+    _ -> do
+      showAlsaPorts h
+      IO.hPutStrLn IO.stderr "need arguments: <input-port> [output-port]"
+      IO.hPutStrLn IO.stderr "  (use port 0 for no input)"
+      Exit.exitFailure
 
 inputPendingLoop h b = do
-  mres <- try (Event.inputPending h b >>= return)
+  mres <- try (Event.inputPending h b)
   case mres of
     (Left e) ->
       case e of
-        (AlsaExc.Cons _ _ (Errno 4)) -> inputPendingLoop h b >>= return -- axis: AlsaException.Cons "inputPending" "Interrupted system call" (Errno 4)
+        (AlsaExc.Cons _ _ (Errno 4)) -> inputPendingLoop h b
+        -- axis: AlsaException.Cons "inputPending" "Interrupted system call" (Errno 4)
+        -- Happens all the time, means nothing.
         (AlsaExc.Cons location _ code) -> do
           putStrLn $ "alsa_exception: " ++ AlsaExc.show e -- TODO: log this to a file
           AlsaExc.throw location code
@@ -150,18 +143,18 @@ type MidiPitchSet = Set.Set (Event.Channel, Event.Pitch)
 type MidiPitchMap = Map.Map (Event.Channel, Event.Pitch) Event.Velocity
 parseAlsaEvents :: SndSeq.AllowInput mode =>
   SndSeq.T mode -> Set.Set (Event.Channel, Event.Pitch) -> (Event.T -> IO a) -> IO MidiPitchSet
-parseAlsaEvents h keysDown immediate = loop keysDown
+parseAlsaEvents h keysDownInit immediate = loop keysDownInit
   where
     loop keysDown = do
       pending <- inputPendingLoop h True
-      if (pending == 0) then
+      if pending == 0 then
         return keysDown
       else do
         ev <- Event.input h
-        immediate ev
+        _ <- immediate ev
         case Event.body ev of
            Event.NoteEv Event.NoteOn n ->
-             if (Event.unVelocity (Event.noteVelocity n) == 0) then
+             if Event.unVelocity (Event.noteVelocity n) == 0 then
                loop (Set.delete (Event.noteChannel n, Event.noteNote n) keysDown)
              else
                loop (Set.insert (Event.noteChannel n, Event.noteNote n) keysDown)
@@ -169,37 +162,19 @@ parseAlsaEvents h keysDown immediate = loop keysDown
              loop (Set.delete (Event.noteChannel n, Event.noteNote n) keysDown)
            _ -> loop keysDown
 
-parseAlsaEvents' h keysDown immediate = loop [] keysDown
-  where
-    loop events keysDown = do
-      pending <- inputPendingLoop h True
-      if (pending == 0) then
-        return (events, keysDown)
-      else do
-        ev <- Event.input h
-        immediate ev
-        case Event.body ev of
-           Event.NoteEv Event.NoteOn n ->
-             if (Event.unVelocity (Event.noteVelocity n) == 0) then
-               loop (ev:events) (Set.delete (Event.noteChannel n, Event.noteNote n) keysDown)
-             else
-               loop (ev:events) (Set.insert (Event.noteChannel n, Event.noteNote n) keysDown)
-           Event.NoteEv Event.NoteOff n ->
-             loop (ev:events) (Set.delete (Event.noteChannel n, Event.noteNote n) keysDown)
-           _ -> loop (ev:events) keysDown
-
-parseAlsaEvents'' h keysDown immediate = loop [] keysDown
+parseAlsaEvents'' :: SndSeq.AllowInput mode => SndSeq.T mode -> MidiPitchMap -> (Event.T -> IO t) -> IO ([Event.T], MidiPitchMap)
+parseAlsaEvents'' h keysDownInit immediate = loop [] keysDownInit
   where
     loop events keysDown = do
       pending <- inputPendingLoop h True
-      if (pending == 0) then
+      if pending == 0 then
         return (events, keysDown)
       else do
         ev <- Event.input h
-        immediate ev
+        _ <- immediate ev
         case Event.body ev of
            Event.NoteEv Event.NoteOn n ->
-             if (Event.unVelocity (Event.noteVelocity n) == 0) then
+             if Event.unVelocity (Event.noteVelocity n) == 0 then
                loop (ev:events) (Map.delete (Event.noteChannel n, Event.noteNote n) keysDown)
              else
                loop (ev:events) (Map.insert (Event.noteChannel n, Event.noteNote n) (Event.noteVelocity n) keysDown)
@@ -216,6 +191,5 @@ forwardNoteEvent h q publicAddr ev = do
 -- data T = Cons { highPriority :: !Bool , tag :: !Tag , queue :: !Queue.T , time :: !Time.T , source :: !Addr.T , dest :: !Addr.T , body :: !Data } deriving Show
 
   let (Event.Cons highPriority tag _ time _ _ body) = ev
-  Event.output h (Event.Cons highPriority tag q time publicAddr Addr.subscribers body)
-  Event.drainOutput h
-  return ()
+  void $ Event.output h (Event.Cons highPriority tag q time publicAddr Addr.subscribers body)
+  void $ Event.drainOutput h