{- 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] -}