{-
The instance Class.C Event.T is orphan.
I could put it in package 'midi' or 'alsa-seq'
but in both them it imposes a lot of new dependencies.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Sound.MIDI.ALSA.Check where

import qualified Sound.MIDI.Message.Class.Check as Class
import qualified Sound.MIDI.Message.Channel.Mode as Mode

import qualified Sound.MIDI.ALSA as MALSA

import qualified Sound.ALSA.Sequencer.Event as Event

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

import Data.Accessor.Basic ((^.), )
import Data.Maybe.HT (toMaybe, )
import Control.Monad (guard, )


instance Class.C Event.T where
   note = note
   program = program
   anyController = anyController
   mode = mode
   pitchBend = pitchBend
   channelPressure = channelPressure


note ::
   Channel -> Event.T -> Maybe (Velocity, Pitch, Bool)
note chan e = do
   Event.NoteEv n c <- Just $ Event.body e
   guard (c ^. MALSA.noteChannel  ==  chan)
   let pitch    = c ^. MALSA.notePitch
       velocity = c ^. MALSA.noteVelocity
   case n of
      Event.NoteOn  -> Just (velocity, pitch, True)
      Event.NoteOff -> Just (velocity, pitch, False)
      _ -> Nothing

program ::
   Channel -> Event.T -> Maybe Program
program chan e = do
   Event.CtrlEv Event.PgmChange c <- Just $ Event.body e
   guard (c ^. MALSA.ctrlChannel  ==  chan)
   return $ c ^. MALSA.ctrlProgram

anyController ::
   Channel -> Event.T -> Maybe (Controller, Int)
anyController chan e = do
   -- let Event.TickTime n = Event.timestamp e
   Event.CtrlEv Event.Controller c <- Just $ Event.body e
   guard (c ^. MALSA.ctrlChannel  ==  chan)
   MALSA.Controller cn cv <- Just $ c ^. MALSA.ctrlControllerMode
   return (cn, cv)

controller :: Channel -> Controller -> Event.T -> Maybe Int
controller chan ctrl e = do
   (c,n) <- anyController chan e
   guard (ctrl==c)
   return n

mode :: Channel -> Event.T -> Maybe Mode.T
mode chan e = do
   Event.CtrlEv Event.Controller c <- Just $ Event.body e
   guard (c ^. MALSA.ctrlChannel  ==  chan)
   MALSA.Mode m <- Just $ c ^. MALSA.ctrlControllerMode
   return m

pitchBend :: Channel -> Event.T -> Maybe Int
pitchBend chan e =
   case Event.body e of
      Event.CtrlEv Event.PitchBend c ->
         toMaybe
            (c ^. MALSA.ctrlChannel == chan)
            (c ^. MALSA.ctrlValue)
      _ -> Nothing

channelPressure :: Channel -> Event.T -> Maybe Int
channelPressure chan e =
   case Event.body e of
      Event.CtrlEv Event.ChanPress c ->
         toMaybe
            (c ^. MALSA.ctrlChannel == chan)
            (c ^. MALSA.ctrlValue)
      _ -> Nothing