{- |
MIDI messages for real-time communication with MIDI devices.
This does not cover MIDI file events.
For these refer to "Sound.MIDI.File.Event".
-}
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
-- Show instance requires Show instance of System.T
--     deriving (Show)


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)
--     else liftM Channel $ StatusParser.run (Channel.getWithStatus code)

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