Fix all hlint and GHC warnings.

1 files changed, 31 insertions, 10 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
index dd59a96..146ac5d 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE KindSignatures #-}
 
 import           AlsaSeq
 import           Control.Monad.RWS.Strict
@@ -27,8 +29,10 @@ import qualified Sound.ALSA.Sequencer.Address
 import qualified Sound.ALSA.Sequencer.Port
 import qualified Sound.ALSA.Sequencer.Queue
 
+verbose :: Bool
 verbose = False
 
+main :: IO ()
 main = main' `AlsaExc.catch` handler
   where
   handler e = when verbose $ putStrLn $ "alsa_exception: " ++ AlsaExc.show e
@@ -53,6 +57,7 @@ data LoopState = LoopState {
   lastTick   :: TimeSpec
 }
 
+initializeState :: TimeSpec -> LoopState
 initializeState now = LoopState False Set.empty [] (emptyRecording now) now
 
 data LoopEnv = LoopEnv {
@@ -70,12 +75,14 @@ data LoopEnv = LoopEnv {
   _lineReader    :: MVar String
 }
 
+getAbsTime :: RWST LoopEnv () LoopState IO TimeSpec
 getAbsTime = do
   startTime <- asks _startTime
   startTimeReal <- asks _startTimeReal
   now <- liftIO $ getTime Monotonic
   return $ now - startTime + startTimeReal
 
+createTable :: Query
 createTable = fromString $ concat
   ["CREATE TABLE IF NOT EXISTS axis_input",
   " (id INTEGER PRIMARY KEY,",
@@ -86,6 +93,7 @@ createTable = fromString $ concat
   " leading_silence INTEGER,",
   " midi BLOB)"]
 
+main' :: IO ()
 main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
   cmdlineAlsaConnect h public
 
@@ -105,6 +113,7 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
   (_, ()) <- execRWST mainLoop env $ initializeState startTimeReal
   return ()
 
+mainLoop :: RWST LoopEnv () LoopState IO ()
 mainLoop = do
   maybeReadLine >>= maybe processMidi processCommand
   wantExit <- gets _wantExit
@@ -117,17 +126,21 @@ mainLoop = do
 
   unless wantExit mainLoop
 
-playNote noteOn note =
+_playNote :: Bool -> Event.Note -> RWST LoopEnv () LoopState IO ()
+_playNote noteOn note =
   playNoteEv $ Event.NoteEv onoff note
   where onoff = if noteOn then Event.NoteOn else Event.NoteOff
 
+playNoteEv :: Event.Data -> RWST LoopEnv () LoopState IO ()
 playNoteEv nevdata = do
   ms <- getMidiSender
   publicAddr <- asks _publicAddr
   liftIO $ ms $ Event.simple publicAddr nevdata
 
-whenFlag flag f = gets flag >>= flip when f
+_whenFlag :: forall (m :: * -> *) s. MonadState s m => (s -> Bool) -> m () -> m ()
+_whenFlag flag f = gets flag >>= flip when f
 
+processCommand :: forall (m :: * -> *). (MonadIO m, MonadState LoopState m) => String -> m ()
 processCommand "exit" = modify $ \s -> s { _wantExit = True }
 processCommand "" = return ()
 processCommand "C" = do
@@ -136,12 +149,14 @@ processCommand "C" = do
   modify $ \s -> s { _playNOW = notes }
 processCommand str = liftIO $ putStrLn $ "Unknown command: " ++ str
 
+getMidiSender :: RWST LoopEnv () LoopState IO MidiHook
 getMidiSender = do
   h <- asks _h
   q <- asks _q
   publicAddr <- asks _publicAddr
   return $ forwardNoteEvent h q publicAddr
 
+processMidi :: RWST LoopEnv () LoopState IO ()
 processMidi = do
   h <- asks _h
   oldKeys <- gets keysDown
@@ -164,12 +179,16 @@ processMidi = do
       when doSave $ gets _recording >>= saveMidi >> return ()
       modify $ \s -> s { _recording = emptyRecording now }
 
+emptyRecording :: TimeSpec -> Recording
 emptyRecording now = Recording now []
 
+maybeReadLine :: RWST LoopEnv () LoopState IO (Maybe String)
 maybeReadLine = asks _lineReader >>= liftIO . tryTakeMVar
+
+startLineReader :: IO (MVar String)
 startLineReader = do
   mv <- liftIO newEmptyMVar
-  thread <- liftIO $ forkIO (forever $ tryIOError getLine >>= either (const $ putMVar mv "exit") (putMVar mv))
+  _thread <- liftIO $ forkIO (forever $ tryIOError getLine >>= either (const $ putMVar mv "exit") (putMVar mv))
   return mv
 
 data Chunk = Chunk Int64 Int64 Int64 Int64 Int64 BS.ByteString
@@ -185,11 +204,13 @@ instance ToRow Chunkable where
       (FinishedRecording (Recording start@(TimeSpec s ns) midi) (TimeSpec s' ns')) = reco
       leadingSilence = fromIntegral $ timeSpecAsNanoSecs $ ts - start
 
+saveMidi :: forall (m :: * -> *). (MonadIO m, MonadState LoopState m, MonadReader LoopEnv m) => Recording -> m ()
 saveMidi recording = do
   saver <- asks _saver
   end <- gets lastTick
   liftIO $ writeChan saver $ FinishedRecording recording end
 
+startSaver :: forall (m :: * -> *). MonadIO m => Connection -> m (Chan FinishedRecording)
 startSaver sqlite = do
   chan <- liftIO newChan
   _thread <- liftIO $ forkIO (saver chan)
@@ -203,14 +224,14 @@ startSaver sqlite = do
       return ()
 
 
-getMidiDesc :: Event.T -> Maybe String
-getMidiDesc (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOn  ev)) = return $ ("on:" ++)  $ showPitch $ unPitch $ Event.noteNote ev
-getMidiDesc (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOff ev)) = return $ ("off:" ++) $ showPitch $ unPitch $ Event.noteNote ev
-getMidiDesc _ = Nothing
+_getMidiDesc :: Event.T -> Maybe String
+_getMidiDesc (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOn  ev)) = return $ ("on:" ++)  $ showPitch $ unPitch $ Event.noteNote ev
+_getMidiDesc (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOff ev)) = return $ ("off:" ++) $ showPitch $ unPitch $ Event.noteNote ev
+_getMidiDesc _ = Nothing
 
-tsDeltas :: [TimeSpec] -> [Integer]
-tsDeltas [] = []
-tsDeltas ls@(x:_) = zipWith (-) nsecs (0:nsecs)
+_tsDeltas :: [TimeSpec] -> [Integer]
+_tsDeltas [] = []
+_tsDeltas ls@(x:_) = zipWith (-) nsecs (0:nsecs)
   where
     nsecs = map timeSpecAsNanoSecs rel
     rel = map (\y -> y - x) ls