{- |
System messages
-}
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