{- | 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 Sound.MIDI.Parser.Class (PossiblyIncomplete, ) import qualified Sound.MIDI.Parser.Class as Parser import qualified Sound.MIDI.Writer.Basic as Writer -- import Control.Monad (liftM, liftM2, when, ) 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 T get = do (err, sysex) <- getIncomplete maybe (return sysex) Parser.giveUp err getIncomplete :: Parser.C parser => parser (PossiblyIncomplete T) getIncomplete = do manu <- Manufacturer.get (err, body) <- Parser.until (0xf7 ==) getByte return $ ((,) err) $ fromMaybe (Commercial manu body) $ lookup manu $ (Manufacturer.nonCommercial, NonCommercial body) : (Manufacturer.nonRealTime, NonRealTime $ NonRealTimeCons body) : (Manufacturer.realTime, RealTime $ RealTimeCons body) : [] {- | It is not checked whether SysEx messages contain only 7-bit values. -} put :: Writer.C writer => T -> writer () put sysex = case sysex of Commercial manu body -> Manufacturer.put manu >> Writer.putByteList body NonCommercial body -> Manufacturer.put Manufacturer.nonCommercial >> Writer.putByteList body NonRealTime (NonRealTimeCons body) -> Manufacturer.put Manufacturer.nonRealTime >> Writer.putByteList body RealTime (RealTimeCons body) -> Manufacturer.put Manufacturer.realTime >> Writer.putByteList body