module Sound.MIDI.Message.System (
T(..), get, getIncomplete, put,
) where
import qualified Sound.MIDI.Message.System.Exclusive as Exclusive
import qualified Sound.MIDI.Message.System.Common as Common
import qualified Sound.MIDI.Message.System.RealTime as RealTime
import qualified Sound.MIDI.Parser.Class as Parser
import qualified Sound.MIDI.Writer.Basic as Writer
import qualified Control.Monad.Exception.Asynchronous as Async
import Control.Monad (liftM, )
data T =
Exclusive Exclusive.T
| Common Common.T
| RealTime RealTime.T
get :: Parser.C parser => Int -> Parser.Fragile parser T
get :: Int -> Fragile parser T
get Int
code =
if Int
code Int -> Int -> Bool
forall a. Eq 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
Exclusive ExceptionalT UserMessage parser T
forall (parser :: * -> *). C parser => Fragile parser T
Exclusive.get
else
if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xF1 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xF6
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
Common (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
Common.get Int
code
else
if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xF8 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFF
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
RealTime (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
RealTime.get Int
code
else UserMessage -> Fragile parser T
forall (m :: * -> *) a. Monad m => UserMessage -> T m a
Parser.giveUp (UserMessage
"invalid System message code " UserMessage -> UserMessage -> UserMessage
forall a. [a] -> [a] -> [a]
++ Int -> UserMessage
forall a. Show a => a -> UserMessage
show Int
code)
getIncomplete :: Parser.C parser => Int -> Parser.Partial (Parser.Fragile parser) T
getIncomplete :: Int -> Partial (Fragile parser) T
getIncomplete Int
code =
if Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xF0
then (Exceptional UserMessage T -> Exceptional UserMessage T)
-> ExceptionalT UserMessage parser (Exceptional UserMessage T)
-> Partial (Fragile 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
Exclusive) ExceptionalT UserMessage parser (Exceptional UserMessage T)
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
Exclusive.getIncomplete
else
if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xF1 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xF6
then (T -> Exceptional UserMessage T)
-> ExceptionalT UserMessage parser T -> Partial (Fragile 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
Common) (ExceptionalT UserMessage parser T -> Partial (Fragile parser) T)
-> ExceptionalT UserMessage parser T -> Partial (Fragile parser) T
forall a b. (a -> b) -> a -> b
$ Int -> ExceptionalT UserMessage parser T
forall (parser :: * -> *). C parser => Int -> Fragile parser T
Common.get Int
code
else
if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xF8 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFF
then (T -> Exceptional UserMessage T)
-> ExceptionalT UserMessage parser T -> Partial (Fragile 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
RealTime) (ExceptionalT UserMessage parser T -> Partial (Fragile parser) T)
-> ExceptionalT UserMessage parser T -> Partial (Fragile parser) T
forall a b. (a -> b) -> a -> b
$ Int -> ExceptionalT UserMessage parser T
forall (parser :: * -> *). C parser => Int -> Fragile parser T
RealTime.get Int
code
else UserMessage -> Partial (Fragile parser) T
forall (m :: * -> *) a. Monad m => UserMessage -> T m a
Parser.giveUp (UserMessage
"invalid System message code " UserMessage -> UserMessage -> UserMessage
forall a. [a] -> [a] -> [a]
++ Int -> UserMessage
forall a. Show a => a -> UserMessage
show Int
code)
put :: Writer.C writer => T -> writer
put :: T -> writer
put T
msg =
case T
msg of
Exclusive T
s -> T -> writer
forall writer. C writer => T -> writer
Exclusive.put T
s
Common T
s -> T -> writer
forall writer. C writer => T -> writer
Common.put T
s
RealTime T
s -> T -> writer
forall writer. C writer => T -> writer
RealTime.put T
s