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 :: (a -> Body) -> Channel -> a -> T
liftChannel a -> Body
makeMsg Channel
channel a
param =
   Channel -> Body -> T
ChannelMsg.Cons Channel
channel (Body -> T) -> Body -> T
forall a b. (a -> b) -> a -> b
$ a -> Body
makeMsg a
param

instance C ChannelMsg.T where
   note :: Channel -> (Velocity, Pitch, Bool) -> T
note =
      ((Velocity, Pitch, Bool) -> Body)
-> Channel -> (Velocity, Pitch, Bool) -> T
forall a. (a -> Body) -> Channel -> a -> T
liftChannel (((Velocity, Pitch, Bool) -> Body)
 -> Channel -> (Velocity, Pitch, Bool) -> T)
-> ((Velocity, Pitch, Bool) -> Body)
-> Channel
-> (Velocity, Pitch, Bool)
-> T
forall a b. (a -> b) -> a -> b
$ \(Velocity
velocity, Pitch
pitch, Bool
on) ->
         T -> Body
ChannelMsg.Voice (T -> Body) -> T -> Body
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 =
      (Program -> Body) -> Channel -> Program -> T
forall a. (a -> Body) -> Channel -> a -> T
liftChannel ((Program -> Body) -> Channel -> Program -> T)
-> (Program -> Body) -> Channel -> Program -> T
forall a b. (a -> b) -> a -> b
$ \Program
pgm ->
         T -> Body
ChannelMsg.Voice (T -> Body) -> T -> Body
forall a b. (a -> b) -> a -> b
$ Program -> T
VoiceMsg.ProgramChange Program
pgm

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

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

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

   mode :: Channel -> T -> T
mode =
      (T -> Body) -> Channel -> T -> T
forall a. (a -> Body) -> Channel -> a -> T
liftChannel ((T -> Body) -> Channel -> T -> T)
-> (T -> Body) -> Channel -> T -> T
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 :: Channel -> (Velocity, Pitch, Bool) -> event
noteExplicitOff Channel
channel =
   Channel -> (Velocity, Pitch, Bool) -> event
forall event.
C event =>
Channel -> (Velocity, Pitch, Bool) -> event
note Channel
channel ((Velocity, Pitch, Bool) -> event)
-> ((Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool))
-> (Velocity, Pitch, Bool)
-> event
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 :: Channel -> (Velocity, Pitch, Bool) -> event
noteImplicitOff Channel
channel =
   Channel -> (Velocity, Pitch, Bool) -> event
forall event.
C event =>
Channel -> (Velocity, Pitch, Bool) -> event
note Channel
channel ((Velocity, Pitch, Bool) -> event)
-> ((Velocity, Pitch, Bool) -> (Velocity, Pitch, Bool))
-> (Velocity, Pitch, Bool)
-> event
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 :: (Channel -> a -> T) -> Channel -> a -> T
liftMidi Channel -> a -> T
makeMsg Channel
channel a
msg =
   T -> T
MidiMsg.Channel (T -> T) -> T -> T
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 = (Channel -> (Velocity, Pitch, Bool) -> T)
-> Channel -> (Velocity, Pitch, Bool) -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftMidi Channel -> (Velocity, Pitch, Bool) -> T
forall event.
C event =>
Channel -> (Velocity, Pitch, Bool) -> event
note
   program :: Channel -> Program -> T
program = (Channel -> Program -> T) -> Channel -> Program -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftMidi Channel -> Program -> T
forall event. C event => Channel -> Program -> event
program
   anyController :: Channel -> (Controller, Int) -> T
anyController = (Channel -> (Controller, Int) -> T)
-> Channel -> (Controller, Int) -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftMidi Channel -> (Controller, Int) -> T
forall event. C event => Channel -> (Controller, Int) -> event
anyController
   pitchBend :: Channel -> Int -> T
pitchBend = (Channel -> Int -> T) -> Channel -> Int -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftMidi Channel -> Int -> T
forall event. C event => Channel -> Int -> event
pitchBend
   channelPressure :: Channel -> Int -> T
channelPressure = (Channel -> Int -> T) -> Channel -> Int -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftMidi Channel -> Int -> T
forall event. C event => Channel -> Int -> event
channelPressure
   mode :: Channel -> T -> T
mode = (Channel -> T -> T) -> Channel -> T -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftMidi Channel -> T -> T
forall event. C event => Channel -> T -> event
mode


liftFile ::
   (Channel -> a -> ChannelMsg.T) ->
   (Channel -> a -> FileEvent.T)
liftFile :: (Channel -> a -> T) -> Channel -> a -> T
liftFile Channel -> a -> T
makeMsg Channel
channel a
msg =
   T -> T
FileEvent.MIDIEvent (T -> T) -> T -> T
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 = (Channel -> (Velocity, Pitch, Bool) -> T)
-> Channel -> (Velocity, Pitch, Bool) -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftFile Channel -> (Velocity, Pitch, Bool) -> T
forall event.
C event =>
Channel -> (Velocity, Pitch, Bool) -> event
note
   program :: Channel -> Program -> T
program = (Channel -> Program -> T) -> Channel -> Program -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftFile Channel -> Program -> T
forall event. C event => Channel -> Program -> event
program
   anyController :: Channel -> (Controller, Int) -> T
anyController = (Channel -> (Controller, Int) -> T)
-> Channel -> (Controller, Int) -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftFile Channel -> (Controller, Int) -> T
forall event. C event => Channel -> (Controller, Int) -> event
anyController
   pitchBend :: Channel -> Int -> T
pitchBend = (Channel -> Int -> T) -> Channel -> Int -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftFile Channel -> Int -> T
forall event. C event => Channel -> Int -> event
pitchBend
   channelPressure :: Channel -> Int -> T
channelPressure = (Channel -> Int -> T) -> Channel -> Int -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftFile Channel -> Int -> T
forall event. C event => Channel -> Int -> event
channelPressure
   mode :: Channel -> T -> T
mode = (Channel -> T -> T) -> Channel -> T -> T
forall a. (Channel -> a -> T) -> Channel -> a -> T
liftFile Channel -> T -> T
forall event. C event => Channel -> T -> event
mode