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

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

import qualified Data.Binary.Get as Binary {- binary -}

import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}
import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}
import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8 {- bytestring -}

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

-- | Get an aligned Osc string.
get_string :: Binary.Get String
get_string :: Get String
get_string = do
  s <- Get ByteString
Binary.getLazyByteStringNul
  Binary.skip (Convert.int64_to_int (Byte.align (ByteString.Lazy.length s + 1)))
  return (ByteString.Lazy.Char8.unpack s)

-- | Get an aligned Osc string.
get_ascii :: Binary.Get Ascii
get_ascii :: Get ByteString
get_ascii = do
  s <- Get ByteString
Binary.getLazyByteStringNul
  Binary.skip (Convert.int64_to_int (Byte.align (ByteString.Lazy.length s + 1)))
  return (ByteString.Char8.pack (ByteString.Lazy.Char8.unpack 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
  b <- Int64 -> Get ByteString
Binary.getLazyByteString (Word32 -> Int64
Convert.word32_to_int64 Word32
n)
  if n /= Convert.int64_to_word32 (ByteString.Lazy.length b)
    then fail "get_bytes: end of stream"
    else Binary.skip (Convert.word32_to_int (Byte.align n))
  return 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' -> (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
Binary.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
Binary.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
Binary.getFloatbe
    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
Binary.getDoublebe
    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' -> (Ntp64 -> Datum) -> Get Ntp64 -> 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) -> (Ntp64 -> Double) -> Ntp64 -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ntp64 -> Double
Time.ntpi_to_ntpr) Get Ntp64
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 an Osc 'Message', fail if type descriptor is invalid.
get_message :: Binary.Get Message
get_message :: Get Message
get_message = do
  cmd <- Get String
get_string
  dsc <- get_ascii
  case ByteString.Char8.unpack dsc of
    DatumType
',' : String
tags -> do
      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
      return (Message cmd 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 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
  b <- Get Bool
Binary.isEmpty
  if b
    then return []
    else do
      p <- flip Binary.isolate get_message . Convert.word32_to_int =<< Binary.getWord32be
      ps <- get_message_seq
      return (p : ps)

-- | Get a bundle. Fail if bundle header is not found in packet.
get_bundle :: Binary.Get (BundleOf Message)
get_bundle :: Get (BundleOf Message)
get_bundle = do
  h <- Int -> Get ByteString
Binary.getByteString (ByteString -> Int
ByteString.Char8.length ByteString
Byte.bundleHeader_strict)
  when (h /= Byte.bundleHeader_strict) (fail "get_bundle: not a bundle")
  t <- fmap Time.ntpi_to_ntpr Binary.getWord64be
  fmap (Bundle t) get_message_seq

-- | Get an Osc 'Packet'.
get_packet :: Binary.Get (PacketOf Message)
get_packet :: Get (PacketOf Message)
get_packet = (BundleOf Message -> PacketOf Message)
-> Get (BundleOf Message) -> Get (PacketOf Message)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BundleOf Message -> PacketOf Message
forall t. BundleOf t -> PacketOf t
Packet_Bundle Get (BundleOf Message)
get_bundle Get (PacketOf Message)
-> Get (PacketOf Message) -> Get (PacketOf Message)
forall a. Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Message -> PacketOf Message)
-> Get Message -> Get (PacketOf Message)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> PacketOf Message
forall t. Message -> PacketOf t
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]
True
-}
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

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

-- | Run decoder and report any error.
runDecoder :: Binary.Get t -> ByteString.Lazy.Char8.ByteString -> Either String t
runDecoder :: forall t. Get t -> ByteString -> Either String t
runDecoder Get t
f ByteString
p =
  case Get t
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, t)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
Binary.runGetOrFail Get t
f ByteString
p of
    Left (ByteString
_, Int64
_, String
err) -> String -> Either String t
forall a b. a -> Either a b
Left String
err
    Right (ByteString
_, Int64
_, t
decoded) -> t -> Either String t
forall a b. b -> Either a b
Right t
decoded

{- | 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])
True
-}
decodePacket :: ByteString.Lazy.ByteString -> PacketOf Message
decodePacket :: ByteString -> PacketOf Message
decodePacket = Get (PacketOf Message) -> ByteString -> PacketOf Message
forall a. Get a -> ByteString -> a
Binary.runGet Get (PacketOf Message)
get_packet

-- | Decode an Osc packet from a strict Char8 ByteString.
decodePacket_strict :: ByteString.Char8.ByteString -> PacketOf Message
decodePacket_strict :: ByteString -> PacketOf Message
decodePacket_strict = Get (PacketOf Message) -> ByteString -> PacketOf Message
forall a. Get a -> ByteString -> a
Binary.runGet Get (PacketOf Message)
get_packet (ByteString -> PacketOf Message)
-> (ByteString -> ByteString) -> ByteString -> PacketOf Message
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]
: [])

{- | Either decode Osc message or return an error message.
Prevents application halt for non-valid message/bundle/packet arrives.

>>> let b = ByteString.Lazy.pack [1,2,3,2,1]
>>> decodePacketOr b
Left "not enough bytes"
-}
decodeMessageOr :: ByteString.Lazy.ByteString -> Either String Message
decodeMessageOr :: ByteString -> Either String Message
decodeMessageOr = Get Message -> ByteString -> Either String Message
forall t. Get t -> ByteString -> Either String t
runDecoder Get Message
get_message

decodeBundleOr :: ByteString.Lazy.ByteString -> Either String Bundle
decodeBundleOr :: ByteString -> Either String (BundleOf Message)
decodeBundleOr = Get (BundleOf Message)
-> ByteString -> Either String (BundleOf Message)
forall t. Get t -> ByteString -> Either String t
runDecoder Get (BundleOf Message)
get_bundle

decodePacketOr :: ByteString.Lazy.ByteString -> Either String Packet
decodePacketOr :: ByteString -> Either String (PacketOf Message)
decodePacketOr = Get (PacketOf Message)
-> ByteString -> Either String (PacketOf Message)
forall t. Get t -> ByteString -> Either String t
runDecoder Get (PacketOf Message)
get_packet