{- |
MIDI messages in MIDI files.
They are not a superset of the messages,
that are used for real-time communication between MIDI devices.
For these refer to "Sound.MIDI.Message".
Namely System Common and System Real Time messages are missing.
If you need both real-time and file messages (say for ALSA sequencer),
you need a custom datatype.
-}
module Sound.MIDI.File.Event (
   T(..), get, put,
   TrackEvent, getTrackEvent,
   ElapsedTime, fromElapsedTime, toElapsedTime,
   mapBody, maybeMIDIEvent, maybeMetaEvent, maybeVoice, mapVoice,
   ) where

import qualified Sound.MIDI.Message.Channel       as ChannelMsg
import qualified Sound.MIDI.Message.Channel.Voice as Voice
import qualified Sound.MIDI.File.Event.SystemExclusive as SysEx
import qualified Sound.MIDI.File.Event.Meta as MetaEvent

import Sound.MIDI.Message.Channel (Channel)

import Sound.MIDI.File.Event.Meta (
   ElapsedTime, fromElapsedTime, toElapsedTime,
   )

import           Sound.MIDI.Parser.Primitive
import qualified Sound.MIDI.Parser.Status as StatusParser
import qualified Sound.MIDI.Parser.Class  as Parser

import Control.Monad (liftM, liftM2, )

import qualified Sound.MIDI.Writer.Status as StatusWriter
import qualified Sound.MIDI.Writer.Basic  as Writer

import Sound.MIDI.Monoid ((+#+))
import Data.Tuple.HT (mapSnd)


import Test.QuickCheck (Arbitrary(arbitrary), )
import qualified Test.QuickCheck as QC



type TrackEvent = (ElapsedTime, T)

mapBody :: (T -> T) -> (TrackEvent -> TrackEvent)
mapBody :: (T -> T) -> TrackEvent -> TrackEvent
mapBody = forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd


data T =
     MIDIEvent       ChannelMsg.T
   | MetaEvent       MetaEvent.T
   | SystemExclusive SysEx.T
     deriving (Int -> T -> ShowS
[T] -> ShowS
T -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> T -> ShowS
Show,T -> T -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq,Eq T
T -> T -> Bool
T -> T -> Ordering
T -> T -> T
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: T -> T -> T
$cmin :: T -> T -> T
max :: T -> T -> T
$cmax :: T -> T -> T
>= :: T -> T -> Bool
$c>= :: T -> T -> Bool
> :: T -> T -> Bool
$c> :: T -> T -> Bool
<= :: T -> T -> Bool
$c<= :: T -> T -> Bool
< :: T -> T -> Bool
$c< :: T -> T -> Bool
compare :: T -> T -> Ordering
$ccompare :: T -> T -> Ordering
Ord)

instance Arbitrary T where
   arbitrary :: Gen T
arbitrary =
      forall a. [(Int, Gen a)] -> Gen a
QC.frequency forall a b. (a -> b) -> a -> b
$
         (Int
100, forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
MIDIEvent forall a. Arbitrary a => Gen a
arbitrary) forall a. a -> [a] -> [a]
:
         (  Int
1, forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
MetaEvent forall a. Arbitrary a => Gen a
arbitrary) forall a. a -> [a] -> [a]
:
         []


maybeMIDIEvent :: T -> Maybe ChannelMsg.T
maybeMIDIEvent :: T -> Maybe T
maybeMIDIEvent (MIDIEvent T
msg) = forall a. a -> Maybe a
Just T
msg
maybeMIDIEvent T
_ = forall a. Maybe a
Nothing

maybeMetaEvent :: T -> Maybe MetaEvent.T
maybeMetaEvent :: T -> Maybe T
maybeMetaEvent (MetaEvent T
mev) = forall a. a -> Maybe a
Just T
mev
maybeMetaEvent T
_ = forall a. Maybe a
Nothing

maybeVoice :: T -> Maybe (Channel, Voice.T)
maybeVoice :: T -> Maybe (Channel, T)
maybeVoice (MIDIEvent (ChannelMsg.Cons Channel
ch (ChannelMsg.Voice T
ev))) = forall a. a -> Maybe a
Just (Channel
ch,T
ev)
maybeVoice T
_ = forall a. Maybe a
Nothing

mapVoice :: (Voice.T -> Voice.T) -> T -> T
mapVoice :: (T -> T) -> T -> T
mapVoice T -> T
f (MIDIEvent (ChannelMsg.Cons Channel
ch (ChannelMsg.Voice T
ev))) =
   T -> T
MIDIEvent (Channel -> Body -> T
ChannelMsg.Cons Channel
ch (T -> Body
ChannelMsg.Voice (T -> T
f T
ev)))
mapVoice T -> T
_ T
msg = T
msg


-- * serialization

get :: Parser.C parser => Parser.Fragile (StatusParser.T parser) T
get :: forall (parser :: * -> *). C parser => Fragile (T parser) T
get =
   forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
StatusParser.lift forall (parser :: * -> *). C parser => Fragile parser Int
get1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
tag ->
   if Int
tag forall a. Ord a => a -> a -> Bool
< Int
0xF0
     then forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
MIDIEvent forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *). C parser => Int -> Fragile (T parser) T
ChannelMsg.getWithStatus Int
tag
     else
       forall (parser :: * -> *).
Monad parser =>
Status -> Fragile (T parser) ()
StatusParser.set forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       (forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
StatusParser.lift forall a b. (a -> b) -> a -> b
$
        if Int
tag forall a. Eq a => a -> a -> Bool
== Int
0xFF
          then forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
MetaEvent forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *). C parser => Fragile parser T
MetaEvent.get
          else forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
SystemExclusive forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *). C parser => Int -> Fragile parser T
SysEx.get Int
tag)

{- |
Each event is preceded by the delta time: the time in ticks between the
last event and the current event.  Parse a time and an event, ignoring
System Exclusive messages.
-}
getTrackEvent :: Parser.C parser => Parser.Fragile (StatusParser.T parser) TrackEvent
getTrackEvent :: forall (parser :: * -> *).
C parser =>
Fragile (T parser) TrackEvent
getTrackEvent  =  forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
StatusParser.lift forall (parser :: * -> *). C parser => Fragile parser Integer
getVar) forall (parser :: * -> *). C parser => Fragile (T parser) T
get


{- |
The following functions encode various 'MIDIFile.T' elements
into the raw data of a standard MIDI file.
-}

put ::
   (StatusWriter.Compression compress, Writer.C writer) =>
   T -> StatusWriter.T compress writer
put :: forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put T
e =
   case T
e of
      MIDIEvent       T
m -> forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
ChannelMsg.putWithStatus T
m
      MetaEvent       T
m -> forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer
StatusWriter.clear forall m. Monoid m => m -> m -> m
+#+ forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift (forall writer. C writer => T -> writer
MetaEvent.put  T
m)
      SystemExclusive T
m -> forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer
StatusWriter.clear forall m. Monoid m => m -> m -> m
+#+ forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift (forall writer. C writer => T -> writer
SysEx.put      T
m)