module Sound.MIDI.Message.Class.Construct 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.Voice as VoiceMsg
import qualified Sound.MIDI.Message.Channel.Mode as Mode


class C event where
   {- |
   Warning: This constructs a note events as is,
   that is, a @NoteOff p 64@ is encoded as such
   and will not be converted to @NoteOn p 0@.
   If you want such a conversion, you may use 'noteImplicitOff'.
   -}
   note :: Channel -> (Velocity, Pitch, Bool) -> event
   program :: Channel -> Program -> event
   anyController :: Channel -> (Controller, Int) -> event
   pitchBend :: Channel -> Int -> event
   channelPressure :: Channel -> Int -> event
   mode :: Channel -> Mode.T -> event


liftChannel ::
   (a -> ChannelMsg.Body) ->
   (Channel -> a -> ChannelMsg.T)
liftChannel :: forall a. (a -> Body) -> Channel -> a -> T
liftChannel a -> Body
makeMsg Channel
channel a
param =
   Channel -> Body -> T
ChannelMsg.Cons Channel
channel forall a b. (a -> b) -> a -> b
$ a -> Body
makeMsg a
param

instance C ChannelMsg.T where
   note :: Channel -> (Velocity, Pitch, Bool) -> T
note =
      forall a. (a -> Body) -> Channel -> a -> T
liftChannel forall a b. (a -> b) -> a -> b
$ \(Velocity
velocity, Pitch
pitch, Bool
on) ->
         T -> Body
ChannelMsg.Voice forall a b. (a -> b) -> a -> b
$
         (if Bool
on then Pitch -> Velocity -> T
VoiceMsg.NoteOn else Pitch -> Velocity -> T
VoiceMsg.NoteOff) Pitch
pitch Velocity
velocity

   program :: Channel -> Program -> T
program =
      forall a. (a -> Body) -> Channel -> a -> T
liftChannel forall a b. (a -> b) -> a -> b
$ \Program
pgm ->
         T -> Body
ChannelMsg.Voice forall a b. (a -> b) -> a -> b
$ Program -> T
VoiceMsg.ProgramChange Program
pgm

   anyController :: Channel -> (Controller, Int) -> T
anyController =
      forall a. (a -> Body) -> Channel -> a -> T
liftChannel forall a b. (a -> b) -> a -> b
$ \(Controller
ctrl, Int
val) ->
         T -> Body
ChannelMsg.Voice forall a b. (a -> b) -> a -> b
$ Controller -> Int -> T
VoiceMsg.Control Controller
ctrl Int
val

   pitchBend :: Channel -> Int -> T
pitchBend =
      forall a. (a -> Body) -> Channel -> a -> T
liftChannel forall a b. (a -> b) -> a -> b
$ \Int
bend ->
         T -> Body
ChannelMsg.Voice forall a b. (a -> b) -> a -> b
$ Int -> T
VoiceMsg.PitchBend Int
bend

   channelPressure :: Channel -> Int -> T
channelPressure =
      forall a. (a -> Body) -> Channel -> a -> T
liftChannel forall a b. (a -> b) -> a -> b
$ \Int
pressure ->
         T -> Body
ChannelMsg.Voice forall a b. (a -> b) -> a -> b
$ Int -> T
VoiceMsg.MonoAftertouch Int
pressure

   mode :: Channel -> T -> T
mode =
      forall a. (a -> Body) -> Channel -> a -> T
liftChannel forall a b. (a -> b) -> a -> b
$ \T
m ->
         T -> Body
ChannelMsg.Mode T
m


{- |
Like 'note', but converts @NoteOn p 0@ to @NoteOff p 64@.
See 'VoiceMsg.explicitNoteOff'.
-}
noteExplicitOff ::
   (C event) =>
   Channel -> (Velocity, Pitch, Bool) -> event
noteExplicitOff :: forall event.
C event =>
Channel -> (Velocity, Pitch, Bool) -> event
noteExplicitOff Channel
channel =
   forall event.
C event =>
Channel -> (Velocity, Pitch, Bool) -> event
note Channel
channel forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool)
CU.explicitNoteOff

{- |
Like 'note', but converts @NoteOff p 64@ to @NoteOn p 0@.
See 'VoiceMsg.implicitNoteOff'.
-}
noteImplicitOff ::
   (C event) =>
   Channel -> (Velocity, Pitch, Bool) -> event
noteImplicitOff :: forall event.
C event =>
Channel -> (Velocity, Pitch, Bool) -> event
noteImplicitOff Channel
channel =
   forall event.
C event =>
Channel -> (Velocity, Pitch, Bool) -> event
note Channel
channel forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool)
CU.implicitNoteOff


liftMidi ::
   (Channel -> a -> ChannelMsg.T) ->
   (Channel -> a -> MidiMsg.T)
liftMidi :: forall a. (Channel -> a -> T) -> Channel -> a -> T
liftMidi Channel -> a -> T
makeMsg Channel
channel a
msg =
   T -> T
MidiMsg.Channel forall a b. (a -> b) -> a -> b
$ Channel -> a -> T
makeMsg Channel
channel a
msg

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


liftFile ::
   (Channel -> a -> ChannelMsg.T) ->
   (Channel -> a -> FileEvent.T)
liftFile :: forall a. (Channel -> a -> T) -> Channel -> a -> T
liftFile Channel -> a -> T
makeMsg Channel
channel a
msg =
   T -> T
FileEvent.MIDIEvent forall a b. (a -> b) -> a -> b
$ Channel -> a -> T
makeMsg Channel
channel a
msg

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