module Sound.OSC.Coding.Decode.Binary
(get_packet
,decodeMessage
,decodeBundle
,decodePacket
,decodePacket_strict) where
import Control.Applicative
import Control.Monad
import qualified Data.Binary.Get as G
import qualified Data.Binary.IEEE754 as I
import qualified Data.ByteString.Char8 as S.C
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Int
import Data.Word
import qualified Sound.OSC.Coding.Byte as Byte
import Sound.OSC.Datum
import Sound.OSC.Packet
import qualified Sound.OSC.Time as Time
getInt32be :: G.Get Int32
getInt32be :: Get Int32
getInt32be = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
G.getWord32be
getInt64be :: G.Get Int64
getInt64be :: Get Int64
getInt64be = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Get Word64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
G.getWord64be
get_string :: G.Get String
get_string :: Get String
get_string = do
ByteString
s <- Get ByteString
G.getLazyByteStringNul
Int -> Get ()
G.skip (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64
forall i. (Num i, Bits i) => i -> i
Byte.align (ByteString -> Int64
B.length ByteString
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ 1)))
String -> Get String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Get String) -> String -> Get String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
C.unpack ByteString
s
get_ascii :: G.Get ASCII
get_ascii :: Get ASCII
get_ascii = do
ByteString
s <- Get ByteString
G.getLazyByteStringNul
Int -> Get ()
G.skip (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64
forall i. (Num i, Bits i) => i -> i
Byte.align (ByteString -> Int64
B.length ByteString
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ 1)))
ASCII -> Get ASCII
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ASCII
S.C.pack (ByteString -> String
C.unpack ByteString
s))
get_bytes :: Word32 -> G.Get B.ByteString
get_bytes :: Word32 -> Get ByteString
get_bytes n :: Word32
n = do
ByteString
b <- Int64 -> Get ByteString
G.getLazyByteString (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
if Word32
n Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length ByteString
b)
then String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "get_bytes: end of stream"
else Int -> Get ()
G.skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32
forall i. (Num i, Bits i) => i -> i
Byte.align Word32
n))
ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
get_datum :: Datum_Type -> G.Get Datum
get_datum :: Datum_Type -> Get Datum
get_datum ty :: Datum_Type
ty =
case Datum_Type
ty of
'i' -> Int32 -> Datum
Int32 (Int32 -> Datum) -> (Int32 -> Int32) -> Int32 -> Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Datum) -> Get Int32 -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be
'h' -> Int64 -> Datum
Int64 (Int64 -> Datum) -> (Int64 -> Int64) -> Int64 -> Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Datum) -> Get Int64 -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be
'f' -> Float -> Datum
Float (Float -> Datum) -> (Float -> Float) -> Float -> Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> Datum) -> Get Float -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
I.getFloat32be
'd' -> Double -> Datum
Double (Double -> Datum) -> Get Double -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
I.getFloat64be
's' -> ASCII -> Datum
ASCII_String (ASCII -> Datum) -> Get ASCII -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ASCII
get_ascii
'b' -> ByteString -> Datum
Blob (ByteString -> Datum) -> Get ByteString -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
G.getWord32be)
't' -> Double -> Datum
TimeStamp (Double -> Datum) -> (Word64 -> Double) -> Word64 -> Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Double
forall n. Fractional n => Word64 -> n
Time.ntpi_to_ntpr (Word64 -> Datum) -> Get Word64 -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
G.getWord64be
'm' -> do Word8
b0 <- Get Word8
G.getWord8
Word8
b1 <- Get Word8
G.getWord8
Word8
b2 <- Get Word8
G.getWord8
Word8
b3 <- Get Word8
G.getWord8
Datum -> Get Datum
forall (m :: * -> *) a. Monad m => a -> m a
return (Datum -> Get Datum) -> Datum -> Get Datum
forall a b. (a -> b) -> a -> b
$ MIDI -> Datum
Midi (Word8 -> Word8 -> Word8 -> Word8 -> MIDI
MIDI Word8
b0 Word8
b1 Word8
b2 Word8
b3)
_ -> String -> Get Datum
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("get_datum: illegal type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Datum_Type -> String
forall a. Show a => a -> String
show Datum_Type
ty)
get_message :: G.Get Message
get_message :: Get Message
get_message = do
String
cmd <- Get String
get_string
ASCII
dsc <- Get ASCII
get_ascii
case ASCII -> String
S.C.unpack ASCII
dsc of
',':tags :: String
tags -> do
[Datum]
arg <- (Datum_Type -> Get Datum) -> String -> Get [Datum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Datum_Type -> Get Datum
get_datum String
tags
Message -> Get Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Get Message) -> Message -> Get Message
forall a b. (a -> b) -> a -> b
$ String -> [Datum] -> Message
Message String
cmd [Datum]
arg
_ -> String -> Get Message
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "get_message: invalid type descriptor string"
get_message_seq :: G.Get [Message]
get_message_seq :: Get [Message]
get_message_seq = do
Bool
b <- Get Bool
G.isEmpty
if Bool
b
then [Message] -> Get [Message]
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
G.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
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Get Message) -> Get Word32 -> Get Message
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word32
G.getWord32be
[Message]
ps <- Get [Message]
get_message_seq
[Message] -> Get [Message]
forall (m :: * -> *) a. Monad m => a -> m a
return (Message
pMessage -> [Message] -> [Message]
forall a. a -> [a] -> [a]
:[Message]
ps)
get_bundle :: G.Get Bundle
get_bundle :: Get Bundle
get_bundle = do
ASCII
h <- Int -> Get ASCII
G.getByteString (ASCII -> Int
S.C.length ASCII
Byte.bundleHeader_strict)
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ASCII
h ASCII -> ASCII -> Bool
forall a. Eq a => a -> a -> Bool
/= ASCII
Byte.bundleHeader_strict) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "get_bundle: not a bundle")
Double
t <- Word64 -> Double
forall n. Fractional n => Word64 -> n
Time.ntpi_to_ntpr (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
G.getWord64be
[Message]
ps <- Get [Message]
get_message_seq
Bundle -> Get Bundle
forall (m :: * -> *) a. Monad m => a -> m a
return (Bundle -> Get Bundle) -> Bundle -> Get Bundle
forall a b. (a -> b) -> a -> b
$ Double -> [Message] -> Bundle
Bundle Double
t [Message]
ps
get_packet :: G.Get Packet
get_packet :: Get Packet
get_packet = (Bundle -> Packet
Packet_Bundle (Bundle -> Packet) -> Get Bundle -> Get Packet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bundle
get_bundle) Get Packet -> Get Packet -> Get Packet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Message -> Packet
Packet_Message (Message -> Packet) -> Get Message -> Get Packet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Message
get_message)
{-# INLINE decodeMessage #-}
{-# INLINE decodeBundle #-}
{-# INLINE decodePacket #-}
{-# INLINE decodePacket_strict #-}
decodeMessage :: B.ByteString -> Message
decodeMessage :: ByteString -> Message
decodeMessage = Get Message -> ByteString -> Message
forall a. Get a -> ByteString -> a
G.runGet Get Message
get_message
decodeBundle :: B.ByteString -> Bundle
decodeBundle :: ByteString -> Bundle
decodeBundle = Get Bundle -> ByteString -> Bundle
forall a. Get a -> ByteString -> a
G.runGet Get Bundle
get_bundle
decodePacket :: B.ByteString -> Packet
decodePacket :: ByteString -> Packet
decodePacket = Get Packet -> ByteString -> Packet
forall a. Get a -> ByteString -> a
G.runGet Get Packet
get_packet
decodePacket_strict :: S.C.ByteString -> Packet
decodePacket_strict :: ASCII -> Packet
decodePacket_strict = Get Packet -> ByteString -> Packet
forall a. Get a -> ByteString -> a
G.runGet Get Packet
get_packet (ByteString -> Packet) -> (ASCII -> ByteString) -> ASCII -> Packet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ASCII] -> ByteString
B.fromChunks ([ASCII] -> ByteString)
-> (ASCII -> [ASCII]) -> ASCII -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASCII -> [ASCII] -> [ASCII]
forall a. a -> [a] -> [a]
:[])