1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
{-
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 Sound.MIDI.Utility (viewR, dropMatch, )
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 viewR tracks0 of
Just (initTracks0, lastTrack0) ->
List.isPrefixOf initTracks0 tracks1 &&
let (lastTrack1:_) = dropMatch 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]
-}
|
