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 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 Sound.MIDI.Monoid ((+#+))
import qualified Sound.MIDI.Parser.Report as Report
import qualified Control.Monad.Exception.Asynchronous as Async
import Control.Monad (liftM, )
import qualified Data.ByteString.Lazy as B
data T =
Channel Channel.T
| System System.T
get :: Parser.C parser => Parser.Fragile parser T
get :: Fragile parser T
get =
Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1 Fragile parser Int -> (Int -> Fragile parser T) -> Fragile parser T
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
code ->
if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xF0
then (T -> T) -> ExceptionalT UserMessage parser T -> Fragile parser T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
System (ExceptionalT UserMessage parser T -> Fragile parser T)
-> ExceptionalT UserMessage parser T -> Fragile parser T
forall a b. (a -> b) -> a -> b
$ Int -> ExceptionalT UserMessage parser T
forall (parser :: * -> *). C parser => Int -> Fragile parser T
System.get Int
code
else (T -> T) -> ExceptionalT UserMessage parser T -> Fragile parser T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
Channel (ExceptionalT UserMessage parser T -> Fragile parser T)
-> ExceptionalT UserMessage parser T -> Fragile parser T
forall a b. (a -> b) -> a -> b
$ ((Int -> Channel -> Int -> ExceptionalT UserMessage parser T)
-> (Int, Channel) -> Int -> ExceptionalT UserMessage parser T
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Channel -> Int -> ExceptionalT UserMessage parser T
forall (parser :: * -> *).
C parser =>
Int -> Channel -> Int -> Fragile parser T
Channel.get (Int -> (Int, Channel)
Channel.decodeStatus Int
code) (Int -> ExceptionalT UserMessage parser T)
-> Fragile parser Int -> ExceptionalT UserMessage parser T
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1)
getWithStatus :: Parser.C parser => Parser.Fragile (StatusParser.T parser) T
getWithStatus :: Fragile (T parser) T
getWithStatus =
Fragile parser Int -> Fragile (T parser) Int
forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
StatusParser.lift Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1 Fragile (T parser) Int
-> (Int -> Fragile (T parser) T) -> Fragile (T parser) T
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
code ->
if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xF0
then Status -> Fragile (T parser) ()
forall (parser :: * -> *).
Monad parser =>
Status -> Fragile (T parser) ()
StatusParser.set Status
forall a. Maybe a
Nothing Fragile (T parser) ()
-> Fragile (T parser) T -> Fragile (T parser) T
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
((T -> T)
-> ExceptionalT UserMessage (T parser) T -> Fragile (T parser) T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
System (ExceptionalT UserMessage (T parser) T -> Fragile (T parser) T)
-> ExceptionalT UserMessage (T parser) T -> Fragile (T parser) T
forall a b. (a -> b) -> a -> b
$ Fragile parser T -> ExceptionalT UserMessage (T parser) T
forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
StatusParser.lift (Fragile parser T -> ExceptionalT UserMessage (T parser) T)
-> Fragile parser T -> ExceptionalT UserMessage (T parser) T
forall a b. (a -> b) -> a -> b
$ Int -> Fragile parser T
forall (parser :: * -> *). C parser => Int -> Fragile parser T
System.get Int
code)
else (T -> T)
-> ExceptionalT UserMessage (T parser) T -> Fragile (T parser) T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM T -> T
Channel (ExceptionalT UserMessage (T parser) T -> Fragile (T parser) T)
-> ExceptionalT UserMessage (T parser) T -> Fragile (T parser) T
forall a b. (a -> b) -> a -> b
$ Int -> ExceptionalT UserMessage (T parser) T
forall (parser :: * -> *). C parser => Int -> Fragile (T parser) T
Channel.getWithStatus Int
code
getIncompleteWithStatus ::
Parser.C parser => Parser.Partial (Parser.Fragile (StatusParser.T parser)) T
getIncompleteWithStatus :: Partial (Fragile (T parser)) T
getIncompleteWithStatus =
Fragile parser Int -> Fragile (T parser) Int
forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
StatusParser.lift Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1 Fragile (T parser) Int
-> (Int -> Partial (Fragile (T parser)) T)
-> Partial (Fragile (T parser)) T
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
code ->
if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xF0
then (Exceptional UserMessage T -> Exceptional UserMessage T)
-> ExceptionalT UserMessage (T parser) (Exceptional UserMessage T)
-> Partial (Fragile (T parser)) T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((T -> T) -> Exceptional UserMessage T -> Exceptional UserMessage T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T -> T
System) (ExceptionalT UserMessage (T parser) (Exceptional UserMessage T)
-> Partial (Fragile (T parser)) T)
-> ExceptionalT UserMessage (T parser) (Exceptional UserMessage T)
-> Partial (Fragile (T parser)) T
forall a b. (a -> b) -> a -> b
$ Fragile parser (Exceptional UserMessage T)
-> ExceptionalT UserMessage (T parser) (Exceptional UserMessage T)
forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
StatusParser.lift (Fragile parser (Exceptional UserMessage T)
-> ExceptionalT UserMessage (T parser) (Exceptional UserMessage T))
-> Fragile parser (Exceptional UserMessage T)
-> ExceptionalT UserMessage (T parser) (Exceptional UserMessage T)
forall a b. (a -> b) -> a -> b
$ Int -> Fragile parser (Exceptional UserMessage T)
forall (parser :: * -> *).
C parser =>
Int -> Partial (Fragile parser) T
System.getIncomplete Int
code
else (T -> Exceptional UserMessage T)
-> ExceptionalT UserMessage (T parser) T
-> Partial (Fragile (T parser)) T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (T -> Exceptional UserMessage T
forall a e. a -> Exceptional e a
Async.pure (T -> Exceptional UserMessage T)
-> (T -> T) -> T -> Exceptional UserMessage T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T
Channel) (ExceptionalT UserMessage (T parser) T
-> Partial (Fragile (T parser)) T)
-> ExceptionalT UserMessage (T parser) T
-> Partial (Fragile (T parser)) T
forall a b. (a -> b) -> a -> b
$ Int -> ExceptionalT UserMessage (T parser) T
forall (parser :: * -> *). C parser => Int -> Fragile (T parser) T
Channel.getWithStatus Int
code
maybeFromByteString :: B.ByteString -> Report.T T
maybeFromByteString :: ByteString -> T T
maybeFromByteString =
Fragile T T -> ByteString -> T T
forall a. Fragile T a -> ByteString -> T a
ParserByteString.run Fragile T T
forall (parser :: * -> *). C parser => Fragile parser T
get
put :: Writer.C writer => T -> writer
put :: T -> writer
put T
msg =
case T
msg of
Channel T
s -> T -> writer
forall writer. C writer => T -> writer
Channel.put T
s
System T
s -> T -> writer
forall writer. C writer => T -> writer
System.put T
s
putWithStatus ::
(StatusWriter.Compression compress, Writer.C writer) =>
T -> StatusWriter.T compress writer
putWithStatus :: T -> T compress writer
putWithStatus T
msg =
case T
msg of
Channel T
s -> T -> T compress writer
forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
Channel.putWithStatus T
s
System T
s -> T compress writer
forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer
StatusWriter.clear T compress writer -> T compress writer -> T compress writer
forall m. Monoid m => m -> m -> m
+#+ writer -> T compress writer
forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift (T -> writer
forall writer. C writer => T -> writer
System.put T
s)
toByteString :: T -> B.ByteString
toByteString :: T -> ByteString
toByteString =
ByteString -> ByteString
Writer.runByteString (ByteString -> ByteString) -> (T -> ByteString) -> T -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> ByteString
forall writer. C writer => T -> writer
put