{- | Base-level decode function for Osc packets.
  For ordinary use see 'Sound.Osc.Coding.Decode.Binary'.
-}
module Sound.Osc.Coding.Decode.Base (
  decodeMessage,
  decodeBundle,
  decodePacket,
) where

import Data.Binary {- base -}
import qualified Data.ByteString.Char8 as C {- bytestring -}
import qualified Data.ByteString.Lazy as B {- bytestring -}
import Data.List {- base -}
import Data.Maybe {- base -}

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

-- | The plain byte count of an Osc value.
size :: DatumType -> B.ByteString -> Int
size :: DatumType -> ByteString -> Int
size DatumType
ty ByteString
b =
  case DatumType
ty of
    DatumType
'i' -> Int
4 -- Int32
    DatumType
'f' -> Int
4 -- Float
    DatumType
'd' -> Int
8 -- Double
    DatumType
't' -> Int
8 -- Time (NTP)
    DatumType
'm' -> Int
4 -- MIDI
    DatumType
's' ->
      Int64 -> Int
int64_to_int
        ( Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe
            ([DatumType] -> Int64
forall a. HasCallStack => [DatumType] -> a
error ([DatumType]
"size: no terminating zero: " [DatumType] -> [DatumType] -> [DatumType]
forall a. [a] -> [a] -> [a]
++ ByteString -> [DatumType]
forall a. Show a => a -> [DatumType]
show ByteString
b))
            (Word8 -> ByteString -> Maybe Int64
B.elemIndex Word8
0 ByteString
b)
        )
    DatumType
'b' -> ByteString -> Int
decode_i32 (Int64 -> ByteString -> ByteString
B.take Int64
4 ByteString
b)
    DatumType
_ -> [DatumType] -> Int
forall a. HasCallStack => [DatumType] -> a
error [DatumType]
"size: illegal type"

-- | The storage byte count (aligned) of an Osc value.
storage :: DatumType -> B.ByteString -> Int
storage :: DatumType -> ByteString -> Int
storage DatumType
ty ByteString
b =
  case DatumType
ty of
    DatumType
's' -> let n :: Int
n = DatumType -> ByteString -> Int
size DatumType
's' ByteString
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 in Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall i. (Num i, Bits i) => i -> i
align Int
n
    DatumType
'b' -> let n :: Int
n = DatumType -> ByteString -> Int
size DatumType
'b' ByteString
b in Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall i. (Num i, Bits i) => i -> i
align Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
    DatumType
_ -> DatumType -> ByteString -> Int
size DatumType
ty ByteString
B.empty

-- | Decode an Osc datum
decode_datum :: DatumType -> B.ByteString -> Datum
decode_datum :: DatumType -> ByteString -> Datum
decode_datum DatumType
ty ByteString
b =
  case DatumType
ty of
    DatumType
'i' -> Int32 -> Datum
Int32 (ByteString -> Int32
forall a. Binary a => ByteString -> a
decode ByteString
b)
    DatumType
'h' -> Int64 -> Datum
Int64 (ByteString -> Int64
forall a. Binary a => ByteString -> a
decode ByteString
b)
    DatumType
'f' -> Float -> Datum
Float (ByteString -> Float
decode_f32 ByteString
b)
    DatumType
'd' -> Double -> Datum
Double (ByteString -> Double
decode_f64 ByteString
b)
    DatumType
's' -> Ascii -> Datum
AsciiString (ByteString -> Ascii
decode_ascii (Int -> ByteString -> ByteString
b_take (DatumType -> ByteString -> Int
size DatumType
's' ByteString
b) ByteString
b))
    DatumType
'b' -> ByteString -> Datum
Blob (Int -> ByteString -> ByteString
b_take (DatumType -> ByteString -> Int
size DatumType
'b' ByteString
b) (Int64 -> ByteString -> ByteString
B.drop Int64
4 ByteString
b))
    DatumType
't' -> Double -> Datum
TimeStamp (Ntp64 -> Double
ntpi_to_ntpr (ByteString -> Ntp64
decode_word64 ByteString
b))
    DatumType
'm' ->
      case ByteString -> [Word8]
B.unpack (Int64 -> ByteString -> ByteString
B.take Int64
4 ByteString
b) of
        [Word8
b0, Word8
b1, Word8
b2, Word8
b3] -> (Word8, Word8, Word8, Word8) -> Datum
midi (Word8
b0, Word8
b1, Word8
b2, Word8
b3)
        [Word8]
_ -> [DatumType] -> Datum
forall a. HasCallStack => [DatumType] -> a
error [DatumType]
"decode_datum: illegal midi data"
    DatumType
_ -> [DatumType] -> Datum
forall a. HasCallStack => [DatumType] -> a
error ([DatumType]
"decode_datum: illegal type (" [DatumType] -> [DatumType] -> [DatumType]
forall a. [a] -> [a] -> [a]
++ [DatumType
ty] [DatumType] -> [DatumType] -> [DatumType]
forall a. [a] -> [a] -> [a]
++ [DatumType]
")")

-- | Decode a sequence of Osc datum given a type descriptor string.
decode_datum_seq :: Ascii -> B.ByteString -> [Datum]
decode_datum_seq :: Ascii -> ByteString -> [Datum]
decode_datum_seq Ascii
cs ByteString
b =
  let swap :: (b, a) -> (a, b)
swap (b
x, a
y) = (a
y, b
x)
      cs' :: [DatumType]
cs' = Ascii -> [DatumType]
C.unpack Ascii
cs
      f :: ByteString -> DatumType -> (ByteString, ByteString)
f ByteString
b' DatumType
c = (ByteString, ByteString) -> (ByteString, ByteString)
forall {b} {a}. (b, a) -> (a, b)
swap (Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt (Int -> Int64
int_to_int64 (DatumType -> ByteString -> Int
storage DatumType
c ByteString
b')) ByteString
b')
  in (DatumType -> ByteString -> Datum)
-> [DatumType] -> [ByteString] -> [Datum]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith DatumType -> ByteString -> Datum
decode_datum [DatumType]
cs' ((ByteString, [ByteString]) -> [ByteString]
forall a b. (a, b) -> b
snd ((ByteString -> DatumType -> (ByteString, ByteString))
-> ByteString -> [DatumType] -> (ByteString, [ByteString])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL ByteString -> DatumType -> (ByteString, ByteString)
f ByteString
b [DatumType]
cs'))

-- | Decode an Osc 'Message'.
decodeMessage :: B.ByteString -> Message
decodeMessage :: ByteString -> Message
decodeMessage ByteString
b =
  let n :: Int
n = DatumType -> ByteString -> Int
storage DatumType
's' ByteString
b
      cmd :: Datum
cmd = DatumType -> ByteString -> Datum
decode_datum DatumType
's' ByteString
b
      m :: Int
m = DatumType -> ByteString -> Int
storage DatumType
's' (Int -> ByteString -> ByteString
b_drop Int
n ByteString
b)
  in case (Datum
cmd, DatumType -> ByteString -> Datum
decode_datum DatumType
's' (Int -> ByteString -> ByteString
b_drop Int
n ByteString
b)) of
      (AsciiString Ascii
cmd', AsciiString Ascii
dsc) ->
        let arg :: [Datum]
arg = Ascii -> ByteString -> [Datum]
decode_datum_seq (Ascii -> Ascii
descriptor_tags Ascii
dsc) (Int -> ByteString -> ByteString
b_drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m) ByteString
b)
        in [DatumType] -> [Datum] -> Message
Message (Ascii -> [DatumType]
C.unpack Ascii
cmd') [Datum]
arg
      (Datum, Datum)
_ -> [DatumType] -> Message
forall a. HasCallStack => [DatumType] -> a
error [DatumType]
"decodeMessage"

-- | Decode a sequence of length prefixed (Int32) Osc messages.
decode_message_seq :: B.ByteString -> [Message]
decode_message_seq :: ByteString -> [Message]
decode_message_seq ByteString
b =
  let s :: Int
s = ByteString -> Int
decode_i32 ByteString
b
      m :: Message
m = ByteString -> Message
decodeMessage (Int -> ByteString -> ByteString
b_drop Int
4 ByteString
b)
      nxt :: [Message]
nxt = ByteString -> [Message]
decode_message_seq (Int -> ByteString -> ByteString
b_drop (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) ByteString
b)
  in if ByteString -> Int64
B.length ByteString
b Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then [] else Message
m Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: [Message]
nxt

-- | Decode an Osc 'Bundle'.
decodeBundle :: B.ByteString -> BundleOf Message
decodeBundle :: ByteString -> BundleOf Message
decodeBundle ByteString
b =
  let h :: Int
h = DatumType -> ByteString -> Int
storage DatumType
's' ByteString
b -- header (should be '#bundle')
      t :: Int
t = DatumType -> ByteString -> Int
storage DatumType
't' (Int -> ByteString -> ByteString
b_drop Int
h ByteString
b) -- time
  in case DatumType -> ByteString -> Datum
decode_datum DatumType
't' (Int -> ByteString -> ByteString
b_drop Int
h ByteString
b) of
      TimeStamp Double
timeStamp -> Double -> [Message] -> BundleOf Message
forall t. Double -> [t] -> BundleOf t
Bundle Double
timeStamp (ByteString -> [Message]
decode_message_seq (Int -> ByteString -> ByteString
b_drop (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t) ByteString
b))
      Datum
_ -> [DatumType] -> BundleOf Message
forall a. HasCallStack => [DatumType] -> a
error [DatumType]
"decodeBundle"

{- | Decode an Osc 'Packet'.

>>> let b = B.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 :: B.ByteString -> PacketOf Message
decodePacket :: ByteString -> PacketOf Message
decodePacket ByteString
b =
  if ByteString
bundleHeader ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
b
    then BundleOf Message -> PacketOf Message
forall t. BundleOf t -> PacketOf t
Packet_Bundle (ByteString -> BundleOf Message
decodeBundle ByteString
b)
    else Message -> PacketOf Message
forall t. Message -> PacketOf t
Packet_Message (ByteString -> Message
decodeMessage ByteString
b)

-- * Util

-- | 'B.take' with 'Int' count.
b_take :: Int -> B.ByteString -> B.ByteString
b_take :: Int -> ByteString -> ByteString
b_take = Int64 -> ByteString -> ByteString
B.take (Int64 -> ByteString -> ByteString)
-> (Int -> Int64) -> Int -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
int_to_int64

-- | 'B.drop' with 'Int' count.
b_drop :: Int -> B.ByteString -> B.ByteString
b_drop :: Int -> ByteString -> ByteString
b_drop = Int64 -> ByteString -> ByteString
B.drop (Int64 -> ByteString -> ByteString)
-> (Int -> Int64) -> Int -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
int_to_int64