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 (Int -> T -> ShowS
[T] -> ShowS
T -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> T -> ShowS
Show, T -> T -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq, Eq T
T -> T -> Bool
T -> T -> Ordering
T -> T -> T
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: T -> T -> T
$cmin :: T -> T -> T
max :: T -> T -> T
$cmax :: T -> T -> T
>= :: T -> T -> Bool
$c>= :: T -> T -> Bool
> :: T -> T -> Bool
$c> :: T -> T -> Bool
<= :: T -> T -> Bool
$c<= :: T -> T -> Bool
< :: T -> T -> Bool
$c< :: T -> T -> Bool
compare :: T -> T -> Ordering
$ccompare :: T -> T -> Ordering
Ord)


instance Arbitrary T where
   arbitrary :: Gen T
arbitrary =
      forall a. [Gen a] -> Gen a
QC.oneof forall a b. (a -> b) -> a -> b
$
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  Int -> T
SequenceNum (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
0xFFFF)) forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  String -> T
TextEvent Gen String
arbitraryString forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  String -> T
Copyright Gen String
arbitraryString forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  String -> T
TrackName Gen String
arbitraryString forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  String -> T
InstrumentName Gen String
arbitraryString forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  String -> T
Lyric Gen String
arbitraryString forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  String -> T
Marker Gen String
arbitraryString forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  String -> T
CuePoint Gen String
arbitraryString forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  (Channel -> T
MIDIPrefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Channel
toChannel) (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
15)) forall a. a -> [a] -> [a]
:
--         return EndOfTrack :
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  (Tempo -> T
SetTempo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Ord a, Num a) => String -> a -> T a
NonNeg.fromNumberMsg String
"Tempo always positive") (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
0xFFFFFF)) forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 a2 a3 a4 a5 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> a5 -> r)
-> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
liftM5 Int -> Int -> Int -> Int -> Int -> T
SMPTEOffset Gen Int
arbitraryByte Gen Int
arbitraryByte Gen Int
arbitraryByte Gen Int
arbitraryByte Gen Int
arbitraryByte forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 Int -> Int -> Int -> Int -> T
TimeSig Gen Int
arbitraryByte Gen Int
arbitraryByte Gen Int
arbitraryByte Gen Int
arbitraryByte forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  T -> T
KeySig forall a. Arbitrary a => Gen a
arbitrary forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  ByteList -> T
SequencerSpecific Gen ByteList
arbitraryByteList forall a. a -> [a] -> [a]
:
--         liftM  Unknown arbitrary arbitraryByteList :
         []

arbitraryByte :: QC.Gen Int
arbitraryByte :: Gen Int
arbitraryByte = forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
0xFF::Int)


toElapsedTime :: Integer -> ElapsedTime
toElapsedTime :: Integer -> ElapsedTime
toElapsedTime = forall a. (Ord a, Num a) => String -> a -> T a
NonNeg.fromNumberMsg String
"toElapsedTime"

fromElapsedTime :: ElapsedTime -> Integer
fromElapsedTime :: ElapsedTime -> Integer
fromElapsedTime = forall a. T a -> a
NonNeg.toNumber


toTempo :: Int -> Tempo
toTempo :: Int -> Tempo
toTempo = forall a. (Ord a, Num a) => String -> a -> T a
NonNeg.fromNumberMsg String
"toTempo"

fromTempo :: Tempo -> Int
fromTempo :: Tempo -> Int
fromTempo = forall a. T a -> a
NonNeg.toNumber

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



-- * serialization

get :: Parser.C parser => Parser.Fragile parser T
get :: forall (parser :: * -> *). C parser => Fragile parser T
get =
   do Int
code <- forall (parser :: * -> *). C parser => Fragile parser Int
get1
      ElapsedTime
len  <- forall (parser :: * -> *). C parser => Fragile parser ElapsedTime
getVar
      let parse :: Fragile (T parser) a -> Fragile parser a
parse = forall (parser :: * -> *) a.
C parser =>
ElapsedTime -> Fragile (T parser) a -> Fragile parser a
ParserRestricted.runFragile ElapsedTime
len
      let returnText :: (String -> r) -> ExceptionalT String parser r
returnText String -> r
cons = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (String -> r
cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteList -> String
listCharFromByte) forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *).
C parser =>
ElapsedTime -> Fragile parser ByteList
getBigN ElapsedTime
len
      case Int
code of
         Int
000 -> forall {a}. Fragile (T parser) a -> Fragile parser a
parse forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int -> T
SequenceNum forall (parser :: * -> *). C parser => Fragile parser Int
get2
         Int
001 -> forall {parser :: * -> *} {r}.
C parser =>
(String -> r) -> ExceptionalT String parser r
returnText String -> T
TextEvent
         Int
002 -> forall {parser :: * -> *} {r}.
C parser =>
(String -> r) -> ExceptionalT String parser r
returnText String -> T
Copyright
         Int
003 -> forall {parser :: * -> *} {r}.
C parser =>
(String -> r) -> ExceptionalT String parser r
returnText String -> T
TrackName
         Int
004 -> forall {parser :: * -> *} {r}.
C parser =>
(String -> r) -> ExceptionalT String parser r
returnText String -> T
InstrumentName
         Int
005 -> forall {parser :: * -> *} {r}.
C parser =>
(String -> r) -> ExceptionalT String parser r
returnText String -> T
Lyric
         Int
006 -> forall {parser :: * -> *} {r}.
C parser =>
(String -> r) -> ExceptionalT String parser r
returnText String -> T
Marker
         Int
007 -> forall {parser :: * -> *} {r}.
C parser =>
(String -> r) -> ExceptionalT String parser r
returnText String -> T
CuePoint

         Int
032 -> forall {a}. Fragile (T parser) a -> Fragile parser a
parse forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Channel -> T
MIDIPrefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Channel
toChannel) forall (parser :: * -> *). C parser => Fragile parser Int
get1
         Int
047 -> forall (m :: * -> *) a. Monad m => a -> m a
return T
EndOfTrack
         Int
081 -> forall {a}. Fragile (T parser) a -> Fragile parser a
parse forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Tempo -> T
SetTempo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tempo
toTempo) forall (parser :: * -> *). C parser => Fragile parser Int
get3

         Int
084 -> forall {a}. Fragile (T parser) a -> Fragile parser a
parse forall a b. (a -> b) -> a -> b
$
                do {Int
hrs    <- forall (parser :: * -> *). C parser => Fragile parser Int
get1 ; Int
mins <- forall (parser :: * -> *). C parser => Fragile parser Int
get1 ; Int
secs <- forall (parser :: * -> *). C parser => Fragile parser Int
get1;
                    Int
frames <- forall (parser :: * -> *). C parser => Fragile parser Int
get1 ; Int
bits <- forall (parser :: * -> *). C parser => Fragile parser Int
get1 ;
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Int -> T
SMPTEOffset Int
hrs Int
mins Int
secs Int
frames Int
bits)}

         Int
088 -> forall {a}. Fragile (T parser) a -> Fragile parser a
parse forall a b. (a -> b) -> a -> b
$
                do
                   Int
n <- forall (parser :: * -> *). C parser => Fragile parser Int
get1
                   Int
d <- forall (parser :: * -> *). C parser => Fragile parser Int
get1
                   Int
c <- forall (parser :: * -> *). C parser => Fragile parser Int
get1
                   Int
b <- forall (parser :: * -> *). C parser => Fragile parser Int
get1
                   forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> T
TimeSig Int
n Int
d Int
c Int
b)

         Int
089 -> forall {a}. Fragile (T parser) a -> Fragile parser a
parse forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
KeySig forall (parser :: * -> *). C parser => Fragile parser T
KeySig.get

         Int
127 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteList -> T
SequencerSpecific forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *).
C parser =>
ElapsedTime -> Fragile parser ByteList
getBigN ElapsedTime
len

         Int
_   -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ByteList -> T
Unknown Int
code) forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *).
C parser =>
ElapsedTime -> Fragile parser ByteList
getBigN ElapsedTime
len


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

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


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

putInt :: Writer.C writer => Int -> Int -> Int -> writer
putInt :: forall writer. C writer => Int -> Int -> Int -> writer
putInt Int
code Int
numBytes Int
x =
   forall writer. C writer => Int -> writer
Writer.putIntAsByte Int
code forall m. Monoid m => m -> m -> m
+#+
   forall writer. C writer => ElapsedTime -> writer
Writer.putVar (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numBytes) forall m. Monoid m => m -> m -> m
+#+
   forall writer. C writer => ByteList -> writer
Writer.putByteList
      (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Int -> a -> ByteList
Bit.someBytes Int
numBytes Int
x)

putStr :: Writer.C writer => Int -> String -> writer
putStr :: forall writer. C writer => Int -> String -> writer
putStr Int
code =
   forall writer. C writer => Int -> ByteList -> writer
putByteList Int
code forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteList
listByteFromChar

putList :: Writer.C writer => Int -> [Int] -> writer
putList :: forall writer. C writer => Int -> [Int] -> writer
putList Int
code =
   forall writer. C writer => Int -> ByteList -> writer
putByteList Int
code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral