hosc 0.2 → 0.3

raw patch · 9 files changed

+171/−199 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README +7/−5
• Sound/OpenSoundControl/Byte.hs +4/−4
• Sound/OpenSoundControl/Cast.hs +25/−17
• Sound/OpenSoundControl/OSC.hs +86/−124
• Sound/OpenSoundControl/Time.hs +2/−7
• Sound/OpenSoundControl/Transport.hs +7/−6
• Sound/OpenSoundControl/Transport/TCP.hs +6/−7
• Sound/OpenSoundControl/Transport/UDP.hs +4/−5
• hosc.cabal +30/−24

@@ -1,10 +1,12 @@-hosc - Haskell Open Sound Control+hosc - haskell open sound control -hosc provides Sound.OpenSoundControl, a Haskell module that implements-the Open Sound Control byte protocol.+hosc provides Sound.OpenSoundControl, a haskell+module implementing a subset of the Open Sound+Control byte protocol. -  http://slavepianos.org/rd/+  http://slavepianos.org/rd/f/269573/   http://haskell.org/   http://opensoundcontrol.org/ -(c) rohan drape, 2006-2008, GPL.2, http://gnu.org/copyleft/+(c) rohan drape, 2006-2008+    gpl.2, http://gnu.org/copyleft/

@@ -1,10 +1,10 @@ module Sound.OpenSoundControl.Byte where -import Data.Int-import Data.Char-import qualified Data.ByteString.Lazy as B import Data.Binary-import Sound.OpenSoundControl.Cast (f32_i32, f64_i64, i32_f32, i64_f64)+import qualified Data.ByteString.Lazy as B+import Data.Char+import Data.Int+import Sound.OpenSoundControl.Cast  -- | Encode a signed 8-bit integer. encode_i8 :: Int -> B.ByteString

@@ -3,40 +3,48 @@                                     str_cstr, cstr_str,                                     str_pstr, pstr_str) where -import Data.Word (Word8)-import Data.Int (Int32, Int64)-import Data.Char (chr, ord)-import Control.Monad.ST (runST, ST)-import Data.Array.ST (MArray, newArray, readArray, castSTUArray)+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 ((fromArray =<< castSTUArray =<< singletonArray d) :: ST s Int32)--f64_i64 :: Double -> Int64-f64_i64 d = runST ((fromArray =<< castSTUArray =<< singletonArray d) :: ST s Int64)+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 ((fromArray =<< castSTUArray =<< singletonArray d) :: ST s 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)++-- | Inverse of 'f64_i64'. i64_f64 :: Int64 -> Double-i64_f64 d = runST ((fromArray =<< castSTUArray =<< singletonArray d) :: ST s Double)+i64_f64 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Double) --- | C strings are null suffixed byte strings.+-- | 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 s = map (chr . fromIntegral) (takeWhile (/= 0) s) --- | Pascal strings are length prefixed byte strings.+-- | 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 s = map (chr . fromIntegral) (drop 1 s) -singletonArray :: (MArray a e m) => e -> m (a Int e)-singletonArray = newArray (0, 0::Int)+-- One element marray.+unit_array :: (MArray a e m) => e -> m (a Int e)+unit_array = newArray (0, 0::Int) -fromArray :: (MArray a e m) => a Int e -> m e-fromArray = flip readArray 0+-- Extract first element from array.+from_array :: (MArray a e m) => a Int e -> m e+from_array = flip readArray 0

@@ -1,19 +1,15 @@-module Sound.OpenSoundControl.OSC ( OSC, message, bundle-                                  , address, arguments-                                  , timestamp, messages-                                  , Datum, int, float, double, string, blob-                                  , encodeOSC-                                  , encodeOSC_NTP+module Sound.OpenSoundControl.OSC ( OSC(..)+                                  , Datum(..)+                                  , encodeOSC, encodeOSCNTP                                   , decodeOSC ) where -import Sound.OpenSoundControl.Time (ntpr_ntp)-import Sound.OpenSoundControl.Byte-import Sound.OpenSoundControl.Cast (str_cstr)--import Data.Word (Word8)-import Data.List (mapAccumL)-import Data.Maybe (fromMaybe) 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@@ -23,157 +19,123 @@            | Blob [Word8]              deriving (Eq, Show) --- | Construct OSC int datum.-int :: Int -> Datum-int = Int---- | Construct OSC float datum.-float :: Double -> Datum-float = Float---- | Construct OSC double datum.-double :: Double -> Datum-double = Double---- | Construct OSC string datum.-string :: String -> Datum-string = String---- | Construct OSC blob datum.-blob :: [Word8] -> Datum-blob = Blob- -- | An OSC packet. data OSC = Message String [Datum]          | Bundle Double [OSC]            deriving (Eq, Show) --- | OSC message constructor-message :: String -> [Datum] -> OSC-message = Message---- | OSC bundle constructor-bundle :: Double -> [OSC] -> OSC-bundle = Bundle---- | Retrieve the address of an OSC message,---   or Nothing for a bundle.-address :: OSC -> Maybe String-address (Message s _) = Just s-address (Bundle _ _) = Nothing---- | Retrieve the arguments of an OSC message,---   or Nothing for a bundle.-arguments :: OSC -> Maybe [Datum]-arguments (Message _ a) = Just a-arguments (Bundle _ _) = Nothing---- | Retrieve the timestamp of an OSC bundle,---   or Nothing for a message.-timestamp :: OSC -> Maybe Double-timestamp (Bundle t _) = Just t-timestamp (Message _ _) = Nothing---- | Retrieve the messages in an OSC bundle,---   or Nothing for a message.-messages :: OSC -> Maybe [OSC]-messages (Bundle _ m) = Just m-messages (Message _ _) = Nothing-+-- | OSC bundles can be ordered (time ascending). instance Ord OSC where     compare (Bundle a _) (Bundle b _) = compare a b-    compare _            _            = EQ+    compare _ _ = EQ --- | OSC types have single character identifiers.+-- OSC types have single character identifiers. tag :: Datum -> Char-tag (Int _)    = 'i'-tag (Float _)  = 'f'+tag (Int _) = 'i'+tag (Float _) = 'f' tag (Double _) = 'd' tag (String _) = 's'-tag (Blob _)   = 'b'+tag (Blob _) = 'b' --- | Command argument types are given by a descriptor.+-- 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.+-- The number of bytes required to align an OSC value. align :: Int -> Int-align n = mod (-n) 4+align n = (-n) `mod` 4 --- | Align a byte string if required.+-- Align a byte string if required. extend :: a -> [a] -> [a] extend p s = s ++ replicate (align (length s)) p --- | Encode an OSC datum.-encodeDatum :: Datum -> B.ByteString-encodeDatum (Int i)    = encode_i32 i-encodeDatum (Float f)  = encode_f32 f-encodeDatum (Double d) = encode_f64 d-encodeDatum (String s) = B.pack (extend 0 (str_cstr s))-encodeDatum (Blob b)   = B.concat [encode_i32 (length b), B.pack (extend 0 b)]+-- 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 (String s) = B.pack (extend 0 (str_cstr s))+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_ntp :: Double -> [OSC] -> B.ByteString+encode_bundle_ntp t l =+    B.concat [ encode_datum (String "#bundle")+             , encode_u64 (ntpr_ntp t)+             , B.concat (map (encode_datum . encode_osc_blob) l) ]+ -- | Encode an OSC packet (NTP epoch).-encodeOSC_NTP :: OSC -> B.ByteString-encodeOSC_NTP (Message c l) = B.concat [ encodeDatum (String c)-                                       , encodeDatum (descriptor l)-                                       , B.concat (map encodeDatum l) ]-encodeOSC_NTP (Bundle t l) = B.concat [ encodeDatum (String "#bundle")-                                      , encode_u64 (ntpr_ntp t)-                                      , B.concat (map f l) ]-    where f = encodeDatum . Blob . B.unpack . encodeOSC+encodeOSCNTP :: OSC -> B.ByteString+encodeOSCNTP (Message c l) = encode_message c l+encodeOSCNTP (Bundle t l) = encode_bundle_ntp t l +-- Offset from UTC to NTP epoch.+utc_ntp_diff :: Double+utc_ntp_diff = (70 * 365 + 17) * 24 * 60 * 60+ -- | Encode an OSC packet. encodeOSC :: OSC -> B.ByteString-encodeOSC (Message c l) = encodeOSC_NTP (Message c l)-encodeOSC (Bundle t l) = encodeOSC_NTP (Bundle (t + n) l)-    where n = (70 * 365 + 17) * 24 * 60 * 60+encodeOSC (Message c l) = encode_message c l+encodeOSC (Bundle t l) = encode_bundle_ntp (t + utc_ntp_diff) l --- | The plain byte count of an OSC value.+-- The plain byte count of an OSC value. size :: Char -> B.ByteString -> Int size 'i' _ = 4 size 'f' _ = 4 size 'd' _ = 8 size 's' b = fromIntegral (fromMaybe-                           (error ("no terminating zero found in " ++ show b))+                           (error ("size: no terminating zero: " ++ show b))                            (B.elemIndex 0 b)) size 'b' b = decode_i32 (B.take 4 b)-size _   _ = error "illegal osc type"+size _ _ = error "size: illegal type" --- | The storage byte count of an OSC value.+-- 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+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 -decodeDatum :: Char -> B.ByteString -> Datum-decodeDatum 'i' b = Int (decode_i32 b)-decodeDatum 'f' b = Float (decode_f32 b)-decodeDatum 'd' b = Double (decode_f64 b)-decodeDatum 's' b = String (decode_str (take' n b)) where n = size 's' b-decodeDatum 'b' b = Blob (B.unpack (take' n (B.drop 4 b))) where n = size 'b' b-decodeDatum _   _ = error "illegal osc type"+-- 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 _ _ = error "decode_datum: illegal type" --- | Trivial utility.-swap :: (a,b) -> (b,a)-swap (x,y) = (y,x)+-- Decode a sequenc 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 data given a type descriptor string.-decodeData :: [Char] -> B.ByteString -> [Datum]-decodeData cs b =-   zipWith decodeDatum cs $ snd $-   mapAccumL (\bRest c -> swap (B.splitAt (fromIntegral (storage c bRest)) bRest)) b cs+-- 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 an OSC packet. decodeOSC :: B.ByteString -> OSC-decodeOSC b = Message cmd arg-    where n            = storage 's' b-          (String cmd) = decodeDatum 's' b-          m            = storage 's' (drop' n b)-          (String dsc) = decodeDatum 's' (drop' n b)-          arg          = decodeData (drop 1 dsc) (drop' (n + m) b)+decodeOSC = decode_message -take' :: Int -> B.ByteString -> B.ByteString-take' n b = B.take (fromIntegral n) b+b_take :: Int -> B.ByteString -> B.ByteString+b_take n = B.take (fromIntegral n) -drop' :: Int -> B.ByteString -> B.ByteString-drop' n b = B.drop (fromIntegral n) b+b_drop :: Int -> B.ByteString -> B.ByteString+b_drop n = B.drop (fromIntegral n)

@@ -1,12 +1,7 @@-module Sound.OpenSoundControl.Time ( UTC-                                   , utc-                                   , NTP-                                   , ntp-                                   , ntpr_ntp-                                   , utc_ntp ) where+module Sound.OpenSoundControl.Time where +import Control.Monad import qualified Data.Time as T-import Control.Monad (liftM)  -- | UTC time is represented as a real number. type UTC = Double

@@ -2,8 +2,8 @@                                         , withTransport                                         , wait ) where -import Sound.OpenSoundControl.OSC import Control.Exception+import Sound.OpenSoundControl.OSC  -- | Abstract over the underlying transport protocol. class Transport t where@@ -14,11 +14,12 @@    -- | Close an existing connection.    close :: t -> IO () --- | Does the OSC message have the specified address.-hasAddress :: String -> OSC -> Bool-hasAddress addr o = maybe False (== addr) (address o)+-- Does the OSC message have the specified address.+has_address :: String -> OSC -> Bool+has_address x (Message y _) = x == y+has_address _ _ = False --- | Repeat action until predicate holds on result.+-- Repeat action until predicate holds on result. untilM :: Monad m => (a -> Bool) -> m a -> m a untilM p act = recurse     where recurse = act >>= (\r -> if p r then return r else recurse)@@ -26,7 +27,7 @@ -- | Wait for an OSC message with the specified address,  --   discarding intervening messages. wait :: Transport t => t -> String -> IO OSC-wait t s = untilM (hasAddress s) (recv t)+wait t s = untilM (has_address s) (recv t)  -- | Bracket OSC communication. withTransport :: Transport t => IO t -> (t -> IO a) -> IO a

@@ -1,13 +1,12 @@ module Sound.OpenSoundControl.Transport.TCP (TCP, openTCP, tcpServer) where -import Sound.OpenSoundControl.Transport-import Sound.OpenSoundControl.Byte (encode_u32, decode_u32)-import Sound.OpenSoundControl.OSC (encodeOSC, decodeOSC)--import Control.Monad (liftM) import qualified Data.ByteString.Lazy as B-import Network (PortID(PortNumber), connectTo, listenOn, accept)-import System.IO (Handle, hFlush, hClose)+import Control.Monad+import Network+import Sound.OpenSoundControl.Transport+import Sound.OpenSoundControl.Byte+import Sound.OpenSoundControl.OSC+import System.IO  -- | The TCP transport handle data type. data TCP = TCP Handle deriving (Eq, Show)

@@ -1,11 +1,10 @@ module Sound.OpenSoundControl.Transport.UDP (UDP, openUDP) where -import Sound.OpenSoundControl.Transport-import Sound.OpenSoundControl.Byte (encode_str, decode_str)-import Sound.OpenSoundControl.OSC (encodeOSC, decodeOSC)--import Control.Monad (liftM)+import Control.Monad import qualified Network.Socket as N+import Sound.OpenSoundControl.Byte+import Sound.OpenSoundControl.OSC+import Sound.OpenSoundControl.Transport  -- | The UDP transport handle data type. data UDP = UDP N.Socket deriving (Eq, Show)

@@ -1,25 +1,31 @@-Name:             hosc-Version:          0.2-License:          GPL-Copyright:        Rohan Drape, 2006-2008-Author:           Rohan Drape-Maintainer:       rd@slavepianos.org-Stability:        Experimental-Homepage:         http://slavepianos.org/rd/f/269573/-Synopsis:         Haskell Open Sound Control-Description:      Haskell implementation of the Open Sound Control byte protocol-Category:         Sound-Tested-With:      GHC==6.8.2-Build-Type:       Simple-Build-Depends:    array, base, bytestring, binary, network, time-GHC-Options:      -Wall -O2-Exposed-modules:  Sound.OpenSoundControl-                  Sound.OpenSoundControl.OSC-                  Sound.OpenSoundControl.Time-                  Sound.OpenSoundControl.Byte-                  Sound.OpenSoundControl.Transport-                  Sound.OpenSoundControl.Transport.TCP-                  Sound.OpenSoundControl.Transport.UDP-Other-modules:    Sound.OpenSoundControl.Cast+Name:              hosc+Version:           0.3+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, 2006-2008+Author:            Rohan Drape+Maintainer:        rd@slavepianos.org+Stability:         Experimental+Homepage:          http://slavepianos.org/rd/f/269573/+Tested-With:       GHC==6.8.2+Build-Type:        Simple+Cabal-Version:     >= 1.2 -Data-Files:       README+Data-Files:        README++Library+  Build-Depends:   array, base, bytestring, binary, network, time+  GHC-Options:     -Wall -fwarn-tabs -O2+  Exposed-modules: Sound.OpenSoundControl+                   Sound.OpenSoundControl.Byte+                   Sound.OpenSoundControl.Cast+                   Sound.OpenSoundControl.OSC+                   Sound.OpenSoundControl.Time+                   Sound.OpenSoundControl.Transport+                   Sound.OpenSoundControl.Transport.TCP+                   Sound.OpenSoundControl.Transport.UDP+  Other-modules: