packages feed

hosc 0.9 → 0.10

raw patch · 21 files changed

+822/−494 lines, 21 filesdep +blaze-builderdep +data-binary-ieee754dep −arraydep ~basedep ~binarydep ~network

Dependencies added: blaze-builder, data-binary-ieee754

Dependencies removed: array

Dependency ranges changed: base, binary, network

Files

− Help/timer.hs 
@@ -1,17 +0,0 @@--- hosc does not directly support a timeout at recv, however the--- standard libraries have the 'System.Timeout.timeout' function that--- works for interupting socket reads.--import Sound.OpenSoundControl-import qualified System.Timeout as T--timeout :: Double -> IO a -> IO (Maybe a)-timeout t =-    let i = floor (t * 1000000)-    in T.timeout i--main :: IO ()-main = do-  fd <- openUDP "127.0.0.1" 57110-  r <- timeout 0.5 (recv fd)-  print r
README view
@@ -8,9 +8,8 @@   http://haskell.org/   http://opensoundcontrol.org/ -(c) rohan drape and others, 2006-2011+(c) rohan drape, stefan kersten and others, 2006-2011     gpl, http://gnu.org/copyleft/     with contributions by alex mclean-                        & stefan kersten                         & henning thielemann     see darcs history for details
Sound/OpenSoundControl.hs view
@@ -1,17 +1,32 @@ -- | hosc implements a subset of the Open Sound Control byte protocol. --   The protocol is documented at <http://opensoundcontrol.org/>.-module Sound.OpenSoundControl (module Sound.OpenSoundControl.OSC,-                               module Sound.OpenSoundControl.Time,-                               module Sound.OpenSoundControl.Cast,-                               module Sound.OpenSoundControl.Byte,-                               module Sound.OpenSoundControl.Transport,-                               module Sound.OpenSoundControl.Transport.UDP,-                               module Sound.OpenSoundControl.Transport.TCP) where+module Sound.OpenSoundControl (module O+                              ,C.encodeOSC,C.decodeOSC+                              ,openUDP,udpServer+                              ,openTCP,tcpServer) where -import Sound.OpenSoundControl.OSC-import Sound.OpenSoundControl.Time-import Sound.OpenSoundControl.Cast-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.Transport-import Sound.OpenSoundControl.Transport.UDP-import Sound.OpenSoundControl.Transport.TCP+import qualified Sound.OpenSoundControl.Coding.Decode.Binary as C+import qualified Sound.OpenSoundControl.Coding.Encode.Builder as C+import Sound.OpenSoundControl.Type as O+import Sound.OpenSoundControl.Time as O+import Sound.OpenSoundControl.Transport as O+import Sound.OpenSoundControl.Transport.UDP as O+import Sound.OpenSoundControl.Transport.TCP as O++-- | Make a UDP connection.+--+-- > withTransport (openUDP "127.0.0.1" 57110) (\fd -> recvT 0.5 fd >>= print)+openUDP :: String -> Int -> IO UDP+openUDP = openUDP' (C.encodeOSC,C.decodeOSC)++-- | Trivial udp server.+udpServer :: String -> Int -> IO UDP+udpServer = udpServer' (C.encodeOSC,C.decodeOSC)++-- | Make a TCP connection.+openTCP :: String -> Int -> IO TCP+openTCP = openTCP' (C.encodeOSC,C.decodeOSC)++-- | A trivial TCP OSC server.+tcpServer :: Int -> (TCP -> IO ()) -> IO ()+tcpServer = tcpServer' (C.encodeOSC,C.decodeOSC)
− Sound/OpenSoundControl/Byte.hs 
@@ -1,81 +0,0 @@--- | Byte-level encoding and decoding functions.-module Sound.OpenSoundControl.Byte where--import Data.Binary-import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString.Lazy.Char8 as BC-import Data.Char-import Data.Int-import Sound.OpenSoundControl.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 :: Integer -> B.ByteString-encode_i64 n = encode (fromIntegral n :: Int64)---- | Encode an unsigned 64-bit integer.-encode_u64 :: Integer -> B.ByteString-encode_u64 n = encode (fromIntegral n :: Word64)---- | Encode a 32-bit IEEE floating point number.-encode_f32 :: Double -> B.ByteString-encode_f32 = encode . f32_i32 . realToFrac---- | Encode a 64-bit IEEE floating point number.-encode_f64 :: Double -> B.ByteString-encode_f64 = encode . f64_i64---- | Encode an ASCII string.-encode_str :: String -> B.ByteString-encode_str = B.pack . map (fromIntegral . ord)---- | 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 -> Integer-decode_i64 b = fromIntegral (decode b :: Int64)---- | Decode an unsigned 64-bit integer.-decode_u64 :: B.ByteString -> Integer-decode_u64 b = fromIntegral (decode b :: Word64)---- | Decode a 32-bit IEEE floating point number.-decode_f32 :: B.ByteString -> Double-decode_f32 b = realToFrac (i32_f32 (decode b :: Int32))---- | Decode a 64-bit IEEE floating point number.-decode_f64 :: B.ByteString -> Double-decode_f64 b = i64_f64 (decode b :: Int64)---- | Decode an ASCII string.-decode_str :: B.ByteString -> String-decode_str = BC.unpack
− Sound/OpenSoundControl/Cast.hs 
@@ -1,62 +0,0 @@--- | Bit-level type casts and byte layout string typecasts.-module Sound.OpenSoundControl.Cast (f32_i32, i32_f32,-                                    f64_i64, i64_f64,-                                    str_cstr, cstr_str,-                                    str_pstr, pstr_str) where--import Control.Monad.ST-import Data.Array.ST-import Data.Char-import Data.Int-import Data.Word---- | The IEEE byte representation of a float packed into an integer.-f32_i32 :: Float -> Int32-f32_i32 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Int32)---- | Inverse of 'f32_i32'.-i32_f32 :: Int32 -> Float-i32_f32 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Float)---- | The IEEE byte representation of a double packed into an integer.-f64_i64 :: Double -> Int64-f64_i64 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Int64)--{--http://www.haskell.org/pipermail/haskell-cafe/2008-February/040000.html--{-# LANGUAGE MagicHash #-}-import Data.Int-import GHC.Exts--f64_i64 :: Double -> Int64 --ghc only-f64_i64 (D# x) = I64# (unsafeCoerce# x)--}---- | Inverse of 'f64_i64'.-i64_f64 :: Int64 -> Double-i64_f64 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Double)---- | 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---- One element marray.-unit_array :: (MArray a e m) => e -> m (a Int e)-unit_array = newArray (0, 0::Int)---- Extract first element from array.-from_array :: (MArray a e m) => a Int e -> m e-from_array = flip readArray 0
+ Sound/OpenSoundControl/Coding.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TypeSynonymInstances #-}+-- | A type-class to provide coding operations to different data types+--   using the same function names.+module Sound.OpenSoundControl.Coding (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 (OSC)+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+    -- | Decode an OSC packet.+    encodeOSC :: OSC -> a+    -- | Encode an OSC packet.+    decodeOSC :: a -> OSC++instance Coding S.ByteString where+    encodeOSC = Builder.encodeOSC'+    decodeOSC = Binary.decodeOSC'++instance Coding B.ByteString where+    encodeOSC = Builder.encodeOSC+    decodeOSC = Binary.decodeOSC++instance Coding String where+    encodeOSC = C.unpack . encodeOSC+    decodeOSC = decodeOSC . C.pack
+ Sound/OpenSoundControl/Coding/Byte.hs view
@@ -0,0 +1,94 @@+-- | 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.+align :: Bits i => i -> i+{-# INLINE align #-}+align n = ((n + 3) .&. complement 3) - n
+ Sound/OpenSoundControl/Coding/Cast.hs view
@@ -0,0 +1,43 @@+-- | 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
+ Sound/OpenSoundControl/Coding/Coerce.hs view
@@ -0,0 +1,38 @@+-- | OSC packet coercion and normalization.+module Sound.OpenSoundControl.Coding.Coerce where++import Sound.OpenSoundControl.Type++-- | Map a normalizing function over datum at an osc packet.+coerce :: (Datum -> Datum) -> OSC -> OSC+coerce f o =+    case o of+      Message s xs -> Message s (map f xs)+      Bundle t xs -> Bundle t (map (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
+ Sound/OpenSoundControl/Coding/Decode/Base.hs view
@@ -0,0 +1,92 @@+-- | Base-level decode function for OSC packets (slow).  For ordinary+--   use see 'Sound.OpenSoundControl.Coding.Decode.Binary'.+module Sound.OpenSoundControl.Coding.Decode.Base (decodeOSC) 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 :: Char -> 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 :: Char -> 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 :: Char -> 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 (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.+decode_message :: B.ByteString -> OSC+decode_message 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 -> [OSC]+decode_message_seq b =+    let s = decode_i32 b+        m = decode_message $ b_drop 4 b+        nxt = decode_message_seq $ b_drop (4+s) b+    in if B.length b == 0 then [] else m:nxt++decode_bundle :: B.ByteString -> OSC+decode_bundle 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.+decodeOSC :: B.ByteString -> OSC+decodeOSC b =+    if bundleHeader `B.isPrefixOf` b+    then decode_bundle b+    else decode_message 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
+ Sound/OpenSoundControl/Coding/Decode/Binary.hs view
@@ -0,0 +1,113 @@+-- | Optimised decode function for OSC packets.+module Sound.OpenSoundControl.Coding.Decode.Binary (getOSC+                                                   ,decodeOSC+                                                   ,decodeOSC') 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 B+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 B.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 (B.length s + 1)))+    return $ 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 :: Char -> Get Datum+get_datum 'i' = Int    <$> fromIntegral <$> getInt32be+get_datum 'f' = Float  <$> realToFrac <$> I.getFloat32be+get_datum 'd' = Double <$> I.getFloat64be+get_datum 's' = String <$> get_string+get_datum 'b' = Blob   <$> (get_bytes =<< getWord32be)+get_datum 't' = TimeStamp <$> NTPi <$> getWord64be+get_datum 'm' = do+    b0 <- getWord8+    b1 <- getWord8+    b2 <- getWord8+    b3 <- getWord8+    return $ Midi (b0,b1,b2,b3)+get_datum t = fail ("get_datum: illegal type " ++ show t)++-- | Get an OSC message.+get_message :: Get OSC+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 an OSC packet.+get_packet :: Get OSC+get_packet = do+    h <- uncheckedLookAhead (B.length bundleHeader)+    if h == bundleHeader+        then get_bundle+        else get_message++-- | Get a sequence of OSC messages, each one headed by its length.+get_packet_seq :: Get [OSC]+get_packet_seq = do+    b <- isEmpty+    if b+        then return []+        else do+            p <- flip isolate get_packet =<< getWord32be+            ps <- get_packet_seq+            return (p:ps)++get_bundle :: Get OSC+get_bundle = do+    skip (fromIntegral (B.length bundleHeader))+    t <- NTPi <$> getWord64be+    ps <- get_packet_seq+    return $ Bundle t ps++-- | Get an OSC packet.+getOSC :: Get OSC+getOSC = get_packet++-- | Decode an OSC packet from a lazy ByteString.+decodeOSC :: B.ByteString -> OSC+{-# INLINE decodeOSC #-}+decodeOSC = runGet getOSC++-- | Decode an OSC packet from a strict ByteString.+decodeOSC' :: S.ByteString -> OSC+{-# INLINE decodeOSC' #-}+decodeOSC' = runGet getOSC . B.fromChunks . (:[])
+ Sound/OpenSoundControl/Coding/Encode/Base.hs view
@@ -0,0 +1,57 @@+-- | Base-level encode function for OSC packets (slow).  For ordinary+--   use see 'Sound.OpenSoundControl.Coding.Encode.Builder'.+module Sound.OpenSoundControl.Coding.Encode.Base (encodeOSC) 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 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 $ as_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.+encode_message :: String -> [Datum] -> B.ByteString+encode_message c l =+    B.concat [encode_datum (String c)+             ,encode_datum (descriptor l)+             ,B.concat (map encode_datum l) ]++-- Encode an OSC packet as an OSC blob.+encode_osc_blob :: OSC -> Datum+encode_osc_blob = Blob . encodeOSC++-- Encode an OSC bundle.+encode_bundle_ntpi :: NTPi -> [OSC] -> B.ByteString+encode_bundle_ntpi t l =+    B.concat [bundleHeader+             ,encode_u64 t+             ,B.concat (map (encode_datum . encode_osc_blob) l) ]++-- | Encode an OSC packet.+encodeOSC :: OSC -> B.ByteString+encodeOSC o =+    case o of+      Message c l -> encode_message c l+      Bundle (NTPi t) l -> encode_bundle_ntpi t l+      Bundle (NTPr t) l -> encode_bundle_ntpi (ntpr_ntpi t) l+      Bundle (UTCr t) l -> encode_bundle_ntpi (utcr_ntpi t) l
+ Sound/OpenSoundControl/Coding/Encode/Builder.hs view
@@ -0,0 +1,74 @@+-- | Optimised encode function for OSC packets.+module Sound.OpenSoundControl.Coding.Encode.Builder (buildOSC+                                                    ,encodeOSC+                                                    ,encodeOSC') where++import qualified Data.Binary.IEEE754 as I+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Blaze.ByteString.Builder as B+import qualified Blaze.ByteString.Builder.Char8 as B+import Data.Monoid (mappend, mconcat)+import Data.Word (Word8)+import Sound.OpenSoundControl.Coding.Byte (align, bundleHeader)+import Sound.OpenSoundControl.Time+import Sound.OpenSoundControl.Type (Datum(..), OSC(..), tag)++-- Command argument types are given by a descriptor.+descriptor :: [Datum] -> String+descriptor l = ',' : map tag l++-- Generate a list of zero bytes for padding.+padding :: Integral i => i -> [Word8]+padding n = replicate (fromIntegral n) 0++-- Encode a string with zero padding.+build_string :: String -> B.Builder+build_string s = B.fromString s `mappend` B.fromWord8s (0:padding (align (length s + 1)))++-- Encode a byte string with prepended length and zero padding.+build_bytes :: L.ByteString -> B.Builder+build_bytes s = B.fromInt32be (fromIntegral (L.length s))+                `mappend` B.fromLazyByteString s+                `mappend` B.fromWord8s (padding (align (L.length s)))++-- Encode an OSC datum.+build_datum :: Datum -> B.Builder+build_datum (Int i)              = B.fromInt32be (fromIntegral i)+build_datum (Float f)            = B.fromWord32be (I.floatToWord (realToFrac f))+build_datum (Double d)           = B.fromWord64be (I.doubleToWord d)+build_datum (TimeStamp t)        = B.fromWord64be (fromIntegral (as_ntpi t))+build_datum (String s)           = build_string s+build_datum (Midi (b0,b1,b2,b3)) = B.fromWord8s [b0,b1,b2,b3]+build_datum (Blob b)             = build_bytes b++-- Encode an OSC message.+build_message :: String -> [Datum] -> B.Builder+build_message c l =+    mconcat [ build_string c+            , build_string (descriptor l)+            , mconcat $ map build_datum l ]++-- Encode an OSC bundle.+build_bundle_ntpi :: NTPi -> [OSC] -> B.Builder+build_bundle_ntpi t l =+    mconcat [ B.fromLazyByteString bundleHeader+            , B.fromWord64be t+            , mconcat $ map (build_bytes . B.toLazyByteString . buildOSC) l ]++-- | Builder monoid for an OSC packet.+buildOSC :: OSC -> B.Builder+buildOSC (Message c l)       = build_message c l+buildOSC (Bundle (NTPi t) l) = build_bundle_ntpi t l+buildOSC (Bundle (NTPr t) l) = build_bundle_ntpi (ntpr_ntpi t) l+buildOSC (Bundle (UTCr t) l) = build_bundle_ntpi (utcr_ntpi t) l++-- | Encode an OSC packet to a lazy ByteString.+encodeOSC :: OSC -> L.ByteString+{-# INLINE encodeOSC #-}+encodeOSC = B.toLazyByteString . buildOSC++-- | Encode an OSC packet to a strict ByteString.+encodeOSC' :: OSC -> S.ByteString+{-# INLINE encodeOSC' #-}+encodeOSC' = B.toByteString . buildOSC
− Sound/OpenSoundControl/Coerce.hs 
@@ -1,30 +0,0 @@--- | OSC packet coercion and normalization.-module Sound.OpenSoundControl.Coerce where--import Sound.OpenSoundControl.OSC---- | Map a normalizing function over datum at an osc packet.-coerce :: (Datum -> Datum) -> OSC -> OSC-coerce f (Message s xs) = Message s (map f xs)-coerce f (Bundle t xs) = Bundle t (map (coerce f) xs)---- | Coerce Float to Double.-f_to_d :: Datum -> Datum-f_to_d (Float n) = Double n-f_to_d x = x---- | Coerce Int and Float to Double.-if_to_d :: Datum -> Datum-if_to_d (Int n) = Double (fromIntegral n)-if_to_d (Float n) = Double n-if_to_d x = x---- | Coerce Float and Double to Int.-fd_to_i :: Datum -> Datum-fd_to_i (Float n) = Int (round n)-fd_to_i (Double n) = Int (round n)-fd_to_i x = x---- | A normalized osc packet has only Int and Double numerical values.-normalize :: OSC -> OSC-normalize = coerce f_to_d
− Sound/OpenSoundControl/OSC.hs 
@@ -1,178 +0,0 @@--- | Alegbraic data types for OSC packets and encode and decode---   functions.-module Sound.OpenSoundControl.OSC ( OSC(..)-                                  , Datum(..)-                                  , message-                                  , bundle-                                  , encodeOSC-                                  , decodeOSC ) where--import qualified Data.ByteString.Lazy as B-import Data.List-import Data.Maybe-import Data.Word-import Sound.OpenSoundControl.Time-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.Cast---- | The basic elements of OSC messages.-data Datum = Int Int-           | Float Double-           | Double Double-           | String String-           | Blob [Word8]-           | TimeStamp Time-           | Midi (Word8,Word8,Word8,Word8)-             deriving (Eq, Show)---- | An OSC packet.-data OSC = Message String [Datum]-         | Bundle Time [OSC]-           deriving (Eq, Show)---- | OSC bundles can be ordered (time ascending).  Bundles and---   messages compare EQ.-instance Ord OSC where-    compare (Bundle a _) (Bundle b _) = compare a b-    compare _ _ = EQ---- OSC types have single character identifiers.-tag :: Datum -> Char-tag (Int _) = 'i'-tag (Float _) = 'f'-tag (Double _) = 'd'-tag (String _) = 's'-tag (Blob _) = 'b'-tag (TimeStamp _) = 't'-tag (Midi _) = 'm'---- Command argument types are given by a descriptor.-descriptor :: [Datum] -> Datum-descriptor l = String (',' : map tag l)---- The number of bytes required to align an OSC value.-align :: Int -> Int-align n = (-n) `mod` 4---- Align a byte string if required.-extend :: a -> [a] -> [a]-extend p s = s ++ replicate (align (length s)) p---- Encode an OSC datum.-encode_datum :: Datum -> B.ByteString-encode_datum (Int i) = encode_i32 i-encode_datum (Float f) = encode_f32 f-encode_datum (Double d) = encode_f64 d-encode_datum (TimeStamp t) = encode_u64 $ as_ntpi t-encode_datum (String s) = B.pack (extend 0 (str_cstr s))-encode_datum (Midi (b0,b1,b2,b3)) = B.pack [b0,b1,b2,b3]-encode_datum (Blob b) = B.concat [encode_i32 (length b), B.pack (extend 0 b)]---- Encode an OSC message.-encode_message :: String -> [Datum] -> B.ByteString-encode_message c l = -    B.concat [ encode_datum (String c)-             , encode_datum (descriptor l)-             , B.concat (map encode_datum l) ]---- Encode an OSC packet as an OSC blob.-encode_osc_blob :: OSC -> Datum-encode_osc_blob = Blob . B.unpack . encodeOSC---- Encode an OSC bundle.-encode_bundle_ntpi :: Integer -> [OSC] -> B.ByteString-encode_bundle_ntpi t l =-    B.concat [ bundle_header-             , encode_u64 t-             , B.concat (map (encode_datum . encode_osc_blob) l) ]---- | Encode an OSC packet.-encodeOSC :: OSC -> B.ByteString-encodeOSC (Message c l) = encode_message c l-encodeOSC (Bundle (NTPi t) l) = encode_bundle_ntpi t l-encodeOSC (Bundle (NTPr t) l) = encode_bundle_ntpi (ntpr_ntpi t) l-encodeOSC (Bundle (UTCr t) l) = encode_bundle_ntpi (utcr_ntpi t) l---- The plain byte count of an OSC value.-size :: Char -> B.ByteString -> Int-size 'i' _ = 4-size 'f' _ = 4-size 'd' _ = 8-size 't' _ = 8 -- timetag-size 's' b = fromIntegral (fromMaybe-                           (error ("size: no terminating zero: " ++ show b))-                           (B.elemIndex 0 b))-size 'b' b = decode_i32 (B.take 4 b)-size _ _ = error "size: illegal type"---- The storage byte count of an OSC value.-storage :: Char -> B.ByteString -> Int-storage 's' b = n + align n where n = size 's' b + 1-storage 'b' b = n + align n + 4 where n = size 'b' b-storage c _ = size c B.empty---- Decode an OSC datum-decode_datum :: Char -> B.ByteString -> Datum-decode_datum 'i' b = Int (decode_i32 b)-decode_datum 'f' b = Float (decode_f32 b)-decode_datum 'd' b = Double (decode_f64 b)-decode_datum 's' b = String (decode_str (b_take n b)) where n = size 's' b-decode_datum 'b' b = Blob (B.unpack (b_take n (B.drop 4 b))) where n = size 'b' b-decode_datum 't' b = TimeStamp $ NTPi (decode_u64 b)-decode_datum t _ = error ("decode_datum: illegal type (" ++ [t] ++ ")")---- Decode a sequence of OSC datum given a type descriptor string.-decode_datum_seq :: [Char] -> B.ByteString -> [Datum]-decode_datum_seq cs b = zipWith decode_datum cs (snd (mapAccumL f b cs))-    where swap (x,y) = (y,x)-          f b' c = swap (B.splitAt (fromIntegral (storage c b')) b')---- Decode an OSC message.-decode_message :: B.ByteString -> OSC-decode_message b = Message cmd arg-    where 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)---- Decode a sequence of OSC messages, each one headed by its length-decode_message_seq :: B.ByteString -> [OSC]-decode_message_seq b | B.length b == 0 = []-                     | otherwise = m:nxt-                     where s = decode_i32 b-                           m = decode_message $ b_drop 4 b-                           nxt = decode_message_seq $ b_drop (4+s) b--decode_bundle :: B.ByteString -> OSC-decode_bundle b = Bundle timeStamp ms-    where 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---- | Decode an OSC packet.-decodeOSC :: B.ByteString -> OSC-decodeOSC b | bundle_header `B.isPrefixOf` b = decode_bundle b-            | otherwise = decode_message b--bundle :: Time -> [OSC] -> OSC-bundle t xs =-    case xs of-      [] -> error "bundle: empty?"-      _ -> Bundle t xs--message :: String -> [Datum] -> OSC-message a xs =-    case a of-      ('/':_) -> Message a xs-      _ -> error "message: ill-formed address"--b_take :: Int -> B.ByteString -> B.ByteString-b_take = B.take . fromIntegral--b_drop :: Int -> B.ByteString -> B.ByteString-b_drop = B.drop . fromIntegral--bundle_header :: B.ByteString-bundle_header = encode_datum (String "#bundle")
Sound/OpenSoundControl/Time.hs view
@@ -4,75 +4,117 @@  import Control.Concurrent import Control.Monad+import Data.Word import qualified Data.Time as T --- | Time is represented in either UTC or NTP form.-data Time = UTCr Double | NTPr Double | NTPi Integer-            deriving (Eq, Show)+-- | Type for integer representation of NTP time.+type NTPi = Word64 +-- | Time is represented in either UTC or NTP form.  The NTP form may+--   be either integral or real.+data Time = UTCr Double | NTPr Double | NTPi NTPi+            deriving (Read, Show)++instance Eq Time where+    a == b = as_ntpi a == as_ntpi b+    a /= b = as_ntpi a /= as_ntpi b+ -- | Coerce to NTPi form.-as_ntpi :: Time -> Integer-as_ntpi (UTCr t) = utcr_ntpi t-as_ntpi (NTPr t) = ntpr_ntpi t-as_ntpi (NTPi t) = t+as_ntpi :: Time -> NTPi+as_ntpi x =+    case x of+      UTCr t -> utcr_ntpi t+      NTPr t -> ntpr_ntpi t+      NTPi t -> t  -- | Coerce to UTCr form. as_utcr :: Time -> Double-as_utcr (UTCr t) = t-as_utcr (NTPr t) = ntpr_utcr t-as_utcr (NTPi t) = ntpi_utcr t+as_utcr x =+    case x of+      UTCr t -> t+      NTPr t -> ntpr_utcr t+      NTPi t -> ntpi_utcr t  -- | Times can be ordered, avoid coercion if not required. instance Ord Time where-    compare (UTCr p) (UTCr q) = compare p q-    compare (NTPr p) (NTPr q) = compare p q-    compare (NTPi p) (NTPi q) = compare p q-    compare p q = compare (as_ntpi p) (as_ntpi q)+    compare p q =+        case (p,q) of+          (UTCr p',UTCr q') -> compare p' q'+          (NTPr p',NTPr q') -> compare p' q'+          (NTPi p',NTPi q') -> compare p' q'+          _ -> compare (as_ntpi p) (as_ntpi q)  -- | Convert a real-valued NTP timestamp to an NTP timestamp.-ntpr_ntpi :: Double -> Integer+ntpr_ntpi :: Double -> NTPi ntpr_ntpi t = round (t * 2^(32::Int))  -- | Convert an NTP timestamp to a real-valued NTP timestamp.-ntpi_ntpr :: Integer -> Double+ntpi_ntpr :: NTPi -> Double ntpi_ntpr t = fromIntegral t / 2^(32::Int)  -- | Convert UTC timestamp to NTP timestamp.-utcr_ntpi :: Double -> Integer-utcr_ntpi t = ntpr_ntpi (t + secdif)-    where secdif = (70 * 365 + 17) * 24 * 60 * 60+utcr_ntpi :: Double -> NTPi+utcr_ntpi t =+    let secdif = (70 * 365 + 17) * 24 * 60 * 60+    in ntpr_ntpi (t + secdif)  -- | Convert NTP timestamp to UTC timestamp. ntpr_utcr :: Double -> Double-ntpr_utcr t = t - secdif-    where secdif = (70 * 365 + 17) * 24 * 60 * 60+ntpr_utcr t =+    let secdif = (70 * 365 + 17) * 24 * 60 * 60+    in t - secdif  -- | Convert NTP timestamp to UTC timestamp.-ntpi_utcr :: Integer -> Double+ntpi_utcr :: NTPi -> Double ntpi_utcr = ntpr_utcr . ntpi_ntpr  -- | The time at 1970-01-01:00:00:00. utc_base :: T.UTCTime-utc_base = T.UTCTime d s-    where d = T.fromGregorian 1970 1 1-          s = T.secondsToDiffTime 0+utc_base =+    let d = T.fromGregorian 1970 1 1+        s = T.secondsToDiffTime 0+    in T.UTCTime d s  -- | Read current UTCr timestamp. utcr :: IO Double-utcr = do t <- T.getCurrentTime-          return (realToFrac (T.diffUTCTime t utc_base))+utcr = do+  t <- T.getCurrentTime+  return (realToFrac (T.diffUTCTime t utc_base))  -- | Read current NTP timestamp.-ntpi :: IO Integer+ntpi :: IO NTPi ntpi = liftM utcr_ntpi utcr --- | Pause current thread for the indicated duration, given in seconds.+-- | 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 :: Double+pauseThreadLimit = fromIntegral (maxBound::Int) / 1e6++-- | Pause current thread for the indicated duration (in seconds), see+--   pauseThreadLimit.  Note also that this function does not attempt+--   pauses less than 1e-4. pauseThread :: Double -> IO () pauseThread n = when (n > 1e-4) (threadDelay (floor (n * 1e6))) --- | Pause current thread until the given utcr time.+-- | Pause current thread until the given utcr time, see+--   pauseThreadLimit. pauseThreadUntil :: Double -> IO () pauseThreadUntil t = pauseThread . (t -) =<< utcr++-- | Sleep current thread for the indicated duration (in seconds).+--   Divides long sleeps into parts smaller than pauseThreadLimit.+sleepThread :: Double -> IO ()+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 utcr time.  Divides long+--   sleeps into parts smaller than pauseThreadLimit.+sleepThreadUntil :: Double -> IO ()+sleepThreadUntil t = sleepThread . (t -) =<< utcr  -- | Execute the bundle immediately. immediately :: Time
Sound/OpenSoundControl/Transport.hs view
@@ -1,11 +1,13 @@--- | An abstract transport layer with implementations for UDP and TCP---   transport.-module Sound.OpenSoundControl.Transport ( Transport(..)-                                        , withTransport-                                        , waitFor, wait ) where+-- | An abstract transport layer. hosc provides implementations for+--   UDP and TCP transport.+module Sound.OpenSoundControl.Transport (Transport(..)+                                        ,withTransport+                                        ,recvT+                                        ,waitFor,wait) where  import Control.Exception-import Sound.OpenSoundControl.OSC+import Sound.OpenSoundControl.Type+import System.Timeout  -- | Abstract over the underlying transport protocol. class Transport t where@@ -18,22 +20,34 @@  -- Does the OSC message have the specified address. has_address :: String -> OSC -> Bool-has_address x (Message y _) = x == y-has_address _ _ = False+has_address x o =+    case o of+      Message y _ -> x == y+      _ -> False --- Repeat action until function does not give Nothing when applied to result.+-- Repeat action until `f' does not give Nothing when applied to result. untilM :: Monad m => (a -> Maybe b) -> m a -> m b-untilM f act = recurse-    where g p = let q = f p in case q of { Nothing -> recurse-                                         ; Just r -> return r }-          recurse = act >>= g+untilM f act =+    let g p = let q = f p in case q of { Nothing -> rec+                                       ; Just r -> return r }+        rec = act >>= g+    in rec +-- | Real valued variant of 'timeout'.+timeout_r :: Double -> IO a -> IO (Maybe a)+timeout_r t = timeout (floor (t * 1000000))++-- | Variant that wraps 'recv' in an /n/ second 'timeout'.+recvT :: Transport t => Double -> t -> IO (Maybe OSC)+recvT n fd = timeout_r n (recv fd)+ -- | Wait for an OSC message where the supplied function does not give --   Nothing, discarding intervening messages. waitFor :: Transport t => t -> (OSC -> Maybe a) -> IO a waitFor t f = untilM f (recv t) --- | A 'waitFor' for variant matching on address string of messages.+-- | A 'waitFor' for variant matching on the address string of+--   incoming messages. wait :: Transport t => t -> String -> IO OSC wait t s = waitFor t (\o -> if has_address s o then Just o else Nothing)
Sound/OpenSoundControl/Transport/TCP.hs view
@@ -1,38 +1,47 @@ -- | OSC over TCP implementation.-module Sound.OpenSoundControl.Transport.TCP (TCP, openTCP, tcpServer) where+module Sound.OpenSoundControl.Transport.TCP (TCP(..)+                                            ,openTCP'+                                            ,tcpServer') where  import qualified Data.ByteString.Lazy as B import Control.Monad import Network+import Sound.OpenSoundControl.Coding.Byte import Sound.OpenSoundControl.Transport-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.OSC+import Sound.OpenSoundControl.Type import System.IO  -- | The TCP transport handle data type.-data TCP = TCP Handle deriving (Eq, Show)+data TCP = TCP {tcpEncode :: OSC -> B.ByteString+               ,tcpDecode :: B.ByteString -> OSC+               ,tcpHandle :: Handle}  instance Transport TCP where-   send (TCP fd) msg =-      do let b = encodeOSC msg+   send (TCP enc _ fd) msg =+      do let b = enc msg              n = fromIntegral (B.length b)          B.hPut fd (B.append (encode_u32 n) b)          hFlush fd--   recv (TCP fd) =+   recv (TCP _ dec fd) =       do b0 <- B.hGet fd 4          b1 <- B.hGet fd (fromIntegral (decode_u32 b0))-         return (decodeOSC b1)+         return (dec b1)+   close (TCP _ _ fd) = hClose fd -   close (TCP fd) = hClose fd+type Coder = (OSC -> B.ByteString,B.ByteString -> OSC) --- | Make a TCP connection.-openTCP :: String -> Int -> IO TCP-openTCP host = liftM TCP . connectTo host . PortNumber . fromIntegral+-- | Make a TCP connection using specified coder.+openTCP' :: Coder -> String -> Int -> IO TCP+openTCP' (enc,dec) host =+    liftM (TCP enc dec) .+    connectTo host .+    PortNumber .+    fromIntegral --- | A trivial TCP OSC server.-tcpServer :: Int -> (TCP -> IO ()) -> IO ()-tcpServer p f = do s <- listenOn (PortNumber (fromIntegral p))-                   (sequence_ . repeat) (do (fd, _, _) <- accept s-                                            f (TCP fd)-                                            return ())+-- | A trivial TCP OSC server using specified coder.+tcpServer' :: Coder -> Int -> (TCP -> IO ()) -> IO ()+tcpServer' (enc,dec) p f = do+  s <- listenOn (PortNumber (fromIntegral p))+  (sequence_ . repeat) (do (fd, _, _) <- accept s+                           f (TCP enc dec fd)+                           return ())
Sound/OpenSoundControl/Transport/UDP.hs view
@@ -1,54 +1,63 @@ -- | OSC over UDP implementation.-module Sound.OpenSoundControl.Transport.UDP ( UDP(udpSocket)-                                            , openUDP-                                            , udpServer-                                            , udpPort-                                            , sendTo, recvFrom ) where+module Sound.OpenSoundControl.Transport.UDP (UDP(..),udpPort+                                            ,openUDP'+                                            ,udpServer'+                                            ,sendTo,recvFrom) where  import Control.Monad+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as B import qualified Network.Socket as N-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.OSC+import qualified Network.Socket.ByteString as C (sendTo,recvFrom)+import qualified Network.Socket.ByteString.Lazy as C (send,recv) import Sound.OpenSoundControl.Transport+import Sound.OpenSoundControl.Type  -- | The UDP transport handle data type.-data UDP = UDP { udpSocket :: N.Socket }-           deriving (Eq, Show)+data UDP = UDP {udpEncode :: OSC -> B.ByteString+               ,udpDecode :: B.ByteString -> OSC+               ,udpSocket :: N.Socket} +-- | Return the port number associated with the UDP socket.+udpPort :: Integral n => UDP -> IO n+udpPort (UDP _ _ fd) = fmap fromIntegral (N.socketPort fd)+ instance Transport UDP where-   send  (UDP fd) msg = N.send fd (decode_str (encodeOSC msg)) >> return ()-   recv  (UDP fd) = liftM (decodeOSC . encode_str) (N.recv fd 8192)-   close (UDP fd) = N.sClose fd+   send  (UDP enc _ fd) msg = C.send fd (enc msg) >> return ()+   recv  (UDP _ dec fd) = liftM dec (C.recv fd 8192)+   close (UDP _ _ fd) = N.sClose fd --- | Make a UDP connection.-openUDP :: String -> Int -> IO UDP-openUDP host port = do+type Coder = (OSC -> B.ByteString,B.ByteString -> OSC)++-- | Make a UDP connection with specified coder.+openUDP' :: Coder -> String -> Int -> IO UDP+openUDP' (enc,dec) host port = do   fd <- N.socket N.AF_INET N.Datagram 0-  a  <- N.inet_addr host-  let sa = N.SockAddrInet (fromIntegral port) a-  N.connect fd sa+  a <- N.inet_addr host+  N.connect fd (N.SockAddrInet (fromIntegral port) a)   -- N.setSocketOption fd N.RecvTimeOut 1000-  return (UDP fd)+  return (UDP enc dec fd) --- | Trivial udp server.-udpServer :: String -> Int -> IO UDP-udpServer host port = do+-- | Trivial udp server with specified coder.+udpServer' :: Coder -> String -> Int -> IO UDP+udpServer' (enc,dec) host port = do   fd <- N.socket N.AF_INET N.Datagram 0   a  <- N.inet_addr host   let sa = N.SockAddrInet (fromIntegral port) a   N.bindSocket fd sa-  return (UDP fd)+  return (UDP enc dec fd) +-- | Send variant to send to specified address. sendTo :: UDP -> OSC -> N.SockAddr -> IO ()-sendTo (UDP fd) o a = do-  _ <- N.sendTo fd (decode_str (encodeOSC o)) a-  return ()+sendTo (UDP enc _ fd) o a = do+  -- Network.Socket.ByteString.Lazy.sendTo does not exist+  let o' = S.pack (B.unpack (enc o))+  C.sendTo fd o' a >> return () +-- | Recv variant to collect message source address. recvFrom :: UDP -> IO (OSC, N.SockAddr)-recvFrom (UDP fd) = do-  (s, _, a) <- N.recvFrom fd 8192-  let o = (decodeOSC . encode_str) s-  return (o, a)--udpPort :: Integral n => UDP -> IO n-udpPort (UDP fd) = fmap fromIntegral (N.socketPort fd)+recvFrom (UDP _ dec fd) = do+  -- Network.Socket.ByteString.Lazy.recvFrom does not exist+  (s,a) <- C.recvFrom fd 8192+  let s' = B.pack (S.unpack s)+  return (dec s',a)
+ Sound/OpenSoundControl/Type.hs view
@@ -0,0 +1,62 @@+-- | Alegbraic data types for OSC datum and packets.+module Sound.OpenSoundControl.Type ( OSC(..)+                                   , Datum(..)+                                   , message+                                   , bundle+                                   , tag ) where++import qualified Data.ByteString.Lazy as B+import Data.Word+import Sound.OpenSoundControl.Time++-- | 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)++-- | An OSC packet.+data OSC = Message String [Datum]+         | Bundle Time [OSC]+           deriving (Eq, Read, Show)++-- | OSC bundles can be ordered (time ascending).  Bundles and+--   messages compare EQ.+instance Ord OSC where+    compare (Bundle a _) (Bundle b _) = compare a b+    compare _ _ = EQ++-- | Single character identifier of an OSC datum.+tag :: Datum -> Char+tag dt =+    case dt of+      Int _ -> 'i'+      Float _ -> 'f'+      Double _ -> 'd'+      String _ -> 's'+      Blob _ -> 'b'+      TimeStamp _ -> 't'+      Midi _ -> 'm'++-- | Bundle constructor.+--+-- Signals an error when @xs@ is empty.+bundle :: Time -> [OSC] -> OSC+bundle t xs =+    case xs of+      [] -> error "bundle: empty?"+      _ -> Bundle t xs++-- | Message constructor+--+-- Signals an error when the address @a@ doesn't conform to the OSC+-- specification.+message :: String -> [Datum] -> OSC+message a xs =+    case a of+      ('/':_) -> Message a xs+      _ -> error "message: ill-formed address"
hosc.cabal view
@@ -1,35 +1,40 @@ Name:              hosc-Version:           0.9+Version:           0.10 Synopsis:          Haskell Open Sound Control Description:       hosc provides Sound.OpenSoundControl, a haskell                    module implementing a subset of the Open Sound                    Control byte protocol. License:           GPL Category:          Sound-Copyright:         (c) Rohan Drape and others, 2006-2011-Author:            Rohan Drape+Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2006-2011+Author:            Rohan Drape, Stefan Kersten Maintainer:        rd@slavepianos.org Stability:         Experimental Homepage:          http://slavepianos.org/rd/?t=hosc-Tested-With:       GHC == 6.12.1+Tested-With:       GHC == 7.0.4 Build-Type:        Simple-Cabal-Version:     >= 1.6+Cabal-Version:     >= 1.8 Data-Files:        README-                   Help/timer.hs  Library-  Build-Depends:   array,-                   base == 4.*,-                   bytestring,+  Build-Depends:   base == 4.*,                    binary,-                   network,+                   blaze-builder >= 0.3,+                   bytestring,+                   data-binary-ieee754,+                   network >= 2.3,                    time   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Sound.OpenSoundControl-                   Sound.OpenSoundControl.Byte-                   Sound.OpenSoundControl.Cast-                   Sound.OpenSoundControl.Coerce-                   Sound.OpenSoundControl.OSC+                   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.Transport                    Sound.OpenSoundControl.Transport.TCP