summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2015-12-06 04:01:46 -0500
committerAndrew Cady <d@jerkface.net>2015-12-06 04:01:46 -0500
commit71b8dea17e015d3266bda8705868184bb1fe4e5a (patch)
treedb66640e1d3e4f414405c36b6673fd8174724287
parentf8ac45371bff74034205fec65a9e69c0a527e8a4 (diff)
use the MidiController type alias in all type signatures
-rw-r--r--midi-dump.hs22
1 files changed, 11 insertions, 11 deletions
diff --git a/midi-dump.hs b/midi-dump.hs
index 536d78d..b68a790 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -67,7 +67,7 @@ data LoopEnv = LoopEnv {
67 _lineReader :: MVar String 67 _lineReader :: MVar String
68} 68}
69 69
70getAbsTime :: RWST LoopEnv () LoopState IO TimeSpec 70getAbsTime :: MidiController TimeSpec
71getAbsTime = do 71getAbsTime = do
72 startTime <- asks _startTime 72 startTime <- asks _startTime
73 startTimeReal <- asks _startTimeReal 73 startTimeReal <- asks _startTimeReal
@@ -128,7 +128,7 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
128 (_, ()) <- execRWST mainLoop env $ initializeState startTimeReal 128 (_, ()) <- execRWST mainLoop env $ initializeState startTimeReal
129 return () 129 return ()
130 130
131mainLoop :: RWST LoopEnv () LoopState IO () 131mainLoop :: MidiController ()
132mainLoop = do 132mainLoop = do
133 maybeReadLine >>= maybe processMidi processCommand 133 maybeReadLine >>= maybe processMidi processCommand
134 wantExit <- gets _wantExit 134 wantExit <- gets _wantExit
@@ -150,7 +150,7 @@ playImmediates = do
150 -- TODO: flush ALSA output here (and remove flush from playNoteEv) 150 -- TODO: flush ALSA output here (and remove flush from playNoteEv)
151 modify $ \s -> s { _playNOW = [] } 151 modify $ \s -> s { _playNOW = [] }
152 152
153_playNote :: Bool -> Event.Note -> RWST LoopEnv () LoopState IO () 153_playNote :: Bool -> Event.Note -> MidiController ()
154_playNote noteOn note = 154_playNote noteOn note =
155 playNoteEv $ Event.NoteEv onoff note 155 playNoteEv $ Event.NoteEv onoff note
156 where onoff = if noteOn then Event.NoteOn else Event.NoteOff 156 where onoff = if noteOn then Event.NoteOn else Event.NoteOff
@@ -159,21 +159,22 @@ delayEvent :: Event.T -> TimeSpec -> Event.T
159delayEvent evt ts = evt {Event.time = Time.consRel $ Time.Real (RealTime.fromInteger nanosecs)} 159delayEvent evt ts = evt {Event.time = Time.consRel $ Time.Real (RealTime.fromInteger nanosecs)}
160 where nanosecs = timeSpecAsNanoSecs ts 160 where nanosecs = timeSpecAsNanoSecs ts
161 161
162playNoteEv :: Event.Data -> RWST LoopEnv () LoopState IO () 162playNoteEv :: Event.Data -> MidiController ()
163playNoteEv = alsaDelayNoteEv (TimeSpec 0 0) 163playNoteEv = alsaDelayNoteEv (TimeSpec 0 0)
164 164
165alsaDelayNoteEv :: TimeSpec -> Event.Data -> RWST LoopEnv () LoopState IO () 165alsaDelayNoteEv :: TimeSpec -> Event.Data -> MidiController ()
166alsaDelayNoteEv delay nevdata = do 166alsaDelayNoteEv delay nevdata = do
167 ms <- getMidiSender 167 ms <- getMidiSender
168 publicAddr <- asks _publicAddr 168 publicAddr <- asks _publicAddr
169 liftIO $ ms $ Event.simple publicAddr nevdata `delayEvent` delay 169 liftIO $ ms $ Event.simple publicAddr nevdata `delayEvent` delay
170 170
171
171queueAction :: (Queue Event.Data -> MidiController (Queue Event.Data)) -> MidiController () 172queueAction :: (Queue Event.Data -> MidiController (Queue Event.Data)) -> MidiController ()
172queueAction act = do 173queueAction act = do
173 q <- gets _scheduled 174 q <- gets _scheduled
174 act q >>= \q' -> modify $ \s -> s { _scheduled = q' } 175 act q >>= \q' -> modify $ \s -> s { _scheduled = q' }
175 176
176delayNoteEv :: TimeSpec -> Event.Data -> RWST LoopEnv () LoopState IO () 177delayNoteEv :: TimeSpec -> Event.Data -> MidiController ()
177delayNoteEv delay nevdata = queueAction $ scheduleEventIO (delay, nevdata) 178delayNoteEv delay nevdata = queueAction $ scheduleEventIO (delay, nevdata)
178 179
179_whenFlag :: forall (m :: * -> *) s. MonadState s m => (s -> Bool) -> m () -> m () 180_whenFlag :: forall (m :: * -> *) s. MonadState s m => (s -> Bool) -> m () -> m ()
@@ -182,7 +183,7 @@ _whenFlag flag f = gets flag >>= flip when f
182mkNote :: Word8 -> Event.Note 183mkNote :: Word8 -> Event.Note
183mkNote pitch = Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 128) 184mkNote pitch = Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 128)
184 185
185processCommand :: String -> RWST LoopEnv () LoopState IO () 186processCommand :: String -> MidiController ()
186processCommand "exit" = modify $ \s -> s { _wantExit = True } 187processCommand "exit" = modify $ \s -> s { _wantExit = True }
187-- processCommand "" = return () 188-- processCommand "" = return ()
188processCommand "" = gets _replay >>= playRecording 189processCommand "" = gets _replay >>= playRecording
@@ -205,21 +206,20 @@ processCommand str = liftIO $ putStrLn $ "Unknown command: " ++ str
205type MidiControllerT m = RWST LoopEnv () LoopState m 206type MidiControllerT m = RWST LoopEnv () LoopState m
206type MidiController = MidiControllerT IO 207type MidiController = MidiControllerT IO
207 208
208-- playRecording :: Recording -> RWST LoopEnv () LoopState IO ()
209playRecording :: Recording -> MidiController () 209playRecording :: Recording -> MidiController ()
210playRecording (RecordingInProgress _ _ evts@(_:_)) = 210playRecording (RecordingInProgress _ _ evts@(_:_)) =
211 mapM_ (uncurry delayNoteEv) (zip (subtract (head delays) <$> delays) events) 211 mapM_ (uncurry delayNoteEv) (zip (subtract (head delays) <$> delays) events)
212 where (delays, events) = unzip $ fmap Event.body <$> reverse evts 212 where (delays, events) = unzip $ fmap Event.body <$> reverse evts
213playRecording _ = return () 213playRecording _ = return ()
214 214
215getMidiSender :: RWST LoopEnv () LoopState IO MidiHook 215getMidiSender :: MidiController MidiHook
216getMidiSender = do 216getMidiSender = do
217 h <- asks _h 217 h <- asks _h
218 q <- asks _q 218 q <- asks _q
219 publicAddr <- asks _publicAddr 219 publicAddr <- asks _publicAddr
220 return $ forwardNoteEvent h q publicAddr 220 return $ forwardNoteEvent h q publicAddr
221 221
222processMidi :: RWST LoopEnv () LoopState IO () 222processMidi :: MidiController ()
223processMidi = do 223processMidi = do
224 h <- asks _h 224 h <- asks _h
225 oldKeys <- gets keysDown 225 oldKeys <- gets keysDown
@@ -256,7 +256,7 @@ latestEvent (StartRecording x) = x
256latestEvent (RecordingInProgress _ x []) = x 256latestEvent (RecordingInProgress _ x []) = x
257latestEvent (RecordingInProgress _ _ ((x,_):_)) = x 257latestEvent (RecordingInProgress _ _ ((x,_):_)) = x
258 258
259maybeReadLine :: RWST LoopEnv () LoopState IO (Maybe String) 259maybeReadLine :: MidiController (Maybe String)
260maybeReadLine = asks _lineReader >>= liftIO . tryTakeMVar 260maybeReadLine = asks _lineReader >>= liftIO . tryTakeMVar
261 261
262startLineReader :: IO (MVar String) 262startLineReader :: IO (MVar String)