    -- | 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