vivid-0.1.0.0: Vivid/OSC.hs

-- | __You probably don't need to use this directly__
-- 
--   Representation of Open Sound Control data

{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoRebindableSyntax #-}

module Vivid.OSC (
     OSC(..)
   , OSCDatum(..)

   , encodeOSC
   , decodeOSC
   ) where

import Vivid.OSC.Util

import Control.DeepSeq
import Data.Binary (encode, decode)
import qualified Data.ByteString as BS
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import Data.Int (Int32) -- , Int16, Int8)
import Data.Monoid

-- | An OSC message, e.g.
-- 
--   > OSC "/n_free" [OSC_I 42]
data OSC
   = OSC ByteString [OSCDatum]
 deriving (Show, Read, Eq)

data OSCDatum
   = OSC_I Int32
   | OSC_S ByteString
   | OSC_F Float
{-
   | OSC_I8 Int8
   | OSC_I16 Int16
-}
   | OSC_B ByteString
 deriving (Show, Read, Eq)

-- formerly known as 'someShit':
encodeOSC :: OSC -> ByteString
encodeOSC (OSC url args) = BSL.toStrict $ BSL.concat $ [
    encodeDatum (OSC_S url)
   ,encodeDatum (OSC_S ("," <> BS.concat (map toTypeChar args)))
   ] <> map encodeDatum args
  where
    toTypeChar (OSC_I _) = "i"
    toTypeChar (OSC_S _) = "s"
    toTypeChar (OSC_F _) = "f"
    toTypeChar (OSC_B _) = "b"

encodeDatum :: OSCDatum -> BSL.ByteString
encodeDatum (OSC_I i) = encode i
encodeDatum (OSC_S s) = BSL.fromStrict $
   s <> BS.replicate (align (BS.length s + 1) + 1) 0
encodeDatum (OSC_F f) = (encode . floatToWord) f
encodeDatum (OSC_B b) = mconcat [
    -- 4 bytes which describe the size of the blob:
     encode (fromIntegral (BS.length b) :: Int32)
    -- the blob itself:
   , BSL.fromStrict b
    -- padding:
   , BSL.fromStrict (BS8.pack (replicate  (align (BS.length b)) '\NUL'))
   ]

decodeDatumWithPadding :: Char -> ByteString -> OSCDatum
decodeDatumWithPadding 'i' b =
   OSC_I (decode $ BSL.fromStrict b)
decodeDatumWithPadding 'f' b =
   OSC_F (wordToFloat . decode $ BSL.fromStrict b)
decodeDatumWithPadding 's' b =
   OSC_S  $ BS.take (numBytesWithoutPadding 's' b)  b
decodeDatumWithPadding 'b' b =
   OSC_B $ BS.take (numBytesWithoutPadding 'b' b) $ BS.drop 4 b
decodeDatumWithPadding c b =
   error $ "unknown character " <> show c <> ": " <> show b

numBytesWithoutPadding :: Char -> ByteString -> Int
numBytesWithoutPadding 'i' _ = 4
numBytesWithoutPadding 'f' _ = 4
numBytesWithoutPadding 's' b = case BS.elemIndex 0 $ b of
   Just x -> fromIntegral x
   Nothing -> error $ "weirdness on " <> show b
numBytesWithoutPadding 'b' b = fromIntegral $
   (decode $ BSL.fromStrict $ BS.take 4 b :: Int32)
numBytesWithoutPadding c b =
   error $ "unknown character " <> show c <> ": " <> show b

numBytesWithPadding :: Char -> ByteString -> Int
numBytesWithPadding 'i' _ = 4
numBytesWithPadding 'f' _ = 4
numBytesWithPadding 's' b =
   let n = (numBytesWithoutPadding 's' b) + 1
   in n + (align n)
numBytesWithPadding 'b' b =
   let n = numBytesWithoutPadding 'b' b
   in n + align n + 4
numBytesWithPadding c b =
   error $ "unknown character " <> show c <> ": " <> show b

decodeOSCData :: [Char] -> ByteString -> [OSCDatum]
decodeOSCData [] "" = []
decodeOSCData [] leftover = error $ "leftover bytes: " <> show leftover
decodeOSCData (t:ypes) blob =
   (:) datum
       (decodeOSCData ypes (BS.drop (numBytesWithPadding t blob) blob))
 where
   datum = decodeDatumWithPadding t thisBlob
   thisBlob = BS.take (numBytesWithPadding t blob) blob

decodeOSC :: ByteString -> OSC
decodeOSC b =
   let sizeOfURL = numBytesWithoutPadding 's' b
       storageOfURL = numBytesWithPadding 's' b

       url = BS.take sizeOfURL b

       -- typeDesc is like ",issif"
       sizeOfTypeDesc = numBytesWithoutPadding 's' $ BS.drop storageOfURL b
       storageOfTypeDesc = numBytesWithPadding 's' $ BS.drop storageOfURL b
       (',':typeDesc) = BS8.unpack $ BS.take sizeOfTypeDesc $
          BS.drop storageOfURL b

       rest = BS.drop (storageOfURL + storageOfTypeDesc) $ b

   in OSC url $ decodeOSCData typeDesc rest

instance NFData OSCDatum where
   rnf (OSC_I x) = rnf x
   rnf (OSC_F x) = rnf x
   rnf (OSC_S x) = rnf x
{-
   rnf (OSC_I8 x) = rnf x
   rnf (OSC_I16 x) = rnf x
-}
   rnf (OSC_B x) = rnf x