hosc 0.20 → 0.21

raw patch · 26 files changed

+1100/−763 lines, 26 filesdep +safedep −data-binary-ieee754dep ~binarydep ~bytestring

Dependencies added: safe

Dependencies removed: data-binary-ieee754

Dependency ranges changed: binary, bytestring

Files

• README.md +14/−6
• Sound/Osc.hs +1/−2
• Sound/Osc/Alias.hs +0/−9
• Sound/Osc/Coding/Byte.hs +229/−158
• Sound/Osc/Coding/Cast.hs +41/−10
• Sound/Osc/Coding/Decode/Base.hs +70/−57
• Sound/Osc/Coding/Decode/Binary.hs +87/−67
• Sound/Osc/Coding/Encode/Base.hs +76/−33
• Sound/Osc/Coding/Encode/Builder.hs +46/−41
• Sound/Osc/Core.hs +4/−6
• Sound/Osc/Datum.hs +121/−82
• Sound/Osc/Fd.hs +1/−2
• Sound/Osc/Packet.hs +72/−59
• Sound/Osc/Text.hs +85/−62
• Sound/Osc/Time.hs +25/−16
• Sound/Osc/Time/System.hs +5/−4
• Sound/Osc/Time/Thread.hs +18/−14
• Sound/Osc/Time/Thread/MonadIO.hs +10/−10
• Sound/Osc/Time/Timeout.hs +1/−1
• Sound/Osc/Transport/Fd.hs +40/−26
• Sound/Osc/Transport/Fd/Socket.hs +40/−0
• Sound/Osc/Transport/Fd/Tcp.hs +45/−39
• Sound/Osc/Transport/Fd/Udp.hs +19/−14
• Sound/Osc/Transport/Monad.hs +38/−33
• Sound/Osc/Wait.hs +6/−6
• hosc.cabal +6/−6

@@ -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+$+```

@@ -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

@@ -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

@@ -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

@@ -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]

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 

@@ -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

@@ -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

@@ -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)

@@ -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

@@ -1,5 +1,6 @@--- | Osc related timing functions.---   Osc timestamps are 64-bit @Ntp@ values, <http://ntp.org/>.+{- | Osc related timing functions.+  Osc timestamps are 64-bit @Ntp@ values, <http://ntp.org/>.+-} 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

@@ -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))

@@ -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

@@ -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

@@ -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)

@@ -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]

@@ -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

@@ -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)

@@ -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)

@@ -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]

@@ -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

@@ -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