-- | Optimised encode function for OSC packets.
{-# LANGUAGE CPP #-}

module Sound.OSC.Coding.Encode.Builder
    (build_packet
    ,encodeMessage
    ,encodeBundle
    ,encodePacket
    ,encodePacket_strict) where

import Data.Word {- base -}

import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}
import qualified Data.ByteString as S {- bytestring -}
import qualified Data.ByteString.Lazy as L {- bytestring -}
import qualified Blaze.ByteString.Builder as B {- bytestring -}
import qualified Blaze.ByteString.Builder.Char8 as B {- bytestring -}

#ifdef IMPORT_SEMIGROUP
import Data.Semigroup
#endif

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 Sound.OSC.Time {- hosc -}

-- | Generate a list of zero bytes for padding.
padding :: Int -> [Word8]
padding :: Int -> [Word8]
padding Int
n = Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
n Word8
0

-- | Nul byte (0) and then zero padding.
nul_and_padding :: Int -> B.Builder
nul_and_padding :: Int -> Builder
nul_and_padding Int
n = [Word8] -> Builder
B.fromWord8s (Word8
0 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> [Word8]
padding (Int -> Int
forall i. (Num i, Bits i) => i -> i
Byte.align Int
n))

-- Encode a string with zero padding.
build_ascii :: ASCII -> B.Builder
build_ascii :: ASCII -> Builder
build_ascii ASCII
s = ASCII -> Builder
B.fromByteString ASCII
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
nul_and_padding (ASCII -> Int
S.length ASCII
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- Encode a string with zero padding.
build_string :: String -> B.Builder
build_string :: String -> Builder
build_string String
s = String -> Builder
B.fromString String
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
nul_and_padding (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- Encode a byte string with prepended length and zero padding.
build_bytes :: L.ByteString -> B.Builder
build_bytes :: ByteString -> Builder
build_bytes ByteString
s =
  Int32 -> Builder
B.fromInt32be (Int64 -> Int32
Convert.int64_to_int32 (ByteString -> Int64
L.length ByteString
s)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Builder
B.fromLazyByteString ByteString
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  [Word8] -> Builder
B.fromWord8s (Int -> [Word8]
padding (Int64 -> Int
Convert.int64_to_int (Int64 -> Int64
forall i. (Num i, Bits i) => i -> i
Byte.align (ByteString -> Int64
L.length ByteString
s))))

-- Encode an OSC datum.
build_datum :: Datum -> B.Builder
build_datum :: Datum -> Builder
build_datum Datum
d =
    case Datum
d of
      Int32 Int32
i -> Int32 -> Builder
B.fromInt32be Int32
i
      Int64 Int64
i -> Int64 -> Builder
B.fromInt64be Int64
i
      Float Float
n -> Word32 -> Builder
B.fromWord32be (Float -> Word32
I.floatToWord Float
n)
      Double Double
n -> Word64 -> Builder
B.fromWord64be (Double -> Word64
I.doubleToWord Double
n)
      TimeStamp Double
t -> Word64 -> Builder
B.fromWord64be (Double -> Word64
ntpr_to_ntpi Double
t)
      ASCII_String ASCII
s -> ASCII -> Builder
build_ascii ASCII
s
      Midi (MIDI Word8
b0 Word8
b1 Word8
b2 Word8
b3) -> [Word8] -> Builder
B.fromWord8s [Word8
b0,Word8
b1,Word8
b2,Word8
b3]
      Blob ByteString
b -> ByteString -> Builder
build_bytes ByteString
b

-- Encode an OSC 'Message'.
build_message :: Message -> B.Builder
build_message :: Message -> Builder
build_message (Message String
c [Datum]
l) =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [String -> Builder
build_string String
c
            ,ASCII -> Builder
build_ascii ([Datum] -> ASCII
descriptor [Datum]
l)
            ,[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Datum -> Builder) -> [Datum] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Datum -> Builder
build_datum [Datum]
l)]

-- Encode an OSC 'Bundle'.
build_bundle_ntpi :: NTP64 -> [Message] -> B.Builder
build_bundle_ntpi :: Word64 -> [Message] -> Builder
build_bundle_ntpi Word64
t [Message]
l =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ByteString -> Builder
B.fromLazyByteString ByteString
Byte.bundleHeader
            ,Word64 -> Builder
B.fromWord64be Word64
t
            ,[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Message -> Builder) -> [Message] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Builder
build_bytes (ByteString -> Builder)
-> (Message -> ByteString) -> Message -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (Message -> Builder) -> Message -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Builder
build_message) [Message]
l)]

-- | Builder for an OSC 'Packet'.
build_packet :: Packet -> B.Builder
build_packet :: Packet -> Builder
build_packet Packet
o =
    case Packet
o of
      Packet_Message Message
m -> Message -> Builder
build_message Message
m
      Packet_Bundle (Bundle Double
t [Message]
m) -> Word64 -> [Message] -> Builder
build_bundle_ntpi (Double -> Word64
ntpr_to_ntpi Double
t) [Message]
m

{-# INLINE encodePacket #-}
{-# INLINE encodeMessage #-}
{-# INLINE encodeBundle #-}
{-# INLINE encodePacket_strict #-}

-- | Encode an OSC 'Packet'.
encodePacket :: Packet -> L.ByteString
encodePacket :: Packet -> ByteString
encodePacket = Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (Packet -> Builder) -> Packet -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packet -> Builder
build_packet

{- | Encode an OSC 'Message', ie. 'encodePacket' of 'Packet_Message'.

> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]
> encodeMessage (Message "/g_free" [Int32 0]) == L.pack m

-}
encodeMessage :: Message -> L.ByteString
encodeMessage :: Message -> ByteString
encodeMessage = Packet -> ByteString
encodePacket (Packet -> ByteString)
-> (Message -> Packet) -> Message -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Packet
Packet_Message

{- | Encode an OSC 'Bundle', ie. 'encodePacket' of 'Packet_Bundle'.

> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]
> let b = [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,16] ++ m
> encodeBundle (Bundle immediately [Message "/g_free" [Int32 0]]) == L.pack b

-}
encodeBundle :: Bundle -> L.ByteString
encodeBundle :: Bundle -> ByteString
encodeBundle = Packet -> ByteString
encodePacket (Packet -> ByteString)
-> (Bundle -> Packet) -> Bundle -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bundle -> Packet
Packet_Bundle

-- | Encode an OSC 'Packet' to a strict 'S.ByteString'.
encodePacket_strict :: Packet -> S.ByteString
encodePacket_strict :: Packet -> ASCII
encodePacket_strict = Builder -> ASCII
B.toByteString (Builder -> ASCII) -> (Packet -> Builder) -> Packet -> ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packet -> Builder
build_packet