module Sound.OSC.Parser (
osc
) where
import Data.Attoparsec.ByteString as AP
import Data.Binary.Get
import Data.Binary.IEEE754
import Data.Word (Word64, Word8)
import Control.Applicative ((<$>), (<|>))
import Data.ByteString.Char8 (unpack, pack)
import Data.Int (Int32)
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (fromStrict)
import Data.ByteString (ByteString)
import Sound.OSC
nest :: AP.Parser ByteString -> AP.Parser a -> AP.Parser a
nest bsp p = bsp >>= parse
where
parse bs = either fail return (parseOnly p bs)
int32 :: AP.Parser Int32
int32 = convert <$> AP.take 4
where
convert :: ByteString -> Int32
convert bs = fromIntegral $ runGet getWord32be $ fromStrict bs
float32 :: AP.Parser Float
float32 = convert <$> AP.take 4
where
convert :: ByteString -> Float
convert bs = runGet getFloat32be $ fromStrict bs
timestamp :: AP.Parser Timestamp
timestamp = convert <$> AP.take 8
where
convert :: ByteString -> Timestamp
convert bs = runGet getWord64be $ fromStrict bs
oscString :: AP.Parser ByteString
oscString = do
str <- AP.takeTill (==0)
AP.take $ blockPadding (BS.length str)
return str
where
blockPadding len = ((len1) `mod` 4)+1
tokenParser :: Word8 -> AP.Parser Datum
tokenParser 115 = String . unpack <$> oscString
tokenParser 105 = Int <$> int32
tokenParser 102 = Float <$> float32
tokenParser 98 = do
size <- int32
Blob <$> (AP.take $ fromIntegral size)
tokenParser t = fail $ "Could not parse type " ++ show t
typeTag :: Parser [Word8]
typeTag = do
first <- AP.peekWord8
case first of
Just 44 -> tail . BS.unpack <$> oscString
Just other -> fail $ "Unexpected token: " ++ show other
Nothing -> return []
message :: AP.Parser OSC
message = do
addr <- unpack <$> oscString
types <- typeTag
(Message addr) <$> (sequence $ map tokenParser types)
bundle :: AP.Parser OSC
bundle = do
string $ pack "#bundle"
word8 0
time <- timestamp
elems <- AP.manyTill bundleElement AP.endOfInput
return $ Bundle time elems
bundleElement :: AP.Parser OSC
bundleElement = do
length <- int32
nest (AP.take $ fromIntegral length) osc
osc :: AP.Parser OSC
osc = do
first <- AP.peekWord8
case first of
Just 35 -> bundle
otherwise -> message