midi-0.2.1: test/Main.hs
{-
ToDo:
check whether load of randomly corrupted files yields Parser errors rather than 'undefined'.
Check parsing and serialization of MIDI messages.
-}
module Main where
import qualified Sound.MIDI.File as MidiFile
import qualified Sound.MIDI.File.Load as Load
import qualified Sound.MIDI.File.Save as Save
import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Sound.MIDI.File.Event as Event
import qualified Sound.MIDI.Message.Channel as ChannelMsg
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Sound.MIDI.Parser.Report as Report
import qualified Sound.MIDI.Parser.Class as Parser
import qualified Sound.MIDI.Parser.Stream as StreamParser
import qualified Data.EventList.Relative.TimeBody as EventList
import Data.EventList.Relative.MixedBody ((/.), (./), )
import qualified Data.ByteString.Lazy as B
import qualified Data.List as List
import qualified Data.List.HT as ListHT
import qualified Data.List.Match as Match
import Control.Monad.Trans.Class (lift, )
import Control.Monad (when, )
import System.Random (mkStdGen, randomR, )
import qualified Numeric.NonNegative.Wrapper as NonNeg
import Test.QuickCheck (quickCheck, )
-- import Debug.Trace (trace)
testMidiName :: FilePath
testMidiName = "quickcheck-test.mid"
exampleEmpty :: MidiFile.T
exampleEmpty =
MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks 10)
[EventList.empty]
exampleMeta :: MidiFile.T
exampleMeta =
MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks 10)
[EventList.cons 0 (Event.MetaEvent (MetaEvent.Lyric "foobarz")) EventList.empty]
exampleStatus :: MidiFile.T
exampleStatus =
let chan = ChannelMsg.toChannel 3
vel = VoiceMsg.toVelocity 64
in MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks 10)
[0 /. Event.MIDIEvent (ChannelMsg.Cons chan (ChannelMsg.Voice (VoiceMsg.NoteOn (VoiceMsg.toPitch 20) vel))) ./
4 /. Event.MIDIEvent (ChannelMsg.Cons chan (ChannelMsg.Voice (VoiceMsg.NoteOn (VoiceMsg.toPitch 24) vel))) ./
4 /. Event.MIDIEvent (ChannelMsg.Cons chan (ChannelMsg.Voice (VoiceMsg.NoteOn (VoiceMsg.toPitch 27) vel))) ./
7 /. Event.MIDIEvent (ChannelMsg.Cons chan (ChannelMsg.Voice (VoiceMsg.NoteOff (VoiceMsg.toPitch 20) vel))) ./
4 /. Event.MIDIEvent (ChannelMsg.Cons chan (ChannelMsg.Voice (VoiceMsg.NoteOff (VoiceMsg.toPitch 24) vel))) ./
4 /. Event.MIDIEvent (ChannelMsg.Cons chan (ChannelMsg.Voice (VoiceMsg.NoteOff (VoiceMsg.toPitch 27) vel))) ./
EventList.empty]
runExample :: MidiFile.T -> IO ()
runExample example =
let bin = Save.toByteString example
struct = Load.maybeFromByteString bin
report = Report.Cons [] (Right example)
in B.writeFile testMidiName bin >>
print (struct == report) >>
when (struct/=report)
(print struct >> print report)
-- provoke a test failure in order to see some examples of Arbitrary MIDI files
checkArbitrary :: MidiFile.T -> Bool
checkArbitrary (MidiFile.Cons _typ _division tracks) =
length (EventList.toPairList (EventList.concat tracks)) < 10
saveLoadByteString :: MidiFile.T -> Bool
saveLoadByteString midi =
let bin = Save.toByteString midi
struct = Load.maybeFromByteString bin
report = Report.Cons [] (Right midi)
in struct == report
saveLoadCompressedByteString :: MidiFile.T -> Bool
saveLoadCompressedByteString midi =
let bin = Save.toCompressedByteString midi
struct = Load.maybeFromByteString bin
report = Report.Cons [] (Right (MidiFile.implicitNoteOff midi))
in struct == report
saveLoadMaybeByteList :: MidiFile.T -> Bool
saveLoadMaybeByteList midi =
let bin = Save.toByteList midi
struct = Load.maybeFromByteList bin
report = Report.Cons [] (Right midi)
in struct == report
saveLoadByteList :: MidiFile.T -> Bool
saveLoadByteList midi =
midi == Load.fromByteList (Save.toByteList midi)
saveLoadFile :: MidiFile.T -> IO Bool
saveLoadFile midi =
do Save.toSeekableFile testMidiName midi
struct <- Load.fromFile testMidiName
return $ struct == midi
loadSaveByteString :: MidiFile.T -> Bool
loadSaveByteString midi0 =
let bin0 = Save.toByteString midi0
in case Load.maybeFromByteString bin0 of
Report.Cons [] (Right midi1) ->
bin0 == Save.toByteString midi1
_ -> False
loadSaveCompressedByteString :: MidiFile.T -> Bool
loadSaveCompressedByteString midi0 =
let bin0 = Save.toCompressedByteString midi0
in case Load.maybeFromByteString bin0 of
Report.Cons [] (Right midi1) ->
bin0 == Save.toByteString midi1
_ -> False
loadSaveByteList :: MidiFile.T -> Bool
loadSaveByteList midi0 =
let bin0 = Save.toByteList midi0
in case Load.maybeFromByteList bin0 of
Report.Cons [] (Right midi1) ->
bin0 == Save.toByteList midi1
_ -> False
restrictionByteList :: MidiFile.T -> Bool
restrictionByteList midi =
let bin = Save.toByteList midi
in Load.fromByteList bin ==
Load.fromByteList (bin++[undefined])
lazinessZeroOrMoreByteList :: NonNeg.Int -> Int -> Bool
lazinessZeroOrMoreByteList pos byte =
let result =
Report.result $ StreamParser.runIncomplete (lift (Parser.zeroOrMore Parser.getByte)) $
StreamParser.ByteList $ repeat $ fromIntegral byte
char = show result !! mod (NonNeg.toNumber pos) 1000
in char == char
lazinessByteList :: MidiFile.T -> Bool
lazinessByteList (MidiFile.Cons typ divsn tracks00) =
let tracks0 = filter (not . EventList.null) tracks00
bin0 = Save.toByteList (MidiFile.Cons typ divsn tracks0)
{- remove trailing EndOfTrack and its time stamp and replace the last by
bin1 = take (length bin0 - 5) bin0 ++ [undefined]
-}
bin1 = init bin0 ++ [undefined]
(MidiFile.Cons _ _ tracks1) = Load.fromByteList bin1
in case ListHT.viewR tracks0 of
Just (initTracks0, lastTrack0) ->
List.isPrefixOf initTracks0 tracks1 &&
let (lastTrack1:_) = Match.drop initTracks0 tracks1
in List.isPrefixOf
(init (EventList.toPairList lastTrack0))
(EventList.toPairList lastTrack1)
{-
fmap fst (EventList.viewR lastTrack0) ==
fmap fst (EventList.viewR lastTrack1)
-}
_ -> True
{- |
Check whether corruptions in a file are properly detected
and do not trap into an errors.
-}
corruptionByteString :: Int -> Int -> MidiFile.T -> Bool
corruptionByteString seed replacement midi =
let bin = Save.toByteString midi
n = fst $ randomR (0, fromIntegral $ B.length bin :: Int) (mkStdGen seed)
(pre, post) = B.splitAt (fromIntegral n) bin
replaceByte = fromIntegral replacement
corruptBin =
B.append pre
(if B.null post
then B.singleton replaceByte
else B.cons replaceByte (B.tail post))
in -- trace (show (B.unpack corruptBin)) $
case Load.maybeFromByteString corruptBin of
Report.Cons _ _ -> True
corruptionByteList :: Int -> Int -> MidiFile.T -> Bool
corruptionByteList seed replacement midi =
let bin = Save.toByteList midi
n = fst $ randomR (0, length bin) (mkStdGen seed)
(pre, post) = splitAt n bin
corruptBin =
pre ++ fromIntegral replacement :
if null post then [] else tail post
in case Load.maybeFromByteList corruptBin of
Report.Cons _ _ -> True
main :: IO ()
main =
do runExample exampleEmpty
runExample exampleMeta
runExample exampleStatus
saveLoadFile exampleStatus >>= print
quickCheck saveLoadByteString
quickCheck saveLoadCompressedByteString
quickCheck saveLoadMaybeByteList
quickCheck saveLoadByteList
-- quickCheck saveLoadFile
quickCheck loadSaveByteString
quickCheck loadSaveCompressedByteString
quickCheck loadSaveByteList
quickCheck restrictionByteList
quickCheck lazinessZeroOrMoreByteList
quickCheck lazinessByteList
quickCheck corruptionByteList
quickCheck corruptionByteString
{-
laziness test:
The following expressions should return the prefix of the track before running into "undefined".
I don't know, how to formalize that.
Load.fromByteList [77,84,104,100,0,0,0,6,0,1,0,1,0,10,77,84,114,107,0,0,0,28,0,147,20,64,4,147,24,64,4,147,27,64,7,131,20,64,4,131,24,64,4,131,27,64,0,255,47,undefined]
Report.result $ StreamParser.runIncomplete Load.getTrackChunk $ StreamParser.ByteList [77,84,114,107,0,0,0,28,0,147,20,64,4,147,24,64,4,147,27,64,7,131,20,64,4,131,24,64,4,131,27,64,0,255,47,undefined]
-}