module Sound.MIDI.Message (
T(..),
get, getWithStatus, getIncompleteWithStatus,
put, putWithStatus,
maybeFromByteString, toByteString,
) where
import qualified Sound.MIDI.Message.Channel as Channel
import qualified Sound.MIDI.Message.System as System
import qualified Sound.MIDI.Parser.Status as StatusParser
import Sound.MIDI.Parser.Class (PossiblyIncomplete, )
import qualified Sound.MIDI.Parser.Class as Parser
import Sound.MIDI.Parser.Primitive (get1)
import qualified Sound.MIDI.Parser.ByteString as ParserByteString
import qualified Sound.MIDI.Writer.Status as StatusWriter
import qualified Sound.MIDI.Writer.Basic as Writer
import qualified Sound.MIDI.Parser.Report as Report
import Control.Monad.Trans (lift, )
import Control.Monad (liftM, )
import qualified Data.ByteString.Lazy as B
import Sound.MIDI.Utility (mapSnd, )
data T =
Channel Channel.T
| System System.T
get :: Parser.C parser => parser T
get =
get1 >>= \code ->
if code >= 0xF0
then liftM System $ System.get code
else liftM Channel $ (uncurry Channel.get (Channel.decodeStatus code) =<< get1)
getWithStatus :: Parser.C parser => StatusParser.T parser T
getWithStatus =
StatusParser.lift get1 >>= \code ->
if code >= 0xF0
then StatusParser.set Nothing >>
(liftM System $ StatusParser.lift $ System.get code)
else liftM Channel $ Channel.getWithStatus code
getIncompleteWithStatus ::
Parser.C parser => StatusParser.T parser (PossiblyIncomplete T)
getIncompleteWithStatus =
StatusParser.lift get1 >>= \code ->
if code >= 0xF0
then liftM (mapSnd System) $ StatusParser.lift $ System.getIncomplete code
else liftM ((,) Nothing . Channel) $ Channel.getWithStatus code
maybeFromByteString :: B.ByteString -> Report.T T
maybeFromByteString =
ParserByteString.run get
put :: Writer.C writer => T -> writer ()
put msg =
case msg of
Channel s -> Channel.put s
System s -> System.put s
putWithStatus :: Writer.C writer => T -> StatusWriter.T writer ()
putWithStatus msg =
case msg of
Channel s -> Channel.putWithStatus s
System s -> StatusWriter.clear >> lift (System.put s)
toByteString :: T -> B.ByteString
toByteString =
Writer.runByteString . put