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

-- | The storage byte count (aligned) of an OSC value.
storage :: Datum_Type -> B.ByteString -> Int
storage :: Datum_Type -> ByteString -> Int
storage Datum_Type
ty ByteString
b =
    case Datum_Type
ty of
      Datum_Type
's' -> let n :: Int
n = Datum_Type -> ByteString -> Int
size Datum_Type
'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
      Datum_Type
'b' -> let n :: Int
n = Datum_Type -> ByteString -> Int
size Datum_Type
'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
      Datum_Type
_ -> Datum_Type -> ByteString -> Int
size Datum_Type
ty ByteString
B.empty

-- | Decode an OSC datum
decode_datum :: Datum_Type -> B.ByteString -> Datum
decode_datum :: Datum_Type -> ByteString -> Datum
decode_datum Datum_Type
ty ByteString
b =
    case Datum_Type
ty of
      Datum_Type
'i' -> Int32 -> Datum
Int32 (ByteString -> Int32
forall a. Binary a => ByteString -> a
decode ByteString
b)
      Datum_Type
'h' -> Int64 -> Datum
Int64 (ByteString -> Int64
forall a. Binary a => ByteString -> a
decode ByteString
b)
      Datum_Type
'f' -> Float -> Datum
Float (ByteString -> Float
decode_f32 ByteString
b)
      Datum_Type
'd' -> Double -> Datum
Double (ByteString -> Double
decode_f64 ByteString
b)
      Datum_Type
's' -> ASCII -> Datum
ASCII_String (ByteString -> ASCII
decode_ascii (Int -> ByteString -> ByteString
b_take (Datum_Type -> ByteString -> Int
size Datum_Type
's' ByteString
b) ByteString
b))
      Datum_Type
'b' -> ByteString -> Datum
Blob (Int -> ByteString -> ByteString
b_take (Datum_Type -> ByteString -> Int
size Datum_Type
'b' ByteString
b) (Int64 -> ByteString -> ByteString
B.drop Int64
4 ByteString
b))
      Datum_Type
't' -> Double -> Datum
TimeStamp (NTP64 -> Double
ntpi_to_ntpr (ByteString -> NTP64
decode_word64 ByteString
b))
      Datum_Type
'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)
      Datum_Type
_ -> [Datum_Type] -> Datum
forall a. HasCallStack => [Datum_Type] -> a
error ([Datum_Type]
"decode_datum: illegal type (" [Datum_Type] -> [Datum_Type] -> [Datum_Type]
forall a. [a] -> [a] -> [a]
++ [Datum_Type
ty] [Datum_Type] -> [Datum_Type] -> [Datum_Type]
forall a. [a] -> [a] -> [a]
++ [Datum_Type]
")")

-- | 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' :: [Datum_Type]
cs' = ASCII -> [Datum_Type]
C.unpack ASCII
cs
        f :: ByteString -> Datum_Type -> (ByteString, ByteString)
f ByteString
b' Datum_Type
c = (ByteString, ByteString) -> (ByteString, ByteString)
forall b a. (b, a) -> (a, b)
swap (Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt (Int -> Int64
int_to_int64 (Datum_Type -> ByteString -> Int
storage Datum_Type
c ByteString
b')) ByteString
b')
    in (Datum_Type -> ByteString -> Datum)
-> [Datum_Type] -> [ByteString] -> [Datum]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Datum_Type -> ByteString -> Datum
decode_datum [Datum_Type]
cs' ((ByteString, [ByteString]) -> [ByteString]
forall a b. (a, b) -> b
snd ((ByteString -> Datum_Type -> (ByteString, ByteString))
-> ByteString -> [Datum_Type] -> (ByteString, [ByteString])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL ByteString -> Datum_Type -> (ByteString, ByteString)
f ByteString
b [Datum_Type]
cs'))

-- | Decode an OSC 'Message'.
decodeMessage :: B.ByteString -> Message
decodeMessage :: ByteString -> Message
decodeMessage ByteString
b =
    let n :: Int
n = Datum_Type -> ByteString -> Int
storage Datum_Type
's' ByteString
b
        (ASCII_String ASCII
cmd) = Datum_Type -> ByteString -> Datum
decode_datum Datum_Type
's' ByteString
b
        m :: Int
m = Datum_Type -> ByteString -> Int
storage Datum_Type
's' (Int -> ByteString -> ByteString
b_drop Int
n ByteString
b)
        (ASCII_String ASCII
dsc) = Datum_Type -> ByteString -> Datum
decode_datum Datum_Type
'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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m) ByteString
b)
    in [Datum_Type] -> [Datum] -> Message
Message (ASCII -> [Datum_Type]
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
4Int -> 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
mMessage -> [Message] -> [Message]
forall a. a -> [a] -> [a]
:[Message]
nxt

-- | Decode an OSC 'Bundle'.
decodeBundle :: B.ByteString -> Bundle
decodeBundle :: ByteString -> Bundle
decodeBundle ByteString
b =
    let h :: Int
h = Datum_Type -> ByteString -> Int
storage Datum_Type
's' ByteString
b -- header (should be '#bundle')
        t :: Int
t = Datum_Type -> ByteString -> Int
storage Datum_Type
't' (Int -> ByteString -> ByteString
b_drop Int
h ByteString
b) -- time
        (TimeStamp Double
timeStamp) = Datum_Type -> ByteString -> Datum
decode_datum Datum_Type
't' (Int -> ByteString -> ByteString
b_drop Int
h ByteString
b)
        ms :: [Message]
ms = ByteString -> [Message]
decode_message_seq (Int -> ByteString -> ByteString
b_drop (Int
hInt -> Int -> Int
forall 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 (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