{- |
MIDI-File Datatype

Taken from Haskore.
-}

module Sound.MIDI.File (
   T(..), Division(..), Track, Type(..),
   empty,
   ElapsedTime, fromElapsedTime, toElapsedTime,
   Tempo,       fromTempo,       toTempo,
   explicitNoteOff, implicitNoteOff,
   getTracks, mergeTracks, mapTrack,
   secondsFromTicks, ticksPerQuarterNote,

   showLines, changeVelocity, resampleTime,
   showEvent, showTime,
   sortEvents, progChangeBeforeSetTempo,
   ) where

import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Sound.MIDI.Message.Channel as ChannelMsg
import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Sound.MIDI.File.Event as Event
import Sound.MIDI.File.Event.Meta (
   ElapsedTime, fromElapsedTime, toElapsedTime,
   Tempo,       fromTempo,       toTempo,
   )


import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Class as NonNeg

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

import qualified Control.Monad.Trans.State as MS
import Control.Monad (liftM, liftM2, )
import Sound.MIDI.String (rightS, )

import Data.Ratio((%))
import Data.Ix(Ix)
import Data.List(groupBy, sort)
import Data.Maybe(fromMaybe)

{- |
The datatypes for MIDI Files and MIDI Events
-}

data T = Cons Type Division [Track] 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)

data Type     = Mixed | Parallel | Serial
     deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
Ord, Ord Type
(Type, Type) -> Int
(Type, Type) -> [Type]
(Type, Type) -> Type -> Bool
(Type, Type) -> Type -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Type, Type) -> Int
$cunsafeRangeSize :: (Type, Type) -> Int
rangeSize :: (Type, Type) -> Int
$crangeSize :: (Type, Type) -> Int
inRange :: (Type, Type) -> Type -> Bool
$cinRange :: (Type, Type) -> Type -> Bool
unsafeIndex :: (Type, Type) -> Type -> Int
$cunsafeIndex :: (Type, Type) -> Type -> Int
index :: (Type, Type) -> Type -> Int
$cindex :: (Type, Type) -> Type -> Int
range :: (Type, Type) -> [Type]
$crange :: (Type, Type) -> [Type]
Ix, Int -> Type
Type -> Int
Type -> [Type]
Type -> Type
Type -> Type -> [Type]
Type -> Type -> Type -> [Type]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Type -> Type -> Type -> [Type]
$cenumFromThenTo :: Type -> Type -> Type -> [Type]
enumFromTo :: Type -> Type -> [Type]
$cenumFromTo :: Type -> Type -> [Type]
enumFromThen :: Type -> Type -> [Type]
$cenumFromThen :: Type -> Type -> [Type]
enumFrom :: Type -> [Type]
$cenumFrom :: Type -> [Type]
fromEnum :: Type -> Int
$cfromEnum :: Type -> Int
toEnum :: Int -> Type
$ctoEnum :: Int -> Type
pred :: Type -> Type
$cpred :: Type -> Type
succ :: Type -> Type
$csucc :: Type -> Type
Enum, Type
forall a. a -> a -> Bounded a
maxBound :: Type
$cmaxBound :: Type
minBound :: Type
$cminBound :: Type
Bounded)
data Division = Ticks Tempo | SMPTE Int Int
     deriving (Int -> Division -> ShowS
[Division] -> ShowS
Division -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Division] -> ShowS
$cshowList :: [Division] -> ShowS
show :: Division -> String
$cshow :: Division -> String
showsPrec :: Int -> Division -> ShowS
$cshowsPrec :: Int -> Division -> ShowS
Show, Division -> Division -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Division -> Division -> Bool
$c/= :: Division -> Division -> Bool
== :: Division -> Division -> Bool
$c== :: Division -> Division -> Bool
Eq)

type Track = EventList.T ElapsedTime Event.T


{- |
An empty MIDI file.
Tempo is set to one tick per quarter note.
-}
empty :: T
empty :: T
empty = Type -> Division -> [Track] -> T
Cons Type
Mixed (Tempo -> Division
Ticks Tempo
1) [forall time body. T time body
EventList.empty]


instance Arbitrary T where
   arbitrary :: Gen T
arbitrary =
      do (Type
typ, [Track]
content) <-
             forall a. [Gen a] -> Gen a
QC.oneof forall a b. (a -> b) -> a -> b
$
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Track
track -> (Type
Mixed, [Track
track])) forall a. Arbitrary a => Gen a
arbitrary forall a. a -> [a] -> [a]
:
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Track]
tracks -> (Type
Parallel, [Track]
tracks)) forall a. Arbitrary a => Gen a
arbitrary forall a. a -> [a] -> [a]
:
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Track]
tracks -> (Type
Serial, [Track]
tracks)) forall a. Arbitrary a => Gen a
arbitrary forall a. a -> [a] -> [a]
:
                []
         Division
division <- forall a. Arbitrary a => Gen a
arbitrary
         forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Division -> [Track] -> T
Cons Type
typ Division
division [Track]
content)
   shrink :: T -> [T]
shrink (Cons Type
typ Division
division [Track]
tracks) =
      forall a b. (a -> b) -> [a] -> [b]
map (Type -> Division -> [Track] -> T
Cons Type
typ Division
division) forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => a -> [a]
shrink [Track]
tracks

instance Arbitrary Division where
   arbitrary :: Gen Division
arbitrary =
      forall a. [Gen a] -> Gen a
QC.oneof forall a b. (a -> b) -> a -> b
$
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  (Tempo -> Division
Ticks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tempo
1forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> a
mod Tempo
32767) forall a. Arbitrary a => Gen a
arbitrary forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\Int
x Int
y -> Int -> Int -> Division
SMPTE (Int
1 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod Int
x Int
127) (Int
1 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod Int
y Int
255)) forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => Gen a
arbitrary forall a. a -> [a] -> [a]
:
         []



{- * Processing -}

{- |
Apply a function to each track.
-}
mapTrack :: (Track -> Track) -> T -> T
mapTrack :: (Track -> Track) -> T -> T
mapTrack Track -> Track
f (Cons Type
mfType Division
division [Track]
tracks) =
   Type -> Division -> [Track] -> T
Cons Type
mfType Division
division (forall a b. (a -> b) -> [a] -> [b]
map Track -> Track
f [Track]
tracks)

{- |
Convert all @NoteOn p 0@ to @NoteOff p 64@.
The latter one is easier to process.
-}
explicitNoteOff :: T -> T
explicitNoteOff :: T -> T
explicitNoteOff =
   (Track -> Track) -> T -> T
mapTrack (forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
EventList.mapBody ((T -> T) -> T -> T
Event.mapVoice T -> T
VoiceMsg.explicitNoteOff))


{- |
Convert all @NoteOff p 64@ to @NoteOn p 0@.
The latter one can be encoded more efficiently using the running status.
-}
implicitNoteOff :: T -> T
implicitNoteOff :: T -> T
implicitNoteOff =
   (Track -> Track) -> T -> T
mapTrack (forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
EventList.mapBody ((T -> T) -> T -> T
Event.mapVoice T -> T
VoiceMsg.implicitNoteOff))


getTracks :: T -> [Track]
getTracks :: T -> [Track]
getTracks (Cons Type
_ Division
_ [Track]
trks) = [Track]
trks

{- |
Merge all tracks into a single track
according to the MIDI file type.
-}
mergeTracks ::
   (NonNeg.C time) =>
   Type ->
   [EventList.T time event] ->
   EventList.T time event
mergeTracks :: forall time event. C time => Type -> [T time event] -> T time event
mergeTracks Type
typ [T time event]
tracks =
   case Type
typ of
      Type
Mixed    -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall time body.
C time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
EventList.mergeBy (\event
_ event
_ -> Bool
True)) forall time body. T time body
EventList.empty [T time event]
tracks
      Type
Parallel -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall time body.
C time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
EventList.mergeBy (\event
_ event
_ -> Bool
True)) forall time body. T time body
EventList.empty [T time event]
tracks
      Type
Serial   -> forall time body. [T time body] -> T time body
EventList.concat [T time event]
tracks

{- |
Process and remove all @SetTempo@ events.
The result is an event list where the times are measured in seconds.
-}
secondsFromTicks ::
   Division ->
   EventList.T ElapsedTime Event.T ->
   EventList.T NonNegW.Rational Event.T
secondsFromTicks :: Division -> Track -> T Rational T
secondsFromTicks Division
division =
   forall time body. C time => T time (Maybe body) -> T time body
EventList.catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
MS.evalState Tempo
MetaEvent.defltTempo forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (m :: * -> *) time0 time1 body0 body1.
Monad m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
EventList.mapM
      (\ElapsedTime
ticks -> do
         Tempo
microsPerQN <- forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
         -- cf. Standard MIDI Files 1.0, page 14
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
            forall a. (Ord a, Num a) => String -> a -> T a
NonNegW.fromNumberMsg String
"MIDI.File.processTempo" forall a b. (a -> b) -> a -> b
$
            ElapsedTime -> Integer
fromElapsedTime ElapsedTime
ticks forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. T a -> a
NonNegW.toNumber Tempo
microsPerQN)
               forall a. Integral a => a -> a -> Ratio a
% (Integer
1000000 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. T a -> a
NonNegW.toNumber (Division -> Tempo
ticksPerQuarterNote Division
division))))
      (\T
ev ->
         case T
ev of
            Event.MetaEvent (MetaEvent.SetTempo Tempo
microsPerQN) ->
               forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put Tempo
microsPerQN forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            T
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just T
ev)


ticksPerQuarterNote :: Division -> Tempo
ticksPerQuarterNote :: Division -> Tempo
ticksPerQuarterNote Division
division =
   case Division
division of
      Ticks Tempo
ticksPerQN -> Tempo
ticksPerQN
      SMPTE Int
framesPerSecond Int
ticksPerFrames ->
         {-
         I am uncertain, whether this is correct.
         The "Standard MIDI File 1.0" is unprecise
         with respect to the question,
         whether SetTempo is relevant also in SMPTE mode.
         TiMidity-2.13.2 interprets this kind of division as we do
         and qualifies it as "totally untested".
         -}
         forall a. (Ord a, Num a) => String -> a -> T a
NonNegW.fromNumberMsg String
"MIDI.File.ticksPerQuarterNote" forall a b. (a -> b) -> a -> b
$
         Int
framesPerSecond forall a. Num a => a -> a -> a
* Int
ticksPerFrames



{- * Debugging -}

{-# DEPRECATED
      showLines, changeVelocity, resampleTime,
      showEvent, showTime,
      sortEvents, progChangeBeforeSetTempo
         "only use this for debugging" #-}

{- |
Show the 'T' with one event per line,
suited for comparing MIDIFiles with @diff@.
Can this be replaced by 'Sound.MIDI.Load.showFile'?
-}
showLines :: T -> String
showLines :: T -> String
showLines (Cons Type
mfType Division
division [Track]
tracks) =
   let showTrack :: T a b -> String
showTrack T a b
track =
          [String] -> String
unlines
             (String
"    (" forall a. a -> [a] -> [a]
:
              forall a b. (a -> b) -> [a] -> [b]
map
                 (\(a, b)
event -> String
"      " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (a, b)
event forall a. [a] -> [a] -> [a]
++ String
" :")
                 (forall a b. T a b -> [(a, b)]
EventList.toPairList T a b
track) forall a. [a] -> [a] -> [a]
++
              String
"    []) :" forall a. a -> [a] -> [a]
:
              [])
   in  String
"MIDIFile.Cons " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Type
mfType forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Division
division forall a. [a] -> [a] -> [a]
++ String
") (\n" forall a. [a] -> [a] -> [a]
++
       forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {b}. (Show a, Show b) => T a b -> String
showTrack [Track]
tracks forall a. [a] -> [a] -> [a]
++
       String
"  [])"

showTime :: ElapsedTime -> ShowS
showTime :: ElapsedTime -> ShowS
showTime ElapsedTime
t =
   Int -> ShowS -> ShowS
rightS Int
10 (forall a. Show a => a -> ShowS
shows ElapsedTime
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" : "

showEvent :: Event.T -> ShowS
showEvent :: T -> ShowS
showEvent (Event.MIDIEvent T
e) =
   String -> ShowS
showString String
"Event.MIDIEvent " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows T
e
showEvent (Event.MetaEvent T
e) =
   String -> ShowS
showString String
"Event.MetaEvent " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows T
e
showEvent (Event.SystemExclusive T
s) =
   String -> ShowS
showString String
"SystemExclusive " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows T
s


{- |
A hack that changes the velocities by a rational factor.
-}

changeVelocity :: Double -> T -> T
changeVelocity :: Double -> T -> T
changeVelocity Double
r =
   let multVel :: Velocity -> Velocity
multVel Velocity
vel =
          Int -> Velocity
VoiceMsg.toVelocity forall a b. (a -> b) -> a -> b
$
          forall a b. (RealFrac a, Integral b) => a -> b
round (Double
r forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Velocity -> Int
VoiceMsg.fromVelocity Velocity
vel))
       procVoice :: T -> T
procVoice (VoiceMsg.NoteOn  Pitch
pitch Velocity
vel) = Pitch -> Velocity -> T
VoiceMsg.NoteOn  Pitch
pitch (Velocity -> Velocity
multVel Velocity
vel)
       procVoice (VoiceMsg.NoteOff Pitch
pitch Velocity
vel) = Pitch -> Velocity -> T
VoiceMsg.NoteOff Pitch
pitch (Velocity -> Velocity
multVel Velocity
vel)
       procVoice T
me = T
me
   in  (Track -> Track) -> T -> T
mapTrack (forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
EventList.mapBody ((T -> T) -> T -> T
Event.mapVoice T -> T
procVoice))

{- |
Change the time base.
-}

resampleTime :: Double -> T -> T
resampleTime :: Double -> T -> T
resampleTime Double
r =
   let divTime :: a -> b
divTime  a
time = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
time forall a. Fractional a => a -> a -> a
/ Double
r)
       newTempo :: a -> b
newTempo a
tmp  = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tmp  forall a. Num a => a -> a -> a
* Double
r)
       procEvent :: T -> T
procEvent T
ev =
          case T
ev of
             Event.MetaEvent (MetaEvent.SetTempo Tempo
tmp) ->
                T -> T
Event.MetaEvent (Tempo -> T
MetaEvent.SetTempo (forall {b} {a}. (Integral b, Integral a) => a -> b
newTempo Tempo
tmp))
             T
_ -> T
ev
   in  (Track -> Track) -> T -> T
mapTrack (forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
EventList.mapBody T -> T
procEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
EventList.mapTime forall {b} {a}. (Integral b, Integral a) => a -> b
divTime)

{- |
Sort MIDI note events lexicographically.
This is to make MIDI files unique
and robust against changes in the computation.
In principle Performance.merge should handle this
but due to rounding errors in Float
the order of note events still depends on some internal issues.
The sample rate of MIDI events should be coarse enough
to assert unique results.
-}

sortEvents :: T -> T
sortEvents :: T -> T
sortEvents =
   let coincideNote :: T -> T -> Bool
coincideNote T
ev0 T
ev1 =
          forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$
             do (Channel
_,T
x0) <- T -> Maybe (Channel, T)
Event.maybeVoice T
ev0
                (Channel
_,T
x1) <- T -> Maybe (Channel, T)
Event.maybeVoice T
ev1
                forall (m :: * -> *) a. Monad m => a -> m a
return (T -> Bool
VoiceMsg.isNote T
x0 Bool -> Bool -> Bool
&& T -> Bool
VoiceMsg.isNote T
x1)
{-
       coincideNote
          (Event.MIDIEvent (ChannelMsg.Cons _ (ChannelMsg.Voice x0)))
          (Event.MIDIEvent (ChannelMsg.Cons _ (ChannelMsg.Voice x1))) =
          VoiceMsg.isNote x0 && VoiceMsg.isNote x1
       coincideNote _ _ = False
-}
       sortTrack :: Track -> Track
sortTrack =
          forall time body. C time => T time [body] -> T time body
EventList.flatten forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
EventList.mapBody forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall time a b. C time => ([a] -> [b]) -> T time a -> T time b
EventList.mapCoincident (forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy T -> T -> Bool
coincideNote)
   in  (Track -> Track) -> T -> T
mapTrack Track -> Track
sortTrack

{- |
Old versions of "Haskore.Interface.MIDI.Write"
wrote 'MIDIEvent.ProgramChange' and 'MetaEvent.SetTempo'
once at the beginning of a file in that order.
The current version supports multiple 'MIDIEvent.ProgramChange's in a track and
thus a 'MIDIEvent.ProgramChange' is set immediately before a note.
Because of this a 'MIDIEvent.ProgramChange' is now always after a 'MetaEvent.SetTempo'.
For checking equivalence with old MIDI files we can switch this back.
-}

progChangeBeforeSetTempo :: T -> T
progChangeBeforeSetTempo :: T -> T
progChangeBeforeSetTempo =
   let sortTrack :: T time T -> Maybe (T time T)
sortTrack T time T
evs =
          do ((time
t0,st :: T
st@(Event.MetaEvent (MetaEvent.SetTempo Tempo
_))), T time T
rest0)
                   <- forall time body. T time body -> Maybe ((time, body), T time body)
EventList.viewL T time T
evs
             ((time
t1,pc :: T
pc@(Event.MIDIEvent (ChannelMsg.Cons Channel
_
                (ChannelMsg.Voice (VoiceMsg.ProgramChange Program
_))))), T time T
rest1)
                   <- forall time body. T time body -> Maybe ((time, body), T time body)
EventList.viewL T time T
rest0
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                forall time body. time -> body -> T time body -> T time body
EventList.cons time
t0 T
pc forall a b. (a -> b) -> a -> b
$
                forall time body. time -> body -> T time body -> T time body
EventList.cons time
0  T
st forall a b. (a -> b) -> a -> b
$
                forall time body. C time => time -> T time body -> T time body
EventList.delay time
t1 T time T
rest1
   in  (Track -> Track) -> T -> T
mapTrack (\Track
track -> forall a. a -> Maybe a -> a
fromMaybe Track
track (forall {time}. (Num time, C time) => T time T -> Maybe (T time T)
sortTrack Track
track))