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