module Sound.Osc.Coding.Decode.Binary
(get_packet
,decodeMessage
,decodeBundle
,decodePacket
,decodePacket_strict) where
import Control.Applicative
import Control.Monad
import Data.Int
import Data.Word
import qualified Data.Binary.Get as Binary
import qualified Data.Binary.IEEE754 as Ieee
import qualified Data.ByteString.Lazy as ByteString.Lazy
import qualified Data.ByteString.Char8 as ByteString.Char8
import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8
import qualified Sound.Osc.Coding.Byte as Byte
import Sound.Osc.Coding.Convert
import Sound.Osc.Datum
import Sound.Osc.Packet
import qualified Sound.Osc.Time as Time
getInt32be :: Binary.Get Int32
getInt32be :: Get Int32
getInt32be = (Word32 -> Int32) -> Get Word32 -> Get Int32
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int32
word32_to_int32 Get Word32
Binary.getWord32be
getInt64be :: Binary.Get Int64
getInt64be :: Get Int64
getInt64be = (Word64 -> Int64) -> Get Word64 -> Get Int64
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int64
word64_to_int64 Get Word64
Binary.getWord64be
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 (Int64 -> Int64
forall i. (Num i, Bits i) => i -> i
Byte.align (ByteString -> Int64
ByteString.Lazy.length ByteString
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)))
String -> Get String
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> String
ByteString.Lazy.Char8.unpack ByteString
s)
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 (Int64 -> Int64
forall i. (Num i, Bits i) => i -> i
Byte.align (ByteString -> Int64
ByteString.Lazy.length ByteString
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)))
ByteString -> Get ByteString
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ByteString
ByteString.Char8.pack (ByteString -> String
ByteString.Lazy.Char8.unpack ByteString
s))
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 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64 -> Word32
int64_to_word32 (ByteString -> Int64
ByteString.Lazy.length ByteString
b)
then String -> Get ()
forall a. String -> Get a
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 (Word32 -> Word32
forall i. (Num i, Bits i) => i -> i
Byte.align Word32
n))
ByteString -> Get ByteString
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
get_datum :: DatumType -> Binary.Get Datum
get_datum :: DatumType -> Get Datum
get_datum DatumType
ty =
case DatumType
ty of
DatumType
'i' -> (Int32 -> Datum) -> Get Int32 -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Datum
Int32 Get Int32
getInt32be
DatumType
'h' -> (Int64 -> Datum) -> Get Int64 -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Datum
Int64 Get Int64
getInt64be
DatumType
'f' -> (Float -> Datum) -> Get Float -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Datum
Float Get Float
Ieee.getFloat32be
DatumType
'd' -> (Double -> Datum) -> Get Double -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Datum
Double Get Double
Ieee.getFloat64be
DatumType
's' -> (ByteString -> Datum) -> Get ByteString -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Datum
AsciiString Get ByteString
get_ascii
DatumType
'b' -> (ByteString -> Datum) -> Get ByteString -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Datum
Blob (Word32 -> Get ByteString
get_bytes (Word32 -> Get ByteString) -> Get Word32 -> Get ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word32
Binary.getWord32be)
DatumType
't' -> (Word64 -> Datum) -> Get Word64 -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Datum
TimeStamp (Double -> Datum) -> (Word64 -> Double) -> Word64 -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
Time.ntpi_to_ntpr) Get Word64
Binary.getWord64be
DatumType
'm' -> (MidiData -> Datum) -> Get MidiData -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MidiData -> Datum
Midi ((Word8 -> Word8 -> Word8 -> Word8 -> MidiData)
-> Get Word8 -> Get Word8 -> Get Word8 -> Get Word8 -> Get MidiData
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
_ -> String -> Get Datum
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"get_datum: illegal type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DatumType -> String
forall a. Show a => a -> String
show DatumType
ty)
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 <- (DatumType -> Get Datum) -> String -> Get [Datum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DatumType -> Get Datum
get_datum String
tags
Message -> Get Message
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [Datum] -> Message
Message String
cmd [Datum]
arg)
String
e -> String -> Get Message
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"get_message: invalid type descriptor string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e)
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 [Message] -> Get [Message]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
Message
p <- (Int -> Get Message -> Get Message)
-> Get Message -> Int -> Get Message
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Get Message -> Get Message
forall a. Int -> Get a -> Get a
Binary.isolate Get Message
get_message (Int -> Get Message) -> (Word32 -> Int) -> Word32 -> Get Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
word32_to_int (Word32 -> Get Message) -> Get Word32 -> Get Message
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word32
Binary.getWord32be
[Message]
ps <- Get [Message]
get_message_seq
[Message] -> Get [Message]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message
pMessage -> [Message] -> [Message]
forall a. a -> [a] -> [a]
:[Message]
ps)
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)
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
h ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
Byte.bundleHeader_strict) (String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"get_bundle: not a bundle")
Double
t <- (Word64 -> Double) -> Get Word64 -> Get Double
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Double
Time.ntpi_to_ntpr Get Word64
Binary.getWord64be
([Message] -> Bundle) -> Get [Message] -> Get Bundle
forall a b. (a -> b) -> Get a -> Get b
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_packet :: Binary.Get Packet
get_packet :: Get Packet
get_packet = (Bundle -> Packet) -> Get Bundle -> Get Packet
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bundle -> Packet
Packet_Bundle Get Bundle
get_bundle Get Packet -> Get Packet -> Get Packet
forall a. Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Message -> Packet) -> Get Message -> Get Packet
forall a b. (a -> b) -> Get a -> Get b
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 #-}
decodeMessage :: ByteString.Lazy.ByteString -> Message
decodeMessage :: ByteString -> Message
decodeMessage = Get Message -> ByteString -> Message
forall a. Get a -> ByteString -> a
Binary.runGet Get Message
get_message
decodeBundle :: ByteString.Lazy.ByteString -> Bundle
decodeBundle :: ByteString -> Bundle
decodeBundle = Get Bundle -> ByteString -> Bundle
forall a. Get a -> ByteString -> a
Binary.runGet Get Bundle
get_bundle
decodePacket :: ByteString.Lazy.ByteString -> Packet
decodePacket :: ByteString -> Packet
decodePacket = Get Packet -> ByteString -> Packet
forall a. Get a -> ByteString -> a
Binary.runGet Get Packet
get_packet
decodePacket_strict :: ByteString.Char8.ByteString -> Packet
decodePacket_strict :: ByteString -> Packet
decodePacket_strict = Get Packet -> ByteString -> Packet
forall a. Get a -> ByteString -> a
Binary.runGet Get Packet
get_packet (ByteString -> Packet)
-> (ByteString -> ByteString) -> ByteString -> Packet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
ByteString.Lazy.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])