module Sound.MIDI.File.Event.SystemExclusive
   (T(..), get, put, ) where

import Sound.MIDI.IO (ByteList)

import           Sound.MIDI.Parser.Primitive
import qualified Sound.MIDI.Parser.Class as Parser

import qualified Sound.MIDI.Writer.Basic as Writer
import Sound.MIDI.Monoid ((+#+))

import Control.Monad (liftM, )



{-# DEPRECATED T "implement this data type properly" #-}
{- |
There are three forms of System Exclusive Messages in MIDI files:
monolithic, chopped into packets, escape form (with unrestricted binary data).

Currently we only support first and last type explicitly.
But we leave the trailing 0xF7 markers
which can be used to detect whether the messages are actually meant as packets.

Since I don't know where manufacturer information is in the packets form,
I omit manufacturer handling for now.
-}
data T =
     Regular ByteList   -- F0
   | Escape  ByteList   -- F7
     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)


get :: Parser.C parser => Int -> Parser.Fragile parser T
get :: forall (parser :: * -> *). C parser => Int -> Fragile parser T
get Int
tag =
   case Int
tag of
      Int
0xF0 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteList -> T
Regular forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *).
C parser =>
Integer -> Fragile parser ByteList
getBigN forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (parser :: * -> *). C parser => Fragile parser Integer
getVar
      Int
0xF7 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteList -> T
Escape  forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *).
C parser =>
Integer -> Fragile parser ByteList
getBigN forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (parser :: * -> *). C parser => Fragile parser Integer
getVar
      Int
_ -> forall (m :: * -> *) a. Monad m => String -> T m a
Parser.giveUp String
"SystemExclusive: unkown message type"

put :: Writer.C writer => T -> writer
put :: forall writer. C writer => T -> writer
put T
sysex =
   case T
sysex of
      Regular ByteList
bytes -> forall m. C m => Word8 -> m
Writer.putByte Word8
0xF0 forall m. Monoid m => m -> m -> m
+#+ forall writer. C writer => ByteList -> writer
Writer.putLenByteList ByteList
bytes
      Escape  ByteList
bytes -> forall m. C m => Word8 -> m
Writer.putByte Word8
0xF7 forall m. Monoid m => m -> m -> m
+#+ forall writer. C writer => ByteList -> writer
Writer.putLenByteList ByteList
bytes