diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,20 +3,20 @@ [hosc][hosc] provides `Sound.Osc`, a [haskell][hs] module implementing a subset of the [Open Sound Control][osc] byte protocol. -hosc is required by the [hsc3][hsc3] haskell [supercollider][sc3] bindings. +hosc is required by the [hsc3][hsc3] Haskell [SuperCollider][sc3] bindings. See also: - [hosc-json](http://rohandrape.net/?t=hosc-json): Json text encoding of Osc - [hosc-util](http://rohandrape.net/?t=hosc-util): non-core Osc functions -© [rohan drape][rd], [stefan kersten][sk] and others, 2007-2022, -[gpl-3][gpl-3]. with contributions by: +© [Rohan Drape][rd], [Stefan Kersten][sk] and others, 2007-2024, +[Gpl-3][gpl-3]. with contributions by: -- [alex mclean][am] -- [henning thielemann][ht] +- [Alex McLean][am] +- [Henning Thielemann][ht] -see the [history](http://rohandrape.net/?t=hosc&q=history) for details +Please see the [history](http://rohandrape.net/?t=hosc&q=history) for details [hosc]: http://rohandrape.net/?t=hosc [hs]: http://haskell.org/ @@ -29,3 +29,11 @@ [ht]: http://www.henning-thielemann.de/Research.html [gpl]: http://gnu.org/copyleft/ [gpl-3]: http://gnu.org/licenses/gpl-3.0.html + +* * * + +``` +$ make doctest +Examples: 110 Tried: 110 Errors: 0 Failures: 0 +$ +``` diff --git a/Sound/Osc.hs b/Sound/Osc.hs --- a/Sound/Osc.hs +++ b/Sound/Osc.hs @@ -3,6 +3,5 @@ import Control.Monad.IO.Class as M (MonadIO, liftIO) 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.Fd.Socket as M import Sound.Osc.Transport.Monad as M diff --git a/Sound/Osc/Alias.hs b/Sound/Osc/Alias.hs deleted file mode 100644 --- a/Sound/Osc/Alias.hs +++ /dev/null @@ -1,9 +0,0 @@ --- | Some backwards compatability, not really... -module Sound.Osc.Alias where - -import Sound.Osc.Datum {- hosc -} - -type Datum_Type = DatumType -type BLOB = Blob -type ASCII = Ascii -type MIDI = MidiData diff --git a/Sound/Osc/Coding/Byte.hs b/Sound/Osc/Coding/Byte.hs --- a/Sound/Osc/Coding/Byte.hs +++ b/Sound/Osc/Coding/Byte.hs @@ -1,5 +1,6 @@ --- | Byte-level coding utility functions. --- Plain forms are big-endian, little-endian forms have @_le@ suffix. +{- | Byte-level coding utility functions. +Plain forms are big-endian, little-endian forms have @_le@ suffix. +-} module Sound.Osc.Coding.Byte where import Data.Bits {- base -} @@ -7,242 +8,287 @@ import Data.Word {- base -} import System.IO {- base -} +import qualified GHC.ByteOrder {- base -} + import qualified Data.Binary as Binary {- binary -} -import qualified Data.Binary.Get as Get {- binary -} -import qualified Data.Binary.Put as Put {- binary -} -import qualified Data.ByteString as S {- bytestring -} -import qualified Data.ByteString.Char8 as S.C {- bytestring -} -import qualified Data.ByteString.Lazy as L {- bytestring -} -import qualified Data.ByteString.Lazy.Char8 as L.C {- bytestring -} +import qualified Data.Binary.Get as Binary.Get {- binary -} +import qualified Data.Binary.Put as Binary.Put {- binary -} -import qualified Sound.Osc.Coding.Cast as Cast {- hosc -} -import Sound.Osc.Coding.Convert {- hosc -} +import qualified Data.ByteString as ByteString {- bytestring -} +import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -} +import qualified Data.ByteString.Internal as ByteString.Internal {- bytestring -} +import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -} +import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8 {- bytestring -} +import qualified Data.ByteString.Unsafe as ByteString.Unsafe {- bytestring -} +import qualified Sound.Osc.Coding.Convert as Convert {- hosc -} + -- * Encode -- | Type specialised 'Binary.encode' (big-endian). -encode_int8 :: Int8 -> L.ByteString +encode_int8 :: Int8 -> ByteString.Lazy.ByteString encode_int8 = Binary.encode --- | Type specialised 'Binary.encode' (big-endian). --- --- > encode_int16 0x0102 == L.pack [0x01,0x02] -encode_int16 :: Int16 -> L.ByteString +{- | Type specialised 'Binary.encode' (big-endian). + +>>> encode_int16 0x0102 == ByteString.Lazy.pack [0x01,0x02] +True +-} +encode_int16 :: Int16 -> ByteString.Lazy.ByteString encode_int16 = Binary.encode --- | Little-endian. --- --- > encode_int16_le 0x0102 == L.pack [0x02,0x01] -encode_int16_le :: Int16 -> L.ByteString -encode_int16_le = Put.runPut . Put.putInt16le +{- | Little-endian. +>>> encode_int16_le 0x0102 == ByteString.Lazy.pack [0x02,0x01] +True +-} +encode_int16_le :: Int16 -> ByteString.Lazy.ByteString +encode_int16_le = Binary.Put.runPut . Binary.Put.putInt16le + -- | Encode a signed 64-bit integer (big-endian). -encode_int64 :: Int64 -> L.ByteString +encode_int64 :: Int64 -> ByteString.Lazy.ByteString encode_int64 = Binary.encode -- | Type specialised 'Binary.encode' (big-endian). -encode_word8 :: Word8 -> L.ByteString +encode_word8 :: Word8 -> ByteString.Lazy.ByteString encode_word8 = Binary.encode --- | Type specialised 'Binary.encode' (big-endian). --- --- > encode_word16 0x0102 == L.pack [0x01,0x02] -encode_word16 :: Word16 -> L.ByteString +{- | Type specialised 'Binary.encode' (big-endian). + +>>> encode_word16 0x0102 == ByteString.Lazy.pack [0x01,0x02] +True +-} +encode_word16 :: Word16 -> ByteString.Lazy.ByteString encode_word16 = Binary.encode --- | Little-endian. --- --- > encode_word16_le 0x0102 == L.pack [0x02,0x01] -encode_word16_le :: Word16 -> L.ByteString -encode_word16_le = Put.runPut . Put.putWord16le +{- | Little-endian. +>>> encode_word16_le 0x0102 == ByteString.Lazy.pack [0x02,0x01] +True +-} +encode_word16_le :: Word16 -> ByteString.Lazy.ByteString +encode_word16_le = Binary.Put.runPut . Binary.Put.putWord16le + -- | Type specialised 'Binary.encode'. -encode_word32 :: Word32 -> L.ByteString +encode_word32 :: Word32 -> ByteString.Lazy.ByteString encode_word32 = Binary.encode -- | Little-endian variant of 'encode_word32'. -encode_word32_le :: Word32 -> L.ByteString -encode_word32_le = Put.runPut . Put.putWord32le +encode_word32_le :: Word32 -> ByteString.Lazy.ByteString +encode_word32_le = Binary.Put.runPut . Binary.Put.putWord32le -- | Encode an unsigned 64-bit integer. -encode_word64 :: Word64 -> L.ByteString +encode_word64 :: Word64 -> ByteString.Lazy.ByteString encode_word64 = Binary.encode -- * Encode/Int -- | Encode a signed 8-bit integer. -encode_i8 :: Int -> L.ByteString -encode_i8 = encode_int8 . int_to_int8 +encode_i8 :: Int -> ByteString.Lazy.ByteString +encode_i8 = encode_int8 . Convert.int_to_int8 -- | Encode an un-signed 8-bit integer. -encode_u8 :: Int -> L.ByteString -encode_u8 = encode_word8 . int_to_word8 +encode_u8 :: Int -> ByteString.Lazy.ByteString +encode_u8 = encode_word8 . Convert.int_to_word8 --- | Encode an un-signed 16-bit integer. --- --- > encode_u16 0x0102 == L.pack [1,2] -encode_u16 :: Int -> L.ByteString -encode_u16 = encode_word16 . int_to_word16 +{- | Encode an un-signed 16-bit integer. --- | Little-endian. --- --- > encode_u16_le 0x0102 == L.pack [2,1] -encode_u16_le :: Int -> L.ByteString -encode_u16_le = encode_word16_le . int_to_word16 +>>> encode_u16 0x0102 == ByteString.Lazy.pack [1,2] +True +-} +encode_u16 :: Int -> ByteString.Lazy.ByteString +encode_u16 = encode_word16 . Convert.int_to_word16 +{- | Little-endian. + +>>> encode_u16_le 0x0102 == ByteString.Lazy.pack [2,1] +True +-} +encode_u16_le :: Int -> ByteString.Lazy.ByteString +encode_u16_le = encode_word16_le . Convert.int_to_word16 + -- | Encode a signed 16-bit integer. -encode_i16 :: Int -> L.ByteString -encode_i16 = Binary.encode . int_to_int16 +encode_i16 :: Int -> ByteString.Lazy.ByteString +encode_i16 = Binary.encode . Convert.int_to_int16 -- | Encode a signed 32-bit integer. -encode_i32 :: Int -> L.ByteString -encode_i32 = Binary.encode . int_to_int32 +encode_i32 :: Int -> ByteString.Lazy.ByteString +encode_i32 = Binary.encode . Convert.int_to_int32 --- | Encode an unsigned 32-bit integer. --- --- > encode_u32 0x01020304 == L.pack [1,2,3,4] -encode_u32 :: Int -> L.ByteString -encode_u32 = encode_word32 . int_to_word32 +{- | Encode an unsigned 32-bit integer. --- | Little-endian. --- --- > encode_u32_le 0x01020304 == L.pack [4,3,2,1] -encode_u32_le :: Int -> L.ByteString -encode_u32_le = encode_word32_le . int_to_word32 +>>> ByteString.Lazy.unpack (encode_u32 0x01020304) +[1,2,3,4] +-} +encode_u32 :: Int -> ByteString.Lazy.ByteString +encode_u32 = encode_word32 . Convert.int_to_word32 +{- | Little-endian. + +>>> ByteString.Lazy.unpack (encode_u32_le 0x01020304) +[4,3,2,1] +-} +encode_u32_le :: Int -> ByteString.Lazy.ByteString +encode_u32_le = encode_word32_le . Convert.int_to_word32 + -- * Encode/Float {- | Encode a 32-bit IEEE floating point number. -> encode_f32 1.0 == L.pack [63, 128, 0, 0] +>>> ByteString.Lazy.unpack (encode_f32 3.141) +[64,73,6,37] -} -encode_f32 :: Float -> L.ByteString -encode_f32 = Binary.encode . Cast.f32_w32 +encode_f32 :: Float -> ByteString.Lazy.ByteString +encode_f32 = Binary.Put.runPut . Binary.Put.putFloatbe --- | Little-endian variant of 'encode_f32'. -encode_f32_le :: Float -> L.ByteString -encode_f32_le = Put.runPut . Put.putWord32le . Cast.f32_w32 +{- | Little-endian variant of 'encode_f32'. --- | Encode a 64-bit IEEE floating point number. -encode_f64 :: Double -> L.ByteString -encode_f64 = Binary.encode . Cast.f64_w64 +>>> ByteString.Lazy.unpack (encode_f32_le 3.141) +[37,6,73,64] +-} +encode_f32_le :: Float -> ByteString.Lazy.ByteString +encode_f32_le = Binary.Put.runPut . Binary.Put.putFloatle --- | Little-endian variant of 'encode_f64'. -encode_f64_le :: Double -> L.ByteString -encode_f64_le = Put.runPut . Put.putWord64le . Cast.f64_w64 +{- | Encode a 64-bit IEEE floating point number. +>>> ByteString.Lazy.unpack (encode_f64 3.141) +[64,9,32,196,155,165,227,84] +-} +encode_f64 :: Double -> ByteString.Lazy.ByteString +encode_f64 = Binary.Put.runPut . Binary.Put.putDoublebe + +{- | Little-endian variant of 'encode_f64'. + +>>> ByteString.Lazy.unpack (encode_f64_le 3.141) +[84,227,165,155,196,32,9,64] +-} +encode_f64_le :: Double -> ByteString.Lazy.ByteString +encode_f64_le = Binary.Put.runPut . Binary.Put.putDoublele + -- * Encode/Ascii -- | Encode an Ascii string (Ascii at Datum is an alias for a Char8 Bytetring). -encode_ascii :: S.C.ByteString -> L.ByteString -encode_ascii = L.pack . S.unpack +encode_ascii :: ByteString.Char8.ByteString -> ByteString.Lazy.ByteString +encode_ascii = ByteString.Lazy.pack . ByteString.unpack -- * Decode -- | Type specialised 'Binary.decode'. -decode_word16 :: L.ByteString -> Word16 +decode_word16 :: ByteString.Lazy.ByteString -> Word16 decode_word16 = Binary.decode -- | Little-endian variant of 'decode_word16'. -decode_word16_le :: L.ByteString -> Word16 -decode_word16_le = Get.runGet Get.getWord16le +decode_word16_le :: ByteString.Lazy.ByteString -> Word16 +decode_word16_le = Binary.Get.runGet Binary.Get.getWord16le -- | Type specialised 'Binary.decode'. -decode_int16 :: L.ByteString -> Int16 +decode_int16 :: ByteString.Lazy.ByteString -> Int16 decode_int16 = Binary.decode -- | Type specialised 'Binary.decode'. -decode_word32 :: L.ByteString -> Word32 +decode_word32 :: ByteString.Lazy.ByteString -> Word32 decode_word32 = Binary.decode -- | Little-endian variant of 'decode_word32'. -decode_word32_le :: L.ByteString -> Word32 -decode_word32_le = Get.runGet Get.getWord32le +decode_word32_le :: ByteString.Lazy.ByteString -> Word32 +decode_word32_le = Binary.Get.runGet Binary.Get.getWord32le -- | Type specialised 'Binary.decode'. -decode_int64 :: L.ByteString -> Int64 +decode_int64 :: ByteString.Lazy.ByteString -> Int64 decode_int64 = Binary.decode -- | Type specialised 'Binary.decode'. -decode_word64 :: L.ByteString -> Word64 +decode_word64 :: ByteString.Lazy.ByteString -> Word64 decode_word64 = Binary.decode -- * Decode/Int -- | Decode an un-signed 8-bit integer. -decode_u8 :: L.ByteString -> Int -decode_u8 = word8_to_int . L.head +decode_u8 :: ByteString.Lazy.ByteString -> Int +decode_u8 = Convert.word8_to_int . ByteString.Lazy.head -- | Decode a signed 8-bit integer. -decode_i8 :: L.ByteString -> Int -decode_i8 = int8_to_int . Binary.decode +decode_i8 :: ByteString.Lazy.ByteString -> Int +decode_i8 = Convert.int8_to_int . Binary.decode -- | Decode an unsigned 8-bit integer. -decode_u16 :: L.ByteString -> Int -decode_u16 = word16_to_int . decode_word16 +decode_u16 :: ByteString.Lazy.ByteString -> Int +decode_u16 = Convert.word16_to_int . decode_word16 -- | Little-endian variant of 'decode_u16'. -decode_u16_le :: L.ByteString -> Int -decode_u16_le = word16_to_int . decode_word16_le +decode_u16_le :: ByteString.Lazy.ByteString -> Int +decode_u16_le = Convert.word16_to_int . decode_word16_le -- | Decode a signed 16-bit integer. -decode_i16 :: L.ByteString -> Int -decode_i16 = int16_to_int . decode_int16 +decode_i16 :: ByteString.Lazy.ByteString -> Int +decode_i16 = Convert.int16_to_int . decode_int16 -- | Little-endian variant of 'decode_i16'. -decode_i16_le :: L.ByteString -> Int -decode_i16_le = decode_i16 . L.reverse +decode_i16_le :: ByteString.Lazy.ByteString -> Int +decode_i16_le = decode_i16 . ByteString.Lazy.reverse --- | Decode a signed 32-bit integer. --- --- > decode_i32 (L.pack [0x00,0x00,0x03,0xe7]) == 0x03e7 -decode_i32 :: L.ByteString -> Int -decode_i32 = int32_to_int . Binary.decode +{- | Decode a signed 32-bit integer. --- | Little-endian variant of 'decode_i32'. --- --- > decode_i32_le (L.pack [0xe7,0x03,0x00,0x00]) == 0x03e7 -decode_i32_le :: L.ByteString -> Int -decode_i32_le = decode_i32 . L.reverse +>>> decode_i32 (ByteString.Lazy.pack [0x00,0x00,0x03,0xe7]) == 0x03e7 +True +-} +decode_i32 :: ByteString.Lazy.ByteString -> Int +decode_i32 = Convert.int32_to_int . Binary.decode --- | Decode an unsigned 32-bit integer. --- --- > decode_u32 (L.pack [1,2,3,4]) == 0x01020304 -decode_u32 :: L.ByteString -> Int -decode_u32 = word32_to_int . decode_word32 +{- | Little-endian variant of 'decode_i32'. --- | Little-endian variant of decode_u32. --- --- > decode_u32_le (L.pack [1,2,3,4]) == 0x04030201 -decode_u32_le :: L.ByteString -> Int -decode_u32_le = word32_to_int . decode_word32_le +>>> decode_i32_le (ByteString.Lazy.pack [0xe7,0x03,0x00,0x00]) == 0x03e7 +True +-} +decode_i32_le :: ByteString.Lazy.ByteString -> Int +decode_i32_le = decode_i32 . ByteString.Lazy.reverse +{- | Decode an unsigned 32-bit integer. + +>>> decode_u32 (ByteString.Lazy.pack [1,2,3,4]) == 0x01020304 +True +-} +decode_u32 :: ByteString.Lazy.ByteString -> Int +decode_u32 = Convert.word32_to_int . decode_word32 + +{- | Little-endian variant of decode_u32. + +>>> decode_u32_le (ByteString.Lazy.pack [1,2,3,4]) == 0x04030201 +True +-} +decode_u32_le :: ByteString.Lazy.ByteString -> Int +decode_u32_le = Convert.word32_to_int . decode_word32_le + -- * Decode/Float --- | Decode a 32-bit IEEE floating point number. -decode_f32 :: L.ByteString -> Float -decode_f32 = Cast.w32_f32 . decode_word32 +{- | Decode a 32-bit IEEE floating point number. +>>> decode_f32 (ByteString.Lazy.pack [64,73,6,37]) +3.141 +-} +decode_f32 :: ByteString.Lazy.ByteString -> Float +decode_f32 = Binary.Get.runGet Binary.Get.getFloatbe + -- | Little-endian variant of 'decode_f32'. -decode_f32_le :: L.ByteString -> Float -decode_f32_le = Cast.w32_f32 . decode_word32_le +decode_f32_le :: ByteString.Lazy.ByteString -> Float +decode_f32_le = Binary.Get.runGet Binary.Get.getFloatle -- | Decode a 64-bit IEEE floating point number. -decode_f64 :: L.ByteString -> Double -decode_f64 b = Cast.w64_f64 (Binary.decode b :: Word64) +decode_f64 :: ByteString.Lazy.ByteString -> Double +decode_f64 = Binary.Get.runGet Binary.Get.getDoublebe -- * Decode/Ascii -- | Decode an Ascii string, inverse of 'encode_ascii'. -decode_ascii :: L.ByteString -> S.C.ByteString +decode_ascii :: ByteString.Lazy.ByteString -> ByteString.Char8.ByteString {-# INLINE decode_ascii #-} -decode_ascii = S.C.pack . L.C.unpack +decode_ascii = ByteString.Char8.pack . ByteString.Lazy.Char8.unpack -- * IO -- | Read /n/ bytes from /h/ and run /f/. -read_decode :: (L.ByteString -> t) -> Int -> Handle -> IO t -read_decode f n = fmap f . flip L.hGet n +read_decode :: (ByteString.Lazy.ByteString -> t) -> Int -> Handle -> IO t +read_decode f n = fmap f . flip ByteString.Lazy.hGet n -- | Type-specialised reader for 'Binary.decode'. read_word32 :: Handle -> IO Word32 @@ -252,88 +298,113 @@ read_word32_le :: Handle -> IO Word32 read_word32_le = read_decode decode_word32_le 4 --- | 'L.hPut' of 'encode_word32'. +-- | 'ByteString.Lazy.hPut' of 'encode_word32'. write_word32 :: Handle -> Word32 -> IO () -write_word32 h = L.hPut h . encode_word32 +write_word32 h = ByteString.Lazy.hPut h . encode_word32 --- | 'L.hPut' of 'encode_word32_le'. +-- | 'ByteString.Lazy.hPut' of 'encode_word32_le'. write_word32_le :: Handle -> Word32 -> IO () -write_word32_le h = L.hPut h . encode_word32_le +write_word32_le h = ByteString.Lazy.hPut h . encode_word32_le -- * Io/Int --- | 'decode_i8' of 'L.hGet'. +-- | 'decode_i8' of 'ByteString.Lazy.hGet'. read_i8 :: Handle -> IO Int read_i8 = read_decode decode_i8 1 --- | 'decode_i16' of 'L.hGet'. +-- | 'decode_i16' of 'ByteString.Lazy.hGet'. read_i16 :: Handle -> IO Int read_i16 = read_decode decode_i16 2 --- | 'decode_i32' of 'L.hGet'. +-- | 'decode_i32' of 'ByteString.Lazy.hGet'. read_i32 :: Handle -> IO Int read_i32 = read_decode decode_i32 4 --- | 'decode_i32_le' of 'L.hGet'. +-- | 'decode_i32_le' of 'ByteString.Lazy.hGet'. read_i32_le :: Handle -> IO Int read_i32_le = read_decode decode_i32_le 4 --- | 'decode_u32' of 'L.hGet'. +-- | 'decode_u32' of 'ByteString.Lazy.hGet'. read_u32 :: Handle -> IO Int read_u32 = read_decode decode_u32 4 --- | 'decode_u32_le' of 'L.hGet'. +-- | 'decode_u32_le' of 'ByteString.Lazy.hGet'. read_u32_le :: Handle -> IO Int read_u32_le = read_decode decode_u32_le 4 --- | 'L.hPut' of 'encode_u32'. +-- | 'ByteString.Lazy.hPut' of 'encode_u32'. write_u32 :: Handle -> Int -> IO () -write_u32 h = L.hPut h . encode_u32 +write_u32 h = ByteString.Lazy.hPut h . encode_u32 --- | 'L.hPut' of 'encode_u32_le'. +-- | 'ByteString.Lazy.hPut' of 'encode_u32_le'. write_u32_le :: Handle -> Int -> IO () -write_u32_le h = L.hPut h . encode_u32_le +write_u32_le h = ByteString.Lazy.hPut h . encode_u32_le -- * Io/Float --- | 'decode_f32' of 'L.hGet'. +-- | 'decode_f32' of 'ByteString.Lazy.hGet'. read_f32 :: Handle -> IO Float read_f32 = read_decode decode_f32 4 --- | 'decode_f32_le' of 'L.hGet'. +-- | 'decode_f32_le' of 'ByteString.Lazy.hGet'. read_f32_le :: Handle -> IO Float read_f32_le = read_decode decode_f32_le 4 -- * Io/Ascii -- | Read u8 length prefixed Ascii string (pascal string). -read_pstr :: Handle -> IO S.C.ByteString +read_pstr :: Handle -> IO ByteString.Char8.ByteString read_pstr h = do - n <- fmap decode_u8 (L.hGet h 1) - fmap decode_ascii (L.hGet h n) + n <- fmap decode_u8 (ByteString.Lazy.hGet h 1) + fmap decode_ascii (ByteString.Lazy.hGet h n) -- * Util -{- | Bundle header as a (strict) 'S.C.ByteString'. +{- | Bundle header as a (strict) 'ByteString.Char8.ByteString'. -> S.C.length bundleHeader_strict == 8 +>>> ByteString.Char8.length bundleHeader_strict +8 -} -bundleHeader_strict :: S.C.ByteString -bundleHeader_strict = S.C.pack "#bundle\0" +bundleHeader_strict :: ByteString.Char8.ByteString +bundleHeader_strict = ByteString.Char8.pack "#bundle\0" {- | Bundle header as a lazy ByteString. -> L.length bundleHeader == 8 +>>> ByteString.Lazy.length bundleHeader +8 -} -bundleHeader :: L.ByteString +bundleHeader :: ByteString.Lazy.ByteString {-# INLINE bundleHeader #-} -bundleHeader = L.C.fromChunks [bundleHeader_strict] +bundleHeader = ByteString.Lazy.Char8.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] -> map align [512::Int .. 519] == [0,3,2,1,0,3,2,1] +>>> map align [0::Int .. 7] +[0,3,2,1,0,3,2,1] + +>>> map align [512::Int .. 519] +[0,3,2,1,0,3,2,1] -} -align :: (Num i,Bits i) => i -> i +align :: (Num i, Bits i) => i -> i {-# INLINE align #-} align n = ((n + 3) .&. complement 3) - n + +-- * ByteString + +-- | Is machine little endian? +isLittleEndian :: Bool +isLittleEndian = GHC.ByteOrder.targetByteOrder == GHC.ByteOrder.LittleEndian + +-- | Byte-swap byte string in four-byte segments. +byteStringSwap32BitWords :: ByteString.ByteString -> ByteString.ByteString +byteStringSwap32BitWords xs = + ByteString.Internal.unsafePackLenBytes + (ByteString.length xs `quot` 4 * 4) + [ ByteString.Unsafe.unsafeIndex xs $ i * 4 + j + | i <- [0 .. ByteString.length xs `quot` 4 - 1] + , j <- [3, 2, 1, 0] + ] + +-- | If target is little-endian, swap bytes to be in network order, else identity. +byteString32BitNetworkOrder :: ByteString.ByteString -> ByteString.ByteString +byteString32BitNetworkOrder x = if isLittleEndian then byteStringSwap32BitWords x else x diff --git a/Sound/Osc/Coding/Cast.hs b/Sound/Osc/Coding/Cast.hs --- a/Sound/Osc/Coding/Cast.hs +++ b/Sound/Osc/Coding/Cast.hs @@ -4,25 +4,56 @@ import Data.Char {- base -} import Data.Word {- base -} -import qualified Data.Binary.IEEE754 as Ieee {- data-binary-ieee754 -} - +import Sound.Osc.Coding.Byte {- hosc3 -} import Sound.Osc.Coding.Convert {- hosc -} --- | The IEEE byte representation of a float. +{- | The IEEE byte representation of a float. + +>>> f32_w32 pi +1078530011 + +>>> f32_w32 (-7913907.5) +3404825447 + +>>> 23 ^ 7 +3404825447 +-} f32_w32 :: Float -> Word32 -f32_w32 = Ieee.floatToWord +f32_w32 = decode_word32 . encode_f32 --- | Inverse of 'f32_w32'. +{- | Inverse of 'f32_w32'. + +>>> w32_f32 1078530011 +3.1415927 + +>>> w32_f32 (23 ^ 7) +-7913907.5 +-} w32_f32 :: Word32 -> Float -w32_f32 = Ieee.wordToFloat +w32_f32 = decode_f32 . encode_word32 --- | The IEEE byte representation of a double. +{- | The IEEE byte representation of a double. + + +>>> f64_w64 pi +4614256656552045848 + +>>> f64_w64 1.6822072834e-314 +3404825447 +-} f64_w64 :: Double -> Word64 -f64_w64 = Ieee.doubleToWord +f64_w64 = decode_word64 . encode_f64 --- | Inverse of 'f64_i64'. +{- | Inverse of 'f64_w64'. + +>>> w64_f64 4614256656552045848 +3.141592653589793 + +>>> w64_f64 (23 ^ 7) +1.6822072834e-314 +-} w64_f64 :: Word64 -> Double -w64_f64 = Ieee.wordToDouble +w64_f64 = decode_f64 . encode_word64 -- | Transform a haskell string into a C string (a null suffixed byte string). str_cstr :: String -> [Word8] diff --git a/Sound/Osc/Coding/Decode/Base.hs b/Sound/Osc/Coding/Decode/Base.hs --- a/Sound/Osc/Coding/Decode/Base.hs +++ b/Sound/Osc/Coding/Decode/Base.hs @@ -1,8 +1,11 @@ --- | Base-level decode function for Osc packets. --- For ordinary use see 'Sound.Osc.Coding.Decode.Binary'. -module Sound.Osc.Coding.Decode.Base (decodeMessage - ,decodeBundle - ,decodePacket) where +{- | Base-level decode function for Osc packets. + 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 -} @@ -19,86 +22,96 @@ -- | The plain byte count of an Osc value. size :: DatumType -> B.ByteString -> Int size ty b = - case ty of - 'i' -> 4 -- Int32 - 'f' -> 4 -- Float - 'd' -> 8 -- Double - 't' -> 8 -- Time (NTP) - 'm' -> 4 -- MIDI - 's' -> int64_to_int (fromMaybe - (error ("size: no terminating zero: " ++ show b)) - (B.elemIndex 0 b)) - 'b' -> decode_i32 (B.take 4 b) - _ -> error "size: illegal type" + case ty of + 'i' -> 4 -- Int32 + 'f' -> 4 -- Float + 'd' -> 8 -- Double + 't' -> 8 -- Time (NTP) + 'm' -> 4 -- MIDI + 's' -> + int64_to_int + ( 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 (aligned) of an Osc value. storage :: DatumType -> 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 + 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 :: DatumType -> 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' -> AsciiString (decode_ascii (b_take (size 's' b) b)) - 'b' -> Blob (b_take (size 'b' b) (B.drop 4 b)) - 't' -> TimeStamp (ntpi_to_ntpr (decode_word64 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] ++ ")") + case ty of + 'i' -> Int32 (decode b) + 'h' -> Int64 (decode b) + 'f' -> Float (decode_f32 b) + 'd' -> Double (decode_f64 b) + 's' -> AsciiString (decode_ascii (b_take (size 's' b) b)) + 'b' -> Blob (b_take (size 'b' b) (B.drop 4 b)) + 't' -> TimeStamp (ntpi_to_ntpr (decode_word64 b)) + 'm' -> + case B.unpack (B.take 4 b) of + [b0, b1, b2, b3] -> midi (b0, b1, b2, b3) + _ -> error "decode_datum: illegal midi data" + _ -> 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 (int_to_int64 (storage c b')) b') - in zipWith decode_datum cs' (snd (mapAccumL f b cs')) + let swap (x, y) = (y, x) + cs' = C.unpack cs + f b' c = swap (B.splitAt (int_to_int64 (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 - (AsciiString cmd) = decode_datum 's' b - m = storage 's' (b_drop n b) - (AsciiString 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 + let n = storage 's' b + cmd = decode_datum 's' b + m = storage 's' (b_drop n b) + in case (cmd, decode_datum 's' (b_drop n b)) of + (AsciiString cmd', AsciiString dsc) -> + let arg = decode_datum_seq (descriptor_tags dsc) (b_drop (n + m) b) + in Message (C.unpack cmd') arg + _ -> error "decodeMessage" -- | Decode a sequence of length prefixed (Int32) Osc messages. 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 + 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.ByteString -> BundleOf Message decodeBundle b = - let h = storage 's' b -- header (should be '#bundle') - t = storage 't' (b_drop h b) -- time - (TimeStamp timeStamp) = decode_datum 't' (b_drop h b) - ms = decode_message_seq (b_drop (h+t) b) - in Bundle timeStamp ms + let h = storage 's' b -- header (should be '#bundle') + t = storage 't' (b_drop h b) -- time + in case decode_datum 't' (b_drop h b) of + TimeStamp timeStamp -> Bundle timeStamp (decode_message_seq (b_drop (h + t) b)) + _ -> error "decodeBundle" --- | Decode an Osc 'Packet'. --- --- > let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] --- > decodePacket b == Packet_Message (Message "/g_free" [Int32 0]) -decodePacket :: B.ByteString -> Packet +{- | Decode an Osc 'Packet'. + +>>> let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] +>>> decodePacket b == Packet_Message (Message "/g_free" [Int32 0]) +True +-} +decodePacket :: B.ByteString -> PacketOf Message decodePacket b = - if bundleHeader `B.isPrefixOf` b + if bundleHeader `B.isPrefixOf` b then Packet_Bundle (decodeBundle b) else Packet_Message (decodeMessage b) --- * UTIL +-- * Util -- | 'B.take' with 'Int' count. b_take :: Int -> B.ByteString -> B.ByteString diff --git a/Sound/Osc/Coding/Decode/Binary.hs b/Sound/Osc/Coding/Decode/Binary.hs --- a/Sound/Osc/Coding/Decode/Binary.hs +++ b/Sound/Osc/Coding/Decode/Binary.hs @@ -1,105 +1,100 @@ -- | Optimised decode function for Osc packets. -module Sound.Osc.Coding.Decode.Binary - (get_packet - ,decodeMessage - ,decodeBundle - ,decodePacket - ,decodePacket_strict) where +module Sound.Osc.Coding.Decode.Binary ( + get_packet, + decodeMessage, + decodeBundle, + decodePacket, + decodePacket_strict, + decodeMessageOr, + decodeBundleOr, + decodePacketOr, +) where import Control.Applicative {- base -} import Control.Monad {- base -} -import Data.Int {- base -} import Data.Word {- base -} import qualified Data.Binary.Get as Binary {- binary -} -import qualified Data.Binary.IEEE754 as Ieee {- data-binary-ieee754 -} -import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -} + import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -} +import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -} import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8 {- bytestring -} import qualified Sound.Osc.Coding.Byte as Byte {- hosc -} -import Sound.Osc.Coding.Convert {- hosc -} +import qualified Sound.Osc.Coding.Convert as Convert {- hosc -} import Sound.Osc.Datum {- hosc -} import Sound.Osc.Packet {- hosc -} import qualified Sound.Osc.Time as Time {- hosc -} --- | Get a 32 bit integer in big-endian byte order. -getInt32be :: Binary.Get Int32 -getInt32be = fmap word32_to_int32 Binary.getWord32be - --- | Get a 64 bit integer in big-endian byte order. -getInt64be :: Binary.Get Int64 -getInt64be = fmap word64_to_int64 Binary.getWord64be - -- | Get an aligned Osc string. get_string :: Binary.Get String get_string = do - s <- Binary.getLazyByteStringNul - Binary.skip (int64_to_int (Byte.align (ByteString.Lazy.length s + 1))) - return (ByteString.Lazy.Char8.unpack s) + s <- Binary.getLazyByteStringNul + Binary.skip (Convert.int64_to_int (Byte.align (ByteString.Lazy.length s + 1))) + return (ByteString.Lazy.Char8.unpack s) -- | Get an aligned Osc string. get_ascii :: Binary.Get Ascii get_ascii = do - s <- Binary.getLazyByteStringNul - Binary.skip (int64_to_int (Byte.align (ByteString.Lazy.length s + 1))) - return (ByteString.Char8.pack (ByteString.Lazy.Char8.unpack s)) + s <- Binary.getLazyByteStringNul + Binary.skip (Convert.int64_to_int (Byte.align (ByteString.Lazy.length s + 1))) + return (ByteString.Char8.pack (ByteString.Lazy.Char8.unpack s)) -- | Get binary data prefixed by byte count. get_bytes :: Word32 -> Binary.Get ByteString.Lazy.ByteString get_bytes n = do - b <- Binary.getLazyByteString (word32_to_int64 n) - if n /= int64_to_word32 (ByteString.Lazy.length b) - then fail "get_bytes: end of stream" - else Binary.skip (word32_to_int (Byte.align n)) - return b + b <- Binary.getLazyByteString (Convert.word32_to_int64 n) + if n /= Convert.int64_to_word32 (ByteString.Lazy.length b) + then fail "get_bytes: end of stream" + else Binary.skip (Convert.word32_to_int (Byte.align n)) + return b -- | Get an Osc datum. get_datum :: DatumType -> Binary.Get Datum get_datum ty = - case ty of - 'i' -> fmap Int32 getInt32be - 'h' -> fmap Int64 getInt64be - 'f' -> fmap Float Ieee.getFloat32be - 'd' -> fmap Double Ieee.getFloat64be - 's' -> fmap AsciiString get_ascii - 'b' -> fmap Blob (get_bytes =<< Binary.getWord32be) - 't' -> fmap (TimeStamp . Time.ntpi_to_ntpr) Binary.getWord64be - 'm' -> fmap Midi (liftM4 MidiData Binary.getWord8 Binary.getWord8 Binary.getWord8 Binary.getWord8) - _ -> fail ("get_datum: illegal type " ++ show ty) + case ty of + 'i' -> fmap Int32 Binary.getInt32be + 'h' -> fmap Int64 Binary.getInt64be + 'f' -> fmap Float Binary.getFloatbe + 'd' -> fmap Double Binary.getDoublebe + 's' -> fmap AsciiString get_ascii + 'b' -> fmap Blob (get_bytes =<< Binary.getWord32be) + 't' -> fmap (TimeStamp . Time.ntpi_to_ntpr) Binary.getWord64be + 'm' -> fmap Midi (liftM4 MidiData Binary.getWord8 Binary.getWord8 Binary.getWord8 Binary.getWord8) + _ -> fail ("get_datum: illegal type " ++ show ty) -- | Get an Osc 'Message', fail if type descriptor is invalid. get_message :: Binary.Get Message get_message = do - cmd <- get_string - dsc <- get_ascii - case ByteString.Char8.unpack dsc of - ',':tags -> do - arg <- mapM get_datum tags - return (Message cmd arg) - e -> fail ("get_message: invalid type descriptor string: " ++ e) + cmd <- get_string + dsc <- get_ascii + case ByteString.Char8.unpack dsc of + ',' : tags -> do + arg <- mapM get_datum tags + return (Message cmd arg) + e -> fail ("get_message: invalid type descriptor string: " ++ e) -- | Get a sequence of Osc 'Message's, each one headed by its length. get_message_seq :: Binary.Get [Message] get_message_seq = do - b <- Binary.isEmpty - if b - then return [] - else do - p <- flip Binary.isolate get_message . word32_to_int =<< Binary.getWord32be - ps <- get_message_seq - return (p:ps) + b <- Binary.isEmpty + if b + then return [] + else do + p <- flip Binary.isolate get_message . Convert.word32_to_int =<< Binary.getWord32be + ps <- get_message_seq + return (p : ps) -- | Get a bundle. Fail if bundle header is not found in packet. -get_bundle :: Binary.Get Bundle +get_bundle :: Binary.Get (BundleOf Message) get_bundle = do - h <- Binary.getByteString (ByteString.Char8.length Byte.bundleHeader_strict) - when (h /= Byte.bundleHeader_strict) (fail "get_bundle: not a bundle") - t <- fmap Time.ntpi_to_ntpr Binary.getWord64be - fmap (Bundle t) get_message_seq + h <- Binary.getByteString (ByteString.Char8.length Byte.bundleHeader_strict) + when (h /= Byte.bundleHeader_strict) (fail "get_bundle: not a bundle") + t <- fmap Time.ntpi_to_ntpr Binary.getWord64be + fmap (Bundle t) get_message_seq -- | Get an Osc 'Packet'. -get_packet :: Binary.Get Packet +get_packet :: Binary.Get (PacketOf Message) get_packet = fmap Packet_Bundle get_bundle <|> fmap Packet_Message get_message {-# INLINE decodeMessage #-} @@ -109,24 +104,49 @@ {- | Decode an Osc 'Message' from a lazy ByteString. -> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] -> decodeMessage b == Message "/g_free" [Int32 0] +>>> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] +>>> decodeMessage b == Message "/g_free" [Int32 0] +True -} decodeMessage :: ByteString.Lazy.ByteString -> Message decodeMessage = Binary.runGet get_message -- | Decode an Osc 'Bundle' from a lazy ByteString. -decodeBundle :: ByteString.Lazy.ByteString -> Bundle +decodeBundle :: ByteString.Lazy.ByteString -> BundleOf Message decodeBundle = Binary.runGet get_bundle +-- | Run decoder and report any error. +runDecoder :: Binary.Get t -> ByteString.Lazy.Char8.ByteString -> Either String t +runDecoder f p = + case Binary.runGetOrFail f p of + Left (_, _, err) -> Left err + Right (_, _, decoded) -> Right decoded + {- | Decode an Osc packet from a lazy ByteString. -> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] -> decodePacket b == Packet_Message (Message "/g_free" [Int32 0]) +>>> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] +>>> decodePacket b == Packet_Message (Message "/g_free" [Int32 0]) +True -} -decodePacket :: ByteString.Lazy.ByteString -> Packet +decodePacket :: ByteString.Lazy.ByteString -> PacketOf Message decodePacket = Binary.runGet get_packet -- | Decode an Osc packet from a strict Char8 ByteString. -decodePacket_strict :: ByteString.Char8.ByteString -> Packet -decodePacket_strict = Binary.runGet get_packet . ByteString.Lazy.fromChunks . (:[]) +decodePacket_strict :: ByteString.Char8.ByteString -> PacketOf Message +decodePacket_strict = Binary.runGet get_packet . ByteString.Lazy.fromChunks . (: []) + +{- | Either decode Osc message or return an error message. +Prevents application halt for non-valid message/bundle/packet arrives. + +>>> let b = ByteString.Lazy.pack [1,2,3,2,1] +>>> decodePacketOr b +Left "not enough bytes" +-} +decodeMessageOr :: ByteString.Lazy.ByteString -> Either String Message +decodeMessageOr = runDecoder get_message + +decodeBundleOr :: ByteString.Lazy.ByteString -> Either String Bundle +decodeBundleOr = runDecoder get_bundle + +decodePacketOr :: ByteString.Lazy.ByteString -> Either String Packet +decodePacketOr = runDecoder get_packet diff --git a/Sound/Osc/Coding/Encode/Base.hs b/Sound/Osc/Coding/Encode/Base.hs --- a/Sound/Osc/Coding/Encode/Base.hs +++ b/Sound/Osc/Coding/Encode/Base.hs @@ -1,5 +1,6 @@ --- | Base-level encode function for Osc packets (slow). --- For ordinary use see 'Sound.Osc.Coding.Encode.Builder'. +{- | Base-level encode function for Osc packets (slow). + For ordinary use see 'Sound.Osc.Coding.Encode.Builder'. +-} module Sound.Osc.Coding.Encode.Base where import Data.Binary {- base -} @@ -20,33 +21,67 @@ MidiData: Bytes from MSB to LSB are: port id, status byte, data1, data2. -> encode_datum (blob [1, 2, 3, 4]) == B.pack [0, 0, 0, 4, 1, 2, 3, 4] +>>> encode_datum (blob [1, 2, 3, 4]) == B.pack [0, 0, 0, 4, 1, 2, 3, 4] +True + +>>> encode_datum (Float 1) == B.pack [63, 128, 0, 0] +True + +>>> encode_datum (Float 2) == B.pack [64, 0, 0, 0] +True + +>>> encode_datum (Float 3) == B.pack [64, 64, 0, 0] +True + +>>> encode_datum (Float 4) == B.pack [64, 128, 0, 0] +True + +>>> encode_datum (Float 5) == B.pack [64, 160, 0, 0] +True + +>>> encode_datum (Int32 65536) == B.pack [0, 1, 0, 0] +True + +>>> encode_datum (Int32 (-65536)) == B.pack [255, 255, 0, 0] +True -} 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_word64 $ ntpr_to_ntpi t - AsciiString s -> extend 0 (B.snoc (encode_ascii s) 0) - Midi (MidiData b0 b1 b2 b3) -> B.pack [b0,b1,b2,b3] - Blob b -> let n = encode (int64_to_int32 (B.length b)) - in B.append n (extend 0 b) + case dt of + Int32 i -> encode i + Int64 i -> encode i + Float f -> encode_f32 f + Double d -> encode_f64 d + TimeStamp t -> encode_word64 $ ntpr_to_ntpi t + AsciiString s -> extend 0 (B.snoc (encode_ascii s) 0) + Midi (MidiData b0 b1 b2 b3) -> B.pack [b0, b1, b2, b3] + Blob b -> + let n = encode (int64_to_int32 (B.length b)) + in B.append n (extend 0 b) {- | Encode Osc 'Message'. -> m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1] -> e = blob_unpack (encodeMessage m) -> length e == 40 -> e == [47,110,95,115,101,116,0,0,44,105,115,102,115,102,0,0,255,255,255,255,102,114,101,113,0,0,0,0,67,220,0,0,97,109,112,0,61,204,204,205] +>>> blob_unpack (encodeMessage (Message "/x" [])) +[47,120,0,0,44,0,0,0] + +>>> blob_unpack (encodeMessage (Message "/y" [float 3.141])) +[47,121,0,0,44,102,0,0,64,73,6,37] + +>>> let m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1] +>>> let e = blob_unpack (encodeMessage m) +>>> length e +40 + +>>> take 20 e +[47,110,95,115,101,116,0,0,44,105,115,102,115,102,0,0,255,255,255,255] -} encodeMessage :: Message -> B.ByteString encodeMessage (Message c l) = - B.concat [encode_datum (AsciiString (C.pack c)) - ,encode_datum (AsciiString (descriptor l)) - ,B.concat (map encode_datum l) ] + B.concat + [ encode_datum (AsciiString (C.pack c)) + , encode_datum (AsciiString (descriptor l)) + , B.concat (map encode_datum l) + ] -- | Encode Osc 'Message' as an Osc blob. encode_message_blob :: Message -> Datum @@ -54,21 +89,29 @@ {- | Encode Osc 'Bundle'. -b = Bundle 0.0 [m] -e = blob_unpack (encodeBundle b) -length e == 60 -e == [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,0,0,0,0,40,47,110,95,115,101,116,0,0,44,105,115,102,115,102,0,0,255,255,255,255,102,114,101,113,0,0,0,0,67,220,0,0,97,109,112,0,61,204,204,205] +>>> blob_unpack (encodeBundle (Bundle immediately [Message "/x" []])) +[35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,8,47,120,0,0,44,0,0,0] + +>>> let m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1] +>>> let b = Bundle 0.0 [m] +>>> let e = blob_unpack (encodeBundle b) +>>> length e +60 + +>> take 20 e +[35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,0,0,0,0,40] -} -encodeBundle :: Bundle -> B.ByteString +encodeBundle :: BundleOf Message -> B.ByteString encodeBundle (Bundle t m) = - B.concat - [bundleHeader - ,encode_word64 (ntpr_to_ntpi t) - ,B.concat (map (encode_datum . encode_message_blob) m)] + B.concat + [ bundleHeader + , encode_word64 (ntpr_to_ntpi t) + , B.concat (map (encode_datum . encode_message_blob) m) + ] -- | Encode Osc 'Packet'. -encodePacket :: Packet -> B.ByteString +encodePacket :: PacketOf Message -> B.ByteString encodePacket o = - case o of - Packet_Message m -> encodeMessage m - Packet_Bundle b -> encodeBundle b + case o of + Packet_Message m -> encodeMessage m + Packet_Bundle b -> encodeBundle b diff --git a/Sound/Osc/Coding/Encode/Builder.hs b/Sound/Osc/Coding/Encode/Builder.hs --- a/Sound/Osc/Coding/Encode/Builder.hs +++ b/Sound/Osc/Coding/Encode/Builder.hs @@ -1,20 +1,21 @@ -- | Optimised encode function for Osc packets. -module Sound.Osc.Coding.Encode.Builder - (build_packet - ,encodeMessage - ,encodeBundle - ,encodePacket - ,encodePacket_strict) where +module Sound.Osc.Coding.Encode.Builder ( + build_packet, + encodeMessage, + encodeBundle, + encodePacket, + encodePacket_strict, +) where import Data.Word {- base -} -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 qualified Data.ByteString as S {- bytestring -} +import qualified Data.ByteString.Lazy as L {- bytestring -} import qualified Sound.Osc.Coding.Byte as Byte {- hosc -} +import qualified Sound.Osc.Coding.Cast as Cast {- hosc -} import qualified Sound.Osc.Coding.Convert as Convert {- hosc -} import Sound.Osc.Datum {- hosc -} import Sound.Osc.Packet {- hosc -} @@ -39,43 +40,47 @@ -- Encode a byte string with prepended length and zero padding. build_bytes :: L.ByteString -> B.Builder build_bytes s = - B.fromInt32be (Convert.int64_to_int32 (L.length s)) <> - B.fromLazyByteString s <> - B.fromWord8s (padding (Convert.int64_to_int (Byte.align (L.length s)))) + B.fromInt32be (Convert.int64_to_int32 (L.length s)) + <> B.fromLazyByteString s + <> B.fromWord8s (padding (Convert.int64_to_int (Byte.align (L.length s)))) -- Encode an Osc datum. build_datum :: Datum -> B.Builder build_datum d = - case d of - Int32 i -> B.fromInt32be i - Int64 i -> B.fromInt64be i - Float n -> B.fromWord32be (I.floatToWord n) - Double n -> B.fromWord64be (I.doubleToWord n) - TimeStamp t -> B.fromWord64be (ntpr_to_ntpi t) - AsciiString s -> build_ascii s - Midi (MidiData b0 b1 b2 b3) -> B.fromWord8s [b0,b1,b2,b3] - Blob b -> build_bytes b + case d of + Int32 i -> B.fromInt32be i + Int64 i -> B.fromInt64be i + Float n -> B.fromWord32be (Cast.f32_w32 n) + Double n -> B.fromWord64be (Cast.f64_w64 n) + TimeStamp t -> B.fromWord64be (ntpr_to_ntpi t) + AsciiString s -> build_ascii s + Midi (MidiData 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)] + mconcat + [ build_string c + , build_ascii (descriptor l) + , mconcat (map build_datum l) + ] -- Encode an Osc 'Bundle'. build_bundle_ntpi :: Ntp64 -> [Message] -> B.Builder build_bundle_ntpi t l = - mconcat [B.fromLazyByteString Byte.bundleHeader - ,B.fromWord64be t - ,mconcat (map (build_bytes . B.toLazyByteString . build_message) l)] + mconcat + [ B.fromLazyByteString Byte.bundleHeader + , B.fromWord64be t + , mconcat (map (build_bytes . B.toLazyByteString . build_message) l) + ] -- | Builder for an Osc 'Packet'. -build_packet :: Packet -> B.Builder +build_packet :: PacketOf Message -> 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 + case o of + Packet_Message m -> build_message m + Packet_Bundle (Bundle t m) -> build_bundle_ntpi (ntpr_to_ntpi t) m {-# INLINE encodePacket #-} {-# INLINE encodeMessage #-} @@ -83,28 +88,28 @@ {-# INLINE encodePacket_strict #-} -- | Encode an Osc 'Packet'. -encodePacket :: Packet -> L.ByteString +encodePacket :: PacketOf Message -> L.ByteString encodePacket = B.toLazyByteString . build_packet {- | Encode an Osc 'Message', ie. 'encodePacket' of 'Packet_Message'. -> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] -> encodeMessage (Message "/g_free" [Int32 0]) == L.pack m - +>>> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] +>>> encodeMessage (Message "/g_free" [Int32 0]) == L.pack m +True -} encodeMessage :: Message -> L.ByteString encodeMessage = encodePacket . Packet_Message {- | Encode an Osc 'Bundle', ie. 'encodePacket' of 'Packet_Bundle'. -> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] -> let b = [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,16] ++ m -> encodeBundle (Bundle immediately [Message "/g_free" [Int32 0]]) == L.pack b - +>>> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0] +>>> let b = [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,16] ++ m +>>> encodeBundle (Bundle immediately [Message "/g_free" [Int32 0]]) == L.pack b +True -} -encodeBundle :: Bundle -> L.ByteString +encodeBundle :: BundleOf Message -> L.ByteString encodeBundle = encodePacket . Packet_Bundle -- | Encode an Osc 'Packet' to a strict 'S.ByteString'. -encodePacket_strict :: Packet -> S.ByteString +encodePacket_strict :: PacketOf Message -> S.ByteString encodePacket_strict = B.toByteString . build_packet diff --git a/Sound/Osc/Core.hs b/Sound/Osc/Core.hs --- a/Sound/Osc/Core.hs +++ b/Sound/Osc/Core.hs @@ -3,12 +3,10 @@ Provides the 'Datum', 'Message', 'Time', 'Bundle' and 'Packet' types and the coding functions 'encodePacket' and 'decodePacket'. -> import Sound.Osc.Core {- hosc -} -> -> let o = bundle immediately [message "/g_free" [Int32 0]] -> let e = encodeBundle o -> decodePacket e == Packet_Bundle o - +>>> let o = bundle immediately [message "/g_free" [Int32 0]] +>>> let e = encodeBundle o +>>> decodePacket e == Packet_Bundle o +True -} module Sound.Osc.Core (module M) where diff --git a/Sound/Osc/Datum.hs b/Sound/Osc/Datum.hs --- a/Sound/Osc/Datum.hs +++ b/Sound/Osc/Datum.hs @@ -5,8 +5,8 @@ import Data.Maybe {- base -} import Data.Word {- base -} -import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -} import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -} +import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -} -- * Datum @@ -28,9 +28,13 @@ type Blob = ByteString.Lazy.ByteString -- | Type-specialised pack. -blob_pack :: [Word8] -> Blob +blob_pack :: [Word8] -> Blob blob_pack = ByteString.Lazy.pack +-- | Type-specialised pack. +blob_pack_int :: [Int] -> Blob +blob_pack_int = ByteString.Lazy.pack . map fromIntegral + -- | Type-specialised unpack. blob_unpack :: Blob -> [Word8] blob_unpack = ByteString.Lazy.unpack @@ -41,14 +45,18 @@ -- | Four-byte midi message: port-id, status-byte, data, data. data MidiData = MidiData !Word8 !Word8 !Word8 !Word8 - deriving (Ord, Eq, Show, Read) + deriving (Ord, Eq, Show, Read) -midi_pack :: [Word8] -> MidiData +midi_pack :: [Word8] -> MidiData midi_pack w = case w of [m1, m2, m3, m4] -> MidiData m1 m2 m3 m4 _ -> error "midi_pack?" +-- | Type-specialised pack. +midi_pack_int :: [Int] -> MidiData +midi_pack_int = midi_pack . map fromIntegral + -- | Type-specialised unpack. midi_unpack_int :: MidiData -> [Int] midi_unpack_int (MidiData m1 m2 m3 m4) = map fromIntegral [m1, m2, m3, m4] @@ -61,44 +69,45 @@ type Time = Double -- | The basic elements of Osc messages. -data Datum = Int32 {d_int32 :: !Int32} - | Int64 {d_int64 :: !Int64} - | Float {d_float :: !Float} - | Double {d_double :: !Double} - | AsciiString {d_ascii_string :: !Ascii} - | Blob {d_blob :: !Blob} - | TimeStamp {d_timestamp :: !Time} -- ie. real valued Ntp - | Midi {d_midi :: !MidiData} - deriving (Ord, Eq, Read, Show) +data Datum + = Int32 {d_int32 :: !Int32} + | Int64 {d_int64 :: !Int64} + | Float {d_float :: !Float} + | Double {d_double :: !Double} + | AsciiString {d_ascii_string :: !Ascii} + | Blob {d_blob :: !Blob} + | TimeStamp {d_timestamp :: !Time} -- ie. real valued Ntp + | Midi {d_midi :: !MidiData} + deriving (Ord, Eq, Read, Show) -- * Datum types -- | List of required data types (tag, name). -osc_types_required :: [(DatumType,String)] +osc_types_required :: [(DatumType, String)] osc_types_required = - [('i',"Int32") - ,('f',"Float") - ,('s',"String") -- Ascii - ,('b',"Blob") - ] + [ ('i', "Int32") + , ('f', "Float") + , ('s', "String") -- Ascii + , ('b', "Blob") + ] -- | List of optional data types (tag,name). osc_types_optional :: [(DatumType, String)] osc_types_optional = - [('h',"Int64") - ,('t',"TimeStamp") - ,('d',"Double") - -- ,('S',"Symbol") + [ ('h', "Int64") + , ('t', "TimeStamp") + , ('d', "Double") + , -- ,('S',"Symbol") -- ,('c',"Character") -- ,('r',"RGBA") - ,('m',"Midi") + ('m', "Midi") -- ,('T',"True") -- ,('F',"False") -- ,('N',"Nil") -- ,('I',"Infinitum") -- ,('[',"Array_Begin") -- ,(']',"Array_End") - ] + ] -- | List of all data types (tag,name). osc_types :: [(DatumType, String)] @@ -115,91 +124,119 @@ -- | Single character identifier of an Osc datum. datum_tag :: Datum -> DatumType datum_tag d = - case d of - Int32 _ -> 'i' - Int64 _ -> 'h' - Float _ -> 'f' - Double _ -> 'd' - AsciiString _ -> 's' - Blob _ -> 'b' - TimeStamp _ -> 't' - Midi _ -> 'm' + case d of + Int32 _ -> 'i' + Int64 _ -> 'h' + Float _ -> 'f' + Double _ -> 'd' + AsciiString _ -> 's' + Blob _ -> 'b' + TimeStamp _ -> 't' + Midi _ -> 'm' -- | Type and name of 'Datum'. datum_type_name :: Datum -> (DatumType, String) -datum_type_name d = let c = datum_tag d in (c,osc_type_name_err c) +datum_type_name d = let c = datum_tag d in (c, osc_type_name_err c) -- * Generalised element access --- | 'Datum' as 'Integral' if Int32 or Int64. --- --- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5] --- > map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing] +{- | 'Datum' as 'Integral' if Int32 or Int64. + +>>> let d = [Int32 5,Int64 5,Float 5.5,Double 5.5] +>>> map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing] +True +-} datum_integral :: Integral i => Datum -> Maybe i datum_integral d = - case d of - Int32 x -> Just (fromIntegral x) - Int64 x -> Just (fromIntegral x) - _ -> Nothing + case d of + Int32 x -> Just (fromIntegral x) + Int64 x -> Just (fromIntegral x) + _ -> Nothing --- | 'Datum' as 'Floating' if Int32, Int64, Float, Double or TimeStamp. --- --- > let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5] --- > mapMaybe datum_floating d == replicate 5 (5::Double) +{- | 'Datum' as 'Floating' if Int32, Int64, Float, Double or TimeStamp. + +>>> let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5] +>>> mapMaybe datum_floating d == replicate 5 (5::Double) +True +-} 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 + 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 -- * Constructors --- | Type generalised 'Int32'. --- --- > int32 (1::Int32) == int32 (1::Integer) --- > d_int32 (int32 (maxBound::Int32)) == maxBound --- > int32 (((2::Int) ^ (64::Int))::Int) == Int32 0 +{- | Type generalised 'Int32'. + +>>> int32 (1::Int32) == int32 (1::Integer) +True + +>>> d_int32 (int32 (maxBound::Int32)) == maxBound +True + +>>> int32 (((2::Int) ^ (64::Int))::Int) == Int32 0 +True +-} int32 :: Integral n => n -> Datum int32 = Int32 . fromIntegral --- | Type generalised Int64. --- --- > int64 (1::Int32) == int64 (1::Integer) --- > d_int64 (int64 (maxBound::Int64)) == maxBound +{- | Type generalised Int64. + +>>> int64 (1::Int32) == int64 (1::Integer) +True + +>>> d_int64 (int64 (maxBound::Int64)) == maxBound +True +-} int64 :: Integral n => n -> Datum int64 = Int64 . fromIntegral --- | Type generalised Float. --- --- > float (1::Int) == float (1::Double) --- > floatRange (undefined::Float) == (-125,128) --- > isInfinite (d_float (float (encodeFloat 1 256 :: Double))) == True +{- | Type generalised Float. + +>>> float (1::Int) == float (1::Double) +True + +>>> floatRange (undefined::Float) +(-125,128) + +>>> isInfinite (d_float (float (encodeFloat 1 256 :: Double))) +True +-} float :: Real n => n -> Datum float = Float . realToFrac --- | Type generalised Double. --- --- > double (1::Int) == double (1::Double) --- > double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77 +{- | Type generalised Double. + +>>> double (1::Int) == double (1::Double) +True + +>>> double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77 +True +-} double :: Real n => n -> Datum double = Double . realToFrac --- | 'AsciiString' of pack. --- --- > string "string" == AsciiString (ByteString.Char8.pack "string") +{- | 'AsciiString' of pack. + +>>> string "string" == AsciiString (ByteString.Char8.pack "string") +True +-} string :: String -> Datum string = AsciiString . ascii --- | Four-tuple variant of 'Midi' '.' 'MidiData'. --- --- > midi (0,0,0,0) == Midi (MidiData 0 0 0 0) -midi :: (Word8,Word8,Word8,Word8) -> Datum -midi (p,q,r,s) = Midi (MidiData p q r s) +{- | Four-tuple variant of 'Midi' '.' 'MidiData'. +>>> midi (0,0,0,0) == Midi (MidiData 0 0 0 0) +True +-} +midi :: (Word8, Word8, Word8, Word8) -> Datum +midi (p, q, r, s) = Midi (MidiData p q r s) + -- | 'Blob' of 'blob_pack'. blob :: [Word8] -> Datum blob = Blob . blob_pack @@ -208,14 +245,16 @@ {- | Message argument types are given by a signature. -> signatureFor [Int32 1,Float 1,string "1"] == ",ifs" +>>> signatureFor [Int32 1,Float 1,string "1"] +",ifs" -} signatureFor :: [Datum] -> String signatureFor = (',' :) . map datum_tag {- | The descriptor is an Ascii encoded signature. -> descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs" +>>> descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs" +True -} descriptor :: [Datum] -> Ascii descriptor = ascii . signatureFor diff --git a/Sound/Osc/Fd.hs b/Sound/Osc/Fd.hs --- a/Sound/Osc/Fd.hs +++ b/Sound/Osc/Fd.hs @@ -3,5 +3,4 @@ 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 +import Sound.Osc.Transport.Fd.Socket as M diff --git a/Sound/Osc/Packet.hs b/Sound/Osc/Packet.hs --- a/Sound/Osc/Packet.hs +++ b/Sound/Osc/Packet.hs @@ -5,25 +5,27 @@ -- * Message --- | Osc address pattern. This is strictly an Ascii value, however it --- is very common to pattern match on addresses and matching on --- Data.ByteString.Char8 requires @OverloadedStrings@. +{- | Osc address pattern. This is strictly an Ascii value, however it + is very common to pattern match on addresses and matching on + Data.ByteString.Char8 requires @OverloadedStrings@. +-} type Address_Pattern = String -- | An Osc message, an 'Address_Pattern' and a sequence of 'Datum'. -data Message = - Message - {messageAddress :: !Address_Pattern - ,messageDatum :: ![Datum]} +data Message = Message + { messageAddress :: !Address_Pattern + , messageDatum :: ![Datum] + } deriving (Ord, Eq, Read, Show) --- | 'Message' constructor. It is an 'error' if the 'Address_Pattern' --- doesn't conform to the Osc specification. +{- | '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" + case a of + '/' : _ -> Message a xs + _ -> error "message: ill-formed address pattern" messageSignature :: Message -> String messageSignature = signatureFor . messageDatum @@ -34,81 +36,89 @@ -- * Bundle {- | An Osc bundle, a 'Time' and a sequence of 'Message's. -Do not allow recursion, all contents must be messages. +The type parameter specifies the element type. +Ordinarily this is Message, which does not allow recursion. -} -data Bundle = - Bundle - {bundleTime :: !Time - ,bundleMessages :: ![Message]} - deriving (Eq,Read,Show) +data BundleOf t = Bundle + { bundleTime :: !Time + , bundleMessages :: ![t] + } + deriving (Eq, Read, Show) +type Bundle = BundleOf Message + -- | Osc 'Bundle's can be ordered (time ascending). -instance Ord Bundle where - compare (Bundle a _) (Bundle b _) = compare a b +instance Eq t => Ord (BundleOf t) 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 :: Time -> [t] -> BundleOf t bundle t xs = - case xs of - [] -> error "bundle: empty?" - _ -> 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) +-- | An Osc 'Packet' is either a 'Message' or a 'Bundle t'. +data PacketOf t + = Packet_Message {packetMessage :: !Message} + | Packet_Bundle {packetBundle :: !(BundleOf t)} + deriving (Eq, Read, Show) +type Packet = PacketOf Message + -- | 'Packet_Bundle' of 'bundle'. -p_bundle :: Time -> [Message] -> Packet +p_bundle :: Time -> [t] -> PacketOf t p_bundle t = Packet_Bundle . bundle t -- | 'Packet_Message' of 'message'. -p_message :: Address_Pattern -> [Datum] -> Packet +p_message :: Address_Pattern -> [Datum] -> PacketOf t p_message a = Packet_Message . message a -{- | Constant indicating a bundle to be executed immediately. It has the Ntp64 representation of @1@. +{- | Constant indicating a bundle to be executed immediately. +It has the Ntp64 representation of @1@. -> ntpr_to_ntpi immediately == 1 +>>> immediately == (1 / (2 ^ 32)) +True -} immediately :: Time -immediately = 1 / 2^(32::Int) +immediately = 1 / 2 ^ (32 :: Int) -- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is 'immediately'. -packetTime :: Packet -> Time +packetTime :: PacketOf t -> Time packetTime = at_packet (const immediately) bundleTime -- | Retrieve the set of 'Message's from a 'Packet'. -packetMessages :: Packet -> [Message] +packetMessages :: PacketOf Message -> [Message] packetMessages = at_packet return bundleMessages -- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'. -packet_to_bundle :: Packet -> Bundle +packet_to_bundle :: PacketOf Message -> BundleOf Message 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 +{- | 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 :: PacketOf Message -> 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 + 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 :: PacketOf t -> Bool packet_is_immediate = (== immediately) . packetTime -- | Variant of 'either' for 'Packet'. -at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a +at_packet :: (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a at_packet f g p = - case p of - Packet_Message m -> f m - Packet_Bundle b -> g b + case p of + Packet_Message m -> f m + Packet_Bundle b -> g b -- * Address Query @@ -116,14 +126,17 @@ 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 +{- | Do any of the 'Message's at 'Bundle Message' have the specified +'Address_Pattern'. +-} +bundle_has_address :: Address_Pattern -> BundleOf Message -> 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 +{- | Does 'Packet' have the specified 'Address_Pattern', ie. +'message_has_address' or 'bundle_has_address'. +-} +packet_has_address :: Address_Pattern -> PacketOf Message -> Bool packet_has_address x = - at_packet (message_has_address x) - (bundle_has_address x) + at_packet + (message_has_address x) + (bundle_has_address x) diff --git a/Sound/Osc/Text.hs b/Sound/Osc/Text.hs --- a/Sound/Osc/Text.hs +++ b/Sound/Osc/Text.hs @@ -6,92 +6,103 @@ import Numeric {- base -} import Text.Printf {- base -} +import qualified Safe {- safe -} + import qualified Text.ParserCombinators.Parsec as P {- parsec -} import Sound.Osc.Datum {- hosc -} -import Sound.Osc.Packet {- hosc3 -} -import Sound.Osc.Time {- hosc3 -} +import Sound.Osc.Packet {- hosc3 -} +import qualified Sound.Osc.Time as Time {- hosc3 -} -- | Precision value for floating point numbers. type FpPrecision = Maybe Int {- | Variant of 'showFFloat' that deletes trailing zeros. -> map (showFloatWithPrecision (Just 4)) [1, 2.0, pi] == ["1.0", "2.0", "3.1416"] +>>> map (showFloatWithPrecision (Just 4)) [1, 2.0, pi] +["1.0","2.0","3.1416"] -} showFloatWithPrecision :: RealFloat n => FpPrecision -> n -> String showFloatWithPrecision p n = - let s = showFFloat p n "" - s' = dropWhile (== '0') (reverse s) - in case s' of - '.':_ -> reverse ('0' : s') - _ -> reverse s' + let s = showFFloat p n "" + s' = dropWhile (== '0') (reverse s) + in case s' of + '.' : _ -> reverse ('0' : s') + _ -> reverse s' {- | Hex encoded byte sequence. -> showBytes [0, 15, 16, 144, 255] == "000f1090ff" +>>> showBytes [0, 15, 16, 144, 255] +"000f1090ff" -} showBytes :: [Int] -> String showBytes = concatMap (printf "%02x") {- | Escape whites space (space, tab, newline) and the escape character (backslash). -> mapM_ (putStrLn . escapeString) ["str", "str ", "st r", "s\tr", "s\\tr", "\nstr"] +>>> map escapeString ["str", "str ", "st r", "s\tr", "s\\tr", "\nstr"] +["str","str\\ ","st\\ r","s\\\tr","s\\\\tr","\\\nstr"] -} escapeString :: String -> String escapeString txt = case txt of [] -> [] - c:txt' -> if c `elem` "\\\t\n " then '\\' : c : escapeString txt' else c : escapeString txt' + c : txt' -> if c `elem` "\\\t\n " then '\\' : c : escapeString txt' else c : escapeString txt' {- | Printer for Datum. -> aDatumSeq = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60),blob [12,16], TimeStamp 100.0] -> map (showDatum (Just 5)) aDatumSeq == ["1","1.2","str","00904060","0c10","429496729600"] +>>> let aDatumSeq = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60),blob [12,16], TimeStamp 100.0] +>>> map (showDatum (Just 5)) aDatumSeq +["1","1.2","str","00904060","0c10","429496729600"] -} showDatum :: FpPrecision -> Datum -> String showDatum p d = - case d of - Int32 n -> show n - Int64 n -> show n - Float n -> showFloatWithPrecision p n - Double n -> showFloatWithPrecision p n - AsciiString s -> escapeString (ascii_to_string s) - Blob s -> showBytes (blob_unpack_int s) - TimeStamp t -> show (ntpr_to_ntpi t) - Midi m -> showBytes (midi_unpack_int m) + case d of + Int32 n -> show n + Int64 n -> show n + Float n -> showFloatWithPrecision p n + Double n -> showFloatWithPrecision p n + AsciiString s -> escapeString (ascii_to_string s) + Blob s -> showBytes (blob_unpack_int s) + TimeStamp t -> show (Time.ntpr_to_ntpi t) + Midi m -> showBytes (midi_unpack_int m) {- | Printer for Message. -> aMessage = Message "/addr" [Int32 1, Int64 2, Float 3, Double 4, string "five", blob [6, 7], midi (8, 9, 10, 11)] -> showMessage (Just 4) aMessage +>>> let aMessage = Message "/addr" [Int32 1, Int64 2, Float 3, Double 4, string "five", blob [6, 7], midi (8, 9, 10, 11)] +>>> showMessage (Just 4) aMessage +"/addr ,ihfdsbm 1 2 3.0 4.0 five 0607 08090a0b" -> aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3], Message "/s_new" [string "sine", Int32 (-1), Int32 1, Int32 1]] -> map (showMessage (Just 4)) aMessageSeq +>>> let aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3], Message "/s_new" [string "sine", Int32 (-1), Int32 1, Int32 1]] +>>> map (showMessage (Just 4)) aMessageSeq +["/c_set ,if 1 2.3","/s_new ,siii sine -1 1 1"] -} showMessage :: FpPrecision -> Message -> String showMessage precision aMessage = unwords - [messageAddress aMessage - ,messageSignature aMessage - ,unwords (map (showDatum precision) (messageDatum aMessage))] + [ messageAddress aMessage + , messageSignature aMessage + , unwords (map (showDatum precision) (messageDatum aMessage)) + ] {- | Printer for Bundle -> aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]] -> showBundle (Just 4) aBundle +>>> let aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]] +>>> showBundle (Just 4) aBundle +"#bundle 4294967296 2 /c_set ,ifhd 1 2.3 4 5.6 /memset ,sb addr 0708" -} -showBundle :: FpPrecision -> Bundle -> String +showBundle :: FpPrecision -> BundleOf Message -> String showBundle precision aBundle = let messages = bundleMessages aBundle in unwords - ["#bundle" - ,show (ntpr_to_ntpi (bundleTime aBundle)) - ,show (length messages) - ,unwords (map (showMessage precision) messages)] + [ "#bundle" + , show (Time.ntpr_to_ntpi (bundleTime aBundle)) + , show (length messages) + , unwords (map (showMessage precision) messages) + ] -- | Printer for Packet. -showPacket :: FpPrecision -> Packet -> String +showPacket :: FpPrecision -> PacketOf Message -> String showPacket precision = at_packet (showMessage precision) (showBundle precision) -- * Parser @@ -124,10 +135,13 @@ -- | Parser for Osc signature. oscSignatureP :: P String -oscSignatureP = lexemeP (do - comma <- P.char ',' - types <- P.many1 (P.oneOf "ifsbhtdm") -- 1.0 = ifsb 2.0 = htdm - return (comma : types)) +oscSignatureP = + lexemeP + ( do + comma <- P.char ',' + types <- P.many1 (P.oneOf "ifsbhtdm") -- 1.0 = ifsb 2.0 = htdm + return (comma : types) + ) -- | Parser for decimal digit. digitP :: P Char @@ -150,11 +164,14 @@ -- | Parser for non-negative float. nonNegativeFloatP :: (Fractional n, Read n) => P n -nonNegativeFloatP = lexemeP (do - integerPart <- P.many1 digitP - _ <- P.char '.' - fractionalPart <- P.many1 digitP - return (read (concat [integerPart, ".", fractionalPart]))) +nonNegativeFloatP = + lexemeP + ( do + integerPart <- P.many1 digitP + _ <- P.char '.' + fractionalPart <- P.many1 digitP + return (read (concat [integerPart, ".", fractionalPart])) + ) -- | Parser for non-negative float. floatP :: (Fractional n, Read n) => P n @@ -170,7 +187,7 @@ c1 <- hexdigitP c2 <- hexdigitP case readHex [c1, c2] of - [(r,"")] -> return r + [(r, "")] -> return r _ -> error "byteP?" -- | Byte sequence parser. @@ -188,7 +205,7 @@ 'h' -> fmap Int64 integerP 'd' -> fmap Double floatP 'm' -> fmap (Midi . midi_pack) (replicateM 4 byteP) - 't' -> fmap (TimeStamp . ntpi_to_ntpr) integerP + 't' -> fmap (TimeStamp . Time.ntpi_to_ntpr) integerP _ -> error "datumP: type?" -- | Message parser. @@ -196,7 +213,7 @@ messageP = do address <- oscAddressP typeSignature <- oscSignatureP - datum <- mapM datumP (tail typeSignature) + datum <- mapM datumP (Safe.tailNote "messageP" typeSignature) return (Message address datum) -- | Bundle tag parser. @@ -204,16 +221,16 @@ bundleTagP = lexemeP (P.string "#bundle") -- | Bundle parser. -bundleP :: P Bundle +bundleP :: P (BundleOf Message) bundleP = do _ <- bundleTagP - timestamp <- fmap ntpi_to_ntpr integerP + timestamp <- fmap Time.ntpi_to_ntpr integerP messageCount <- integerP messages <- replicateM messageCount messageP return (Bundle timestamp messages) -- | Packet parser. -packetP :: P Packet +packetP :: P (PacketOf Message) packetP = (fmap Packet_Bundle bundleP) P.<|> (fmap Packet_Message messageP) -- | Run parser. @@ -225,32 +242,38 @@ {- | Run datum parser. -> parseDatum 'i' "-1" == Int32 (-1) -> parseDatum 'f' "-2.3" == Float (-2.3) +>>> parseDatum 'i' "-1" == Int32 (-1) +True + +>>> parseDatum 'f' "-2.3" == Float (-2.3) +True -} parseDatum :: Char -> String -> Datum parseDatum typ = runP (datumP typ) {- | Run message parser. -> aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]] -> map (parseMessage . showMessage (Just 4)) aMessageSeq == aMessageSeq +>>> let aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]] +>>> map (parseMessage . showMessage (Just 4)) aMessageSeq == aMessageSeq +True -} parseMessage :: String -> Message parseMessage = runP messageP {- | Run bundle parser. -> aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]] -> parseBundle (showBundle (Just 4) aBundle) == aBundle +>>> let aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]] +>>> parseBundle (showBundle (Just 4) aBundle) == aBundle +True -} -parseBundle :: String -> Bundle +parseBundle :: String -> BundleOf Message parseBundle = runP bundleP {- | Run packet parser. -> aPacket = Packet_Bundle (Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]) -> parsePacket (showPacket (Just 4) aPacket) == aPacket +>>> let aPacket = Packet_Bundle (Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]) +>>> parsePacket (showPacket (Just 4) aPacket) == aPacket +True -} -parsePacket :: String -> Packet +parsePacket :: String -> PacketOf Message parsePacket = runP packetP diff --git a/Sound/Osc/Time.hs b/Sound/Osc/Time.hs --- a/Sound/Osc/Time.hs +++ b/Sound/Osc/Time.hs @@ -1,5 +1,6 @@ --- | Osc related timing functions. --- Osc timestamps are 64-bit @Ntp@ values, . +{- | Osc related timing functions. + Osc timestamps are 64-bit @Ntp@ values, . +-} module Sound.Osc.Time where import Data.Word {- base -} @@ -12,39 +13,47 @@ -- * Temporal types --- | Type for binary (integeral) representation of a 64-bit Ntp timestamp (ie. ntpi). --- The Ntp epoch is January 1, 1900. --- Ntp v4 also includes a 128-bit format, which is not used by Osc. +{- | Type for binary (integeral) representation of a 64-bit Ntp timestamp (ie. ntpi). + The Ntp epoch is January 1, 1900. + Ntp v4 also includes a 128-bit format, which is not used by Osc. +-} type Ntp64 = Word64 -- | @Ntp@ time in real-valued (fractional) form. type NtpReal = Double --- | @Unix/Posix@ time in real-valued (fractional) form. --- The Unix/Posix epoch is January 1, 1970. +{- | @Unix/Posix@ time in real-valued (fractional) form. + The Unix/Posix epoch is January 1, 1970. +-} type PosixReal = Double -- * Time conversion {- | Convert an NtpReal timestamp to an Ntp64 timestamp. -> ntpr_to_ntpi 0 == 0 +>>> ntpr_to_ntpi 0 +0 + > fmap ntpr_to_ntpi time -} ntpr_to_ntpi :: NtpReal -> Ntp64 -ntpr_to_ntpi t = round (t * (2 ^ (32::Int))) +ntpr_to_ntpi t = round (t * (2 ^ (32 :: Int))) {- | Convert an 'Ntp64' timestamp to a real-valued Ntp timestamp. -> ntpi_to_ntpr 0 == 0.0 +>>> ntpi_to_ntpr 0 +0.0 -} ntpi_to_ntpr :: Ntp64 -> NtpReal -ntpi_to_ntpr t = word64_to_double t / 2^(32::Int) +ntpi_to_ntpr t = word64_to_double t / 2 ^ (32 :: Int) {- | Difference (in seconds) between /Ntp/ and /Posix/ epochs. -> ntp_posix_epoch_diff / (24 * 60 * 60) == 25567 -> 25567 `div` 365 == 70 +>>> ntp_posix_epoch_diff / (24 * 60 * 60) +25567.0 + +>>> 25567 `div` 365 +70 -} ntp_posix_epoch_diff :: Num n => n ntp_posix_epoch_diff = (70 * 365 + 17) * 24 * 60 * 60 @@ -78,9 +87,9 @@ -- | The time at 1970-01-01:00:00:00 which is the Unix/Posix epoch. posix_epoch :: Time.UTCTime posix_epoch = - let d = Time.fromGregorian 1970 1 1 - s = fromInteger 0 -- Time.secondsToDiffTime - in Time.UTCTime d s + let d = Time.fromGregorian 1970 1 1 + s = fromInteger 0 -- Time.secondsToDiffTime + in Time.UTCTime d s -- | Convert 'Time.UTCTime' to @Unix/Posix@. utc_to_posix :: Fractional n => Time.UTCTime -> n diff --git a/Sound/Osc/Time/System.hs b/Sound/Osc/Time/System.hs --- a/Sound/Osc/Time/System.hs +++ b/Sound/Osc/Time/System.hs @@ -6,11 +6,12 @@ import qualified Data.Time.Clock.System as Clock.System {- time >= 1.8 -} -import Sound.Osc.Time {- hosc -} +import qualified Sound.Osc.Time as Time {- hosc -} --- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored. --- getSystemTime is typically much faster than getCurrentTime, however it is not available in Hugs. -getSystemTimeAsNtpReal :: IO NtpReal +{- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored. + getSystemTime is typically much faster than getCurrentTime, however it is not available in Hugs. +-} +getSystemTimeAsNtpReal :: IO Time.NtpReal getSystemTimeAsNtpReal = do tm <- Clock.System.getSystemTime return (fromIntegral (Clock.System.systemSeconds tm) + (fromIntegral (Clock.System.systemNanoseconds tm) * 1.0e-9)) diff --git a/Sound/Osc/Time/Thread.hs b/Sound/Osc/Time/Thread.hs --- a/Sound/Osc/Time/Thread.hs +++ b/Sound/Osc/Time/Thread.hs @@ -4,13 +4,14 @@ import Control.Concurrent {- base -} import Control.Monad {- base -} -import Sound.Osc.Time {- hosc -} +import qualified Sound.Osc.Time as Time {- hosc -} --- | 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@. +{- | 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 +pauseThreadLimit = fromIntegral (maxBound :: Int) / 1e6 -- | Pause current thread for the indicated duration (in seconds), see 'pauseThreadLimit'. pauseThreadFor :: RealFrac n => n -> IO () @@ -18,18 +19,21 @@ -- | Pause current thread until the given time, see 'pauseThreadLimit'. pauseThreadUntilTime :: RealFrac n => n -> IO () -pauseThreadUntilTime t = pauseThreadFor . (t -) . realToFrac =<< currentTime +pauseThreadUntilTime t = pauseThreadFor . (t -) . realToFrac =<< Time.currentTime --- | Sleep current thread for the indicated duration (in seconds). --- Divides long sleeps into parts smaller than 'pauseThreadLimit'. +{- | Sleep current thread for the indicated duration (in seconds). + Divides long sleeps into parts smaller than 'pauseThreadLimit'. +-} sleepThreadFor :: RealFrac n => n -> IO () sleepThreadFor n = - if n >= pauseThreadLimit - then let n' = pauseThreadLimit - 1 - in pauseThreadFor n' >> sleepThreadFor (n - n') + if n >= pauseThreadLimit + then + let n' = pauseThreadLimit - 1 + in pauseThreadFor n' >> sleepThreadFor (n - n') else pauseThreadFor n --- | Sleep current thread until the given time. --- Divides long sleeps into parts smaller than 'pauseThreadLimit'. +{- | Sleep current thread until the given time. + Divides long sleeps into parts smaller than 'pauseThreadLimit'. +-} sleepThreadUntilTime :: RealFrac n => n -> IO () -sleepThreadUntilTime t = sleepThreadFor . (t -) . realToFrac =<< currentTime +sleepThreadUntilTime t = sleepThreadFor . (t -) . realToFrac =<< Time.currentTime diff --git a/Sound/Osc/Time/Thread/MonadIO.hs b/Sound/Osc/Time/Thread/MonadIO.hs --- a/Sound/Osc/Time/Thread/MonadIO.hs +++ b/Sound/Osc/Time/Thread/MonadIO.hs @@ -3,23 +3,23 @@ import Control.Monad.IO.Class {- base >= 4.9 -} -import Sound.Osc.Time {- hosc -} -import Sound.Osc.Time.Thread {- hosc -} +import qualified Sound.Osc.Time as Time {- hosc -} +import qualified Sound.Osc.Time.Thread as Time.Thread {- hosc -} -time :: MonadIO m => m NtpReal -time = liftIO currentTime +time :: MonadIO m => m Time.NtpReal +time = liftIO Time.currentTime -pauseThread :: (MonadIO m,RealFrac n) => n -> m () -pauseThread = liftIO . pauseThreadFor +pauseThread :: (MonadIO m, RealFrac n) => n -> m () +pauseThread = liftIO . Time.Thread.pauseThreadFor wait :: MonadIO m => Double -> m () wait = pauseThread -pauseThreadUntil :: (MonadIO m,RealFrac n) => n -> m () -pauseThreadUntil = liftIO . pauseThreadUntilTime +pauseThreadUntil :: (MonadIO m, RealFrac n) => n -> m () +pauseThreadUntil = liftIO . Time.Thread.pauseThreadUntilTime sleepThread :: (RealFrac n, MonadIO m) => n -> m () -sleepThread = liftIO . sleepThreadFor +sleepThread = liftIO . Time.Thread.sleepThreadFor sleepThreadUntil :: (RealFrac n, MonadIO m) => n -> m () -sleepThreadUntil = liftIO . sleepThreadUntilTime +sleepThreadUntil = liftIO . Time.Thread.sleepThreadUntilTime diff --git a/Sound/Osc/Time/Timeout.hs b/Sound/Osc/Time/Timeout.hs --- a/Sound/Osc/Time/Timeout.hs +++ b/Sound/Osc/Time/Timeout.hs @@ -11,5 +11,5 @@ timeout_r = timeout . floor . (* 1000000) -- | Variant of 'recvPacket' that implements an /n/ second 'timeout'. -recvPacketTimeout :: Transport t => Double -> t -> IO (Maybe Packet) +recvPacketTimeout :: Transport t => Double -> t -> IO (Maybe (PacketOf Message)) recvPacketTimeout n fd = timeout_r n (recvPacket fd) diff --git a/Sound/Osc/Transport/Fd.hs b/Sound/Osc/Transport/Fd.hs --- a/Sound/Osc/Transport/Fd.hs +++ b/Sound/Osc/Transport/Fd.hs @@ -11,13 +11,18 @@ -- | Abstract over the underlying transport protocol. class Transport t where - -- | Encode and send an Osc packet. - sendPacket :: t -> Packet -> IO () - -- | Receive and decode an Osc packet. - recvPacket :: t -> IO Packet - -- | Close an existing connection. - close :: t -> IO () + -- | Encode and send an Osc packet. + sendPacket :: t -> PacketOf Message -> IO () + -- | Receive and decode an Osc packet. + recvPacket :: t -> IO (PacketOf Message) + + -- | Receive and either decode an Osc packet. + recvPacketOr :: t -> IO (Either String Packet) + + -- | Close an existing connection. + close :: t -> IO () + -- | Bracket Osc communication. withTransport :: Transport t => IO t -> (t -> IO a) -> IO a withTransport u = bracket u close @@ -29,58 +34,67 @@ sendMessage t = sendPacket t . Packet_Message -- | 'sendPacket' of 'Packet_Bundle'. -sendBundle :: Transport t => t -> Bundle -> IO () +sendBundle :: Transport t => t -> BundleOf Message -> IO () sendBundle t = sendPacket t . Packet_Bundle -- * Receive -- | Variant of 'recvPacket' that runs 'packet_to_bundle'. -recvBundle :: (Transport t) => t -> IO Bundle +recvBundle :: (Transport t) => t -> IO (BundleOf Message) recvBundle = fmap packet_to_bundle . recvPacket -- | Variant of 'recvPacket' that runs 'packet_to_message'. recvMessage :: (Transport t) => t -> IO (Maybe Message) recvMessage = fmap packet_to_message . recvPacket +-- | Erroring variant. +recvMessage_err :: (Transport t) => t -> IO Message +recvMessage_err = fmap (fromMaybe (error "recvMessage")) . recvMessage + -- | Variant of 'recvPacket' that runs 'packetMessages'. recvMessages :: (Transport t) => t -> IO [Message] recvMessages = fmap packetMessages . recvPacket -- * Wait --- | Wait for a 'Packet' where the supplied predicate is 'True', --- discarding intervening packets. -waitUntil :: (Transport t) => t -> (Packet -> Bool) -> IO Packet +{- | Wait for a 'Packet' where the supplied predicate is 'True', +discarding intervening packets. +-} +waitUntil :: (Transport t) => t -> (PacketOf Message -> Bool) -> IO (PacketOf Message) waitUntil t f = Wait.untilPredicate f (recvPacket t) --- | Wait for a 'Packet' where the supplied function does not give --- 'Nothing', discarding intervening packets. -waitFor :: (Transport t) => t -> (Packet -> Maybe a) -> IO a +{- | Wait for a 'Packet' where the supplied function does not give +'Nothing', discarding intervening packets. +-} +waitFor :: (Transport t) => t -> (PacketOf Message -> Maybe a) -> IO a waitFor t f = Wait.untilMaybe f (recvPacket t) -- | 'waitUntil' 'packet_is_immediate'. -waitImmediate :: Transport t => t -> IO Packet +waitImmediate :: Transport t => t -> IO (PacketOf Message) waitImmediate t = waitUntil t packet_is_immediate --- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or --- immediate mode 'Bundle' with one element. +{- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or +immediate mode 'Bundle' with one element. +-} waitMessage :: Transport t => t -> IO Message waitMessage t = waitFor t packet_to_message --- | A 'waitFor' for variant using 'packet_has_address' to match on --- the 'Address_Pattern' of incoming 'Packets'. -waitAddress :: Transport t => t -> Address_Pattern -> IO Packet +{- | A 'waitFor' for variant using 'packet_has_address' to match on +the 'Address_Pattern' of incoming 'Packets'. +-} +waitAddress :: Transport t => t -> Address_Pattern -> IO (PacketOf Message) waitAddress t s = - let f o = if packet_has_address s o then Just o else Nothing - in waitFor t f + let f o = if packet_has_address s o then Just o else Nothing + in waitFor t f -- | Variant on 'waitAddress' that returns matching 'Message'. waitReply :: Transport t => t -> Address_Pattern -> IO Message waitReply t s = - let f = fromMaybe (error "waitReply: message not located?") . - find (message_has_address s) . - packetMessages - in fmap f (waitAddress t s) + let f = + fromMaybe (error "waitReply: message not located?") + . find (message_has_address s) + . packetMessages + in fmap f (waitAddress t s) -- | Variant of 'waitReply' that runs 'messageDatum'. waitDatum :: Transport t => t -> Address_Pattern -> IO [Datum] diff --git a/Sound/Osc/Transport/Fd/Socket.hs b/Sound/Osc/Transport/Fd/Socket.hs new file mode 100644 --- /dev/null +++ b/Sound/Osc/Transport/Fd/Socket.hs @@ -0,0 +1,40 @@ +-- | Osc over Udp/Tcp implementation. +module Sound.Osc.Transport.Fd.Socket where + +import qualified Sound.Osc.Transport.Fd as Fd {- hosc -} +import qualified Sound.Osc.Transport.Fd.Tcp as Fd.Tcp {- hosc -} +import qualified Sound.Osc.Transport.Fd.Udp as Fd.Udp {- hosc -} + +-- | Protocol, either Udp or Tcp +data OscProtocol = Udp | Tcp + deriving (Eq, Read, Show) + +-- | Hostname +type OscHostname = String + +-- | Port number +type OscPort = Int + +-- | Socket address +type OscSocketAddress = (OscProtocol, OscHostname, OscPort) + +-- | Socket +data OscSocket = OscUdpSocket Fd.Udp.Udp | OscTcpSocket Fd.Tcp.Tcp + +-- | Open socket at address +openOscSocket :: OscSocketAddress -> IO OscSocket +openOscSocket address = + case address of + (Tcp, hostname, port) -> fmap OscTcpSocket (Fd.Tcp.openTcp hostname port) + (Udp, hostname, port) -> fmap OscUdpSocket (Fd.Udp.openUdp hostname port) + +-- | 'OscSocket' is an instance of 'Fd.Transport'. +instance Fd.Transport OscSocket where + sendPacket (OscTcpSocket fd) = Fd.Tcp.tcp_send_packet fd + sendPacket (OscUdpSocket fd) = Fd.Udp.udp_send_packet fd + recvPacket (OscTcpSocket fd) = Fd.Tcp.tcp_recv_packet fd + recvPacket (OscUdpSocket fd) = Fd.Udp.udp_recv_packet fd + recvPacketOr (OscTcpSocket fd) = Fd.Tcp.tcp_recv_packet_or fd + recvPacketOr (OscUdpSocket fd) = Fd.Udp.udp_recv_packet_or fd + close (OscTcpSocket fd) = Fd.Tcp.tcp_close fd + close (OscUdpSocket fd) = Fd.Udp.udp_close fd diff --git a/Sound/Osc/Transport/Fd/Tcp.hs b/Sound/Osc/Transport/Fd/Tcp.hs --- a/Sound/Osc/Transport/Fd/Tcp.hs +++ b/Sound/Osc/Transport/Fd/Tcp.hs @@ -2,94 +2,100 @@ module Sound.Osc.Transport.Fd.Tcp where import qualified Control.Exception as Exception {- base -} -import qualified Data.ByteString.Lazy as B {- bytestring -} -import qualified Network.Socket as N {- network -} -import qualified System.IO as IO {- base -} +import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -} +import qualified Network.Socket as Socket {- network -} +import qualified System.IO as Io {- base -} -import qualified Sound.Osc.Coding.Decode.Binary as Binary {- hosc -} -import qualified Sound.Osc.Coding.Encode.Builder as Builder {- hosc -} import qualified Sound.Osc.Coding.Byte as Byte {- hosc -} import qualified Sound.Osc.Coding.Convert as Convert {- hosc -} +import qualified Sound.Osc.Coding.Decode.Binary as Decode.Binary {- hosc -} +import qualified Sound.Osc.Coding.Encode.Builder as Encode.Builder {- hosc -} import qualified Sound.Osc.Packet as Packet {- hosc -} import qualified Sound.Osc.Transport.Fd as Fd {- hosc -} -- | The Tcp transport handle data type. -newtype Tcp = Tcp {tcpHandle :: IO.Handle} +newtype Tcp = Tcp {tcpHandle :: Io.Handle} -- | Send data over Tcp. -tcp_send_data :: Tcp -> B.ByteString -> IO () +tcp_send_data :: Tcp -> ByteString.Lazy.ByteString -> IO () tcp_send_data (Tcp fd) d = do - let n = Convert.int64_to_word32 (B.length d) - B.hPut fd (B.append (Byte.encode_word32 n) d) - IO.hFlush fd + let n = Convert.int64_to_word32 (ByteString.Lazy.length d) + ByteString.Lazy.hPut fd (ByteString.Lazy.append (Byte.encode_word32 n) d) + Io.hFlush fd -- | Send packet over Tcp. -tcp_send_packet :: Tcp -> Packet.Packet -> IO () -tcp_send_packet tcp p = tcp_send_data tcp (Builder.encodePacket p) +tcp_send_packet :: Tcp -> Packet.PacketOf Packet.Message -> IO () +tcp_send_packet tcp p = tcp_send_data tcp (Encode.Builder.encodePacket p) -- | Receive packet over Tcp. -tcp_recv_packet :: Tcp -> IO Packet.Packet +tcp_recv_packet :: Tcp -> IO (Packet.PacketOf Packet.Message) tcp_recv_packet (Tcp fd) = do - b0 <- B.hGet fd 4 - b1 <- B.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0)) - return (Binary.decodePacket b1) + b0 <- ByteString.Lazy.hGet fd 4 + b1 <- ByteString.Lazy.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0)) + return (Decode.Binary.decodePacket b1) +tcp_recv_packet_or :: Tcp -> IO (Either String Packet.Packet) +tcp_recv_packet_or (Tcp fd) = do + b0 <- ByteString.Lazy.hGet fd 4 + b1 <- ByteString.Lazy.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0)) + return (Decode.Binary.decodePacketOr b1) + -- | Close Tcp. tcp_close :: Tcp -> IO () -tcp_close = IO.hClose . tcpHandle +tcp_close = Io.hClose . tcpHandle -- | 'Tcp' is an instance of 'Transport'. instance Fd.Transport Tcp where - sendPacket = tcp_send_packet - recvPacket = tcp_recv_packet - close = tcp_close + sendPacket = tcp_send_packet + recvPacket = tcp_recv_packet + recvPacketOr = tcp_recv_packet_or + close = tcp_close --- | Bracket UDP communication. +-- | Bracket Tcp communication. with_tcp :: IO Tcp -> (Tcp -> IO t) -> IO t with_tcp u = Exception.bracket u tcp_close -- | Create and initialise Tcp socket. -tcp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> Maybe String -> Int -> IO N.Socket +tcp_socket :: (Socket.Socket -> Socket.SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket.Socket tcp_socket f host port = do - fd <- N.socket N.AF_INET N.Stream 0 - let hints = N.defaultHints {N.addrFamily = N.AF_INET} -- localhost=ipv4 - i:_ <- N.getAddrInfo (Just hints) host (Just (show port)) - let sa = N.addrAddress i + fd <- Socket.socket Socket.AF_INET Socket.Stream 0 + let hints = Socket.defaultHints {Socket.addrFamily = Socket.AF_INET} -- localhost=ipv4 + i : _ <- Socket.getAddrInfo (Just hints) host (Just (show port)) + let sa = Socket.addrAddress i _ <- f fd sa return fd --- | Convert 'N.Socket' to 'Tcp'. -socket_to_tcp :: N.Socket -> IO Tcp -socket_to_tcp fd = fmap Tcp (N.socketToHandle fd IO.ReadWriteMode) +-- | Convert 'Socket.Socket' to 'Tcp'. +socket_to_tcp :: Socket.Socket -> IO Tcp +socket_to_tcp fd = fmap Tcp (Socket.socketToHandle fd Io.ReadWriteMode) -- | Create and initialise Tcp. -tcp_handle :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO Tcp +tcp_handle :: (Socket.Socket -> Socket.SockAddr -> IO ()) -> String -> Int -> IO Tcp tcp_handle f host port = tcp_socket f (Just host) port >>= socket_to_tcp {- | Make a 'Tcp' connection. -> import Sound.Osc.Datum {- hosc -} -> import Sound.Osc.Time {- hosc -} +> import Sound.Osc.Datum +> import Sound.Osc.Time > let t = openTcp "127.0.0.1" 57110 > let m1 = Packet.message "/dumpOsc" [Int32 1] > let m2 = Packet.message "/g_new" [Int32 1] > Fd.withTransport t (\fd -> let f = Fd.sendMessage fd in f m1 >> pauseThread 0.25 >> f m2) - -} openTcp :: String -> Int -> IO Tcp -openTcp = tcp_handle N.connect +openTcp = tcp_handle Socket.connect --- | 'N.accept' connection at /s/ and run /f/. -tcp_server_f :: N.Socket -> (Tcp -> IO ()) -> IO () +-- | 'Socket.accept' connection at /s/ and run /f/. +tcp_server_f :: Socket.Socket -> (Tcp -> IO ()) -> IO () tcp_server_f s f = do - (fd, _) <- N.accept s + (fd, _) <- Socket.accept s h <- socket_to_tcp fd f h -- | A trivial 'Tcp' /Osc/ server. tcp_server :: Int -> (Tcp -> IO ()) -> IO () tcp_server port f = do - s <- tcp_socket N.bind Nothing port - N.listen s 1 + s <- tcp_socket Socket.bind Nothing port + Socket.listen s 1 let repeatM_ = sequence_ . repeat repeatM_ (tcp_server_f s f) diff --git a/Sound/Osc/Transport/Fd/Udp.hs b/Sound/Osc/Transport/Fd/Udp.hs --- a/Sound/Osc/Transport/Fd/Udp.hs +++ b/Sound/Osc/Transport/Fd/Udp.hs @@ -5,7 +5,7 @@ import Control.Monad {- base -} import Data.Bifunctor {- base -} -import qualified Data.ByteString as B {- bytestring -} +import qualified Data.ByteString as B {- bytestring -} import qualified Network.Socket as N {- network -} import qualified Network.Socket.ByteString as C {- network -} @@ -33,22 +33,26 @@ udp_sendAll_data (Udp fd) = C.sendAll fd -- | Send packet over Udp. -udp_send_packet :: Udp -> Packet.Packet -> IO () +udp_send_packet :: Udp -> Packet.PacketOf Packet.Message -> IO () udp_send_packet udp = udp_sendAll_data udp . Builder.encodePacket_strict -- | Receive packet over Udp. -udp_recv_packet :: Udp -> IO Packet.Packet +udp_recv_packet :: Udp -> IO (Packet.PacketOf Packet.Message) udp_recv_packet (Udp fd) = fmap Binary.decodePacket_strict (C.recv fd 8192) +udp_recv_packet_or :: Udp -> IO (Either String Packet.Packet) +udp_recv_packet_or (Udp fd) = Binary.decodePacketOr . B.fromStrict <$> C.recv fd 8192 + -- | Close Udp. udp_close :: Udp -> IO () udp_close (Udp fd) = N.close fd -- | 'Udp' is an instance of 'Fd.Transport'. instance Fd.Transport Udp where - sendPacket = udp_send_packet - recvPacket = udp_recv_packet - close = udp_close + sendPacket = udp_send_packet + recvPacket = udp_recv_packet + recvPacketOr = udp_recv_packet_or + close = udp_close -- | Bracket Udp communication. with_udp :: IO Udp -> (Udp -> IO t) -> IO t @@ -59,7 +63,7 @@ udp_socket f host port = do fd <- N.socket N.AF_INET N.Datagram 0 let hints = N.defaultHints {N.addrFamily = N.AF_INET} -- localhost=ipv4 - i:_ <- N.getAddrInfo (Just hints) (Just host) (Just (show port)) + i : _ <- N.getAddrInfo (Just hints) (Just host) (Just (show port)) let sa = N.addrAddress i f fd sa return (Udp fd) @@ -78,7 +82,7 @@ {- | Trivial 'Udp' server socket. -> import Control.Concurrent {- base -} +> import Control.Concurrent > let u0 = udpServer "127.0.0.1" 57300 > t0 <- forkIO (Fd.withTransport u0 (\fd -> forever (Fd.recvMessage fd >>= print >> print "Received message, continuing"))) @@ -95,19 +99,20 @@ udp_server p = do let hints = N.defaultHints - {N.addrFamily = N.AF_INET -- localhost=ipv4 - ,N.addrFlags = [N.AI_PASSIVE,N.AI_NUMERICSERV] - ,N.addrSocketType = N.Datagram} - a:_ <- N.getAddrInfo (Just hints) Nothing (Just (show p)) + { N.addrFamily = N.AF_INET -- localhost=ipv4 + , N.addrFlags = [N.AI_PASSIVE, N.AI_NUMERICSERV] + , N.addrSocketType = N.Datagram + } + a : _ <- N.getAddrInfo (Just hints) Nothing (Just (show p)) s <- N.socket (N.addrFamily a) (N.addrSocketType a) (N.addrProtocol a) N.setSocketOption s N.ReuseAddr 1 N.bind s (N.addrAddress a) return (Udp s) -- | Send to specified address using 'C.sendAllTo. -sendTo :: Udp -> Packet.Packet -> N.SockAddr -> IO () +sendTo :: Udp -> Packet.PacketOf Packet.Message -> N.SockAddr -> IO () sendTo (Udp fd) p = C.sendAllTo fd (Builder.encodePacket_strict p) -- | Recv variant to collect message source address. -recvFrom :: Udp -> IO (Packet.Packet, N.SockAddr) +recvFrom :: Udp -> IO (Packet.PacketOf Packet.Message, N.SockAddr) recvFrom (Udp fd) = fmap (first Binary.decodePacket_strict) (C.recvFrom fd 8192) diff --git a/Sound/Osc/Transport/Monad.hs b/Sound/Osc/Transport/Monad.hs --- a/Sound/Osc/Transport/Monad.hs +++ b/Sound/Osc/Transport/Monad.hs @@ -9,39 +9,39 @@ import qualified Control.Monad.Trans.Reader as R {- transformers -} import qualified Sound.Osc.Datum as Datum {- hosc -} -import qualified Sound.Osc.Transport.Fd as Fd {- hosc -} import qualified Sound.Osc.Packet as Packet {- hosc -} +import qualified Sound.Osc.Transport.Fd as Fd {- hosc -} import qualified Sound.Osc.Wait as Wait {- hosc -} -- | Sender monad. class Monad m => SendOsc m where - -- | Encode and send an Osc packet. - sendPacket :: Packet.Packet -> m () + -- | Encode and send an Osc packet. + sendPacket :: Packet.PacketOf Packet.Message -> m () -- | Receiver monad. class Monad m => RecvOsc m where - -- | Receive and decode an Osc packet. - recvPacket :: m Packet.Packet + -- | Receive and decode an Osc packet. + recvPacket :: m (Packet.PacketOf Packet.Message) -- | 'DuplexOsc' is the union of 'SendOsc' and 'RecvOsc'. -class (SendOsc m,RecvOsc m) => DuplexOsc m where +class (SendOsc m, RecvOsc m) => DuplexOsc m -- | 'Transport' is 'DuplexOsc' with a 'MonadIO' constraint. -class (DuplexOsc m,MonadIO m) => Transport m where +class (DuplexOsc m, MonadIO m) => Transport m -- | 'SendOsc' over 'ReaderT'. -instance (Fd.Transport t,MonadIO io) => SendOsc (R.ReaderT t io) where - sendPacket p = R.ReaderT (liftIO . flip Fd.sendPacket p) +instance (Fd.Transport t, MonadIO io) => SendOsc (R.ReaderT t io) where + sendPacket p = R.ReaderT (liftIO . flip Fd.sendPacket p) -- | 'RecvOsc' over 'ReaderT'. -instance (Fd.Transport t,MonadIO io) => RecvOsc (R.ReaderT t io) where - recvPacket = R.ReaderT (liftIO . Fd.recvPacket) +instance (Fd.Transport t, MonadIO io) => RecvOsc (R.ReaderT t io) where + recvPacket = R.ReaderT (liftIO . Fd.recvPacket) -- | 'DuplexOsc' over 'ReaderT'. -instance (Fd.Transport t,MonadIO io) => DuplexOsc (R.ReaderT t io) where +instance (Fd.Transport t, MonadIO io) => DuplexOsc (R.ReaderT t io) -- | 'Transport' over 'ReaderT'. -instance (Fd.Transport t,MonadIO io) => Transport (R.ReaderT t io) where +instance (Fd.Transport t, MonadIO io) => Transport (R.ReaderT t io) -- | Transport connection. type Connection t a = R.ReaderT t IO a @@ -61,13 +61,13 @@ sendMessage = sendPacket . Packet.Packet_Message -- | Type restricted synonym for 'sendOsc'. -sendBundle :: SendOsc m => Packet.Bundle -> m () +sendBundle :: SendOsc m => Packet.BundleOf Packet.Message -> m () sendBundle = sendPacket . Packet.Packet_Bundle -- * Receive -- | Variant of 'recvPacket' that runs 'packet_to_bundle'. -recvBundle :: (RecvOsc m) => m Packet.Bundle +recvBundle :: (RecvOsc m) => m (Packet.BundleOf Packet.Message) recvBundle = fmap Packet.packet_to_bundle recvPacket -- | Variant of 'recvPacket' that runs 'packet_to_message'. @@ -84,39 +84,44 @@ -- * Wait --- | Wait for a 'Packet' where the supplied predicate is 'True', --- discarding intervening packets. -waitUntil :: (RecvOsc m) => (Packet.Packet -> Bool) -> m Packet.Packet +{- | Wait for a 'Packet' where the supplied predicate is 'True', +discarding intervening packets. +-} +waitUntil :: (RecvOsc m) => (Packet.PacketOf Packet.Message -> Bool) -> m (Packet.PacketOf Packet.Message) waitUntil f = Wait.untilPredicate f recvPacket --- | Wait for a 'Packet' where the supplied function does not give --- 'Nothing', discarding intervening packets. -waitFor :: (RecvOsc m) => (Packet.Packet -> Maybe a) -> m a +{- | Wait for a 'Packet' where the supplied function does not give 'Nothing', +discarding intervening packets. +-} +waitFor :: (RecvOsc m) => (Packet.PacketOf Packet.Message -> Maybe a) -> m a waitFor f = Wait.untilMaybe f recvPacket -- | 'waitUntil' 'packet_is_immediate'. -waitImmediate :: RecvOsc m => m Packet.Packet +waitImmediate :: RecvOsc m => m (Packet.PacketOf Packet.Message) waitImmediate = waitUntil Packet.packet_is_immediate --- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or --- immediate mode 'Bundle' with one element. +{- | 'waitFor' 'packet_to_message', +ie. an incoming 'Message' or immediate mode 'Bundle' with one element. +-} waitMessage :: RecvOsc m => m Packet.Message waitMessage = waitFor Packet.packet_to_message --- | A 'waitFor' for variant using 'packet_has_address' to match on --- the 'Address_Pattern' of incoming 'Packets'. -waitAddress :: RecvOsc m => Packet.Address_Pattern -> m Packet.Packet +{- | A 'waitFor' for variant using 'packet_has_address' to match on +the 'Address_Pattern' of incoming 'Packets'. +-} +waitAddress :: RecvOsc m => Packet.Address_Pattern -> m (Packet.PacketOf Packet.Message) waitAddress s = - let f o = if Packet.packet_has_address s o then Just o else Nothing - in waitFor f + let f o = if Packet.packet_has_address s o then Just o else Nothing + in waitFor f -- | Variant on 'waitAddress' that returns matching 'Message'. waitReply :: RecvOsc m => Packet.Address_Pattern -> m Packet.Message waitReply s = - let f = fromMaybe (error "waitReply: message not located?") . - find (Packet.message_has_address s) . - Packet.packetMessages - in fmap f (waitAddress s) + let f = + fromMaybe (error "waitReply: message not located?") + . find (Packet.message_has_address s) + . Packet.packetMessages + in fmap f (waitAddress s) -- | Variant of 'waitReply' that runs 'messageDatum'. waitDatum :: RecvOsc m => Packet.Address_Pattern -> m [Datum.Datum] diff --git a/Sound/Osc/Wait.hs b/Sound/Osc/Wait.hs --- a/Sound/Osc/Wait.hs +++ b/Sound/Osc/Wait.hs @@ -6,13 +6,13 @@ -- | 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 recur else return p - recur = act >>= g - in recur + let g p = if f p then recur else return p + recur = act >>= g + in recur -- | 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 = maybe recur return (f p) - recur = act >>= g - in recur + let g p = maybe recur return (f p) + recur = act >>= g + in recur diff --git a/hosc.cabal b/hosc.cabal --- a/hosc.cabal +++ b/hosc.cabal @@ -1,17 +1,17 @@ Cabal-Version: 2.4 Name: hosc -Version: 0.20 +Version: 0.21 Synopsis: Haskell Open Sound Control Description: Haskell library implementing the Open Sound Control protocol License: GPL-3.0-only License-File: contrib/LICENSE Category: Sound -Copyright: (c) Rohan Drape, Stefan Kersten and others, 2007-2022 +Copyright: (c) Rohan Drape, Stefan Kersten and others, 2007-2024 Author: Rohan Drape, Stefan Kersten Maintainer: rd@rohandrape.net Stability: Experimental Homepage: http://rohandrape.net/t/hosc -Tested-With: GHC == 9.4.3 +Tested-With: GHC == 9.10.1 Build-Type: Simple Data-Files: README.md @@ -20,15 +20,14 @@ binary >= 0.7.2, blaze-builder >= 0.3, bytestring, - data-binary-ieee754, network >= 2.3, parsec, + safe, time >= 1.5, transformers Default-Language:Haskell2010 - GHC-Options: -Wall -fwarn-tabs + GHC-Options: -Wall -Wno-x-partial -Wno-incomplete-uni-patterns Exposed-modules: Sound.Osc - Sound.Osc.Alias Sound.Osc.Coding.Byte Sound.Osc.Coding.Cast Sound.Osc.Coding.Convert @@ -47,6 +46,7 @@ Sound.Osc.Time.Thread.MonadIO Sound.Osc.Time.Timeout Sound.Osc.Transport.Fd + Sound.Osc.Transport.Fd.Socket Sound.Osc.Transport.Fd.Tcp Sound.Osc.Transport.Fd.Udp Sound.Osc.Transport.Monad