{- |
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 err sysex) <- Partial (ExceptionalT UserMessage parser) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
getIncomplete
      maybe (return sysex) Parser.giveUp err

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

getBody :: Parser.C parser => Parser.Partial parser ByteList
getBody :: forall (parser :: * -> *). C parser => Partial parser ByteList
getBody = (Word8 -> Bool) -> Fragile parser Word8 -> Partial parser ByteList
forall (parser :: * -> *) a.
EndCheck parser =>
(a -> Bool) -> Fragile parser a -> Partial parser [a]
Parser.until (Word8
0xf7 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==) Fragile parser Word8
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 ->
         T -> writer
forall writer. C writer => T -> writer
Manufacturer.put T
manu writer -> writer -> writer
forall m. Monoid m => m -> m -> m
+#+
         ByteList -> writer
forall writer. C writer => ByteList -> writer
Writer.putByteList ByteList
body
      NonCommercial ByteList
body ->
         T -> writer
forall writer. C writer => T -> writer
Manufacturer.put T
Manufacturer.nonCommercial writer -> writer -> writer
forall m. Monoid m => m -> m -> m
+#+
         ByteList -> writer
forall writer. C writer => ByteList -> writer
Writer.putByteList ByteList
body
      NonRealTime (NonRealTimeCons ByteList
body) ->
         T -> writer
forall writer. C writer => T -> writer
Manufacturer.put T
Manufacturer.nonRealTime writer -> writer -> writer
forall m. Monoid m => m -> m -> m
+#+
         ByteList -> writer
forall writer. C writer => ByteList -> writer
Writer.putByteList ByteList
body
      RealTime (RealTimeCons ByteList
body) ->
         T -> writer
forall writer. C writer => T -> writer
Manufacturer.put T
Manufacturer.realTime writer -> writer -> writer
forall m. Monoid m => m -> m -> m
+#+
         ByteList -> writer
forall writer. C writer => ByteList -> writer
Writer.putByteList ByteList
body