-- | Optimised decode function for Osc packets.
module Sound.Osc.Coding.Decode.Binary
    (get_packet
    ,decodeMessage
    ,decodeBundle
    ,decodePacket
    ,decodePacket_strict) where

import Control.Applicative {- base -}
import Control.Monad {- base -}
import Data.Int {- base -}
import Data.Word {- base -}

import qualified Data.Binary.Get as Binary {- binary -}
import qualified Data.Binary.IEEE754 as Ieee {- data-binary-ieee754 -}
import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}
import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}
import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8 {- bytestring -}

import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}
import Sound.Osc.Coding.Convert {- hosc -}
import Sound.Osc.Datum {- hosc -}
import Sound.Osc.Packet {- hosc -}
import qualified Sound.Osc.Time as Time {- hosc -}

-- | Get a 32 bit integer in big-endian byte order.
getInt32be :: Binary.Get Int32
getInt32be :: Get Int32
getInt32be = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int32
word32_to_int32 Get Word32
Binary.getWord32be

-- | Get a 64 bit integer in big-endian byte order.
getInt64be :: Binary.Get Int64
getInt64be :: Get Int64
getInt64be = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int64
word64_to_int64 Get Word64
Binary.getWord64be

-- | Get an aligned Osc string.
get_string :: Binary.Get String
get_string :: Get String
get_string = do
    ByteString
s <- Get ByteString
Binary.getLazyByteStringNul
    Int -> Get ()
Binary.skip (Int64 -> Int
int64_to_int (forall i. (Num i, Bits i) => i -> i
Byte.align (ByteString -> Int64
ByteString.Lazy.length ByteString
s forall a. Num a => a -> a -> a
+ Int64
1)))
    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> String
ByteString.Lazy.Char8.unpack ByteString
s)

-- | Get an aligned Osc string.
get_ascii :: Binary.Get Ascii
get_ascii :: Get ByteString
get_ascii = do
    ByteString
s <- Get ByteString
Binary.getLazyByteStringNul
    Int -> Get ()
Binary.skip (Int64 -> Int
int64_to_int (forall i. (Num i, Bits i) => i -> i
Byte.align (ByteString -> Int64
ByteString.Lazy.length ByteString
s forall a. Num a => a -> a -> a
+ Int64
1)))
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ByteString
ByteString.Char8.pack (ByteString -> String
ByteString.Lazy.Char8.unpack ByteString
s))

-- | Get binary data prefixed by byte count.
get_bytes :: Word32 -> Binary.Get ByteString.Lazy.ByteString
get_bytes :: Word32 -> Get ByteString
get_bytes Word32
n = do
    ByteString
b <- Int64 -> Get ByteString
Binary.getLazyByteString (Word32 -> Int64
word32_to_int64 Word32
n)
    if Word32
n forall a. Eq a => a -> a -> Bool
/= Int64 -> Word32
int64_to_word32 (ByteString -> Int64
ByteString.Lazy.length ByteString
b)
        then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"get_bytes: end of stream"
        else Int -> Get ()
Binary.skip (Word32 -> Int
word32_to_int (forall i. (Num i, Bits i) => i -> i
Byte.align Word32
n))
    forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b

-- | Get an Osc datum.
get_datum :: DatumType -> Binary.Get Datum
get_datum :: DatumType -> Get Datum
get_datum DatumType
ty =
    case DatumType
ty of
      DatumType
'i' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Datum
Int32 Get Int32
getInt32be
      DatumType
'h' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Datum
Int64 Get Int64
getInt64be
      DatumType
'f' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Datum
Float Get Float
Ieee.getFloat32be
      DatumType
'd' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Datum
Double Get Double
Ieee.getFloat64be
      DatumType
's' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Datum
AsciiString Get ByteString
get_ascii
      DatumType
'b' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Datum
Blob (Word32 -> Get ByteString
get_bytes forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word32
Binary.getWord32be)
      DatumType
't' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Datum
TimeStamp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
Time.ntpi_to_ntpr) Get Word64
Binary.getWord64be
      DatumType
'm' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MidiData -> Datum
Midi (forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 Word8 -> Word8 -> Word8 -> Word8 -> MidiData
MidiData Get Word8
Binary.getWord8 Get Word8
Binary.getWord8 Get Word8
Binary.getWord8 Get Word8
Binary.getWord8)
      DatumType
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"get_datum: illegal type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DatumType
ty)

-- | Get an Osc 'Message', fail if type descriptor is invalid.
get_message :: Binary.Get Message
get_message :: Get Message
get_message = do
    String
cmd <- Get String
get_string
    ByteString
dsc <- Get ByteString
get_ascii
    case ByteString -> String
ByteString.Char8.unpack ByteString
dsc of
        DatumType
',':String
tags -> do
            [Datum]
arg <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DatumType -> Get Datum
get_datum String
tags
            forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [Datum] -> Message
Message String
cmd [Datum]
arg)
        String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"get_message: invalid type descriptor string: " forall a. [a] -> [a] -> [a]
++ String
e)

-- | Get a sequence of Osc 'Message's, each one headed by its length.
get_message_seq :: Binary.Get [Message]
get_message_seq :: Get [Message]
get_message_seq = do
    Bool
b <- Get Bool
Binary.isEmpty
    if Bool
b
        then forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do
            Message
p <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> Get a -> Get a
Binary.isolate Get Message
get_message forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
word32_to_int forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word32
Binary.getWord32be
            [Message]
ps <- Get [Message]
get_message_seq
            forall (m :: * -> *) a. Monad m => a -> m a
return (Message
pforall a. a -> [a] -> [a]
:[Message]
ps)

-- | Get a bundle. Fail if bundle header is not found in packet.
get_bundle :: Binary.Get Bundle
get_bundle :: Get Bundle
get_bundle = do
    ByteString
h <- Int -> Get ByteString
Binary.getByteString (ByteString -> Int
ByteString.Char8.length ByteString
Byte.bundleHeader_strict)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
h forall a. Eq a => a -> a -> Bool
/= ByteString
Byte.bundleHeader_strict) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"get_bundle: not a bundle")
    Double
t <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Double
Time.ntpi_to_ntpr Get Word64
Binary.getWord64be
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> [Message] -> Bundle
Bundle Double
t) Get [Message]
get_message_seq

-- | Get an Osc 'Packet'.
get_packet :: Binary.Get Packet
get_packet :: Get Packet
get_packet = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bundle -> Packet
Packet_Bundle Get Bundle
get_bundle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> Packet
Packet_Message Get Message
get_message

{-# INLINE decodeMessage #-}
{-# INLINE decodeBundle #-}
{-# INLINE decodePacket #-}
{-# INLINE decodePacket_strict #-}

{- | Decode an Osc 'Message' from a lazy ByteString.

> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]
> decodeMessage b == Message "/g_free" [Int32 0]
-}
decodeMessage :: ByteString.Lazy.ByteString -> Message
decodeMessage :: ByteString -> Message
decodeMessage = forall a. Get a -> ByteString -> a
Binary.runGet Get Message
get_message

-- | Decode an Osc 'Bundle' from a lazy ByteString.
decodeBundle :: ByteString.Lazy.ByteString -> Bundle
decodeBundle :: ByteString -> Bundle
decodeBundle = forall a. Get a -> ByteString -> a
Binary.runGet Get Bundle
get_bundle

{- | Decode an Osc packet from a lazy ByteString.

> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]
> decodePacket b == Packet_Message (Message "/g_free" [Int32 0])
-}
decodePacket :: ByteString.Lazy.ByteString -> Packet
decodePacket :: ByteString -> Packet
decodePacket = forall a. Get a -> ByteString -> a
Binary.runGet Get Packet
get_packet

-- | Decode an Osc packet from a strict Char8 ByteString.
decodePacket_strict :: ByteString.Char8.ByteString -> Packet
decodePacket_strict :: ByteString -> Packet
decodePacket_strict = forall a. Get a -> ByteString -> a
Binary.runGet Get Packet
get_packet forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
ByteString.Lazy.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])