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 Data.Maybe (fromMaybe, )
data T =
Commercial Manufacturer.T ByteList
| NonCommercial ByteList
| NonRealTime NonRealTime
| RealTime RealTime
newtype NonRealTime = NonRealTimeCons ByteList
newtype RealTime = RealTimeCons ByteList
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) :
[]
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