-- | 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 (forall a. a -> Maybe a -> a
fromMaybe
                           (forall a. HasCallStack => [DatumType] -> a
error ([DatumType]
"size: no terminating zero: " forall a. [a] -> [a] -> [a]
++ 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
_ -> 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 forall a. Num a => a -> a -> a
+ Int
1 in Int
n forall a. Num a => a -> a -> a
+ 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 forall a. Num a => a -> a -> a
+ forall i. (Num i, Bits i) => i -> i
align Int
n 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 (forall a. Binary a => ByteString -> a
decode ByteString
b)
      DatumType
'h' -> Int64 -> Datum
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' -> let [Word8
b0,Word8
b1,Word8
b2,Word8
b3] = ByteString -> [Word8]
B.unpack (Int64 -> ByteString -> ByteString
B.take Int64
4 ByteString
b) in (Word8, Word8, Word8, Word8) -> Datum
midi (Word8
b0,Word8
b1,Word8
b2,Word8
b3)
      DatumType
_ -> forall a. HasCallStack => [DatumType] -> a
error ([DatumType]
"decode_datum: illegal type (" forall a. [a] -> [a] -> [a]
++ [DatumType
ty] 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 = 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 forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith DatumType -> ByteString -> Datum
decode_datum [DatumType]
cs' (forall a b. (a, b) -> b
snd (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
        (AsciiString Ascii
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)
        (AsciiString Ascii
dsc) = DatumType -> ByteString -> Datum
decode_datum DatumType
's' (Int -> ByteString -> ByteString
b_drop Int
n ByteString
b)
        arg :: [Datum]
arg = Ascii -> ByteString -> [Datum]
decode_datum_seq (Ascii -> Ascii
descriptor_tags Ascii
dsc) (Int -> ByteString -> ByteString
b_drop (Int
n forall a. Num a => a -> a -> a
+ Int
m) ByteString
b)
    in [DatumType] -> [Datum] -> Message
Message (Ascii -> [DatumType]
C.unpack Ascii
cmd) [Datum]
arg

-- | 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
4forall a. Num a => a -> a -> a
+Int
s) ByteString
b)
    in if ByteString -> Int64
B.length ByteString
b forall a. Eq a => a -> a -> Bool
== Int64
0 then [] else Message
mforall a. a -> [a] -> [a]
:[Message]
nxt

-- | Decode an Osc 'Bundle'.
decodeBundle :: B.ByteString -> Bundle
decodeBundle :: ByteString -> Bundle
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
        (TimeStamp Double
timeStamp) = DatumType -> ByteString -> Datum
decode_datum DatumType
't' (Int -> ByteString -> ByteString
b_drop Int
h ByteString
b)
        ms :: [Message]
ms = ByteString -> [Message]
decode_message_seq (Int -> ByteString -> ByteString
b_drop (Int
hforall a. Num a => a -> a -> a
+Int
t) ByteString
b)
    in Double -> [Message] -> Bundle
Bundle Double
timeStamp [Message]
ms

-- | 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])
decodePacket :: B.ByteString -> Packet
decodePacket :: ByteString -> Packet
decodePacket ByteString
b =
    if ByteString
bundleHeader ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
b
    then Bundle -> Packet
Packet_Bundle (ByteString -> Bundle
decodeBundle ByteString
b)
    else Message -> Packet
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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
int_to_int64