{- |
System Exclusive messages
-}
module Sound.MIDI.Message.System.Exclusive (
   T(..), get, getIncomplete, put,
   ) where

import qualified Sound.MIDI.Manufacturer as Manufacturer
import Sound.MIDI.IO (ByteList)

import           Sound.MIDI.Parser.Primitive
import           Sound.MIDI.Parser.Class (PossiblyIncomplete, )
import qualified Sound.MIDI.Parser.Class as Parser

import qualified Sound.MIDI.Writer.Basic as Writer

-- import Control.Monad (liftM, liftM2, when, )

import Data.Maybe (fromMaybe, )


data T =
     Commercial    Manufacturer.T ByteList
   | NonCommercial ByteList
   | NonRealTime   NonRealTime
   | RealTime      RealTime


-- * Non-real time

{-# DEPRECATED NonRealTime "structure must be defined, yet" #-}
newtype NonRealTime = NonRealTimeCons ByteList

-- * Real time

{-# DEPRECATED RealTime "structure must be defined, yet" #-}
newtype RealTime = RealTimeCons ByteList


-- * serialization

get :: Parser.C parser => parser T
get =
   do (err, sysex) <- getIncomplete
      maybe (return sysex) Parser.giveUp err

getIncomplete :: Parser.C parser => parser (PossiblyIncomplete T)
getIncomplete =
   do manu <- Manufacturer.get
      (err, body) <- Parser.until (0xf7 ==) getByte
      return $ ((,) err) $
        fromMaybe (Commercial manu body) $
        lookup manu $
           (Manufacturer.nonCommercial, NonCommercial body) :
           (Manufacturer.nonRealTime,   NonRealTime $ NonRealTimeCons body) :
           (Manufacturer.realTime,      RealTime    $ RealTimeCons body) :
           []

{- |
It is not checked whether SysEx messages contain only 7-bit values.
-}
put :: Writer.C writer => T -> writer ()
put sysex =
   case sysex of
      Commercial manu body ->
         Manufacturer.put manu >>
         Writer.putByteList body
      NonCommercial body ->
         Manufacturer.put Manufacturer.nonCommercial >>
         Writer.putByteList body
      NonRealTime (NonRealTimeCons body) ->
         Manufacturer.put Manufacturer.nonRealTime >>
         Writer.putByteList body
      RealTime (RealTimeCons body) ->
         Manufacturer.put Manufacturer.realTime >>
         Writer.putByteList body