module Sound.MIDI.Message.Class.Check (
   C(..),
   noteExplicitOff,
   noteImplicitOff,
   controller,
   liftMidi,
   liftFile,
   ) where

import qualified Sound.MIDI.Message.Class.Utility as CU

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

import qualified Sound.MIDI.File.Event as FileEvent
import qualified Sound.MIDI.Message as MidiMsg
import qualified Sound.MIDI.Message.Channel as ChannelMsg
import qualified Sound.MIDI.Message.Channel.Mode as Mode

import Control.Monad (guard, )


{- |
All methods have default implementations that return 'Nothing'.
This helps implementing event data types
that support only a subset of types of events.

Maybe a better approach is to provide type classes
for every type of event
and make 'C' a subclass of all of them.
-}
class C event where
   {- |
   Warning: This returns note events as they are,
   that is, a @NoteOff p 64@ might be encoded as such or as @NoteOn p 0@
   depending on the content of @event@.
   For normalized results you may use 'noteExplicitOff'.
   -}
   note :: Channel -> event -> Maybe (Velocity, Pitch, Bool)
   program :: Channel -> event -> Maybe Program
   anyController :: Channel -> event -> Maybe (Controller, Int)
   pitchBend :: Channel -> event -> Maybe Int
   channelPressure :: Channel -> event -> Maybe Int
   mode :: Channel -> event -> Maybe Mode.T

   note Channel
_chan event
_ev = forall a. Maybe a
Nothing
   program Channel
_chan event
_ev = forall a. Maybe a
Nothing
   anyController Channel
_chan event
_ev = forall a. Maybe a
Nothing
   pitchBend Channel
_chan event
_ev = forall a. Maybe a
Nothing
   channelPressure Channel
_chan event
_ev = forall a. Maybe a
Nothing
   mode Channel
_chan event
_ev = forall a. Maybe a
Nothing


{- |
Like 'note', but converts @NoteOn p 0@ to @NoteOff p 64@.
See 'VoiceMsg.explicitNoteOff'.
-}
noteExplicitOff ::
   (C event) =>
   Channel -> event -> Maybe (Velocity, Pitch, Bool)
noteExplicitOff :: forall event.
C event =>
Channel -> event -> Maybe (Velocity, Pitch, Bool)
noteExplicitOff Channel
chan event
e =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool)
CU.explicitNoteOff forall a b. (a -> b) -> a -> b
$ forall event.
C event =>
Channel -> event -> Maybe (Velocity, Pitch, Bool)
note Channel
chan event
e

{- |
Like 'note', but converts @NoteOff p 64@ to @NoteOn p 0@.
See 'VoiceMsg.implicitNoteOff'.
-}
noteImplicitOff ::
   (C event) =>
   Channel -> event -> Maybe (Velocity, Pitch, Bool)
noteImplicitOff :: forall event.
C event =>
Channel -> event -> Maybe (Velocity, Pitch, Bool)
noteImplicitOff Channel
chan event
e =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool)
CU.implicitNoteOff forall a b. (a -> b) -> a -> b
$ forall event.
C event =>
Channel -> event -> Maybe (Velocity, Pitch, Bool)
note Channel
chan event
e


controller ::
   (C event) =>
   Channel -> Controller -> event -> Maybe Int
controller :: forall event.
C event =>
Channel -> Controller -> event -> Maybe Int
controller Channel
chan Controller
ctrl event
e = do
   (Controller
c,Int
n) <- forall event.
C event =>
Channel -> event -> Maybe (Controller, Int)
anyController Channel
chan event
e
   forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Controller
ctrlforall a. Eq a => a -> a -> Bool
==Controller
c)
   forall (m :: * -> *) a. Monad m => a -> m a
return Int
n


lift ::
   (Maybe ChannelMsg.Body -> Maybe a) ->
   Channel -> ChannelMsg.T -> Maybe a
lift :: forall a. (Maybe Body -> Maybe a) -> Channel -> T -> Maybe a
lift Maybe Body -> Maybe a
act Channel
chan T
msg = do
   forall (f :: * -> *). Alternative f => Bool -> f ()
guard (T -> Channel
ChannelMsg.messageChannel T
msg  forall a. Eq a => a -> a -> Bool
==  Channel
chan)
   Maybe Body -> Maybe a
act forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ T -> Body
ChannelMsg.messageBody T
msg

instance C ChannelMsg.T where
   note :: Channel -> T -> Maybe (Velocity, Pitch, Bool)
note = forall a. (Maybe Body -> Maybe a) -> Channel -> T -> Maybe a
lift Maybe Body -> Maybe (Velocity, Pitch, Bool)
CU.note
   program :: Channel -> T -> Maybe Program
program = forall a. (Maybe Body -> Maybe a) -> Channel -> T -> Maybe a
lift Maybe Body -> Maybe Program
CU.program
   anyController :: Channel -> T -> Maybe (Controller, Int)
anyController = forall a. (Maybe Body -> Maybe a) -> Channel -> T -> Maybe a
lift Maybe Body -> Maybe (Controller, Int)
CU.anyController
   pitchBend :: Channel -> T -> Maybe Int
pitchBend = forall a. (Maybe Body -> Maybe a) -> Channel -> T -> Maybe a
lift Maybe Body -> Maybe Int
CU.pitchBend
   channelPressure :: Channel -> T -> Maybe Int
channelPressure = forall a. (Maybe Body -> Maybe a) -> Channel -> T -> Maybe a
lift Maybe Body -> Maybe Int
CU.channelPressure
   mode :: Channel -> T -> Maybe T
mode = forall a. (Maybe Body -> Maybe a) -> Channel -> T -> Maybe a
lift Maybe Body -> Maybe T
CU.mode


liftMidi ::
   (Channel -> ChannelMsg.T -> Maybe a) ->
   (Channel -> MidiMsg.T -> Maybe a)
liftMidi :: forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftMidi Channel -> T -> Maybe a
checkMsg Channel
chan T
msg =
   case T
msg of
      MidiMsg.Channel T
chanMsg -> Channel -> T -> Maybe a
checkMsg Channel
chan T
chanMsg
      T
_ -> forall a. Maybe a
Nothing

instance C MidiMsg.T where
   note :: Channel -> T -> Maybe (Velocity, Pitch, Bool)
note = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftMidi forall event.
C event =>
Channel -> event -> Maybe (Velocity, Pitch, Bool)
note
   program :: Channel -> T -> Maybe Program
program = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftMidi forall event. C event => Channel -> event -> Maybe Program
program
   anyController :: Channel -> T -> Maybe (Controller, Int)
anyController = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftMidi forall event.
C event =>
Channel -> event -> Maybe (Controller, Int)
anyController
   pitchBend :: Channel -> T -> Maybe Int
pitchBend = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftMidi forall event. C event => Channel -> event -> Maybe Int
pitchBend
   channelPressure :: Channel -> T -> Maybe Int
channelPressure = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftMidi forall event. C event => Channel -> event -> Maybe Int
channelPressure
   mode :: Channel -> T -> Maybe T
mode = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftMidi forall event. C event => Channel -> event -> Maybe T
mode


liftFile ::
   (Channel -> ChannelMsg.T -> Maybe a) ->
   (Channel -> FileEvent.T -> Maybe a)
liftFile :: forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftFile Channel -> T -> Maybe a
checkMsg Channel
chan T
msg =
   case T
msg of
      FileEvent.MIDIEvent T
midiMsg -> Channel -> T -> Maybe a
checkMsg Channel
chan T
midiMsg
      T
_ -> forall a. Maybe a
Nothing

instance C FileEvent.T where
   note :: Channel -> T -> Maybe (Velocity, Pitch, Bool)
note = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftFile forall event.
C event =>
Channel -> event -> Maybe (Velocity, Pitch, Bool)
note
   program :: Channel -> T -> Maybe Program
program = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftFile forall event. C event => Channel -> event -> Maybe Program
program
   anyController :: Channel -> T -> Maybe (Controller, Int)
anyController = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftFile forall event.
C event =>
Channel -> event -> Maybe (Controller, Int)
anyController
   pitchBend :: Channel -> T -> Maybe Int
pitchBend = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftFile forall event. C event => Channel -> event -> Maybe Int
pitchBend
   channelPressure :: Channel -> T -> Maybe Int
channelPressure = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftFile forall event. C event => Channel -> event -> Maybe Int
channelPressure
   mode :: Channel -> T -> Maybe T
mode = forall a. (Channel -> T -> Maybe a) -> Channel -> T -> Maybe a
liftFile forall event. C event => Channel -> event -> Maybe T
mode