Builder.hs

-- | Optimised encode function for OSC packets.
module Sound.OpenSoundControl.Coding.Encode.Builder (buildOSC
                                                    ,encodeOSC
                                                    ,encodeOSC') where

import qualified Data.Binary.IEEE754 as I
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Blaze.ByteString.Builder as B
import qualified Blaze.ByteString.Builder.Char8 as B
import Data.Monoid (mappend, mconcat)
import Data.Word (Word8)
import Sound.OpenSoundControl.Coding.Byte (align, bundleHeader)
import Sound.OpenSoundControl.Time
import Sound.OpenSoundControl.Type (Datum(..), OSC(..), tag)

-- Command argument types are given by a descriptor.
descriptor :: [Datum] -> String
descriptor l = ',' : map tag l

-- Generate a list of zero bytes for padding.
padding :: Integral i => i -> [Word8]
padding n = replicate (fromIntegral n) 0

-- Encode a string with zero padding.
build_string :: String -> B.Builder
build_string s = B.fromString s `mappend` B.fromWord8s (0:padding (align (length s + 1)))

-- Encode a byte string with prepended length and zero padding.
build_bytes :: L.ByteString -> B.Builder
build_bytes s = B.fromInt32be (fromIntegral (L.length s))
                `mappend` B.fromLazyByteString s
                `mappend` B.fromWord8s (padding (align (L.length s)))

-- Encode an OSC datum.
build_datum :: Datum -> B.Builder
build_datum (Int i)              = B.fromInt32be (fromIntegral i)
build_datum (Float f)            = B.fromWord32be (I.floatToWord (realToFrac f))
build_datum (Double d)           = B.fromWord64be (I.doubleToWord d)
build_datum (TimeStamp t)        = B.fromWord64be (fromIntegral (as_ntpi t))
build_datum (String s)           = build_string s
build_datum (Midi (b0,b1,b2,b3)) = B.fromWord8s [b0,b1,b2,b3]
build_datum (Blob b)             = build_bytes b

-- Encode an OSC message.
build_message :: String -> [Datum] -> B.Builder
build_message c l =
    mconcat [ build_string c
            , build_string (descriptor l)
            , mconcat $ map build_datum l ]

-- Encode an OSC bundle.
build_bundle_ntpi :: NTPi -> [OSC] -> B.Builder
build_bundle_ntpi t l =
    mconcat [ B.fromLazyByteString bundleHeader
            , B.fromWord64be t
            , mconcat $ map (build_bytes . B.toLazyByteString . buildOSC) l ]

-- | Builder monoid for an OSC packet.
buildOSC :: OSC -> B.Builder
buildOSC (Message c l)       = build_message c l
buildOSC (Bundle (NTPi t) l) = build_bundle_ntpi t l
buildOSC (Bundle (NTPr t) l) = build_bundle_ntpi (ntpr_ntpi t) l
buildOSC (Bundle (UTCr t) l) = build_bundle_ntpi (utcr_ntpi t) l

-- | Encode an OSC packet to a lazy ByteString.
--
-- > let b = L.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]
-- > in encodeOSC (Message "/g_free" [Int 0]) == b
encodeOSC :: OSC -> L.ByteString
{-# INLINE encodeOSC #-}
encodeOSC = B.toLazyByteString . buildOSC

-- | Encode an OSC packet to a strict ByteString.
encodeOSC' :: OSC -> S.ByteString
{-# INLINE encodeOSC' #-}
encodeOSC' = B.toByteString . buildOSC