    module Sound.MIDI.File.Event.Meta (
       T(..),
       ElapsedTime, fromElapsedTime, toElapsedTime,
       Tempo,       fromTempo,       toTempo,
       defltTempo,
       SMPTEHours, SMPTEMinutes, SMPTESeconds, SMPTEFrames, SMPTEBits,
       get, put, ) where

    import Sound.MIDI.Message.Channel (Channel, toChannel, fromChannel, )

    import qualified Sound.MIDI.KeySignature as KeySig

    import Sound.MIDI.Parser.Primitive (get1, get2, get3, getVar, getBigN, )
    import qualified Sound.MIDI.Parser.Class as Parser
    import qualified Sound.MIDI.Parser.Restricted as ParserRestricted

    import Control.Monad (liftM, liftM4, liftM5, )

    import qualified Sound.MIDI.Writer.Basic as Writer
    import qualified Sound.MIDI.Bit as Bit

    import Sound.MIDI.Monoid ((+#+))

    import qualified Numeric.NonNegative.Wrapper as NonNeg
    import Sound.MIDI.IO (ByteList, listCharFromByte, listByteFromChar, )

    import Sound.MIDI.Utility
             (arbitraryString, arbitraryByteList, )

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

    import Prelude hiding (putStr, )

    {- * Meta Events -}

    type ElapsedTime  = NonNeg.Integer
    type Tempo        = NonNeg.Int
    type SMPTEHours   = Int
    type SMPTEMinutes = Int
    type SMPTESeconds = Int
    type SMPTEFrames  = Int
    type SMPTEBits    = Int

    data T =
         SequenceNum Int
       | TextEvent String
       | Copyright String
       | TrackName String
       | InstrumentName String
       | Lyric String
       | Marker String
       | CuePoint String
       | MIDIPrefix Channel
       | EndOfTrack
       | SetTempo Tempo
       | SMPTEOffset SMPTEHours SMPTEMinutes SMPTESeconds SMPTEFrames SMPTEBits
       | TimeSig Int Int Int Int
       | KeySig KeySig.T
       | SequencerSpecific ByteList
       | Unknown Int ByteList
         deriving (Show, Eq, Ord)

    instance Arbitrary T where
       arbitrary =
          QC.oneof $
             liftM  SequenceNum (QC.choose (0,0xFFFF)) :
             liftM  TextEvent arbitraryString :
             liftM  Copyright arbitraryString :
             liftM  TrackName arbitraryString :
             liftM  InstrumentName arbitraryString :
             liftM  Lyric arbitraryString :
             liftM  Marker arbitraryString :
             liftM  CuePoint arbitraryString :
             liftM  (MIDIPrefix . toChannel) (QC.choose (0,15)) :
    --         return EndOfTrack :
             liftM  (SetTempo . NonNeg.fromNumberMsg "Tempo always positive") (QC.choose (0,0xFFFFFF)) :
             liftM5 SMPTEOffset arbitraryByte arbitraryByte arbitraryByte arbitraryByte arbitraryByte :
             liftM4 TimeSig arbitraryByte arbitraryByte arbitraryByte arbitraryByte :
             liftM  KeySig arbitrary :
             liftM  SequencerSpecific arbitraryByteList :
    --         liftM  Unknown arbitrary arbitraryByteList :
             []

    arbitraryByte :: QC.Gen Int
    arbitraryByte = QC.choose (0,0xFF::Int)

    toElapsedTime :: Integer -> ElapsedTime
    toElapsedTime = NonNeg.fromNumberMsg "toElapsedTime"

    fromElapsedTime :: ElapsedTime -> Integer
    fromElapsedTime = NonNeg.toNumber

    toTempo :: Int -> Tempo
    toTempo = NonNeg.fromNumberMsg "toTempo"

    fromTempo :: Tempo -> Int
    fromTempo = NonNeg.toNumber

    {- |
    The default SetTempo value, in microseconds per quarter note.
    This expresses the default of 120 beats per minute.
    -}
    defltTempo :: Tempo
    defltTempo = 500000

    -- * serialization

    get :: Parser.C parser => Parser.Fallible parser T
    get =
       do code <- get1
          len  <- getVar
          let parse = ParserRestricted.runFallible len
          let returnText cons = liftM (cons . listCharFromByte) $ getBigN len
          case code of
             000 -> parse $ liftM SequenceNum get2
             001 -> returnText TextEvent
             002 -> returnText Copyright
             003 -> returnText TrackName
             004 -> returnText InstrumentName
             005 -> returnText Lyric
             006 -> returnText Marker
             007 -> returnText CuePoint

             032 -> parse $
                    liftM (MIDIPrefix . toChannel) get1
             047 -> return EndOfTrack
             081 -> parse $
                    liftM (SetTempo . toTempo) get3

             084 -> parse $
                    do {hrs    <- get1 ; mins <- get1 ; secs <- get1;
                        frames <- get1 ; bits <- get1 ;
                        return (SMPTEOffset hrs mins secs frames bits)}

             088 -> parse $
                    do
                       n <- get1
                       d <- get1
                       c <- get1
                       b <- get1
                       return (TimeSig n d c b)

             089 -> parse $ liftM KeySig KeySig.get

             127 -> liftM SequencerSpecific $ getBigN len

             _   -> liftM (Unknown code) $ getBigN len

    put :: Writer.C writer => T -> writer
    put ev =
       Writer.putByte 255 +#+
       case ev of
         SequenceNum num  -> putInt    0 2 num
         TextEvent s      -> putStr    1 s
         Copyright s      -> putStr    2 s
         TrackName s      -> putStr    3 s
         InstrumentName s -> putStr    4 s
         Lyric s          -> putStr    5 s
         Marker s         -> putStr    6 s
         CuePoint s       -> putStr    7 s
         MIDIPrefix c     -> putList  32 [fromChannel c]
         EndOfTrack       -> putList  47 []

         SetTempo tp      -> putInt   81 3 (fromTempo tp)
         SMPTEOffset hr mn se fr ff
                          -> putList  84 [hr,mn,se,fr,ff]
         TimeSig n d c b  -> putList  88 [n,d,c,b]
         KeySig key       -> putList  89 $ KeySig.toBytes key
         SequencerSpecific codes
                          -> putByteList 127 codes
         Unknown typ s    -> putByteList typ s

    putByteList :: Writer.C writer => Int -> ByteList -> writer
    putByteList code bytes =
       Writer.putIntAsByte code +#+
       Writer.putLenByteList bytes

    putInt :: Writer.C writer => Int -> Int -> Int -> writer
    putInt code numBytes x =
       Writer.putIntAsByte code +#+
       Writer.putVar (fromIntegral numBytes) +#+
       Writer.putByteList
          (map fromIntegral $ Bit.someBytes numBytes x)

    putStr :: Writer.C writer => Int -> String -> writer
    putStr code =
       putByteList code . listByteFromChar

    putList :: Writer.C writer => Int -> [Int] -> writer
    putList code =
       putByteList code . map fromIntegral