hosc 0.13 → 0.14

raw patch · 39 files changed

+1487/−1097 lines, 39 filesdep +QuickCheckdep +criteriondep +deepseqdep ~binarydep ~bytestringdep ~networkPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, criterion, deepseq, hosc, test-framework, test-framework-quickcheck2

Dependency ranges changed: binary, bytestring, network

API changes (from Hackage documentation)

Files

• README +2/−2
• Sound/OSC.hs +2/−3
• Sound/OSC/Class.hs +31/−0
• Sound/OSC/Coding.hs +48/−0
• Sound/OSC/Coding/Byte.hs +104/−0
• Sound/OSC/Coding/Cast.hs +43/−0
• Sound/OSC/Coding/Decode/Base.hs +104/−0
• Sound/OSC/Coding/Decode/Binary.hs +128/−0
• Sound/OSC/Coding/Encode/Base.hs +56/−0
• Sound/OSC/Coding/Encode/Builder.hs +95/−0
• Sound/OSC/Core.hs +22/−0
• Sound/OSC/Datum.hs +63/−0
• Sound/OSC/FD.hs +2/−3
• Sound/OSC/Normalise.hs +64/−0
• Sound/OSC/Time.hs +111/−0
• Sound/OSC/Transport/FD.hs +7/−6
• Sound/OSC/Transport/FD/TCP.hs +6/−5
• Sound/OSC/Transport/FD/UDP.hs +12/−15
• Sound/OSC/Transport/Monad.hs +8/−7
• Sound/OSC/Type.hs +377/−0
• Sound/OSC/Wait.hs +28/−0
• Sound/OpenSoundControl.hs +0/−20
• Sound/OpenSoundControl/Class.hs +0/−31
• Sound/OpenSoundControl/Coding.hs +0/−47
• Sound/OpenSoundControl/Coding/Byte.hs +0/−96
• Sound/OpenSoundControl/Coding/Cast.hs +0/−43
• Sound/OpenSoundControl/Coding/Coerce.hs +0/−39
• Sound/OpenSoundControl/Coding/Decode/Base.hs +0/−98
• Sound/OpenSoundControl/Coding/Decode/Binary.hs +0/−115
• Sound/OpenSoundControl/Coding/Encode/Base.hs +0/−57
• Sound/OpenSoundControl/Coding/Encode/Builder.hs +0/−93
• Sound/OpenSoundControl/Time.hs +0/−120
• Sound/OpenSoundControl/Type.hs +0/−252
• Sound/OpenSoundControl/Wait.hs +0/−27
• benchmarks/Sound/OSC/NFData.hs +26/−0
• benchmarks/benchmark.hs +32/−0
• hosc.cabal +50/−18
• tests/Sound/OSC/Arbitrary.hs +43/−0
• tests/test.hs +23/−0

@@ -1,10 +1,10 @@ hosc - haskell open sound control --------------------------------- -[hosc][hosc] provides Sound.OpenSoundControl, a [haskell][hs]+[hosc][hosc] provides `Sound.OSC`, a [haskell][hs] module implementing a subset of the [Open Sound Control][osc] byte protocol. -© [rohan drape][rd], [stefan kersten][sk] and others, 2006-2012,+© [rohan drape][rd], [stefan kersten][sk] and others, 2006-2013, [gpl][gpl]. with contributions by:  - [alex mclean][am]

@@ -1,9 +1,8 @@--- | Composite of "Sound.OpenSoundControl" and--- "Sound.OSC.Transport.Monad".+-- | Composite of "Sound.OSC.Core" and "Sound.OSC.Transport.Monad". module Sound.OSC (module M) where  import Control.Monad.IO.Class as M (MonadIO,liftIO)-import Sound.OpenSoundControl as M+import Sound.OSC.Core as M import Sound.OSC.Transport.FD.UDP as M import Sound.OSC.Transport.FD.TCP as M import Sound.OSC.Transport.Monad as M

@@ -0,0 +1,31 @@+-- | Typeclass for encoding and decoding OSC packets.+module Sound.OSC.Class where++import Sound.OSC.Type+import Sound.OSC.Coding++-- | A type-class for values that can be translated to and from OSC+-- 'Packet's.+class OSC o where+    toPacket :: o -> Packet -- ^ Translation to 'Packet'.+    fromPacket :: Packet -> Maybe o -- ^ Translation from 'Packet'.++instance OSC Message where+    toPacket = Packet_Message+    fromPacket = packet_to_message++instance OSC Bundle where+    toPacket = Packet_Bundle+    fromPacket = Just . packet_to_bundle++instance OSC Packet where+    toPacket = id+    fromPacket = Just++-- | 'encodePacket' '.' 'toPacket'.+encodeOSC :: (Coding c,OSC o) => o -> c+encodeOSC = encodePacket . toPacket++-- | 'fromPacket' '.' 'decodePacket'.+decodeOSC :: (Coding c,OSC o) => c -> Maybe o+decodeOSC = fromPacket . decodePacket

@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleInstances,TypeSynonymInstances #-}+-- | A type-class to provide coding operations to different data types+--   using the same function names.+module Sound.OSC.Coding where++import qualified Data.ByteString as S {- bytestring -}+import qualified Data.ByteString.Lazy as B {- bytestring -}+import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -}++import Sound.OSC.Type+import qualified Sound.OSC.Coding.Decode.Binary as Binary+import qualified Sound.OSC.Coding.Encode.Builder as Builder++-- | Converting from and to binary packet representations.+class Coding a where+    encodePacket :: Packet -> a -- ^ Decode an OSC packet.+    decodePacket :: a -> Packet -- ^ Encode an OSC packet.++instance Coding S.ByteString where+    encodePacket = Builder.encodePacket_strict+    decodePacket = Binary.decodePacket_strict++instance Coding B.ByteString where+    encodePacket = Builder.encodePacket+    decodePacket = Binary.decodePacket++instance Coding String where+    encodePacket = C.unpack . encodePacket+    decodePacket = decodePacket . C.pack++-- | An 'encodePacket' and 'decodePacket' pair over 'B.ByteString'.+type Coder = (Packet -> B.ByteString,B.ByteString -> Packet)++-- | 'encodePacket' '.' 'Packet_Message'.+encodeMessage :: Coding c => Message -> c+encodeMessage = encodePacket . Packet_Message++-- | 'encodePacket' '.' 'Packet_Bundle'.+encodeBundle :: Coding c => Bundle -> c+encodeBundle = encodePacket . Packet_Bundle++-- | 'packet_to_message' '.' 'decodePacket'.+decodeMessage :: Coding c => c -> Maybe Message+decodeMessage = packet_to_message . decodePacket++-- | 'packet_to_bundle' '.' 'decodePacket'.+decodeBundle :: Coding c => c -> Bundle+decodeBundle = packet_to_bundle . decodePacket

@@ -0,0 +1,104 @@+-- | Byte-level coding utility functions.+module Sound.OSC.Coding.Byte where++import Data.Binary {- base -}+import Data.Bits {- base -}+import qualified Data.ByteString as S.B {- bytestring -}+import qualified Data.ByteString.Char8 as S.C {- bytestring -}+import qualified Data.ByteString.Lazy as B {- bytestring -}+import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -}+import Data.Int {- base -}++import Sound.OSC.Coding.Cast+import Sound.OSC.Type++-- | Encode a signed 8-bit integer.+encode_i8 :: Int -> B.ByteString+encode_i8 n = encode (fromIntegral n :: Int8)++-- | Encode a signed 16-bit integer.+encode_i16 :: Int -> B.ByteString+encode_i16 n = encode (fromIntegral n :: Int16)++-- | Encode a signed 32-bit integer.+encode_i32 :: Int -> B.ByteString+encode_i32 n = encode (fromIntegral n :: Int32)++-- | Encode an unsigned 16-bit integer.+encode_u32 :: Int -> B.ByteString+encode_u32 n = encode (fromIntegral n :: Word32)++-- | Encode a signed 64-bit integer.+encode_i64 :: Int64 -> B.ByteString+encode_i64 = encode++-- | Encode an unsigned 64-bit integer.+encode_u64 :: Word64 -> B.ByteString+encode_u64 = encode++-- | Encode a 32-bit IEEE floating point number.+encode_f32 :: Float -> B.ByteString+encode_f32 = encode . f32_w32++-- | Encode a 64-bit IEEE floating point number.+encode_f64 :: Double -> B.ByteString+encode_f64 = encode . f64_w64++-- | Encode an ASCII string.+encode_str :: ASCII -> B.ByteString+{-# INLINE encode_str #-}+encode_str = B.pack . S.B.unpack++-- | Decode a signed 8-bit integer.+decode_i8 :: B.ByteString -> Int+decode_i8 b = fromIntegral (decode b :: Int8)++-- | Decode a signed 16-bit integer.+decode_i16 :: B.ByteString -> Int+decode_i16 b = fromIntegral (decode b :: Int16)++-- | Decode a signed 32-bit integer.+decode_i32 :: B.ByteString -> Int+decode_i32 b = fromIntegral (decode b :: Int32)++-- | Decode an unsigned 32-bit integer.+decode_u32 :: B.ByteString -> Int+decode_u32 b = fromIntegral (decode b :: Word32)++-- | Decode a signed 64-bit integer.+decode_i64 :: B.ByteString -> Int64+decode_i64 = decode++-- | Decode an unsigned 64-bit integer.+decode_u64 :: B.ByteString -> Word64+decode_u64 = decode++-- | Decode a 32-bit IEEE floating point number.+decode_f32 :: B.ByteString -> Float+decode_f32 b = w32_f32 (decode b :: Word32)++-- | Decode a 64-bit IEEE floating point number.+decode_f64 :: B.ByteString -> Double+decode_f64 b = w64_f64 (decode b :: Word64)++-- | Decode an ASCII string.+decode_str :: B.ByteString -> ASCII+{-# INLINE decode_str #-}+decode_str = S.C.pack . C.unpack++-- | Bundle header as a (strict) 'S.C.ByteString'.+bundleHeader_strict :: S.C.ByteString+bundleHeader_strict = S.C.pack "#bundle\0"++-- | Bundle header as a lazy ByteString.+bundleHeader :: B.ByteString+{-# INLINE bundleHeader #-}+bundleHeader = C.fromChunks [bundleHeader_strict]++-- | The number of bytes required to align an OSC value to the next+--   4-byte boundary.+--+-- > map align [0::Int .. 7] == [0,3,2,1,0,3,2,1]+align :: (Num i,Bits i) => i -> i+{-# INLINE align #-}+align n = ((n + 3) .&. complement 3) - n

@@ -0,0 +1,43 @@+-- | Bit-level type casts and byte layout string typecasts.+module Sound.OSC.Coding.Cast (f32_w32,w32_f32+                             ,f64_w64,w64_f64+                             ,str_cstr,cstr_str+                             ,str_pstr,pstr_str) where++import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}+import Data.Char {- base -}+import Data.Word {- base -}++-- | The IEEE byte representation of a float.+f32_w32 :: Float -> Word32+f32_w32 = I.floatToWord++-- | Inverse of 'f32_w32'.+w32_f32 :: Word32 -> Float+w32_f32 = I.wordToFloat++-- | The IEEE byte representation of a double.+f64_w64 :: Double -> Word64+f64_w64 = I.doubleToWord++-- | Inverse of 'f64_i64'.+w64_f64 :: Word64 -> Double+w64_f64 = I.wordToDouble++-- | Transform a haskell string into a C string (a null suffixed byte+--   string).+str_cstr :: String -> [Word8]+str_cstr s = map (fromIntegral . ord) s ++ [0]++-- | Inverse of 'str_cstr'.+cstr_str :: [Word8] -> String+cstr_str = map (chr . fromIntegral) . takeWhile (/= 0)++-- | Transform a haskell string to a pascal string (a length prefixed+--   byte string).+str_pstr :: String -> [Word8]+str_pstr s = fromIntegral (length s) : map (fromIntegral . ord) s++-- | Inverse of 'str_pstr'.+pstr_str :: [Word8] -> String+pstr_str = map (chr . fromIntegral) . drop 1

@@ -0,0 +1,104 @@+-- | Base-level decode function for OSC packets (slow).  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+import Sound.OSC.Time+import Sound.OSC.Type++-- The plain byte count of an OSC value.+size :: Datum_Type -> B.ByteString -> Int+size ty b =+    case ty of+      'i' -> 4+      'f' -> 4+      'd' -> 8+      't' -> 8 -- timetag+      'm' -> 4 -- MIDI message+      's' -> fromIntegral (fromMaybe+                           (error ("size: no terminating zero: " ++ show b))+                           (B.elemIndex 0 b))+      'b' -> decode_i32 (B.take 4 b)+      _ -> error "size: illegal type"++-- The storage byte count of an OSC value.+storage :: Datum_Type -> B.ByteString -> Int+storage ty b =+    case ty of+      's' -> let n = size 's' b + 1 in n + align n+      'b' -> let n = size 'b' b in n + align n + 4+      _ -> size ty B.empty++-- Decode an OSC datum+decode_datum :: Datum_Type -> B.ByteString -> Datum+decode_datum ty b =+    case ty of+      'i' -> Int32 (decode b)+      'h' -> Int64 (decode b)+      'f' -> Float (decode_f32 b)+      'd' -> Double (decode_f64 b)+      's' -> ASCII_String (decode_str (b_take (size 's' b) b))+      'b' -> Blob (b_take (size 'b' b) (B.drop 4 b))+      't' -> TimeStamp (ntpi_to_ntpr (decode_u64 b))+      'm' -> let [b0,b1,b2,b3] = B.unpack (B.take 4 b)+             in midi (b0,b1,b2,b3)+      _ -> error ("decode_datum: illegal type (" ++ [ty] ++ ")")++-- Decode a sequence of OSC datum given a type descriptor string.+decode_datum_seq :: ASCII -> B.ByteString -> [Datum]+decode_datum_seq cs b =+    let swap (x,y) = (y,x)+        cs' = C.unpack cs+        f b' c = swap (B.splitAt (fromIntegral (storage c b')) b')+    in zipWith decode_datum cs' (snd (mapAccumL f b cs'))++-- | Decode an OSC 'Message'.+decodeMessage :: B.ByteString -> Message+decodeMessage b =+    let n = storage 's' b+        (ASCII_String cmd) = decode_datum 's' b+        m = storage 's' (b_drop n b)+        (ASCII_String dsc) = decode_datum 's' (b_drop n b)+        arg = decode_datum_seq (descriptor_tags dsc) (b_drop (n + m) b)+    in Message (C.unpack cmd) arg++-- Decode a sequence of OSC messages, each one headed by its length+decode_message_seq :: B.ByteString -> [Message]+decode_message_seq b =+    let s = decode_i32 b+        m = decodeMessage (b_drop 4 b)+        nxt = decode_message_seq (b_drop (4+s) b)+    in if B.length b == 0 then [] else m:nxt++-- | Decode an OSC 'Bundle'.+decodeBundle :: B.ByteString -> Bundle+decodeBundle b =+    let h = storage 's' b -- header (should be '#bundle')+        t = storage 't' (b_drop h b) -- time tag+        (TimeStamp timeStamp) = decode_datum 't' (b_drop h b)+        ms = decode_message_seq (b_drop (h+t) b)+    in Bundle timeStamp 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]+-- > in decodePacket b == Message "/g_free" [Int 0]+decodePacket :: B.ByteString -> Packet+decodePacket b =+    if bundleHeader `B.isPrefixOf` b+    then Packet_Bundle (decodeBundle b)+    else Packet_Message (decodeMessage b)++b_take :: Int -> B.ByteString -> B.ByteString+b_take = B.take . fromIntegral++b_drop :: Int -> B.ByteString -> B.ByteString+b_drop = B.drop . fromIntegral

@@ -0,0 +1,128 @@+-- | Optimised decode function for OSC packets.+module Sound.OSC.Coding.Decode.Binary+    (getPacket+    ,decodePacket+    ,decodePacket_strict) where++import Control.Applicative {- base -}+import Control.Monad (when) {- base -}+import Data.Binary.Get {- binary -}+import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}+import qualified Data.ByteString.Char8 as S.C {- bytestring -}+import qualified Data.ByteString.Lazy as B {- bytestring -}+import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -}+import Data.Int {- base -}+import Data.Word {- base -}++import Sound.OSC.Coding.Byte+import Sound.OSC.Time+import Sound.OSC.Type++-- | Isolate an action to operating within a fixed block of bytes. The+-- action is required to consume all the bytes that it is isolated to.+isolate :: Word32 -> Get a -> Get a+isolate n m = do+    s <- get_bytes n+    case runGetOrFail m s of+        Left (_, _, e) -> fail e+        Right (s', _, a) ->+            if B.null s'+                then return a+                else fail "isolate: not all bytes consumed"++-- | Get a 32 bit integer in big-endian byte order.+getInt32be :: Get Int32+getInt32be = fromIntegral <$> getWord32be++-- | Get a 64 bit integer in big-endian byte order.+getInt64be :: Get Int64+getInt64be = fromIntegral <$> getWord64be++-- | Get an aligned OSC string.+get_string :: Get String+get_string = do+    s <- getLazyByteStringNul+    skip (fromIntegral (align (B.length s + 1)))+    return $ C.unpack s++-- | Get an aligned OSC string.+get_ascii :: Get ASCII+get_ascii = do+    s <- getLazyByteStringNul+    skip (fromIntegral (align (B.length s + 1)))+    return (S.C.pack (C.unpack s))++-- | Get binary data prefixed by byte count.+get_bytes :: Word32 -> Get B.ByteString+get_bytes n = do+    b <- getLazyByteString (fromIntegral n)+    if n /= fromIntegral (B.length b)+        then fail "get_bytes: end of stream"+        else skip (fromIntegral (align n))+    return b++-- | Get an OSC datum.+get_datum :: Datum_Type -> Get Datum+get_datum ty =+    case ty of+      'i' -> Int32  <$> fromIntegral <$> getInt32be+      'h' -> Int64  <$> fromIntegral <$> getInt64be+      'f' -> Float  <$> realToFrac <$> I.getFloat32be+      'd' -> Double <$> I.getFloat64be+      's' -> ASCII_String <$> get_ascii+      'b' -> Blob   <$> (get_bytes =<< getWord32be)+      't' -> TimeStamp <$> ntpi_to_ntpr <$> getWord64be+      'm' -> do b0 <- getWord8+                b1 <- getWord8+                b2 <- getWord8+                b3 <- getWord8+                return $ Midi (MIDI b0 b1 b2 b3)+      _ -> fail ("get_datum: illegal type " ++ show ty)++-- | Get an OSC 'Message'.+get_message :: Get Message+get_message = do+    cmd <- get_string+    dsc <- get_ascii+    case S.C.unpack dsc of+        ',':tags -> do+            arg <- mapM get_datum tags+            return $ Message cmd arg+        _ -> fail "get_message: invalid type descriptor string"++-- | Get a sequence of OSC 'Message's, each one headed by its length.+get_message_seq :: Get [Message]+get_message_seq = do+    b <- isEmpty+    if b+        then return []+        else do+            p <- flip isolate get_message =<< getWord32be+            ps <- get_message_seq+            return (p:ps)++-- | Get a bundle. Fail if bundle header is not found in packet.+get_bundle :: Get Bundle+get_bundle = do+    h <- getByteString (S.C.length bundleHeader_strict)+    when (h /= bundleHeader_strict) (fail "get_bundle: not a bundle")+    t <- ntpi_to_ntpr <$> getWord64be+    ps <- get_message_seq+    return $ Bundle t ps++-- | Get an OSC 'Packet'.+getPacket :: Get Packet+getPacket = (Packet_Bundle <$> get_bundle) <|> (Packet_Message <$> get_message)++-- | Decode an OSC packet from a lazy ByteString.+--+-- > let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+-- > in decodeOSC b == Message "/g_free" [Int 0]+decodePacket :: B.ByteString -> Packet+{-# INLINE decodePacket #-}+decodePacket = runGet getPacket++-- | Decode an OSC packet from a strict ByteString.+decodePacket_strict :: S.C.ByteString -> Packet+{-# INLINE decodePacket_strict #-}+decodePacket_strict = runGet getPacket . B.fromChunks . (:[])

@@ -0,0 +1,56 @@+-- | Base-level encode function for OSC packets (slow).  For ordinary+--   use see 'Sound.OSC.Coding.Encode.Builder'.+module Sound.OSC.Coding.Encode.Base (encodeMessage+                                    ,encodeBundle+                                    ,encodePacket) where++import Data.Binary {- base -}+import qualified Data.ByteString.Char8 as C {- bytestring -}+import qualified Data.ByteString.Lazy as B {- bytestring -}++import Sound.OSC.Coding.Byte+import Sound.OSC.Type+import Sound.OSC.Time++-- Align a byte string if required.+extend :: Word8 -> B.ByteString -> B.ByteString+extend p s = B.append s (B.replicate (align (B.length s)) p)++-- Encode an OSC datum.+encode_datum :: Datum -> B.ByteString+encode_datum dt =+    case dt of+      Int32 i -> encode i+      Int64 i -> encode i+      Float f -> encode_f32 f+      Double d -> encode_f64 d+      TimeStamp t -> encode_u64 $ ntpr_to_ntpi t+      ASCII_String s -> extend 0 (B.snoc (encode_str s) 0)+      Midi (MIDI b0 b1 b2 b3) -> B.pack [b0,b1,b2,b3]+      Blob b -> let n = encode_i32 (fromIntegral (B.length b))+                in B.append n (extend 0 b)++-- | Encode an OSC 'Message'.+encodeMessage :: Message -> B.ByteString+encodeMessage (Message c l) =+    B.concat [encode_datum (ASCII_String (C.pack c))+             ,encode_datum (ASCII_String (descriptor l))+             ,B.concat (map encode_datum l) ]++-- Encode an OSC 'Message' as an OSC blob.+encode_message_blob :: Message -> Datum+encode_message_blob = Blob . encodeMessage++-- | Encode an OSC 'Bundle'.+encodeBundle :: Bundle -> B.ByteString+encodeBundle (Bundle t m) =+    B.concat [bundleHeader+             ,encode_u64 (ntpr_to_ntpi t)+             ,B.concat (map (encode_datum . encode_message_blob) m)]++-- | Encode an OSC 'Packet'.+encodePacket :: Packet -> B.ByteString+encodePacket o =+    case o of+      Packet_Message m -> encodeMessage m+      Packet_Bundle b -> encodeBundle b

@@ -0,0 +1,95 @@+-- | Optimised encode function for OSC packets.+module Sound.OSC.Coding.Encode.Builder+    (build_packet+    ,encodeMessage+    ,encodeBundle+    ,encodePacket+    ,encodePacket_strict) where++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 -}+import Data.Monoid (mappend, mconcat) {- base -}+import Data.Word (Word8) {- base -}++import Sound.OSC.Coding.Byte (align, bundleHeader)+import Sound.OSC.Time+import Sound.OSC.Type++-- 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_ascii :: ASCII -> B.Builder+build_ascii s = B.fromByteString s `mappend` B.fromWord8s (0:padding (align (S.length s + 1)))++-- 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 d =+    case d of+      Int32 i -> B.fromInt32be (fromIntegral i)+      Int64 i -> B.fromInt64be (fromIntegral i)+      Float n -> B.fromWord32be (I.floatToWord (realToFrac n))+      Double n -> B.fromWord64be (I.doubleToWord n)+      TimeStamp t -> B.fromWord64be (fromIntegral (ntpr_to_ntpi t))+      ASCII_String s -> build_ascii s+      Midi (MIDI b0 b1 b2 b3) -> B.fromWord8s [b0,b1,b2,b3]+      Blob b -> build_bytes b++-- Encode an OSC 'Message'.+build_message :: Message -> B.Builder+build_message (Message c l) =+    mconcat [build_string c+            ,build_ascii (descriptor l)+            ,mconcat $ map build_datum l]++-- Encode an OSC 'Bundle'.+build_bundle_ntpi :: NTPi -> [Message] -> B.Builder+build_bundle_ntpi t l =+    mconcat [B.fromLazyByteString bundleHeader+            ,B.fromWord64be t+            ,mconcat $ map (build_bytes . B.toLazyByteString . build_message) l]++-- | Builder monoid for an OSC 'Packet'.+build_packet :: Packet -> B.Builder+build_packet o =+    case o of+      Packet_Message m -> build_message m+      Packet_Bundle (Bundle t m) -> build_bundle_ntpi (ntpr_to_ntpi t) m++{-# INLINE encodeMessage #-}+{-# INLINE encodeBundle #-}+{-# INLINE encodePacket #-}+{-# INLINE encodePacket_strict #-}++-- | Encode an OSC 'Message'.+encodeMessage :: Message -> L.ByteString+encodeMessage = B.toLazyByteString . build_packet . Packet_Message++-- | Encode an OSC 'Bundle'.+encodeBundle :: Bundle -> L.ByteString+encodeBundle = B.toLazyByteString . build_packet . Packet_Bundle++-- | Encode an OSC 'Packet' to a lazy 'L.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+encodePacket :: Packet -> L.ByteString+encodePacket = B.toLazyByteString . build_packet++-- | Encode an Packet packet to a strict ByteString.+encodePacket_strict :: Packet -> S.ByteString+encodePacket_strict = B.toByteString . build_packet

@@ -0,0 +1,22 @@+-- | Composite of non-transport related modules.+--+-- Provides the 'Datum', 'Message', 'Bundle' and 'Packet' types and+-- the 'Datem', 'OSC' and 'Coding' type-classes.+--+-- The basic constructors are 'message' and 'bundle', the basic coding+-- functions are 'encodePacket' and 'decodePacket'.+--+-- > import Sound.OSC.Core+-- >+-- > let {o = bundle immediately [message "/g_free" [Int32 0]]+-- >     ;e = encodeBundle o :: String}+-- > in decodeBundle e == o+module Sound.OSC.Core (module M) where++import Sound.OSC.Class as M+import Sound.OSC.Coding as M+import Sound.OSC.Datum as M+import Sound.OSC.Normalise as M+import Sound.OSC.Time as M+import Sound.OSC.Type as M+import Sound.OSC.Wait as M

@@ -0,0 +1,63 @@+-- | 'Datum' related functions.+module Sound.OSC.Datum where++import qualified Data.ByteString.Lazy as B {- bytestring -}+import qualified Data.ByteString.Char8 as C {- bytestring -}+import Data.Int {- base -}+import Data.Word {- base -}++import Sound.OSC.Type++-- | Type specialised 'd_get'.+--+-- > map datum_int32 [Int32 1,Float 1] == [Just 1,Nothing]+datum_int32 :: Datum -> Maybe Int32+datum_int32 = d_get++-- | Type specialised 'd_get'.+datum_int64 :: Datum -> Maybe Int64+datum_int64 = d_get++-- | Type specialised 'd_get'.+datum_float :: Datum -> Maybe Float+datum_float = d_get++-- | Type specialised 'd_get'.+datum_double :: Datum -> Maybe Double+datum_double = d_get++-- | Type specialised 'd_get'.+--+-- > datum_ascii (d_put (C.pack "string")) == Just (C.pack "string")+datum_ascii :: Datum -> Maybe ASCII+datum_ascii = d_get++-- | 'C.unpack' of 'd_get'.+--+-- > datum_string (d_put (C.pack "string")) == Just "string"+datum_string :: Datum -> Maybe String+datum_string = fmap C.unpack . datum_ascii++-- | Type specialised 'd_get'.+datum_blob :: Datum -> Maybe B.ByteString+datum_blob = d_get++-- | 'Maybe' variant of 'd_timestamp'.+datum_timestamp :: Datum -> Maybe Time+datum_timestamp d = case d of {TimeStamp x -> Just x;_ -> Nothing}++-- | Type specialised 'd_get'.+datum_midi :: Datum -> Maybe MIDI+datum_midi = d_get++-- | 'Datum' as sequence of 'Word8' if 'ASCII_String', 'Blob' or 'Midi'.+--+-- > let d = [string "5",Blob (B.pack [53]),midi (0x00,0x90,0x40,0x60)]+-- > in Data.Maybe.mapMaybe datum_sequence d == [[53],[53],[0,144,64,96]]+datum_sequence :: Datum -> Maybe [Word8]+datum_sequence d =+    case d of+      ASCII_String s -> Just (map (fromIntegral . fromEnum) (C.unpack s))+      Blob s -> Just (B.unpack s)+      Midi (MIDI p q r s) -> Just [p,q,r,s]+      _ -> Nothing

@@ -1,8 +1,7 @@--- | Composite of "Sound.OpenSoundControl" and--- "Sound.OSC.Transport.FD".+-- | Composite of "Sound.OSC.Core" and "Sound.OSC.Transport.FD". module Sound.OSC.FD (module M) where -import Sound.OpenSoundControl as M+import Sound.OSC.Core as M import Sound.OSC.Transport.FD as M import Sound.OSC.Transport.FD.UDP as M import Sound.OSC.Transport.FD.TCP as M

@@ -0,0 +1,64 @@+-- | Datum normalisation.+module Sound.OSC.Normalise where++import Sound.OSC.Type as O++-- | Lift 'O.Int32' to 'O.Int64' and 'O.Float' to 'O.Double'.+--+-- > map normalise_datum [Int32 1,Float 1] == [Int64 1,Double 1]+normalise_datum :: Datum -> Datum+normalise_datum d =+    case d of+      Int32 n -> Int64 (fromIntegral n)+      Float n -> Double (realToFrac n)+      _ -> d++-- | A normalised 'O.Message' has only 'O.Int64' and 'O.Double'+-- numerical values.+--+-- > let m = message "/m" [Int32 0,Float 0]+-- > in normalise_message m == message "/m" [Int64 0,Double 0]+normalise_message :: Message -> Message+normalise_message = message_coerce normalise_datum++-- | A normalised 'O.Bundle' has only 'O.Int64' and 'O.Double'+-- numerical values.+normalise_bundle :: Bundle -> Bundle+normalise_bundle = bundle_coerce normalise_datum++-- * Coercion++-- | Map a normalising function over datum at an OSC 'Message'.+message_coerce :: (Datum -> Datum) -> Message -> Message+message_coerce f (Message s xs) = Message s (map f xs)++-- | Map a normalising function over datum at an OSC 'Bundle'.+bundle_coerce :: (Datum -> Datum) -> Bundle -> Bundle+bundle_coerce f (Bundle t xs) = Bundle t (map (message_coerce f) xs)++-- * Promotion++-- | Coerce 'Int32', 'Int64' and 'Float' to 'Double'.+--+-- > map datum_promote [Int32 5,Float 5] == [Double 5,Double 5]+datum_promote :: Datum -> Datum+datum_promote d =+    case d of+      Int32 n -> Double (fromIntegral n)+      Int64 n -> Double (fromIntegral n)+      Float n -> Double (realToFrac n)+      _ -> d++-- | 'O.Datum' as 'O.Int64' if 'O.Int32', 'O.Int64', 'O.Float' or+-- 'O.Double'.+--+-- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5,string "5"]+-- > in map datum_floor d == [Int64 5,Int64 5,Int64 5,Int64 5,string "5"]+datum_floor :: Datum -> Datum+datum_floor d =+    case d of+      Int32 x -> Int64 (fromIntegral x)+      Float x -> Int64 (fromInteger (floor x))+      Double x -> Int64 (fromInteger (floor x))+      _ -> d+

@@ -0,0 +1,111 @@+-- | OSC related timing functions.  OSC timestamps are @NTP@ values,+-- <http://ntp.org/>.+module Sound.OSC.Time where++import Control.Concurrent {- base -}+import Control.Monad {- base -}+import Control.Monad.IO.Class {- transformers -}+import Data.Word {- base -}+import qualified Data.Time as T {- time -}+import qualified Data.Time.Clock.POSIX as T {- time -}++import Sound.OSC.Type++-- * Temporal types++-- | Type for integer (binary) representation of @NTP@ time.+type NTPi = Word64++-- | @Unix/Posix@ epoch time in real-valued (fractional) form.+type UT = Double++-- * Time conversion++-- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp.+ntpr_to_ntpi :: RealFrac n => n -> NTPi+ntpr_to_ntpi t = round (t * 2^(32::Int))++-- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp.+ntpi_to_ntpr :: Fractional n => NTPi -> n+ntpi_to_ntpr t = fromIntegral t / 2^(32::Int)++-- | Difference (in seconds) between /NTP/ and /UT/ epochs.+--+-- > ntp_ut_epoch_diff / (24 * 60 * 60) == 25567+ntp_ut_epoch_diff :: Num n => n+ntp_ut_epoch_diff = (70 * 365 + 17) * 24 * 60 * 60++-- | Convert a 'UT' timestamp to an 'NTPi' timestamp.+ut_to_ntpi :: UT -> NTPi+ut_to_ntpi t = ntpr_to_ntpi (t + ntp_ut_epoch_diff)++-- | Convert @Unix/Posix@ to @NTP@.+ut_to_ntpr :: Num n => n -> n+ut_to_ntpr = (+) ntp_ut_epoch_diff++-- | Convert @NTP@ to @Unix/Posix@.+ntpr_to_ut :: Num n => n -> n+ntpr_to_ut = (+) (negate ntp_ut_epoch_diff)++-- | Convert 'NTPi' to @Unix/Posix@.+ntpi_to_ut :: NTPi -> UT+ntpi_to_ut = ntpr_to_ut . ntpi_to_ntpr++-- * 'Data.Time' inter-operation.++-- | The time at 1970-01-01:00:00:00.+ut_epoch :: T.UTCTime+ut_epoch =+    let d = T.fromGregorian 1970 1 1+        s = T.secondsToDiffTime 0+    in T.UTCTime d s++-- | Convert 'T.UTCTime' to @Unix/Posix@.+utc_to_ut :: Fractional n => T.UTCTime -> n+utc_to_ut t = realToFrac (T.diffUTCTime t ut_epoch)++-- * Clock operations++-- | Read current real-valued @NTP@ timestamp.+--+-- > do {ct <- fmap utc_to_ut T.getCurrentTime+-- >    ;pt <- fmap realToFrac T.getPOSIXTime+-- >    ;print (pt - ct,pt - ct < 1e-5)}+time :: MonadIO m => m Time+time = liftIO (fmap (ut_to_ntpr . realToFrac) T.getPOSIXTime)++-- * Thread operations.++-- | The 'pauseThread' limit (in seconds).  Values larger than this+-- require a different thread delay mechanism, see 'sleepThread'.  The+-- value is the number of microseconds in @maxBound::Int@.+pauseThreadLimit :: Fractional n => n+pauseThreadLimit = fromIntegral (maxBound::Int) / 1e6++-- | Pause current thread for the indicated duration (in seconds), see+--   'pauseThreadLimit'.+pauseThread :: (MonadIO m,Ord n,RealFrac n) => n -> m ()+pauseThread n = when (n > 0) (liftIO (threadDelay (floor (n * 1e6))))++-- | Type restricted 'pauseThread'.+wait :: MonadIO m => Double -> m ()+wait = pauseThread++-- | Pause current thread until the given 'Time', see+-- 'pauseThreadLimit'.+pauseThreadUntil :: MonadIO m => Time -> m ()+pauseThreadUntil t = pauseThread . (t -) =<< time++-- | Sleep current thread for the indicated duration (in seconds).+--   Divides long sleeps into parts smaller than 'pauseThreadLimit'.+sleepThread :: (RealFrac n, MonadIO m) => n -> m ()+sleepThread n =+    if n >= pauseThreadLimit+    then let n' = pauseThreadLimit - 1+         in pauseThread n >> sleepThread (n - n')+    else pauseThread n++-- | Sleep current thread until the given 'Time'.  Divides long sleeps+-- into parts smaller than 'pauseThreadLimit'.+sleepThreadUntil :: MonadIO m => Time -> m ()+sleepThreadUntil t = sleepThread . (t -) =<< time

@@ -2,12 +2,13 @@ -- @TCP@ transport. module Sound.OSC.Transport.FD where -import Control.Exception-import Data.List-import Data.Maybe-import Sound.OpenSoundControl.Class-import Sound.OpenSoundControl.Type-import Sound.OpenSoundControl.Wait+import Control.Exception {- base -}+import Data.List {- base -}+import Data.Maybe {- base -}++import Sound.OSC.Class+import Sound.OSC.Type+import Sound.OSC.Wait  -- | Abstract over the underlying transport protocol. class Transport t where

@@ -2,13 +2,14 @@ module Sound.OSC.Transport.FD.TCP where  import qualified Data.ByteString.Lazy as B {- bytestring -}-import Control.Monad+import Control.Monad {- base -} import Network {- network -}-import Sound.OpenSoundControl.Class-import Sound.OpenSoundControl.Coding-import Sound.OpenSoundControl.Coding.Byte+import System.IO {- base -}++import Sound.OSC.Class+import Sound.OSC.Coding+import Sound.OSC.Coding.Byte import Sound.OSC.Transport.FD-import System.IO  -- | The TCP transport handle data type. data TCP = TCP {tcpHandle :: Handle}

@@ -1,15 +1,13 @@ -- | OSC over UDP implementation. module Sound.OSC.Transport.FD.UDP where -import Control.Monad-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as B-import qualified Network.Socket as N-import qualified Network.Socket.ByteString as C (sendTo,recvFrom)-import qualified Network.Socket.ByteString.Lazy as C (send,recv)-import Sound.OpenSoundControl.Class-import Sound.OpenSoundControl.Coding-import Sound.OpenSoundControl.Type+import Control.Monad {- base -}+import qualified Network.Socket as N {- network -}+import qualified Network.Socket.ByteString as C {- network -}++import Sound.OSC.Class+import Sound.OSC.Coding+import Sound.OSC.Type import Sound.OSC.Transport.FD  -- | The UDP transport handle data type.@@ -20,6 +18,7 @@ udpPort (UDP fd) = fmap fromIntegral (N.socketPort fd)  instance Transport UDP where+   -- C.L.send is not implemented for W32    sendOSC (UDP fd) msg = void (C.send fd (encodeOSC msg))    recvPacket (UDP fd) = liftM decodePacket (C.recv fd 8192)    close (UDP fd) = N.sClose fd@@ -57,14 +56,12 @@ -- | Send variant to send to specified address. sendTo :: OSC o => UDP -> o -> N.SockAddr -> IO () sendTo (UDP fd) o a = do-  -- Network.Socket.ByteString.Lazy.sendTo does not exist-  let o' = S.pack (B.unpack (encodeOSC o))-  void (C.sendTo fd o' a)+  -- C.L.sendTo does not exist+  void (C.sendTo fd (encodeOSC o) a)  -- | Recv variant to collect message source address. recvFrom :: UDP -> IO (Packet, N.SockAddr) recvFrom (UDP fd) = do-  -- Network.Socket.ByteString.Lazy.recvFrom does not exist+  -- C.L.recvFrom does not exist   (s,a) <- C.recvFrom fd 8192-  let s' = B.pack (S.unpack s)-  return (decodePacket s',a)+  return (decodePacket s,a)

@@ -1,15 +1,16 @@ -- | Monad class implementing an Open Sound Control transport. module Sound.OSC.Transport.Monad where -import Control.Monad (liftM)+import Control.Monad (liftM) {- base -} import Control.Monad.Trans.Reader {- transformers -}-import Control.Monad.IO.Class as M-import Data.List-import Data.Maybe-import Sound.OpenSoundControl.Class+import Control.Monad.IO.Class as M {- transformers -}+import Data.List {- base -}+import Data.Maybe {- base -}++import Sound.OSC.Class import qualified Sound.OSC.Transport.FD as T-import Sound.OpenSoundControl.Type-import Sound.OpenSoundControl.Wait+import Sound.OSC.Type+import Sound.OSC.Wait  -- | Sender monad. class Monad m => SendOSC m where

@@ -0,0 +1,377 @@+-- | Alegbraic data types for OSC datum and packets.+module Sound.OSC.Type where++import qualified Data.ByteString.Lazy as B {- bytestring -}+import qualified Data.ByteString.Char8 as C {- bytestring -}+import Data.Int {- base -}+import Data.List {- base -}+import Data.Word {- base -}+import Numeric {- base -}++-- * Time++-- | @NTP@ time in real-valued (fractional) form.+type Time = Double++-- | Constant indicating a bundle to be executed immediately.+immediately :: Time+immediately = 1 / 2^(32::Int)++-- * Datum++-- | Type enumerating Datum categories.+type Datum_Type = Char++-- | Type for ASCII strings (strict 'Char'8 'C.ByteString').+type ASCII = C.ByteString++-- | Four-byte midi message.+data MIDI = MIDI Word8 Word8 Word8 Word8+    deriving (Eq,Show,Read)++-- | The basic elements of OSC messages.+data Datum = Int32 {d_int32 :: Int32}+           | Int64 {d_int64 :: Int64}+           | Float {d_float :: Float}+           | Double {d_double :: Double}+           | ASCII_String {d_ascii_string :: ASCII}+           | Blob {d_blob :: B.ByteString}+           | TimeStamp {d_timestamp :: Time}+           | Midi {d_midi :: MIDI}+             deriving (Eq,Read,Show)++-- | Single character identifier of an OSC datum.+datum_tag :: Datum -> Datum_Type+datum_tag dt =+    case dt of+      Int32 _ -> 'i'+      Int64 _ -> 'h'+      Float _ -> 'f'+      Double _ -> 'd'+      ASCII_String _ -> 's'+      Blob _ -> 'b'+      TimeStamp _ -> 't'+      Midi _ -> 'm'++-- | 'Datum' as 'Integral' if 'Sound.OSC.Type.Int32' or+-- 'Sound.OSC.Type.Int64'.+--+-- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]+-- > in map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing]+datum_integral :: Integral i => Datum -> Maybe i+datum_integral d =+    case d of+      Int32 x -> Just (fromIntegral x)+      Int64 x -> Just (fromIntegral x)+      _ -> Nothing++-- | 'Datum' as 'Floating' if 'Sound.OSC.Type.Int32',+-- 'Sound.OSC.Type.Int64', 'Sound.OSC.Type.Float',+-- 'Sound.OSC.Type.Double' or 'TimeStamp'.+--+-- > let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]+-- > in Data.Maybe.mapMaybe datum_floating d == replicate 5 (5::Double)+datum_floating :: Floating n => Datum -> Maybe n+datum_floating d =+    case d of+      Int32 n -> Just (fromIntegral n)+      Int64 n -> Just (fromIntegral n)+      Float n -> Just (realToFrac n)+      Double n -> Just (realToFrac n)+      TimeStamp n -> Just (realToFrac n)+      _ -> Nothing++-- | Class for translating to and from 'Datum'.  There are instances+-- for the direct 'Datum' field types.+--+-- > d_put (1::Int32) == Int32 1+-- > d_put (1::Int64) == Int64 1+-- > d_put (1::Float) == Float 1+-- > d_put (1::Double) == Double 1+-- > d_put (C.pack "str") == ASCII_String (C.pack "str")+-- > d_put (B.pack [37,37]) == Blob (B.pack [37,37])+-- > d_put (MIDI 0 0 0 0) == Midi (MIDI 0 0 0 0)+--+-- There are also instances for standard Haskell types.+--+-- > d_put (1::Int) == Int64 1+-- > d_put (1::Integer) == Int64 1+class Datem a where+    d_put :: a -> Datum+    d_get :: Datum -> Maybe a++instance Datem Int32 where+    d_put = Int32+    d_get d = case d of {Int32 x -> Just x;_ -> Nothing}++instance Datem Int64 where+    d_put = Int64+    d_get d = case d of {Int64 x -> Just x;_ -> Nothing}++instance Datem Int where+    d_put = Int64 . fromIntegral+    d_get = datum_integral++instance Datem Integer where+    d_put = Int64 . fromIntegral+    d_get = datum_integral++instance Datem Float where+    d_put = Float+    d_get d = case d of {Float x -> Just x;_ -> Nothing}++instance Datem Double where+    d_put = Double+    d_get d = case d of {Double x -> Just x;_ -> Nothing}++instance Datem C.ByteString where+    d_put = ASCII_String+    d_get d = case d of {ASCII_String x -> Just x;_ -> Nothing}++instance Datem B.ByteString where+    d_put = Blob+    d_get d = case d of {Blob x -> Just x;_ -> Nothing}++instance Datem MIDI where+    d_put = Midi+    d_get d = case d of {Midi x -> Just x;_ -> Nothing}++-- | Type generalised 'Sound.OSC.Type.Int32'.+--+-- > int32 (1::Int32) == int32 (1::Integer)+-- > d_int32 (int32 (maxBound::Int32)) == maxBound+-- > int32 (((2::Int) ^ (64::Int))::Int) == Int32 0+int32 :: Integral n => n -> Datum+int32 = Int32 . fromIntegral++-- | Type generalised 'Sound.OSC.Type.Int64'.+--+-- > int64 (1::Int32) == int64 (1::Integer)+-- > d_int64 (int64 (maxBound::Int64)) == maxBound+int64 :: Integral n => n -> Datum+int64 = Int64 . fromIntegral++-- | Type generalised 'Sound.OSC.Type.Float'.+--+-- > float (1::Int) == float (1::Double)+-- > floatRange (undefined::Float) == (-125,128)+-- > isInfinite (d_float (float (encodeFloat 1 256 :: Double))) == True+float :: Real n => n -> Datum+float = Float . realToFrac++-- | Type generalised 'Sound.OSC.Type.Double'.+--+-- > double (1::Int) == double (1::Double)+-- > double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77+double :: Real n => n -> Datum+double = Double . realToFrac++-- | 'ASCII_String' of 'C.pack'.+--+-- > string "string" == ASCII_String (C.pack "string")+string :: String -> Datum+string = ASCII_String . C.pack++-- | Four-tuple variant of 'Midi' '.' 'MIDI'.+--+-- > midi (0,0,0,0) == Midi (MIDI 0 0 0 0)+midi :: (Word8,Word8,Word8,Word8) -> Datum+midi (p,q,r,s) = Midi (MIDI p q r s)++-- * Message++-- | OSC address pattern.  This is strictly an ASCII value, but it is+-- very common to pattern match on addresses and matching on+-- 'C.ByteString' requires @OverloadedStrings@.+type Address_Pattern = String++-- | An OSC message.+data Message = Message {messageAddress :: Address_Pattern+                       ,messageDatum :: [Datum]}+               deriving (Eq,Read,Show)++-- | 'Message' constructor.  It is an 'error' if the 'Address_Pattern'+-- doesn't conform to the OSC specification.+message :: Address_Pattern -> [Datum] -> Message+message a xs =+    case a of+      '/':_ -> Message a xs+      _ -> error "message: ill-formed address pattern"++-- | Message argument types are given by a descriptor.+--+-- > C.unpack (descriptor [Int32 1,Float 1,string "1"]) == ",ifs"+descriptor :: [Datum] -> ASCII+descriptor l = C.pack (',' : map datum_tag l)++-- | Descriptor tags are @comma@ prefixed.+descriptor_tags :: ASCII -> ASCII+descriptor_tags = C.drop 1++-- * Bundle++-- | An OSC bundle.+data Bundle = Bundle {bundleTime :: Time+                     ,bundleMessages :: [Message]}+              deriving (Eq,Read,Show)++-- | OSC 'Bundle's can be ordered (time ascending).+instance Ord Bundle where+    compare (Bundle a _) (Bundle b _) = compare a b++-- | 'Bundle' constructor. It is an 'error' if the 'Message' list is+-- empty.+bundle :: Time -> [Message] -> Bundle+bundle t xs =+    case xs of+      [] -> error "bundle: empty?"+      _ -> Bundle t xs++-- * Packet++-- | An OSC 'Packet' is either a 'Message' or a 'Bundle'.+data Packet = Packet_Message {packetMessage :: Message}+            | Packet_Bundle {packetBundle :: Bundle}+              deriving (Eq,Read,Show)++-- | 'Packet_Bundle' '.' 'bundle'.+p_bundle :: Time -> [Message] -> Packet+p_bundle t = Packet_Bundle . bundle t++-- | 'Packet_Message' '.' 'message'.+p_message :: Address_Pattern -> [Datum] -> Packet+p_message a = Packet_Message . message a++-- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is+-- 'immediately'.+packetTime :: Packet -> Time+packetTime = at_packet (const immediately) bundleTime++-- | Retrieve the set of 'Message's from a 'Packet'.+packetMessages :: Packet -> [Message]+packetMessages = at_packet return bundleMessages++-- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.+packet_to_bundle :: Packet -> Bundle+packet_to_bundle = at_packet (\m -> Bundle immediately [m]) id++-- | If 'Packet' is a 'Message' or a 'Bundle' with an /immediate/ time+-- tag and with one element, return the 'Message', else 'Nothing'.+packet_to_message :: Packet -> Maybe Message+packet_to_message p =+    case p of+      Packet_Bundle b ->+          case b of+            Bundle t [m] -> if t == immediately then Just m else Nothing+            _ -> Nothing+      Packet_Message m -> Just m++-- | Is 'Packet' immediate, ie. a 'Bundle' with timestamp+-- 'immediately', or a plain Message.+packet_is_immediate :: Packet -> Bool+packet_is_immediate = (== immediately) . packetTime++-- | Variant of 'either' for 'Packet'.+at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a+at_packet f g p =+    case p of+      Packet_Message m -> f m+      Packet_Bundle b -> g b++-- * Address Query++-- | Does 'Message' have the specified 'Address_Pattern'.+message_has_address :: Address_Pattern -> Message -> Bool+message_has_address x = (== x) . messageAddress++-- | Do any of the 'Message's at 'Bundle' have the specified+-- 'Address_Pattern'.+bundle_has_address :: Address_Pattern -> Bundle -> Bool+bundle_has_address x = any (message_has_address x) . bundleMessages++-- | Does 'Packet' have the specified 'Address_Pattern', ie.+-- 'message_has_address' or 'bundle_has_address'.+packet_has_address :: Address_Pattern -> Packet -> Bool+packet_has_address x =+    at_packet (message_has_address x)+              (bundle_has_address x)++-- * Pretty printing++-- | Pretty printer for 'Time' (truncate to 4 decimal places).+--+-- > timePP (1/3) == "0.3333"+timePP :: Time -> String+timePP t = showGFloat (Just 4) t ""++-- | Pretty printer for vectors.+--+-- > vecPP [1::Int,2,3] == "<1,2,3>"+vecPP :: Show a => [a] -> String+vecPP v = '<' : intercalate "," (map show v) ++ ">"++-- | Pretty printer for 'Datum'.+--+-- > let d = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60)]+-- > in map datumPP d ==  ["1","1.2","\"str\"","<0,144,64,96>"]+datumPP :: Datum -> String+datumPP d =+    case d of+      Int32 n -> show n+      Int64 n -> show n+      Float n -> show n+      Double n -> show n+      ASCII_String s -> show (C.unpack s)+      Blob s -> show s+      TimeStamp t -> timePP t+      Midi (MIDI p q r s) -> vecPP [p,q,r,s]++-- | Pretty printer for 'Message'.+messagePP :: Message -> String+messagePP (Message a d) =+    let d' = map datumPP d+    in unwords ("#message" : a : d')++-- | Pretty printer for 'Bundle'.+bundlePP :: Bundle -> String+bundlePP (Bundle t m) =+    let m' = intersperse ";" (map messagePP m)+    in unwords ("#bundle" : timePP t : m')++-- | Pretty printer for 'Packet'.+packetPP :: Packet -> String+packetPP p =+    case p of+      Packet_Message m -> messagePP m+      Packet_Bundle b -> bundlePP b++-- * Parser++-- | Variant of 'read'.+readMaybe :: (Read a) => String -> Maybe a+readMaybe s =+    case reads s of+      [(x, "")] -> Just x+      _ -> Nothing++-- | Given 'Datum_Type' attempt to parse 'Datum' at 'String'.+--+-- > parse_datum 'i' "42" == Just (Int32 42)+-- > parse_datum 'h' "42" == Just (Int64 42)+-- > parse_datum 'f' "3.14159" == Just (Float 3.14159)+-- > parse_datum 'd' "3.14159" == Just (Double 3.14159)+-- > parse_datum 's' "\"pi\"" == Just (string "pi")+-- > parse_datum 'b' "[112,105]" == Just (Blob (B.pack [112,105]))+-- > parse_datum 'm' "(0,144,60,90)" == Just (midi (0,144,60,90))+parse_datum :: Datum_Type -> String -> Maybe Datum+parse_datum ty =+    case ty of+      'i' -> fmap Int32 . readMaybe+      'h' -> fmap Int64 . readMaybe+      'f' -> fmap Float . readMaybe+      'd' -> fmap Double . readMaybe+      's' -> fmap (ASCII_String . C.pack) . readMaybe+      'b' -> fmap (Blob . B.pack) . readMaybe+      't' -> error "parse_datum: timestamp"+      'm' -> fmap midi . readMaybe+      _ -> error "parse_datum: type"

@@ -0,0 +1,28 @@+-- | Waiting (for replies).+module Sound.OSC.Wait where++import System.Timeout {- base -}++-- * Timeout++-- | Real valued variant of 'timeout'.+timeout_r :: Double -> IO a -> IO (Maybe a)+timeout_r t = timeout (floor (t * 1000000))++-- * Wait++-- | Repeat action until predicate /f/ is 'True' when applied to+-- result.+untilPredicate :: Monad m => (a -> Bool) -> m a -> m a+untilPredicate f act =+    let g p = if f p then rec else return p+        rec = act >>= g+    in rec++-- | Repeat action until /f/ does not give 'Nothing' when applied to+-- result.+untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b+untilMaybe f act =+    let g p = case f p of {Nothing -> rec;Just r -> return r}+        rec = act >>= g+    in rec

@@ -1,20 +0,0 @@--- | Composite of non-transport related modules.------ Provides the 'Datum', 'Message', 'Bundle' and 'Packet' types and--- the 'OSC' and 'Coding' type-classes.------ The basic constructors are 'message' and 'bundle', the basic coding--- functions are 'encodePacket' and 'decodePacket'.------ > import Sound.OpenSoundControl--- >--- > let {o = bundle immediately [message "/g_free" [Int 0]]--- >     ;e = encodeBundle o :: String}--- > in decodeBundle e == o-module Sound.OpenSoundControl (module M) where--import Sound.OpenSoundControl.Class as M-import Sound.OpenSoundControl.Coding as M-import Sound.OpenSoundControl.Type as M-import Sound.OpenSoundControl.Time as M-import Sound.OpenSoundControl.Wait as M

@@ -1,31 +0,0 @@--- | Typeclass for encoding and decoding OSC packets.-module Sound.OpenSoundControl.Class where--import Sound.OpenSoundControl.Type-import Sound.OpenSoundControl.Coding---- | A type-class for values that can be translated to and from OSC--- 'Packet's.-class OSC o where-    toPacket :: o -> Packet -- ^ Translation to 'Packet'.-    fromPacket :: Packet -> Maybe o -- ^ Translation from 'Packet'.--instance OSC Message where-    toPacket = Packet_Message-    fromPacket = packet_to_message--instance OSC Bundle where-    toPacket = Packet_Bundle-    fromPacket = Just . packet_to_bundle--instance OSC Packet where-    toPacket = id-    fromPacket = Just---- | 'encodePacket' '.' 'toPacket'.-encodeOSC :: (Coding c,OSC o) => o -> c-encodeOSC = encodePacket . toPacket---- | 'fromPacket' '.' 'decodePacket'.-decodeOSC :: (Coding c,OSC o) => c -> Maybe o-decodeOSC = fromPacket . decodePacket

@@ -1,47 +0,0 @@-{-# LANGUAGE FlexibleInstances,TypeSynonymInstances #-}--- | A type-class to provide coding operations to different data types---   using the same function names.-module Sound.OpenSoundControl.Coding where--import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString.Lazy.Char8 as C-import Sound.OpenSoundControl.Type-import qualified Sound.OpenSoundControl.Coding.Decode.Binary as Binary-import qualified Sound.OpenSoundControl.Coding.Encode.Builder as Builder---- | Converting from and to binary packet representations.-class Coding a where-    encodePacket :: Packet -> a -- ^ Decode an OSC packet.-    decodePacket :: a -> Packet -- ^ Encode an OSC packet.--instance Coding S.ByteString where-    encodePacket = Builder.encodePacket_strict-    decodePacket = Binary.decodePacket_strict--instance Coding B.ByteString where-    encodePacket = Builder.encodePacket-    decodePacket = Binary.decodePacket--instance Coding String where-    encodePacket = C.unpack . encodePacket-    decodePacket = decodePacket . C.pack---- | An 'encodePacket' and 'decodePacket' pair over 'B.ByteString'.-type Coder = (Packet -> B.ByteString,B.ByteString -> Packet)---- | 'encodePacket' '.' 'Packet_Message'.-encodeMessage :: Coding c => Message -> c-encodeMessage = encodePacket . Packet_Message---- | 'encodePacket' '.' 'Packet_Bundle'.-encodeBundle :: Coding c => Bundle -> c-encodeBundle = encodePacket . Packet_Bundle---- | 'packet_to_message' '.' 'decodePacket'.-decodeMessage :: Coding c => c -> Maybe Message-decodeMessage = packet_to_message . decodePacket---- | 'packet_to_bundle' '.' 'decodePacket'.-decodeBundle :: Coding c => c -> Bundle-decodeBundle = packet_to_bundle . decodePacket

@@ -1,96 +0,0 @@--- | Byte-level coding utility functions.-module Sound.OpenSoundControl.Coding.Byte where--import Data.Binary-import Data.Bits-import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString.Lazy.Char8 as C-import Data.Int-import Sound.OpenSoundControl.Coding.Cast---- | Encode a signed 8-bit integer.-encode_i8 :: Int -> B.ByteString-encode_i8 n = encode (fromIntegral n :: Int8)---- | Encode a signed 16-bit integer.-encode_i16 :: Int -> B.ByteString-encode_i16 n = encode (fromIntegral n :: Int16)---- | Encode a signed 32-bit integer.-encode_i32 :: Int -> B.ByteString-encode_i32 n = encode (fromIntegral n :: Int32)---- | Encode an unsigned 16-bit integer.-encode_u32 :: Int -> B.ByteString-encode_u32 n = encode (fromIntegral n :: Word32)---- | Encode a signed 64-bit integer.-encode_i64 :: Int64 -> B.ByteString-encode_i64 = encode---- | Encode an unsigned 64-bit integer.-encode_u64 :: Word64 -> B.ByteString-encode_u64 = encode---- | Encode a 32-bit IEEE floating point number.-encode_f32 :: Double -> B.ByteString-encode_f32 = encode . f32_w32 . realToFrac---- | Encode a 64-bit IEEE floating point number.-encode_f64 :: Double -> B.ByteString-encode_f64 = encode . f64_w64---- | Encode an ASCII string.-encode_str :: String -> B.ByteString-{-# INLINE encode_str #-}-encode_str = C.pack---- | Decode a signed 8-bit integer.-decode_i8 :: B.ByteString -> Int-decode_i8 b = fromIntegral (decode b :: Int8)---- | Decode a signed 16-bit integer.-decode_i16 :: B.ByteString -> Int-decode_i16 b = fromIntegral (decode b :: Int16)---- | Decode a signed 32-bit integer.-decode_i32 :: B.ByteString -> Int-decode_i32 b = fromIntegral (decode b :: Int32)---- | Decode an unsigned 32-bit integer.-decode_u32 :: B.ByteString -> Int-decode_u32 b = fromIntegral (decode b :: Word32)---- | Decode a signed 64-bit integer.-decode_i64 :: B.ByteString -> Int64-decode_i64 = decode---- | Decode an unsigned 64-bit integer.-decode_u64 :: B.ByteString -> Word64-decode_u64 = decode---- | Decode a 32-bit IEEE floating point number.-decode_f32 :: B.ByteString -> Double-decode_f32 b = realToFrac (w32_f32 (decode b :: Word32))---- | Decode a 64-bit IEEE floating point number.-decode_f64 :: B.ByteString -> Double-decode_f64 b = w64_f64 (decode b :: Word64)---- | Decode an ASCII string.-decode_str :: B.ByteString -> String-{-# INLINE decode_str #-}-decode_str = C.unpack---- | Bundle header string.-bundleHeader :: B.ByteString-{-# INLINE bundleHeader #-}-bundleHeader = C.pack "#bundle\0"---- | The number of bytes required to align an OSC value to the next---   4-byte boundary.------ > map align [0::Int .. 7] == [0,3,2,1,0,3,2,1]-align :: (Num i,Bits i) => i -> i-{-# INLINE align #-}-align n = ((n + 3) .&. complement 3) - n

@@ -1,43 +0,0 @@--- | Bit-level type casts and byte layout string typecasts.-module Sound.OpenSoundControl.Coding.Cast (f32_w32,w32_f32-                                          ,f64_w64,w64_f64-                                          ,str_cstr,cstr_str-                                          ,str_pstr,pstr_str) where--import qualified Data.Binary.IEEE754 as I-import Data.Char-import Data.Word---- | The IEEE byte representation of a float.-f32_w32 :: Float -> Word32-f32_w32 = I.floatToWord---- | Inverse of 'f32_w32'.-w32_f32 :: Word32 -> Float-w32_f32 = I.wordToFloat---- | The IEEE byte representation of a double.-f64_w64 :: Double -> Word64-f64_w64 = I.doubleToWord---- | Inverse of 'f64_i64'.-w64_f64 :: Word64 -> Double-w64_f64 = I.wordToDouble---- | Transform a haskell string into a C string (a null suffixed byte---   string).-str_cstr :: String -> [Word8]-str_cstr s = map (fromIntegral . ord) s ++ [0]---- | Inverse of 'str_cstr'.-cstr_str :: [Word8] -> String-cstr_str = map (chr . fromIntegral) . takeWhile (/= 0)---- | Transform a haskell string to a pascal string (a length prefixed---   byte string).-str_pstr :: String -> [Word8]-str_pstr s = fromIntegral (length s) : map (fromIntegral . ord) s---- | Inverse of 'str_pstr'.-pstr_str :: [Word8] -> String-pstr_str = map (chr . fromIntegral) . drop 1

@@ -1,39 +0,0 @@--- | OSC packet coercion and normalization.-module Sound.OpenSoundControl.Coding.Coerce where--import Sound.OpenSoundControl.Type---- | Map a normalizing function over datum at an OSC 'Message'.-message_coerce :: (Datum -> Datum) -> Message -> Message-message_coerce f (Message s xs) = Message s (map f xs)---- | Map a normalizing function over datum at an OSC 'Bundle'.-bundle_coerce :: (Datum -> Datum) -> Bundle -> Bundle-bundle_coerce f (Bundle t xs) = Bundle t (map (message_coerce f) xs)---- | Coerce Float to Double.-f_to_d :: Datum -> Datum-f_to_d d =-    case d of-      Float n -> Double n-      _ -> d---- | Coerce Int and Float to Double.-if_to_d :: Datum -> Datum-if_to_d d =-    case d of-      Int n -> Double (fromIntegral n)-      Float n -> Double n-      _ -> d---- | Coerce Float and Double to Int.-fd_to_i :: Datum -> Datum-fd_to_i d =-    case d of-      Float n -> Int (round n)-      Double n -> Int (round n)-      _ -> d---- | A normalized osc packet has only Int and Double numerical values.---normalize :: OSC -> OSC---normalize = coerce f_to_d

@@ -1,98 +0,0 @@--- | Base-level decode function for OSC packets (slow).  For ordinary---   use see 'Sound.OpenSoundControl.Coding.Decode.Binary'.-module Sound.OpenSoundControl.Coding.Decode.Base (decodeMessage-                                                 ,decodeBundle-                                                 ,decodePacket) where--import qualified Data.ByteString.Lazy as B-import Data.List-import Data.Maybe-import Sound.OpenSoundControl.Coding.Byte-import Sound.OpenSoundControl.Time-import Sound.OpenSoundControl.Type---- The plain byte count of an OSC value.-size :: Datum_Type -> B.ByteString -> Int-size ty b =-    case ty of-      'i' -> 4-      'f' -> 4-      'd' -> 8-      't' -> 8 -- timetag-      'm' -> 4 -- MIDI message-      's' -> fromIntegral (fromMaybe-                           (error ("size: no terminating zero: " ++ show b))-                           (B.elemIndex 0 b))-      'b' -> decode_i32 (B.take 4 b)-      _ -> error "size: illegal type"---- The storage byte count of an OSC value.-storage :: Datum_Type -> B.ByteString -> Int-storage ty b =-    case ty of-      's' -> let n = size 's' b + 1 in n + align n-      'b' -> let n = size 'b' b in n + align n + 4-      _ -> size ty B.empty---- Decode an OSC datum-decode_datum :: Datum_Type -> B.ByteString -> Datum-decode_datum ty b =-    case ty of-      'i' -> Int (decode_i32 b)-      'f' -> Float (decode_f32 b)-      'd' -> Double (decode_f64 b)-      's' -> String (decode_str (b_take (size 's' b) b))-      'b' -> Blob (b_take (size 'b' b) (B.drop 4 b))-      't' -> TimeStamp (ntpi_to_ntpr (decode_u64 b))-      'm' -> let [b0,b1,b2,b3] = B.unpack (B.take 4 b) in Midi (b0,b1,b2,b3)-      _ -> error ("decode_datum: illegal type (" ++ [ty] ++ ")")---- Decode a sequence of OSC datum given a type descriptor string.-decode_datum_seq :: String -> B.ByteString -> [Datum]-decode_datum_seq cs b =-    let swap (x,y) = (y,x)-        f b' c = swap (B.splitAt (fromIntegral (storage c b')) b')-    in zipWith decode_datum cs (snd (mapAccumL f b cs))---- | Decode an OSC 'Message'.-decodeMessage :: B.ByteString -> Message-decodeMessage b =-    let n = storage 's' b-        (String cmd) = decode_datum 's' b-        m = storage 's' (b_drop n b)-        (String dsc) = decode_datum 's' (b_drop n b)-        arg = decode_datum_seq (drop 1 dsc) (b_drop (n + m) b)-    in Message cmd arg---- Decode a sequence of OSC messages, each one headed by its length-decode_message_seq :: B.ByteString -> [Message]-decode_message_seq b =-    let s = decode_i32 b-        m = decodeMessage (b_drop 4 b)-        nxt = decode_message_seq (b_drop (4+s) b)-    in if B.length b == 0 then [] else m:nxt---- | Decode an OSC 'Bundle'.-decodeBundle :: B.ByteString -> Bundle-decodeBundle b =-    let h = storage 's' b -- header (should be '#bundle')-        t = storage 't' (b_drop h b) -- time tag-        (TimeStamp timeStamp) = decode_datum 't' (b_drop h b)-        ms = decode_message_seq (b_drop (h+t) b)-    in Bundle timeStamp 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]--- > in decodePacket b == Message "/g_free" [Int 0]-decodePacket :: B.ByteString -> Packet-decodePacket b =-    if bundleHeader `B.isPrefixOf` b-    then Packet_Bundle (decodeBundle b)-    else Packet_Message (decodeMessage b)--b_take :: Int -> B.ByteString -> B.ByteString-b_take = B.take . fromIntegral--b_drop :: Int -> B.ByteString -> B.ByteString-b_drop = B.drop . fromIntegral

@@ -1,115 +0,0 @@--- | Optimised decode function for OSC packets.-module Sound.OpenSoundControl.Coding.Decode.Binary-    (getPacket-    ,decodePacket-    ,decodePacket_strict) where--import Control.Applicative-import Data.Binary.Get-import qualified Data.Binary.IEEE754 as I-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Char8 as C-import Data.Int (Int32)-import Data.Word (Word32)-import Sound.OpenSoundControl.Coding.Byte-import Sound.OpenSoundControl.Time-import Sound.OpenSoundControl.Type---- | Isolate an action to operating within a fixed block of bytes. The action---   is required to consume all the bytes that it is isolated to.-isolate :: Word32 -> Get a -> Get a-isolate n m = do-    s <- get_bytes n-    let (a, s', _) = runGetState m s 0-    if L.null s'-        then return a-        else fail "isolate: not all bytes consumed"---- | Get a 32 biut integer in big-endian byte order.-getInt32be :: Get Int32-getInt32be = fromIntegral <$> getWord32be---- | Get an aligned OSC string.-get_string :: Get String-get_string = do-    s <- getLazyByteStringNul-    skip (fromIntegral (align (L.length s + 1)))-    return $ C.unpack s---- | Get binary data prefixed by byte count.-get_bytes :: Word32 -> Get L.ByteString-get_bytes n = do-    b <- getLazyByteString (fromIntegral n)-    if n /= fromIntegral (L.length b)-        then fail "get_bytes: end of stream"-        else skip (fromIntegral (align n))-    return b---- | Get an OSC datum.-get_datum :: Datum_Type -> Get Datum-get_datum ty =-    case ty of-      'i' -> Int    <$> fromIntegral <$> getInt32be-      'f' -> Float  <$> realToFrac <$> I.getFloat32be-      'd' -> Double <$> I.getFloat64be-      's' -> String <$> get_string-      'b' -> Blob   <$> (get_bytes =<< getWord32be)-      't' -> TimeStamp <$> ntpi_to_ntpr <$> getWord64be-      'm' -> do b0 <- getWord8-                b1 <- getWord8-                b2 <- getWord8-                b3 <- getWord8-                return $ Midi (b0,b1,b2,b3)-      _ -> fail ("get_datum: illegal type " ++ show ty)---- | Get an OSC 'Message'.-get_message :: Get Message-get_message = do-    cmd <- get_string-    dsc <- get_string-    case dsc of-        (',':tags) -> do-            arg <- mapM get_datum tags-            return $ Message cmd arg-        _ -> fail "get_message: invalid type descriptor string"---- | Get a sequence of OSC 'Message's, each one headed by its length.-get_message_seq :: Get [Message]-get_message_seq = do-    b <- isEmpty-    if b-        then return []-        else do-            p <- flip isolate get_message =<< getWord32be-            ps <- get_message_seq-            return (p:ps)--get_bundle :: Get Bundle-get_bundle = do-    skip (fromIntegral (L.length bundleHeader))-    t <- ntpi_to_ntpr <$> getWord64be-    ps <- get_message_seq-    return $ Bundle t ps---- | Get an OSC 'Packet'.-getPacket :: Get Packet-getPacket = do-    h <- uncheckedLookAhead (L.length bundleHeader)-    if h == bundleHeader-        then fmap Packet_Bundle get_bundle-        else fmap Packet_Message get_message----- | Decode an OSC packet from a lazy ByteString.------ > let b = L.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]--- > in decodeOSC b == Message "/g_free" [Int 0]-decodePacket :: L.ByteString -> Packet-{-# INLINE decodePacket #-}-decodePacket = runGet getPacket---- | Decode an OSC packet from a strict ByteString.-decodePacket_strict :: S.ByteString -> Packet-{-# INLINE decodePacket_strict #-}-decodePacket_strict = runGet getPacket . L.fromChunks . (:[])

@@ -1,57 +0,0 @@--- | Base-level encode function for OSC packets (slow).  For ordinary---   use see 'Sound.OpenSoundControl.Coding.Encode.Builder'.-module Sound.OpenSoundControl.Coding.Encode.Base (encodeMessage-                                                 ,encodeBundle-                                                 ,encodePacket) where--import qualified Data.ByteString.Lazy as B-import Data.Word-import Sound.OpenSoundControl.Coding.Byte-import Sound.OpenSoundControl.Type-import Sound.OpenSoundControl.Time---- Command argument types are given by a descriptor.-descriptor :: [Datum] -> Datum-descriptor l = String (',' : map datum_tag l)---- Align a byte string if required.-extend :: Word8 -> B.ByteString -> B.ByteString-extend p s = B.append s (B.replicate (align (B.length s)) p)---- Encode an OSC datum.-encode_datum :: Datum -> B.ByteString-encode_datum dt =-    case dt of-      Int i -> encode_i32 i-      Float f -> encode_f32 f-      Double d -> encode_f64 d-      TimeStamp t -> encode_u64 $ ntpr_to_ntpi t-      String s -> extend 0 (B.snoc (encode_str s) 0)-      Midi (b0,b1,b2,b3) -> B.pack [b0,b1,b2,b3]-      Blob b -> let n = encode_i32 (fromIntegral (B.length b))-                in B.append n (extend 0 b)---- | Encode an OSC 'Message'.-encodeMessage :: Message -> B.ByteString-encodeMessage (Message c l) =-    B.concat [encode_datum (String c)-             ,encode_datum (descriptor l)-             ,B.concat (map encode_datum l) ]---- Encode an OSC 'Message' as an OSC blob.-encode_message_blob :: Message -> Datum-encode_message_blob = Blob . encodeMessage---- | Encode an OSC 'Bundle'.-encodeBundle :: Bundle -> B.ByteString-encodeBundle (Bundle t m) =-    B.concat [bundleHeader-             ,encode_u64 (ntpr_to_ntpi t)-             ,B.concat (map (encode_datum . encode_message_blob) m)]---- | Encode an OSC 'Packet'.-encodePacket :: Packet -> B.ByteString-encodePacket o =-    case o of-      Packet_Message m -> encodeMessage m-      Packet_Bundle b -> encodeBundle b

@@ -1,93 +0,0 @@--- | Optimised encode function for OSC packets.-module Sound.OpenSoundControl.Coding.Encode.Builder-    (build_packet-    ,encodeMessage-    ,encodeBundle-    ,encodePacket-    ,encodePacket_strict) 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---- Command argument types are given by a descriptor.-descriptor :: [Datum] -> String-descriptor l = ',' : map datum_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 d =-    case d of-      Int i -> B.fromInt32be (fromIntegral i)-      Float n -> B.fromWord32be (I.floatToWord (realToFrac n))-      Double n -> B.fromWord64be (I.doubleToWord n)-      TimeStamp t -> B.fromWord64be (fromIntegral (ntpr_to_ntpi t))-      String s -> build_string s-      Midi (b0,b1,b2,b3) -> B.fromWord8s [b0,b1,b2,b3]-      Blob b -> build_bytes b---- Encode an OSC 'Message'.-build_message :: Message -> B.Builder-build_message (Message c l) =-    mconcat [build_string c-            ,build_string (descriptor l)-            ,mconcat $ map build_datum l]---- Encode an OSC 'Bundle'.-build_bundle_ntpi :: NTPi -> [Message] -> B.Builder-build_bundle_ntpi t l =-    mconcat [B.fromLazyByteString bundleHeader-            ,B.fromWord64be t-            ,mconcat $ map (build_bytes . B.toLazyByteString . build_message) l]---- | Builder monoid for an OSC 'Packet'.-build_packet :: Packet -> B.Builder-build_packet o =-    case o of-      Packet_Message m -> build_message m-      Packet_Bundle (Bundle t m) -> build_bundle_ntpi (ntpr_to_ntpi t) m--{-# INLINE encodeMessage #-}-{-# INLINE encodeBundle #-}-{-# INLINE encodePacket #-}-{-# INLINE encodePacket_strict #-}---- | Encode an OSC 'Message'.-encodeMessage :: Message -> L.ByteString-encodeMessage = B.toLazyByteString . build_packet . Packet_Message---- | Encode an OSC 'Bundle'.-encodeBundle :: Bundle -> L.ByteString-encodeBundle = B.toLazyByteString . build_packet . Packet_Bundle---- | Encode an OSC 'Packet' to a lazy 'L.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-encodePacket :: Packet -> L.ByteString-encodePacket = B.toLazyByteString . build_packet---- | Encode an Packet packet to a strict ByteString.-encodePacket_strict :: Packet -> S.ByteString-encodePacket_strict = B.toByteString . build_packet

@@ -1,120 +0,0 @@--- | OSC related timing functions.  OSC timestamps are @NTP@ values,--- <http://ntp.org/>.-module Sound.OpenSoundControl.Time where--import Control.Concurrent-import Control.Monad-import Control.Monad.IO.Class-import Data.Word-import qualified Data.Time as T-import qualified Data.Time.Clock.POSIX as T---- * Temporal types---- | Type for integer (binary) representation of @NTP@ time.-type NTPi = Word64---- | @NTP@ time in real-valued (fractional) form.-type Time = Double---- | @Unix/Posix@ epoch time in real-valued (fractional) form.-type UT = Double---- * Time conversion---- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp.-ntpr_to_ntpi :: RealFrac n => n -> NTPi-ntpr_to_ntpi t = round (t * 2^(32::Int))---- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp.-ntpi_to_ntpr :: Fractional n => NTPi -> n-ntpi_to_ntpr t = fromIntegral t / 2^(32::Int)---- | Difference (in seconds) between /NTP/ and /UT/ epochs.------ > ntp_ut_epoch_diff / (24 * 60 * 60) == 25567-ntp_ut_epoch_diff :: Num n => n-ntp_ut_epoch_diff = (70 * 365 + 17) * 24 * 60 * 60---- | Convert a 'UT' timestamp to an 'NTPi' timestamp.-ut_to_ntpi :: UT -> NTPi-ut_to_ntpi t = ntpr_to_ntpi (t + ntp_ut_epoch_diff)---- | Convert @Unix/Posix@ to @NTP@.-ut_to_ntpr :: Num n => n -> n-ut_to_ntpr = (+) ntp_ut_epoch_diff---- | Convert @NTP@ to @Unix/Posix@.-ntpr_to_ut :: Num n => n -> n-ntpr_to_ut = (+) (negate ntp_ut_epoch_diff)---- | Convert 'NTPi' to @Unix/Posix@.-ntpi_to_ut :: NTPi -> UT-ntpi_to_ut = ntpr_to_ut . ntpi_to_ntpr---- * Constants---- | Constant indicating a bundle to be executed immediately.------ > ntpr_to_ntpi immediately == 1-immediately :: Time-immediately = ntpi_to_ntpr 1---- * 'Data.Time' inter-operation.---- | The time at 1970-01-01:00:00:00.-ut_epoch :: T.UTCTime-ut_epoch =-    let d = T.fromGregorian 1970 1 1-        s = T.secondsToDiffTime 0-    in T.UTCTime d s---- | Convert 'T.UTCTime' to @Unix/Posix@.-utc_to_ut :: Fractional n => T.UTCTime -> n-utc_to_ut t = realToFrac (T.diffUTCTime t ut_epoch)---- * Clock operations---- | Read current real-valued @NTP@ timestamp.------ > do {ct <- fmap utc_to_ut T.getCurrentTime--- >    ;pt <- fmap realToFrac T.getPOSIXTime--- >    ;print (pt - ct,pt - ct < 1e-5)}-time :: MonadIO m => m Time-time = liftIO (fmap (ut_to_ntpr . realToFrac) T.getPOSIXTime)---- * Thread operations.---- | The 'pauseThread' limit (in seconds).  Values larger than this--- require a different thread delay mechanism, see 'sleepThread'.  The--- value is the number of microseconds in @maxBound::Int@.-pauseThreadLimit :: Fractional n => n-pauseThreadLimit = fromIntegral (maxBound::Int) / 1e6---- | Pause current thread for the indicated duration (in seconds), see---   'pauseThreadLimit'.-pauseThread :: (MonadIO m,Ord n,RealFrac n) => n -> m ()-pauseThread n = when (n > 0) (liftIO (threadDelay (floor (n * 1e6))))---- | Type restricted 'pauseThread'.-wait :: MonadIO m => Double -> m ()-wait = pauseThread---- | Pause current thread until the given 'Time', see--- 'pauseThreadLimit'.-pauseThreadUntil :: MonadIO m => Time -> m ()-pauseThreadUntil t = pauseThread . (t -) =<< time---- | Sleep current thread for the indicated duration (in seconds).---   Divides long sleeps into parts smaller than 'pauseThreadLimit'.-sleepThread :: (RealFrac n, MonadIO m) => n -> m ()-sleepThread n =-    if n >= pauseThreadLimit-    then let n' = pauseThreadLimit - 1-         in pauseThread n >> sleepThread (n - n')-    else pauseThread n---- | Sleep current thread until the given 'Time'.  Divides long sleeps--- into parts smaller than 'pauseThreadLimit'.-sleepThreadUntil :: MonadIO m => Time -> m ()-sleepThreadUntil t = sleepThread . (t -) =<< time

@@ -1,252 +0,0 @@--- | Alegbraic data types for OSC datum and packets.-module Sound.OpenSoundControl.Type where--import qualified Data.ByteString.Lazy as B-import Data.List-import Data.Maybe-import Data.Word-import Sound.OpenSoundControl.Time---- | Type enumerating Datum categories.-type Datum_Type = Char---- | The basic elements of OSC messages.-data Datum = Int Int-           | Float Double-           | Double Double-           | String String-           | Blob B.ByteString-           | TimeStamp Time-           | Midi (Word8,Word8,Word8,Word8)-             deriving (Eq,Read,Show)---- | OSC address pattern.-type Address_Pattern = String---- | An OSC message.-data Message = Message {messageAddress :: Address_Pattern-                       ,messageDatum :: [Datum]}-               deriving (Eq,Read,Show)---- | An OSC bundle.-data Bundle = Bundle {bundleTime :: Time-                     ,bundleMessages :: [Message]}-              deriving (Eq,Read,Show)---- | An OSC 'Packet' is either a 'Message' or a 'Bundle'.-data Packet = Packet_Message {packetMessage :: Message}-            | Packet_Bundle {packetBundle :: Bundle}-              deriving (Eq,Read,Show)---- | OSC 'Bundle's can be ordered (time ascending).-instance Ord Bundle where-    compare (Bundle a _) (Bundle b _) = compare a b---- | 'Bundle' constructor. It is an 'error' if the 'Message' list is--- empty.-bundle :: Time -> [Message] -> Bundle-bundle t xs =-    case xs of-      [] -> error "bundle: empty?"-      _ -> Bundle t xs---- | 'Message' constructor.  It is an 'error' if the 'Address_Pattern'--- doesn't conform to the OSC specification.-message :: Address_Pattern -> [Datum] -> Message-message a xs =-    case a of-      '/':_ -> Message a xs-      _ -> error "message: ill-formed address pattern"---- | 'Packet_Bundle' '.' 'bundle'.-p_bundle :: Time -> [Message] -> Packet-p_bundle t = Packet_Bundle . bundle t---- | 'Packet_Message' '.' 'message'.-p_message :: Address_Pattern -> [Datum] -> Packet-p_message a = Packet_Message . message a---- * Datum---- | Single character identifier of an OSC datum.-datum_tag :: Datum -> Datum_Type-datum_tag dt =-    case dt of-      Int _ -> 'i'-      Float _ -> 'f'-      Double _ -> 'd'-      String _ -> 's'-      Blob _ -> 'b'-      TimeStamp _ -> 't'-      Midi _ -> 'm'---- | Variant of 'read'.-readMaybe :: (Read a) => String -> Maybe a-readMaybe s =-    case reads s of-      [(x, "")] -> Just x-      _ -> Nothing---- | Given 'Datum_Type' attempt to parse 'Datum' at 'String'.------ > parse_datum 'i' "42" == Just (Int 42)--- > parse_datum 'f' "3.14159" == Just (Float 3.14159)--- > parse_datum 'd' "3.14159" == Just (Double 3.14159)--- > parse_datum 's' "\"pi\"" == Just (String "pi")--- > parse_datum 'b' "pi" == Just (Blob (B.pack [112,105]))--- > parse_datum 'm' "(0,144,60,90)" == Just (Midi (0,144,60,90))-parse_datum :: Datum_Type -> String -> Maybe Datum-parse_datum ty =-    case ty of-      'i' -> fmap Int . readMaybe-      'f' -> fmap Float . readMaybe-      'd' -> fmap Double . readMaybe-      's' -> fmap String . readMaybe-      'b' -> Just . Blob . B.pack . map (fromIntegral . fromEnum)-      't' -> error "parse_datum: timestamp"-      'm' -> fmap Midi . readMaybe-      _ -> error "parse_datum: type"---- | 'Datum' as real number if 'Double', 'Float' or 'Int', else 'Nothing'.------ > map datum_real [Int 5,Float 5,String "5"] == [Just 5,Just 5,Nothing]-datum_real :: Datum -> Maybe Double-datum_real d =-    case d of-      Double n -> Just n-      Float n -> Just n-      Int n -> Just (fromIntegral n)-      _ -> Nothing---- | A 'fromJust' variant of 'datum_real'.------ > map datum_real_err [Int 5,Float 5] == [5,5]-datum_real_err :: Datum -> Double-datum_real_err = fromJust . datum_real---- | 'Datum' as integral number if 'Double', 'Float' or 'Int', else--- 'Nothing'.------ > map datum_int [Int 5,Float 5.5,String "5"] == [Just 5,Just 5,Nothing]-datum_int :: Integral i => Datum -> Maybe i-datum_int d =-    case d of-      Int x -> Just (fromIntegral x)-      Float x -> Just (floor x)-      Double x -> Just (floor x)-      _ -> Nothing---- | A 'fromJust' variant of 'datum_int'.------ > map datum_int_err [Int 5,Float 5.5] == [5,5]-datum_int_err :: Integral i => Datum -> i-datum_int_err = fromJust . datum_int---- | 'Datum' as 'String' if 'String' or 'Blob', else 'Nothing'.------ > map datum_string [String "5",Blob (B.pack [53])] == [Just "5",Just "5"]-datum_string :: Datum -> Maybe String-datum_string d =-    case d of-      Blob s -> Just (map (toEnum . fromIntegral) (B.unpack s))-      String s -> Just s-      _ -> Nothing---- | A 'fromJust' variant of 'datum_string'.------ > map datum_string_err [String "5",Blob (B.pack [53])] == ["5","5"]-datum_string_err :: Datum -> String-datum_string_err = fromJust . datum_string---- * Address---- | Does 'Message' have the specified 'Address_Pattern'.-message_has_address :: Address_Pattern -> Message -> Bool-message_has_address x = (== x) . messageAddress---- | Do any of the 'Message's at 'Bundle' have the specified--- 'Address_Pattern'.-bundle_has_address :: Address_Pattern -> Bundle -> Bool-bundle_has_address x = any (message_has_address x) . bundleMessages---- * Packet---- | Does 'Packet' have the specified 'Address_Pattern', ie.--- 'message_has_address' or 'bundle_has_address'.-packet_has_address :: Address_Pattern -> Packet -> Bool-packet_has_address x =-    at_packet (message_has_address x)-              (bundle_has_address x)---- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is--- 'immediately'.-packetTime :: Packet -> Time-packetTime = at_packet (const immediately) bundleTime---- | Retrieve the set of 'Message's from a 'Packet'.-packetMessages :: Packet -> [Message]-packetMessages = at_packet return bundleMessages---- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.-packet_to_bundle :: Packet -> Bundle-packet_to_bundle = at_packet (\m -> Bundle immediately [m]) id---- | If 'Packet' is a 'Message' or a 'Bundle' with an /immediate/ time--- tag and with one element, return the 'Message', else 'Nothing'.-packet_to_message :: Packet -> Maybe Message-packet_to_message p =-    case p of-      Packet_Bundle b ->-          case b of-            Bundle t [m] -> if t == immediately then Just m else Nothing-            _ -> Nothing-      Packet_Message m -> Just m---- | Is 'Packet' immediate, ie. a 'Bundle' with timestamp--- 'immediately', or a plain Message.-packet_is_immediate :: Packet -> Bool-packet_is_immediate = (== immediately) . packetTime---- | Variant of 'either' for 'Packet'.-at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a-at_packet f g p =-    case p of-      Packet_Message m -> f m-      Packet_Bundle b -> g b---- * Pretty printing---- | Pretty printer for 'Time'.-timePP :: Time -> String-timePP = (:) 'N' . show---- | Pretty printer for 'Datum'.------ > map datumPP [Float 1.2,String "str",Midi (0,0x90,0x40,0x60)]-datumPP :: Datum -> String-datumPP d =-    case d of-      Int n -> show n-      Float n -> show n-      Double n -> show n-      String s -> show s-      Blob s -> show s-      TimeStamp t -> timePP t-      Midi (p,q,r,s) -> '<' : intercalate "," (map show [p,q,r,s]) ++ ">"---- | Pretty printer for 'Message'.-messagePP :: Message -> String-messagePP (Message a d) = unwords ("#message" : a : map datumPP d)---- | Pretty printer for 'Bundle'.-bundlePP :: Bundle -> String-bundlePP (Bundle t m) =-    let m' = intersperse ";" (map messagePP m)-    in unwords ("#bundle" : timePP t : m')---- | Pretty printer for 'Packet'.-packetPP :: Packet -> String-packetPP p =-    case p of-      Packet_Message m -> messagePP m-      Packet_Bundle b -> bundlePP b

@@ -1,27 +0,0 @@-module Sound.OpenSoundControl.Wait where--import System.Timeout---- * Timeout---- | Real valued variant of 'timeout'.-timeout_r :: Double -> IO a -> IO (Maybe a)-timeout_r t = timeout (floor (t * 1000000))---- * Wait---- | Repeat action until predicate /f/ is 'True' when applied to--- result.-untilPredicate :: Monad m => (a -> Bool) -> m a -> m a-untilPredicate f act =-    let g p = if f p then rec else return p-        rec = act >>= g-    in rec---- | Repeat action until /f/ does not give 'Nothing' when applied to--- result.-untilMaybe :: Monad m => (a -> Maybe b) -> m a -> m b-untilMaybe f act =-    let g p = case f p of {Nothing -> rec;Just r -> return r}-        rec = act >>= g-    in rec

@@ -0,0 +1,26 @@+module Sound.OSC.NFData () where++import Control.DeepSeq (NFData(..)) {- deepseq -}+import Sound.OSC.Type++instance NFData Datum where+    rnf (Int32 x1) = rnf x1 `seq` ()+    rnf (Float x1) = rnf x1 `seq` ()+    rnf (Double x1) = rnf x1 `seq` ()+    rnf (ASCII_String x1) = rnf x1 `seq` ()+    rnf (Blob x1) = rnf x1 `seq` ()+    rnf (TimeStamp x1) = rnf x1 `seq` ()+    rnf (Midi x1) = rnf x1 `seq` ()++instance NFData MIDI where+    rnf (MIDI x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()++instance NFData Message where+    rnf (Message x1 x2) = rnf x1 `seq` rnf x2 `seq` ()++instance NFData Bundle where+    rnf (Bundle x1 x2)  = rnf x1 `seq` rnf x2 `seq` ()++instance NFData Packet where+    rnf (Packet_Message x1) = rnf x1 `seq` ()+    rnf (Packet_Bundle x1) = rnf x1 `seq` ()

@@ -0,0 +1,32 @@+import Criterion.Main {- criterion -}+import qualified Data.ByteString.Lazy as B {- bytestring -}++import Sound.OSC+import qualified Sound.OSC.Coding.Decode.Binary as Binary+import qualified Sound.OSC.Coding.Encode.Builder as Builder+import qualified Sound.OSC.Coding.Decode.Base as Decode+import qualified Sound.OSC.Coding.Encode.Base as Encode+import Sound.OSC.NFData ()++type EncodingFunc = Bundle -> B.ByteString+type DecodingFunc = B.ByteString -> Packet++main :: IO ()+main =+    defaultMain [+        bgroup "encodeOSC" [+            bench "Encode"  (nf (Encode.encodeBundle :: EncodingFunc) b)+          , bench "Builder" (nf (Builder.encodeBundle :: EncodingFunc) b)+          ]+      , bgroup "decodeOSC" [+            bench "Decode" (nf (Decode.decodePacket :: DecodingFunc) p)+          , bench "Binary" (nf (Binary.decodePacket :: DecodingFunc) p)+          ]+      ]+    where+        m = Message "/fooblah" [Float 42.0+                               ,Int32 16+                               ,string "yeah"+                               ,Blob (B.pack [0..128])]+        b = Bundle pi (replicate 12 m)+        p = Encode.encodeBundle b

@@ -1,10 +1,10 @@ Name:              hosc-Version:           0.13+Version:           0.14 Synopsis:          Haskell Open Sound Control Description:       @hosc@ implements a subset of the /Open Sound Control/                    byte protocol, <http://opensoundcontrol.org/>.                    .-                   "Sound.OpenSoundControl" implements the actual protocol.+                   "Sound.OSC.Core" implements the actual protocol.                    .                    "Sound.OSC.Transport.FD" implements a                    /file descriptor/ based transport layer for @UDP@@@ -16,7 +16,7 @@                    Composite modules are at "Sound.OSC" and "Sound.OSC.FD". License:           GPL Category:          Sound-Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2006-2012+Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2006-2013 Author:            Rohan Drape, Stefan Kersten Maintainer:        rd@slavepianos.org Stability:         Experimental@@ -28,7 +28,7 @@  Library   Build-Depends:   base == 4.*,-                   binary,+                   binary >= 0.6,                    blaze-builder >= 0.3,                    bytestring,                    data-binary-ieee754,@@ -36,26 +36,58 @@                    time,                    transformers   GHC-Options:     -Wall -fwarn-tabs-  Exposed-modules: Sound.OpenSoundControl-                   Sound.OpenSoundControl.Class-                   Sound.OpenSoundControl.Coding.Byte-                   Sound.OpenSoundControl.Coding.Cast-                   Sound.OpenSoundControl.Coding.Coerce-                   Sound.OpenSoundControl.Coding.Decode.Base-                   Sound.OpenSoundControl.Coding.Decode.Binary-                   Sound.OpenSoundControl.Coding.Encode.Base-                   Sound.OpenSoundControl.Coding.Encode.Builder-                   Sound.OpenSoundControl.Type-                   Sound.OpenSoundControl.Coding-                   Sound.OpenSoundControl.Time-                   Sound.OpenSoundControl.Wait-                   Sound.OSC+  Exposed-modules: Sound.OSC+                   Sound.OSC.Class+                   Sound.OSC.Coding+                   Sound.OSC.Coding.Byte+                   Sound.OSC.Coding.Cast+                   Sound.OSC.Coding.Decode.Base+                   Sound.OSC.Coding.Decode.Binary+                   Sound.OSC.Coding.Encode.Base+                   Sound.OSC.Coding.Encode.Builder+                   Sound.OSC.Core+                   Sound.OSC.Datum                    Sound.OSC.FD+                   Sound.OSC.Normalise+                   Sound.OSC.Time                    Sound.OSC.Transport.FD                    Sound.OSC.Transport.FD.TCP                    Sound.OSC.Transport.FD.UDP                    Sound.OSC.Transport.Monad+                   Sound.OSC.Type+                   Sound.OSC.Wait  Source-Repository  head   Type:            darcs   Location:        http://rd.slavepianos.org/sw/hosc/++Benchmark hosc-benchmark+  Type: exitcode-stdio-1.0+  Hs-Source-Dirs: benchmarks+  Main-Is: benchmark.hs+  Other-Modules:+      Sound.OSC.NFData+  Build-Depends:+      base == 4.*+    , hosc == 0.14.*+    , bytestring+    , criterion+    , deepseq+  GHC-Options:      -Wall -fwarn-tabs -rtsopts -fno-warn-orphans+  GHC-Prof-Options: -Wall -fwarn-tabs -rtsopts -auto-all++Test-Suite hosc-test+  Type: exitcode-stdio-1.0+  Hs-Source-Dirs: tests+  Main-Is: test.hs+  Other-Modules:+      Sound.OSC.Arbitrary+  Build-Depends:+      base == 4.*+    , bytestring >= 0.10+    , hosc == 0.14.*+    , QuickCheck >= 2+    , test-framework >= 0.2+    , test-framework-quickcheck2 >= 0.2+  GHC-Options:      -Wall -fwarn-tabs -rtsopts -fno-warn-orphans+  GHC-Prof-Options: -Wall -fwarn-tabs -rtsopts -auto-all

@@ -0,0 +1,43 @@+module Sound.OSC.Arbitrary () where++import Control.Applicative {- base -}+import qualified Data.ByteString.Char8 as C {- bytestring -}+import qualified Data.ByteString.Lazy as B {- bytestring -}+import Test.QuickCheck {- QuickCheck -}++import Sound.OSC++-- Avoid floating point representation/conversion errors+genTime :: Gen Time+genTime = ntpi_to_ntpr <$> arbitrary++genString :: Gen String+genString = resize 128 (listOf (arbitrary `suchThat` (/= '\0')))++genASCII :: Gen ASCII+genASCII = fmap C.pack genString++genMIDI :: Gen MIDI+genMIDI = do+  (p,q,r,s) <- arbitrary+  return (MIDI p q r s)++instance Arbitrary Datum where+    arbitrary = oneof [+        Int32 <$> arbitrary+      , Float <$> realToFrac <$> (arbitrary :: Gen Float)+      , Double <$> arbitrary+      , ASCII_String <$> genASCII+      , Blob <$> B.pack <$> resize 128 arbitrary+      , TimeStamp <$> genTime+      , Midi <$> genMIDI+      ]++genMessage :: Gen Message+genMessage = message <$> ("/"++) <$> genString <*> resize 32 (listOf1 arbitrary)++instance Arbitrary Packet where+    arbitrary = oneof [+        Packet_Message <$> genMessage+      , p_bundle <$> genTime <*> resize 32 (listOf1 genMessage)+      ]

@@ -0,0 +1,23 @@+{-# LANGUAGE ScopedTypeVariables #-}++import           Sound.OSC.Arbitrary ()+import qualified Sound.OSC.Coding.Decode.Base as DecodeBase+import qualified Sound.OSC.Coding.Encode.Base as EncodeBase+import qualified Sound.OSC.Coding.Decode.Binary as DecodeBinary+import qualified Sound.OSC.Coding.Encode.Builder as EncodeBuilder+import           Sound.OSC.Type (Packet)+import           Test.Framework (Test, defaultMain)+import           Test.Framework.Providers.QuickCheck2 (testProperty)++tests :: [Test]+tests =+    [ testProperty "encodePacket (Builder)" $ \(osc :: Packet) ->+        EncodeBuilder.encodePacket osc == EncodeBase.encodePacket osc+    , testProperty "encodePacket/decodePacket" $ \(osc :: Packet) ->+        DecodeBase.decodePacket (EncodeBase.encodePacket osc) == osc+    , testProperty "decodePacket (Get)" $ \(osc :: Packet) ->+        DecodeBinary.decodePacket (EncodeBase.encodePacket osc) == osc+    ]++main :: IO ()+main = defaultMain tests