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
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
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
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