module Sound.MIDI.Message.Class.Utility where

import Sound.MIDI.Message.Channel.Voice (Pitch, Velocity, Program, Controller, )

import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Sound.MIDI.Message.Channel.Mode as Mode
import qualified Sound.MIDI.Message.Channel as ChannelMsg


note :: Maybe ChannelMsg.Body -> Maybe (Velocity, Pitch, Bool)
program :: Maybe ChannelMsg.Body -> Maybe Program
anyController :: Maybe ChannelMsg.Body -> Maybe (Controller, Int)
pitchBend :: Maybe ChannelMsg.Body -> Maybe Int
channelPressure :: Maybe ChannelMsg.Body -> Maybe Int
mode :: Maybe ChannelMsg.Body -> Maybe Mode.T

note :: Maybe Body -> Maybe (Velocity, Pitch, Bool)
note Maybe Body
msg = do
   ChannelMsg.Voice T
voice <- Maybe Body
msg
   case T
voice of
      VoiceMsg.NoteOn  Pitch
pitch Velocity
velocity -> (Velocity, Pitch, Bool) -> Maybe (Velocity, Pitch, Bool)
forall a. a -> Maybe a
Just (Velocity
velocity, Pitch
pitch, Bool
True)
      VoiceMsg.NoteOff Pitch
pitch Velocity
velocity -> (Velocity, Pitch, Bool) -> Maybe (Velocity, Pitch, Bool)
forall a. a -> Maybe a
Just (Velocity
velocity, Pitch
pitch, Bool
False)
      T
_ -> Maybe (Velocity, Pitch, Bool)
forall a. Maybe a
Nothing

program :: Maybe Body -> Maybe Program
program Maybe Body
msg = do
   ChannelMsg.Voice (VoiceMsg.ProgramChange Program
pgm) <- Maybe Body
msg
   Program -> Maybe Program
forall (m :: * -> *) a. Monad m => a -> m a
return Program
pgm

anyController :: Maybe Body -> Maybe (Controller, Int)
anyController Maybe Body
msg = do
   ChannelMsg.Voice (VoiceMsg.Control Controller
ctrl Int
val) <- Maybe Body
msg
   (Controller, Int) -> Maybe (Controller, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Controller
ctrl, Int
val)

pitchBend :: Maybe Body -> Maybe Int
pitchBend Maybe Body
msg = do
   ChannelMsg.Voice (VoiceMsg.PitchBend Int
bend) <- Maybe Body
msg
   Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
bend

channelPressure :: Maybe Body -> Maybe Int
channelPressure Maybe Body
msg = do
   ChannelMsg.Voice (VoiceMsg.MonoAftertouch Int
pressure) <- Maybe Body
msg
   Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
pressure

mode :: Maybe Body -> Maybe T
mode Maybe Body
msg = do
   ChannelMsg.Mode T
m <- Maybe Body
msg
   T -> Maybe T
forall (m :: * -> *) a. Monad m => a -> m a
return T
m


explicitNoteOff ::
   (Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool)
explicitNoteOff :: (Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool)
explicitNoteOff x :: (Velocity, Pitch, Bool)
x@(Velocity
v,Pitch
p,Bool
b) =
   if Bool
b Bool -> Bool -> Bool
&& Velocity
v Velocity -> Velocity -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Velocity
VoiceMsg.toVelocity Int
0
     then (Int -> Velocity
VoiceMsg.toVelocity Int
64, Pitch
p, Bool
False)
     else (Velocity, Pitch, Bool)
x

implicitNoteOff ::
   (Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool)
implicitNoteOff :: (Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool)
implicitNoteOff x :: (Velocity, Pitch, Bool)
x@(Velocity
v,Pitch
p,Bool
b) =
   if Bool -> Bool
not Bool
b Bool -> Bool -> Bool
&& Velocity
v Velocity -> Velocity -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Velocity
VoiceMsg.toVelocity Int
64
     then (Int -> Velocity
VoiceMsg.toVelocity Int
0, Pitch
p, Bool
True)
     else (Velocity, Pitch, Bool)
x