{- |
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 :: Fragile parser T
get =
   do (Async.Exceptional Maybe UserMessage
err T
sysex) <- Partial (Fragile parser) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
getIncomplete
      Fragile parser T
-> (UserMessage -> Fragile parser T)
-> Maybe UserMessage
-> Fragile parser T
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (T -> Fragile parser T
forall (m :: * -> *) a. Monad m => a -> m a
return T
sysex) UserMessage -> Fragile parser T
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 :: Partial (Fragile parser) T
getIncomplete =
   do T
manu <- Fragile parser T
forall (parser :: * -> *). C parser => Fragile parser T
Manufacturer.get
      PossiblyIncomplete ByteList
incBody <- parser (PossiblyIncomplete ByteList)
-> ExceptionalT UserMessage parser (PossiblyIncomplete ByteList)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift parser (PossiblyIncomplete ByteList)
forall (parser :: * -> *). C parser => Partial parser ByteList
getBody
      Exceptional UserMessage T -> Partial (Fragile parser) T
forall (m :: * -> *) a. Monad m => a -> m a
return (Exceptional UserMessage T -> Partial (Fragile parser) T)
-> Exceptional UserMessage T -> Partial (Fragile parser) T
forall a b. (a -> b) -> a -> b
$ ((ByteList -> T)
 -> PossiblyIncomplete ByteList -> Exceptional UserMessage T)
-> PossiblyIncomplete ByteList
-> (ByteList -> T)
-> Exceptional UserMessage T
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ByteList -> T)
-> PossiblyIncomplete ByteList -> Exceptional UserMessage T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PossiblyIncomplete ByteList
incBody ((ByteList -> T) -> Exceptional UserMessage T)
-> (ByteList -> T) -> Exceptional UserMessage T
forall a b. (a -> b) -> a -> b
$ \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 :: 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 :: 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