{- |
System Exclusive messages
-}
module Sound.MIDI.Message.System.Exclusive (
   T(..), get, getIncomplete, put,
   ) where

import qualified Sound.MIDI.Manufacturer as Manufacturer
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 qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Exception.Asynchronous as Async

import Data.Maybe (fromMaybe, )


data T =
     Commercial    Manufacturer.T ByteList
   | NonCommercial ByteList
   | NonRealTime   NonRealTime
   | RealTime      RealTime


-- * Non-real time

{-# DEPRECATED NonRealTime "structure must be defined, yet" #-}
newtype NonRealTime = NonRealTimeCons ByteList

-- * Real time

{-# DEPRECATED RealTime "structure must be defined, yet" #-}
newtype RealTime = RealTimeCons ByteList


-- * serialization

get :: Parser.C parser => Parser.Fragile parser T
get :: forall (parser :: * -> *). C parser => Fragile parser T
get =
   do (Async.Exceptional Maybe UserMessage
err T
sysex) <- forall (parser :: * -> *). C parser => Partial (Fragile parser) T
getIncomplete
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return T
sysex) forall (m :: * -> *) a. Monad m => UserMessage -> T m a
Parser.giveUp Maybe UserMessage
err

getIncomplete :: Parser.C parser => Parser.Partial (Parser.Fragile parser) T
getIncomplete :: forall (parser :: * -> *). C parser => Partial (Fragile parser) T
getIncomplete =
   do T
manu <- forall (parser :: * -> *). C parser => Fragile parser T
Manufacturer.get
      PossiblyIncomplete ByteList
incBody <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift forall (parser :: * -> *). C parser => Partial parser ByteList
getBody
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PossiblyIncomplete ByteList
incBody forall a b. (a -> b) -> a -> b
$ \ByteList
body ->
         forall a. a -> Maybe a -> a
fromMaybe (T -> ByteList -> T
Commercial T
manu ByteList
body) forall a b. (a -> b) -> a -> b
$
         forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup T
manu forall a b. (a -> b) -> a -> b
$
            (T
Manufacturer.nonCommercial, ByteList -> T
NonCommercial ByteList
body) forall a. a -> [a] -> [a]
:
            (T
Manufacturer.nonRealTime,   NonRealTime -> T
NonRealTime forall a b. (a -> b) -> a -> b
$ ByteList -> NonRealTime
NonRealTimeCons ByteList
body) forall a. a -> [a] -> [a]
:
            (T
Manufacturer.realTime,      RealTime -> T
RealTime    forall a b. (a -> b) -> a -> b
$ ByteList -> RealTime
RealTimeCons ByteList
body) forall a. a -> [a] -> [a]
:
            []

getBody :: Parser.C parser => Parser.Partial parser ByteList
getBody :: forall (parser :: * -> *). C parser => Partial parser ByteList
getBody = forall (parser :: * -> *) a.
EndCheck parser =>
(a -> Bool) -> Fragile parser a -> Partial parser [a]
Parser.until (Word8
0xf7 forall a. Eq a => a -> a -> Bool
==) forall (parser :: * -> *). C parser => Fragile parser Word8
getByte


{- |
It is not checked whether SysEx messages contain only 7-bit values.
-}
put :: Writer.C writer => T -> writer
put :: forall writer. C writer => T -> writer
put T
sysex =
   case T
sysex of
      Commercial T
manu ByteList
body ->
         forall writer. C writer => T -> writer
Manufacturer.put T
manu forall m. Monoid m => m -> m -> m
+#+
         forall writer. C writer => ByteList -> writer
Writer.putByteList ByteList
body
      NonCommercial ByteList
body ->
         forall writer. C writer => T -> writer
Manufacturer.put T
Manufacturer.nonCommercial forall m. Monoid m => m -> m -> m
+#+
         forall writer. C writer => ByteList -> writer
Writer.putByteList ByteList
body
      NonRealTime (NonRealTimeCons ByteList
body) ->
         forall writer. C writer => T -> writer
Manufacturer.put T
Manufacturer.nonRealTime forall m. Monoid m => m -> m -> m
+#+
         forall writer. C writer => ByteList -> writer
Writer.putByteList ByteList
body
      RealTime (RealTimeCons ByteList
body) ->
         forall writer. C writer => T -> writer
Manufacturer.put T
Manufacturer.realTime forall m. Monoid m => m -> m -> m
+#+
         forall writer. C writer => ByteList -> writer
Writer.putByteList ByteList
body