hosc 0.19.1 → 0.20

raw patch · 44 files changed

+2270/−2031 lines, 44 filesdep +parsecPVP ok

version bump matches the API change (PVP)

Dependencies added: parsec

API changes (from Hackage documentation)

Files

• README.md +6/−6
• Sound/OSC.hs +0/−8
• Sound/OSC/Coding/Byte.hs +0/−329
• Sound/OSC/Coding/Cast.hs +0/−41
• Sound/OSC/Coding/Convert.hs +0/−129
• Sound/OSC/Coding/Decode/Base.hs +0/−109
• Sound/OSC/Coding/Decode/Binary.hs +0/−136
• Sound/OSC/Coding/Encode/Base.hs +0/−58
• Sound/OSC/Coding/Encode/Builder.hs +0/−116
• Sound/OSC/Core.hs +0/−20
• Sound/OSC/Datum.hs +0/−289
• Sound/OSC/FD.hs +0/−7
• Sound/OSC/Packet.hs +0/−135
• Sound/OSC/Time.hs +0/−183
• Sound/OSC/Transport/FD.hs +0/−93
• Sound/OSC/Transport/FD/TCP.hs +0/−95
• Sound/OSC/Transport/FD/UDP.hs +0/−99
• Sound/OSC/Transport/Monad.hs +0/−123
• Sound/OSC/Wait.hs +0/−26
• Sound/Osc.hs +8/−0
• Sound/Osc/Alias.hs +9/−0
• Sound/Osc/Coding/Byte.hs +339/−0
• Sound/Osc/Coding/Cast.hs +41/−0
• Sound/Osc/Coding/Convert.hs +129/−0
• Sound/Osc/Coding/Decode/Base.hs +109/−0
• Sound/Osc/Coding/Decode/Binary.hs +132/−0
• Sound/Osc/Coding/Encode/Base.hs +74/−0
• Sound/Osc/Coding/Encode/Builder.hs +110/−0
• Sound/Osc/Core.hs +23/−0
• Sound/Osc/Datum.hs +225/−0
• Sound/Osc/Fd.hs +7/−0
• Sound/Osc/Packet.hs +129/−0
• Sound/Osc/Text.hs +256/−0
• Sound/Osc/Time.hs +107/−0
• Sound/Osc/Time/System.hs +24/−0
• Sound/Osc/Time/Thread.hs +35/−0
• Sound/Osc/Time/Thread/MonadIO.hs +25/−0
• Sound/Osc/Time/Timeout.hs +15/−0
• Sound/Osc/Transport/Fd.hs +87/−0
• Sound/Osc/Transport/Fd/Tcp.hs +95/−0
• Sound/Osc/Transport/Fd/Udp.hs +113/−0
• Sound/Osc/Transport/Monad.hs +123/−0
• Sound/Osc/Wait.hs +18/−0
• hosc.cabal +31/−29

@@ -1,26 +1,26 @@ hosc - haskell open sound control --------------------------------- -[hosc][hosc] provides `Sound.OSC`, a [haskell][hs]+[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.  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+- [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-2021,+© [rohan drape][rd], [stefan kersten][sk] and others, 2007-2022, [gpl-3][gpl-3]. with contributions by:  - [alex mclean][am] - [henning thielemann][ht] -see the [git](https://git-scm.com/) [history](http://rohandrape.net/?t=hosc&q=history) for details+see the [history](http://rohandrape.net/?t=hosc&q=history) for details  [hosc]: http://rohandrape.net/?t=hosc [hs]: http://haskell.org/-[osc]: http://opensoundcontrol.org/+[osc]: https://opensoundcontrol.stanford.edu/ [hsc3]: http://rohandrape.net/?t=hsc3 [sc3]: http://audiosynth.com/ [rd]:  http://rohandrape.net/

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

@@ -1,329 +0,0 @@--- | 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 -}-import Data.Int {- base -}-import Data.Word {- base -}-import System.IO {- 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 Sound.OSC.Coding.Cast as Cast {- hosc -}-import Sound.OSC.Coding.Convert {- hosc -}---- * Encode---- | Type specialised 'Binary.encode' (big-endian).-encode_int8 :: Int8 -> L.ByteString-encode_int8 = Binary.encode---- | Type specialised 'Binary.encode' (big-endian).------ > encode_int16 0x0102 == L.pack [0x01,0x02]-encode_int16 :: Int16 -> L.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---- | Encode a signed 64-bit integer (big-endian).-encode_int64 :: Int64 -> L.ByteString-encode_int64 = Binary.encode---- | Type specialised 'Binary.encode' (big-endian).-encode_word8 :: Word8 -> L.ByteString-encode_word8 = Binary.encode---- | Type specialised 'Binary.encode' (big-endian).------ > encode_word16 0x0102 == L.pack [0x01,0x02]-encode_word16 :: Word16 -> L.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---- | Type specialised 'Binary.encode'.-encode_word32 :: Word32 -> L.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 an unsigned 64-bit integer.-encode_word64 :: Word64 -> L.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 an un-signed 8-bit integer.-encode_u8 :: Int -> L.ByteString-encode_u8 = encode_word8 . 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---- | 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 a signed 16-bit integer.-encode_i16 :: Int -> L.ByteString-encode_i16 = Binary.encode . int_to_int16---- | Encode a signed 32-bit integer.-encode_i32 :: Int -> L.ByteString-encode_i32 = Binary.encode . 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---- | 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---- * Encode/Float---- | Encode a 32-bit IEEE floating point number.-encode_f32 :: Float -> L.ByteString-encode_f32 = Binary.encode . Cast.f32_w32---- | Little-endian variant of 'encode_f32'.-encode_f32_le :: Float -> L.ByteString-encode_f32_le = Put.runPut . Put.putWord32le . Cast.f32_w32---- | Encode a 64-bit IEEE floating point number.-encode_f64 :: Double -> L.ByteString-encode_f64 = Binary.encode . Cast.f64_w64---- | Little-endian variant of 'encode_f64'.-encode_f64_le :: Double -> L.ByteString-encode_f64_le = Put.runPut . Put.putWord64le . Cast.f64_w64---- * 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---- * Decode---- | Type specialised 'Binary.decode'.-decode_word16 :: L.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---- | Type specialised 'Binary.decode'.-decode_int16 :: L.ByteString -> Int16-decode_int16 = Binary.decode---- | Type specialised 'Binary.decode'.-decode_word32 :: L.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---- | Type specialised 'Binary.decode'.-decode_int64 :: L.ByteString -> Int64-decode_int64 = Binary.decode---- | Type specialised 'Binary.decode'.-decode_word64 :: L.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 a signed 8-bit integer.-decode_i8 :: L.ByteString -> Int-decode_i8 = int8_to_int . Binary.decode---- | Decode an unsigned 8-bit integer.-decode_u16 :: L.ByteString -> Int-decode_u16 = 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 a signed 16-bit integer.-decode_i16 :: L.ByteString -> Int-decode_i16 = 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 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---- | 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 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_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/Float---- | Decode a 32-bit IEEE floating point number.-decode_f32 :: L.ByteString -> Float-decode_f32 = Cast.w32_f32 . decode_word32---- | Little-endian variant of 'decode_f32'.-decode_f32_le :: L.ByteString -> Float-decode_f32_le = Cast.w32_f32 . decode_word32_le---- | Decode a 64-bit IEEE floating point number.-decode_f64 :: L.ByteString -> Double-decode_f64 b = Cast.w64_f64 (Binary.decode b :: Word64)---- * Decode/ASCII---- | Decode an ASCII string, inverse of 'encode_ascii'.-decode_ascii :: L.ByteString -> S.C.ByteString-{-# INLINE decode_ascii #-}-decode_ascii = S.C.pack . L.C.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---- | Type-specialised reader for 'Binary.decode'.-read_word32 :: Handle -> IO Word32-read_word32 = read_decode Binary.decode 4---- | 'read_decode' of 'decode_word32_le'.-read_word32_le :: Handle -> IO Word32-read_word32_le = read_decode decode_word32_le 4---- | 'L.hPut' of 'encode_word32'.-write_word32 :: Handle -> Word32 -> IO ()-write_word32 h = L.hPut h . encode_word32---- | 'L.hPut' of 'encode_word32_le'.-write_word32_le :: Handle -> Word32 -> IO ()-write_word32_le h = L.hPut h . encode_word32_le---- * IO/Int---- | 'decode_i8' of 'L.hGet'.-read_i8 :: Handle -> IO Int-read_i8 = read_decode decode_i8 1---- | 'decode_i16' of 'L.hGet'.-read_i16 :: Handle -> IO Int-read_i16 = read_decode decode_i16 2---- | 'decode_i32' of 'L.hGet'.-read_i32 :: Handle -> IO Int-read_i32 = read_decode decode_i32 4---- | 'decode_i32_le' of 'L.hGet'.-read_i32_le :: Handle -> IO Int-read_i32_le = read_decode decode_i32_le 4---- | 'decode_u32' of 'L.hGet'.-read_u32 :: Handle -> IO Int-read_u32 = read_decode decode_u32 4---- | 'decode_u32_le' of 'L.hGet'.-read_u32_le :: Handle -> IO Int-read_u32_le = read_decode decode_u32_le 4---- | 'L.hPut' of 'encode_u32'.-write_u32 :: Handle -> Int -> IO ()-write_u32 h = L.hPut h . encode_u32---- | 'L.hPut' of 'encode_u32_le'.-write_u32_le :: Handle -> Int -> IO ()-write_u32_le h = L.hPut h . encode_u32_le---- * IO/Float---- | 'decode_f32' of 'L.hGet'.-read_f32 :: Handle -> IO Float-read_f32 = read_decode decode_f32 4---- | 'decode_f32_le' of 'L.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 h = do-  n <- fmap decode_u8 (L.hGet h 1)-  fmap decode_ascii (L.hGet h n)---- * Util---- | Bundle header as a (strict) 'S.C.ByteString'.-bundleHeader_strict :: S.C.ByteString-bundleHeader_strict = S.C.pack "#bundle\0"---- | Bundle header as a lazy ByteString.-bundleHeader :: L.ByteString-{-# INLINE bundleHeader #-}-bundleHeader = L.C.fromChunks [bundleHeader_strict]---- | The number of bytes required to align an OSC value to the next---   4-byte boundary.------ > map align [0::Int .. 7] == [0,3,2,1,0,3,2,1]-align :: (Num i,Bits i) => i -> i-{-# INLINE align #-}-align n = ((n + 3) .&. complement 3) - n

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

@@ -1,129 +0,0 @@--- | Type conversion.-module Sound.OSC.Coding.Convert where--import Data.Int {- base -}-import Data.Word {- base -}---- * Int -> N---- | Type specialised 'fromIntegral'-int_to_word8 :: Int -> Word8-int_to_word8 = fromIntegral---- | Type specialised 'fromIntegral'-int_to_word32 :: Int -> Word32-int_to_word32 = fromIntegral---- | Type specialised 'fromIntegral'.-int_to_word16 :: Int -> Word16-int_to_word16 = fromIntegral---- | Type specialised 'fromIntegral'-int_to_int8 :: Int -> Int8-int_to_int8 = fromIntegral---- | Type specialised 'fromIntegral'-int_to_int16 :: Int -> Int16-int_to_int16 = fromIntegral---- | Type specialised 'fromIntegral'-int_to_int32 :: Int -> Int32-int_to_int32 = fromIntegral---- | Type specialised 'fromIntegral'-int_to_int64 :: Int -> Int64-int_to_int64 = fromIntegral---- * N -> Int---- | Type specialised 'fromIntegral'-int8_to_int :: Int8 -> Int-int8_to_int = fromIntegral---- | Type specialised 'fromIntegral'-int16_to_int :: Int16 -> Int-int16_to_int = fromIntegral---- | Type specialised 'fromIntegral'-int32_to_int :: Int32 -> Int-int32_to_int = fromIntegral---- | Type specialised 'fromIntegral'-int64_to_int :: Int64 -> Int-int64_to_int = fromIntegral---- | Type specialised 'fromIntegral'-word8_to_int :: Word8 -> Int-word8_to_int = fromIntegral---- | Type specialised 'fromIntegral'-word16_to_int :: Word16 -> Int-word16_to_int = fromIntegral---- | Type specialised 'fromIntegral'-word32_to_int :: Word32 -> Int-word32_to_int = fromIntegral---- * N -> N---- | Type specialised 'fromIntegral'-word16_to_word32 :: Word16 -> Word32-word16_to_word32 = fromIntegral---- | Type specialised 'fromIntegral'-word32_to_word16 :: Word32 -> Word16-word32_to_word16 = fromIntegral---- | Type specialised 'fromIntegral'-word32_to_int32 :: Word32 -> Int32-word32_to_int32 = fromIntegral---- | Type specialised 'fromIntegral'-word32_to_int64 :: Word32 -> Int64-word32_to_int64 = fromIntegral---- | Type specialised 'fromIntegral'-word64_to_int64 :: Word64 -> Int64-word64_to_int64 = fromIntegral---- | Type specialised 'fromIntegral'-int64_to_int32 :: Int64 -> Int32-int64_to_int32 = fromIntegral---- | Type specialised 'fromIntegral'-int64_to_word32 :: Int64 -> Word32-int64_to_word32 = fromIntegral---- * N -> Real---- | Type specialised 'fromIntegral'-word64_to_double :: Word64 -> Double-word64_to_double = fromIntegral---- * Enum---- | Type-specialised 'toEnum' of 'fromIntegral'-word8_to_enum :: Enum e => Word8 -> e-word8_to_enum = toEnum . fromIntegral---- | Type-specialised 'toEnum' of 'fromIntegral'-word16_to_enum :: Enum e => Word16 -> e-word16_to_enum = toEnum . fromIntegral---- | Type-specialised 'fromIntegral' of 'fromEnum'.-enum_to_word8 :: Enum e => e -> Word8-enum_to_word8 = fromIntegral . fromEnum---- | Type-specialised 'fromIntegral' of 'fromEnum'.-enum_to_word16 :: Enum e => e -> Word16-enum_to_word16 = fromIntegral . fromEnum---- * Enum/Char---- | Type-specialised 'word8_to_enum'.-word8_to_char :: Word8 -> Char-word8_to_char = word8_to_enum---- | Type-specialised 'enum_to_word8'.-char_to_word8 :: Char -> Word8-char_to_word8 = enum_to_word8

@@ -1,109 +0,0 @@--- | 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 -}-import qualified Data.ByteString.Lazy as B {- bytestring -}-import Data.List {- base -}-import Data.Maybe {- base -}--import Sound.OSC.Coding.Byte {- hosc -}-import Sound.OSC.Coding.Convert {- hosc -}-import Sound.OSC.Datum {- hosc -}-import Sound.OSC.Packet {- hosc -}-import Sound.OSC.Time {- hosc -}---- | The plain byte count of an OSC value.-size :: Datum_Type -> 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"---- | The storage byte count (aligned) of an OSC value.-storage :: Datum_Type -> B.ByteString -> Int-storage ty b =-    case ty of-      's' -> let n = size 's' b + 1 in n + align n-      'b' -> let n = size 'b' b in n + align n + 4-      _ -> size ty B.empty---- | Decode an OSC datum-decode_datum :: Datum_Type -> B.ByteString -> Datum-decode_datum ty b =-    case ty of-      'i' -> Int32 (decode b)-      'h' -> Int64 (decode b)-      'f' -> Float (decode_f32 b)-      'd' -> Double (decode_f64 b)-      's' -> ASCII_String (decode_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] ++ ")")---- | 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'))---- | Decode an OSC 'Message'.-decodeMessage :: B.ByteString -> Message-decodeMessage b =-    let n = storage 's' b-        (ASCII_String cmd) = decode_datum 's' b-        m = storage 's' (b_drop n b)-        (ASCII_String dsc) = decode_datum 's' (b_drop n b)-        arg = decode_datum_seq (descriptor_tags dsc) (b_drop (n + m) b)-    in Message (C.unpack cmd) arg---- | Decode a sequence of 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---- | Decode an OSC 'Bundle'.-decodeBundle :: B.ByteString -> Bundle-decodeBundle b =-    let h = storage 's' b -- header (should be '#bundle')-        t = storage 't' (b_drop h b) -- time-        (TimeStamp timeStamp) = decode_datum 't' (b_drop h b)-        ms = decode_message_seq (b_drop (h+t) b)-    in Bundle timeStamp ms---- | Decode an OSC 'Packet'.------ > let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]--- > decodePacket b == Packet_Message (Message "/g_free" [Int32 0])-decodePacket :: B.ByteString -> Packet-decodePacket b =-    if bundleHeader `B.isPrefixOf` b-    then Packet_Bundle (decodeBundle b)-    else Packet_Message (decodeMessage b)---- * UTIL---- | 'B.take' with 'Int' count.-b_take :: Int -> B.ByteString -> B.ByteString-b_take = B.take . int_to_int64---- | 'B.drop' with 'Int' count.-b_drop :: Int -> B.ByteString -> B.ByteString-b_drop = B.drop . int_to_int64

@@ -1,136 +0,0 @@--- | Optimised decode function for OSC packets.-module Sound.OSC.Coding.Decode.Binary-    (get_packet-    ,decodeMessage-    ,decodeBundle-    ,decodePacket-    ,decodePacket_strict) where--import Control.Applicative {- base -}-import Control.Monad {- base -}-import Data.Int {- base -}-import Data.Word {- base -}--import qualified Data.Binary.Get as G {- binary -}-import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}-import qualified Data.ByteString.Char8 as S.C {- bytestring -}-import qualified Data.ByteString.Lazy as B {- bytestring -}-import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -}--import qualified Sound.OSC.Coding.Byte as Byte {- hosc -}-import Sound.OSC.Coding.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 :: G.Get Int32-getInt32be = fmap word32_to_int32 G.getWord32be---- | Get a 64 bit integer in big-endian byte order.-getInt64be :: G.Get Int64-getInt64be = fmap word64_to_int64 G.getWord64be---- | Get an aligned OSC string.-get_string :: G.Get String-get_string = do-    s <- G.getLazyByteStringNul-    G.skip (int64_to_int (Byte.align (B.length s + 1)))-    return (C.unpack s)---- | Get an aligned OSC string.-get_ascii :: G.Get ASCII-get_ascii = do-    s <- G.getLazyByteStringNul-    G.skip (int64_to_int (Byte.align (B.length s + 1)))-    return (S.C.pack (C.unpack s))---- | Get binary data prefixed by byte count.-get_bytes :: Word32 -> G.Get B.ByteString-get_bytes n = do-    b <- G.getLazyByteString (word32_to_int64 n)-    if n /= int64_to_word32 (B.length b)-        then fail "get_bytes: end of stream"-        else G.skip (word32_to_int (Byte.align n))-    return b---- | Get an OSC datum.-get_datum :: Datum_Type -> G.Get Datum-get_datum ty =-    case ty of-      'i' -> fmap Int32 getInt32be-      'h' -> fmap Int64 getInt64be-      'f' -> fmap Float I.getFloat32be-      'd' -> fmap Double I.getFloat64be-      's' -> fmap ASCII_String get_ascii-      'b' -> fmap Blob (get_bytes =<< G.getWord32be)-      't' -> fmap (TimeStamp . Time.ntpi_to_ntpr) G.getWord64be-      'm' -> do b0 <- G.getWord8-                b1 <- G.getWord8-                b2 <- G.getWord8-                b3 <- G.getWord8-                return (Midi (MIDI b0 b1 b2 b3))-      _ -> fail ("get_datum: illegal type " ++ show ty)---- | Get an OSC 'Message', fail if type descriptor is invalid.-get_message :: G.Get Message-get_message = do-    cmd <- get_string-    dsc <- get_ascii-    case S.C.unpack dsc of-        ',':tags -> do-            arg <- mapM get_datum tags-            return (Message cmd arg)-        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 :: G.Get [Message]-get_message_seq = do-    b <- G.isEmpty-    if b-        then return []-        else do-            p <- flip G.isolate get_message . word32_to_int =<< G.getWord32be-            ps <- get_message_seq-            return (p:ps)---- | Get a bundle. Fail if bundle header is not found in packet.-get_bundle :: G.Get Bundle-get_bundle = do-    h <- G.getByteString (S.C.length Byte.bundleHeader_strict)-    when (h /= Byte.bundleHeader_strict) (fail "get_bundle: not a bundle")-    t <- fmap Time.ntpi_to_ntpr G.getWord64be-    fmap (Bundle t) get_message_seq---- | Get an OSC 'Packet'.-get_packet :: G.Get Packet-get_packet = fmap Packet_Bundle get_bundle <|> fmap Packet_Message get_message--{-# INLINE decodeMessage #-}-{-# INLINE decodeBundle #-}-{-# INLINE decodePacket #-}-{-# INLINE decodePacket_strict #-}--{- | Decode an OSC 'Message' from a lazy ByteString.--> let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]-> decodeMessage b == Message "/g_free" [Int32 0]--}-decodeMessage :: B.ByteString -> Message-decodeMessage = G.runGet get_message---- | Decode an OSC 'Bundle' from a lazy ByteString.-decodeBundle :: B.ByteString -> Bundle-decodeBundle = G.runGet get_bundle--{- | Decode an OSC packet from a lazy ByteString.--> let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]-> decodePacket b == Packet_Message (Message "/g_free" [Int32 0])--}-decodePacket :: B.ByteString -> Packet-decodePacket = G.runGet get_packet---- | Decode an OSC packet from a strict Char8 ByteString.-decodePacket_strict :: S.C.ByteString -> Packet-decodePacket_strict = G.runGet get_packet . B.fromChunks . (:[])

@@ -1,58 +0,0 @@--- | 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 -}-import qualified Data.ByteString.Char8 as C {- bytestring -}-import qualified Data.ByteString.Lazy as B {- bytestring -}--import Sound.OSC.Coding.Byte {- hosc -}-import Sound.OSC.Coding.Convert {- hosc -}-import Sound.OSC.Datum {- hosc -}-import Sound.OSC.Packet {- hosc -}-import Sound.OSC.Time {- hosc -}---- | Align byte string, if required.-extend :: Word8 -> B.ByteString -> B.ByteString-extend p s = B.append s (B.replicate (align (B.length s)) p)---- | Encode OSC 'Datum'.------ MIDI: Bytes from MSB to LSB are: port id, status byte, data1, data2.-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-      ASCII_String s -> extend 0 (B.snoc (encode_ascii s) 0)-      Midi (MIDI 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'.-encodeMessage :: Message -> B.ByteString-encodeMessage (Message c l) =-    B.concat [encode_datum (ASCII_String (C.pack c))-             ,encode_datum (ASCII_String (descriptor l))-             ,B.concat (map encode_datum l) ]---- | Encode OSC 'Message' as an OSC blob.-encode_message_blob :: Message -> Datum-encode_message_blob = Blob . encodeMessage---- | Encode OSC 'Bundle'.-encodeBundle :: Bundle -> B.ByteString-encodeBundle (Bundle t 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 o =-    case o of-      Packet_Message m -> encodeMessage m-      Packet_Bundle b -> encodeBundle b

@@ -1,116 +0,0 @@--- | Optimised encode function for OSC packets.-{-# LANGUAGE CPP #-}--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 -}--#ifdef IMPORT_SEMIGROUP-import Data.Semigroup-#endif--import qualified Sound.OSC.Coding.Byte as Byte {- hosc -}-import qualified Sound.OSC.Coding.Convert as Convert {- hosc -}-import Sound.OSC.Datum {- hosc -}-import Sound.OSC.Packet {- hosc -}-import Sound.OSC.Time {- hosc -}---- | Generate a list of zero bytes for padding.-padding :: Int -> [Word8]-padding n = replicate n 0---- | Nul byte (0) and then zero padding.-nul_and_padding :: Int -> B.Builder-nul_and_padding n = B.fromWord8s (0 : padding (Byte.align n))---- Encode a string with zero padding.-build_ascii :: ASCII -> B.Builder-build_ascii s = B.fromByteString s <> nul_and_padding (S.length s + 1)---- Encode a string with zero padding.-build_string :: String -> B.Builder-build_string s = B.fromString s <> nul_and_padding (length s + 1)---- 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))))---- 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)-      ASCII_String s -> build_ascii s-      Midi (MIDI b0 b1 b2 b3) -> B.fromWord8s [b0,b1,b2,b3]-      Blob b -> build_bytes b---- Encode an OSC 'Message'.-build_message :: Message -> B.Builder-build_message (Message c l) =-    mconcat [build_string c-            ,build_ascii (descriptor l)-            ,mconcat (map build_datum l)]---- Encode an OSC 'Bundle'.-build_bundle_ntpi :: 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)]---- | Builder for an OSC 'Packet'.-build_packet :: Packet -> B.Builder-build_packet o =-    case o of-      Packet_Message m -> build_message m-      Packet_Bundle (Bundle t m) -> build_bundle_ntpi (ntpr_to_ntpi t) m--{-# INLINE encodePacket #-}-{-# INLINE encodeMessage #-}-{-# INLINE encodeBundle #-}-{-# INLINE encodePacket_strict #-}---- | Encode an OSC 'Packet'.-encodePacket :: Packet -> 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---}-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---}-encodeBundle :: Bundle -> L.ByteString-encodeBundle = encodePacket . Packet_Bundle---- | Encode an OSC 'Packet' to a strict 'S.ByteString'.-encodePacket_strict :: Packet -> S.ByteString-encodePacket_strict = B.toByteString . build_packet

@@ -1,20 +0,0 @@-{- | Composite of non-transport related modules.--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---}-module Sound.OSC.Core (module M) where--import Sound.OSC.Coding.Decode.Binary as M-import Sound.OSC.Coding.Encode.Builder as M-import Sound.OSC.Datum as M-import Sound.OSC.Packet as M-import Sound.OSC.Time as M-import Sound.OSC.Wait as M

@@ -1,289 +0,0 @@--- | Data type for OSC datum.-module Sound.OSC.Datum where--import Data.Char {- base -}-import Data.Int {- base -}-import Data.List {- base -}-import Data.Maybe {- base -}-import Data.Word {- base -}-import Numeric {- base -}-import Text.Printf {- base -}-import Text.Read {- base -}--import qualified Data.ByteString.Lazy as Lazy {- bytestring -}-import qualified Data.ByteString.Char8 as Char8 {- bytestring -}--import qualified Sound.OSC.Time as Time {- hosc -}---- * Datum---- | Type enumerating Datum categories.-type Datum_Type = Char---- | Type for ASCII strings (strict 'Char'8 'Char8.ByteString').-type ASCII = Char8.ByteString---- | Type-specialised 'Char8.pack'.-ascii :: String -> ASCII-ascii = Char8.pack---- | Type-specialised 'Char8.unpack'.-ascii_to_string :: ASCII -> String-ascii_to_string = Char8.unpack---- | Type for 'Word8' arrays, these are stored with an 'Int32' length prefix.-type BLOB = Lazy.ByteString---- | Type-specialised 'Lazy.pack'.-blob_pack ::  [Word8] -> BLOB-blob_pack = Lazy.pack---- | Type-specialised 'Lazy.unpack'.-blob_unpack :: BLOB -> [Word8]-blob_unpack = Lazy.unpack---- | Four-byte midi message: port-id, status-byte, data, data.-data MIDI = MIDI !Word8 !Word8 !Word8 !Word8-    deriving (Eq,Show,Read)---- | The basic elements of OSC messages.-data Datum = Int32 {d_int32 :: !Int32}-           | Int64 {d_int64 :: !Int64}-           | Float {d_float :: !Float}-           | Double {d_double :: !Double}-           | ASCII_String {d_ascii_string :: !ASCII}-           | Blob {d_blob :: !BLOB}-           | TimeStamp {d_timestamp :: !Time.Time} -- ie. NTPr-           | Midi {d_midi :: !MIDI}-             deriving (Eq,Read,Show)---- * Datum types---- | List of required data types (tag,name).-osc_types_required :: [(Datum_Type,String)]-osc_types_required =-    [('i',"Int32")-    ,('f',"Float")-    ,('s',"ASCII_String") -- ASCII-    ,('b',"ByteArray") -- Blob-    ]---- | List of optional data types (tag,name).-osc_types_optional :: [(Datum_Type,String)]-osc_types_optional =-    [('h',"Int64")-    ,('t',"TimeStamp")-    ,('d',"Double")-    -- ,('S',"Symbol")-    -- ,('c',"ASCII_Character")-    -- ,('r',"RGBA")-    ,('m',"MIDI")-    -- ,('T',"True")-    -- ,('F',"False")-    -- ,('N',"Nil")-    -- ,('I',"Infinitum")-    -- ,('[',"Array_Begin")-    -- ,(']',"Array_End")-    ]---- | List of all data types (tag,name).-osc_types :: [(Datum_Type,String)]-osc_types = osc_types_required ++ osc_types_optional---- | Lookup name of type.-osc_type_name :: Datum_Type -> Maybe String-osc_type_name c = lookup c osc_types---- | Erroring variant.-osc_type_name_err :: Datum_Type -> String-osc_type_name_err = fromMaybe (error "osc_type_name") . osc_type_name---- | Single character identifier of an OSC datum.-datum_tag :: Datum -> Datum_Type-datum_tag d =-    case d of-      Int32 _ -> 'i'-      Int64 _ -> 'h'-      Float _ -> 'f'-      Double _ -> 'd'-      ASCII_String _ -> 's'-      Blob _ -> 'b'-      TimeStamp _ -> 't'-      Midi _ -> 'm'---- | Type and name of 'Datum'.-datum_type_name :: Datum -> (Datum_Type,String)-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_integral :: Integral i => Datum -> Maybe i-datum_integral d =-    case d of-      Int32 x -> Just (fromIntegral x)-      Int64 x -> Just (fromIntegral x)-      _ -> Nothing---- | 'Datum' as 'Floating' if 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_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---- * Constructors---- | Type generalised 'Int32'.------ > int32 (1::Int32) == int32 (1::Integer)--- > d_int32 (int32 (maxBound::Int32)) == maxBound--- > int32 (((2::Int) ^ (64::Int))::Int) == Int32 0-int32 :: Integral n => n -> Datum-int32 = Int32 . fromIntegral---- | Type generalised Int64.------ > int64 (1::Int32) == int64 (1::Integer)--- > d_int64 (int64 (maxBound::Int64)) == maxBound-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-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-double :: Real n => n -> Datum-double = Double . realToFrac---- | 'ASCII_String' of 'Char8.pack'.------ > string "string" == ASCII_String (Char8.pack "string")-string :: String -> Datum-string = ASCII_String . Char8.pack---- | Four-tuple variant of 'Midi' '.' 'MIDI'.------ > midi (0,0,0,0) == Midi (MIDI 0 0 0 0)-midi :: (Word8,Word8,Word8,Word8) -> Datum-midi (p,q,r,s) = Midi (MIDI p q r s)---- | 'Blob' of 'blob_pack'.-blob :: [Word8] -> Datum-blob = Blob . blob_pack---- * Descriptor---- | Message argument types are given by a descriptor.------ > descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs"-descriptor :: [Datum] -> ASCII-descriptor l = Char8.pack (',' : map datum_tag l)---- | Descriptor tags are @comma@ prefixed.-descriptor_tags :: ASCII -> ASCII-descriptor_tags = Char8.drop 1---- * Pretty printing---- | Perhaps a precision value for floating point numbers.-type FP_Precision = Maybe Int---- | Variant of 'showFFloat' that deletes trailing zeros.------ > map (floatPP (Just 4)) [1,pi] == ["1.0","3.1416"]-floatPP :: RealFloat n => FP_Precision -> n -> String-floatPP p n =-    let s = showFFloat p n ""-        s' = dropWhile (== '0') (reverse s)-    in case s' of-         '.':_ -> reverse ('0' : s')-         _ -> reverse s'---- | Pretty printer for 'Time'.------ > timePP (Just 4) (1/3) == "0.3333"-timePP :: FP_Precision -> Time.Time -> String-timePP = floatPP---- | Pretty printer for vectors.------ > vecPP show [1::Int,2,3] == "<1,2,3>"-vecPP :: (a -> String) -> [a] -> String-vecPP f v = '<' : intercalate "," (map f v) ++ ">"---- | Pretty printer for blobs, two-digit zero-padded hexadecimal.-blobPP :: BLOB -> String-blobPP = ('B':) . vecPP (printf "%02X") . Lazy.unpack---- | Print strings in double quotes iff they contain white space.-stringPP :: String -> String-stringPP x = if any isSpace x then show x else x--{- | Pretty printer for 'Datum'.--> let d = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60),blob [12,16]]-> map (datumPP (Just 5)) d==  ["1","1.2","str","M<0,144,64,96>","B<0C,10>"]---}-datumPP :: FP_Precision -> Datum -> String-datumPP p d =-    case d of-      Int32 n -> show n-      Int64 n -> show n-      Float n -> floatPP p n-      Double n -> floatPP p n-      ASCII_String s -> stringPP (Char8.unpack s)-      Blob s -> blobPP s-      TimeStamp t -> timePP p t-      Midi (MIDI b1 b2 b3 b4) -> 'M': vecPP show [b1,b2,b3,b4]---- | Variant of 'datumPP' that appends the 'datum_type_name'.-datum_pp_typed :: FP_Precision -> Datum -> String-datum_pp_typed fp d = datumPP fp d ++ ":" ++ snd (datum_type_name d)---- * Parser---- | Given 'Datum_Type' attempt to parse 'Datum' at 'String'.------ > parse_datum 'i' "42" == Just (Int32 42)--- > parse_datum 'h' "42" == Just (Int64 42)--- > parse_datum 'f' "3.14159" == Just (Float 3.14159)--- > parse_datum 'd' "3.14159" == Just (Double 3.14159)--- > parse_datum 's' "\"pi\"" == Just (string "pi")--- > parse_datum 'b' "[112,105]" == Just (Blob (blob_pack [112,105]))--- > parse_datum 'm' "(0,144,60,90)" == Just (midi (0,144,60,90))-parse_datum :: Datum_Type -> String -> Maybe Datum-parse_datum ty =-    case ty of-      'i' -> fmap Int32 . readMaybe-      'h' -> fmap Int64 . readMaybe-      'f' -> fmap Float . readMaybe-      'd' -> fmap Double . readMaybe-      's' -> fmap (ASCII_String . Char8.pack) . readMaybe-      'b' -> fmap (Blob . blob_pack) . readMaybe-      't' -> error "parse_datum: timestamp not implemented"-      'm' -> fmap midi . readMaybe-      _ -> error "parse_datum: unknown type"---- | Erroring variant of 'parse_datum'.-parse_datum_err :: Datum_Type -> String -> Datum-parse_datum_err ty = fromMaybe (error "parse_datum") . parse_datum ty

@@ -1,7 +0,0 @@--- | Composite of "Sound.OSC.Core" and "Sound.OSC.Transport.FD".-module Sound.OSC.FD (module M) where--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

@@ -1,135 +0,0 @@--- | Data types for OSC messages, bundles and packets.-module Sound.OSC.Packet where--import Data.List {- base -}--import Sound.OSC.Datum {- hosc -}-import Sound.OSC.Time {- hosc -}---- * 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@.-type Address_Pattern = String---- | An OSC message, an 'Address_Pattern' and a sequence of 'Datum'.-data Message = Message {messageAddress :: !Address_Pattern-                       ,messageDatum :: ![Datum]}-               deriving (Eq,Read,Show)---- | 'Message' constructor.  It is an 'error' if the 'Address_Pattern'--- doesn't conform to the OSC specification.-message :: Address_Pattern -> [Datum] -> Message-message a xs =-    case a of-      '/':_ -> Message a xs-      _ -> error "message: ill-formed address pattern"---- * Bundle---- | An OSC bundle, a 'Time' and a sequence of 'Message's.-data Bundle = Bundle {bundleTime :: !Time-                     ,bundleMessages :: ![Message]}-              deriving (Eq,Read,Show)---- | OSC 'Bundle's can be ordered (time ascending).-instance Ord Bundle where-    compare (Bundle a _) (Bundle b _) = compare a b---- | 'Bundle' constructor. It is an 'error' if the 'Message' list is--- empty.-bundle :: Time -> [Message] -> Bundle-bundle t xs =-    case xs of-      [] -> error "bundle: empty?"-      _ -> Bundle t xs---- * Packet---- | An OSC 'Packet' is either a 'Message' or a 'Bundle'.-data Packet = Packet_Message {packetMessage :: !Message}-            | Packet_Bundle {packetBundle :: !Bundle}-              deriving (Eq,Read,Show)---- | 'Packet_Bundle' of 'bundle'.-p_bundle :: Time -> [Message] -> Packet-p_bundle t = Packet_Bundle . bundle t---- | 'Packet_Message' of 'message'.-p_message :: Address_Pattern -> [Datum] -> Packet-p_message a = Packet_Message . message a---- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is--- 'immediately'.-packetTime :: Packet -> Time-packetTime = at_packet (const immediately) bundleTime---- | Retrieve the set of 'Message's from a 'Packet'.-packetMessages :: Packet -> [Message]-packetMessages = at_packet return bundleMessages---- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.-packet_to_bundle :: Packet -> Bundle-packet_to_bundle = at_packet (\m -> Bundle immediately [m]) id---- | If 'Packet' is a 'Message' or a 'Bundle' with an /immediate/ time--- tag and with one element, return the 'Message', else 'Nothing'.-packet_to_message :: Packet -> Maybe Message-packet_to_message p =-    case p of-      Packet_Bundle b ->-          case b of-            Bundle t [m] -> if t == immediately then Just m else Nothing-            _ -> Nothing-      Packet_Message m -> Just m---- | Is 'Packet' immediate, ie. a 'Bundle' with timestamp--- 'immediately', or a plain Message.-packet_is_immediate :: Packet -> Bool-packet_is_immediate = (== immediately) . packetTime---- | Variant of 'either' for 'Packet'.-at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a-at_packet f g p =-    case p of-      Packet_Message m -> f m-      Packet_Bundle b -> g b---- * Address Query---- | Does 'Message' have the specified 'Address_Pattern'.-message_has_address :: Address_Pattern -> Message -> Bool-message_has_address x = (== x) . messageAddress---- | Do any of the 'Message's at 'Bundle' have the specified--- 'Address_Pattern'.-bundle_has_address :: Address_Pattern -> Bundle -> Bool-bundle_has_address x = any (message_has_address x) . bundleMessages---- | Does 'Packet' have the specified 'Address_Pattern', ie.--- 'message_has_address' or 'bundle_has_address'.-packet_has_address :: Address_Pattern -> Packet -> Bool-packet_has_address x =-    at_packet (message_has_address x)-              (bundle_has_address x)---- * Pretty printing--{- | Pretty printer for 'Message'.--> messagePP Nothing (Message "/m" [int32 0,float 1.0,string "s",midi (1,2,3,4),blob [1,2,3]])--}-messagePP :: FP_Precision -> Message -> String-messagePP p (Message a d) = let d' = map (datumPP p) d in unwords (a : d')---- | Pretty printer for 'Bundle'.-bundlePP :: FP_Precision -> Bundle -> String-bundlePP p (Bundle t m) = let m' = intersperse ";" (map (messagePP p) m) in unwords (timePP p t : m')---- | Pretty printer for 'Packet'.-packetPP :: FP_Precision -> Packet -> String-packetPP p pkt =-    case pkt of-      Packet_Message m -> messagePP p m-      Packet_Bundle b -> bundlePP p b

@@ -1,183 +0,0 @@--- | OSC related timing functions.---   OSC timestamps are 64-bit @NTP@ values, <http://ntp.org/>.-module Sound.OSC.Time where--import Control.Concurrent {- base -}-import Control.Monad {- base -}-import Control.Monad.IO.Class {- transformers -}-import Data.Word {- base -}--import qualified Data.Time as T {- time -}-import qualified Data.Time.Clock.POSIX as T {- time -}--import Sound.OSC.Coding.Convert {- hosc -}---- * Temporal types---- | Type for binary (integeral) representation of a 64-bit @NTP@ timestamp (ie. @ntpi@).---   The NTP epoch is January 1, 1900.---   NTPv4 also includes a 128-bit format, which is not used by OSC.-type NTP64 = Word64---- | @NTP@ time in real-valued (fractional) form (ie. @ntpr@).---   This is the primary form of timestamp used by hosc.-type Time = Double---- | Constant indicating a bundle to be executed immediately.---   It has the NTP64 representation of @1@.-immediately :: Time-immediately = 1 / 2^(32::Int)---- | @Unix/Posix@ time in real-valued (fractional) form.---   The Unix/Posix epoch is January 1, 1970.-type UT = Double---- * Time conversion---- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp.------ > ntpr_to_ntpi immediately == 1--- > fmap ntpr_to_ntpi time-ntpr_to_ntpi :: Time -> NTP64-ntpr_to_ntpi t = round (t * (2 ^ (32::Int)))---- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp.-ntpi_to_ntpr :: NTP64 -> Time-ntpi_to_ntpr t = word64_to_double t / 2^(32::Int)---- | Difference (in seconds) between /NTP/ and /UT/ epochs.------ > ntp_ut_epoch_diff / (24 * 60 * 60) == 25567--- > 25567 `div` 365 == 70-ntp_ut_epoch_diff :: Num n => n-ntp_ut_epoch_diff = (70 * 365 + 17) * 24 * 60 * 60---- | Convert a 'UT' timestamp to an 'NTPi' timestamp.-ut_to_ntpi :: UT -> NTP64-ut_to_ntpi t = ntpr_to_ntpi (t + ntp_ut_epoch_diff)---- | Convert @Unix/Posix@ to @NTP@.-ut_to_ntpr :: Num n => n -> n-ut_to_ntpr = (+) ntp_ut_epoch_diff---- | Convert @NTP@ to @Unix/Posix@.-ntpr_to_ut :: Num n => n -> n-ntpr_to_ut = (+) (negate ntp_ut_epoch_diff)---- | Convert 'NTPi' to @Unix/Posix@.-ntpi_to_ut :: NTP64 -> UT-ntpi_to_ut = ntpr_to_ut . ntpi_to_ntpr---- | Convert 'Time' to 'T.POSIXTime'.-ntpr_to_posixtime :: Time -> T.POSIXTime-ntpr_to_posixtime = realToFrac . ntpr_to_ut---- | Convert 'T.POSIXTime' to 'Time'.-posixtime_to_ntpr :: T.POSIXTime -> Time-posixtime_to_ntpr = ut_to_ntpr . realToFrac---- * 'Data.Time' inter-operation.---- | The time at 1970-01-01:00:00:00.-ut_epoch :: T.UTCTime-ut_epoch =-    let d = T.fromGregorian 1970 1 1-        s = T.secondsToDiffTime 0-    in T.UTCTime d s---- | Convert 'T.UTCTime' to @Unix/Posix@.-utc_to_ut :: Fractional n => T.UTCTime -> n-utc_to_ut t = realToFrac (T.diffUTCTime t ut_epoch)---- * Clock operations--{- | Read current real-valued @NTP@ timestamp.--> get_ct = fmap utc_to_ut T.getCurrentTime-> get_pt = fmap realToFrac T.getPOSIXTime-> (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1)-> print (pt - ct,pt - ct < 1e-5)---}-time :: MonadIO m => m Time-time = liftIO (fmap posixtime_to_ntpr T.getPOSIXTime)---- * Thread operations.---- | The 'pauseThread' limit (in seconds).---   Values larger than this require a different thread delay mechanism, see 'sleepThread'.---   The value is the number of microseconds in @maxBound::Int@.-pauseThreadLimit :: Fractional n => n-pauseThreadLimit = fromIntegral (maxBound::Int) / 1e6---- | Pause current thread for the indicated duration (in seconds), see 'pauseThreadLimit'.-pauseThread :: (MonadIO m,RealFrac n) => n -> m ()-pauseThread n = when (n > 0) (liftIO (threadDelay (floor (n * 1e6))))---- | Type restricted 'pauseThread'.-wait :: MonadIO m => Double -> m ()-wait = pauseThread---- | Pause current thread until the given 'Time', see 'pauseThreadLimit'.-pauseThreadUntil :: MonadIO m => Time -> m ()-pauseThreadUntil t = pauseThread . (t -) =<< time---- | Sleep current thread for the indicated duration (in seconds).---   Divides long sleeps into parts smaller than 'pauseThreadLimit'.-sleepThread :: (RealFrac n, MonadIO m) => n -> m ()-sleepThread n =-    if n >= pauseThreadLimit-    then let n' = pauseThreadLimit - 1-         in pauseThread n >> sleepThread (n - n')-    else pauseThread n---- | Sleep current thread until the given 'Time'.---   Divides long sleeps into parts smaller than 'pauseThreadLimit'.-sleepThreadUntil :: MonadIO m => Time -> m ()-sleepThreadUntil t = sleepThread . (t -) =<< time---- * Pretty printing---- | Detailed 37-character ISO 8601 format, including fractional seconds and '+0000' suffix.-iso_8601_fmt :: String-iso_8601_fmt = "%Y-%m-%dT%H:%M:%S,%q+0000"---- | Parse time according to 'iso_8601_fmt'------ > iso_8601_to_utctime "2015-11-26T00:29:37,145875000000+0000"-iso_8601_to_utctime :: String -> Maybe T.UTCTime-iso_8601_to_utctime = T.parseTimeM True T.defaultTimeLocale iso_8601_fmt---- | UTC time in 'iso_8601_fmt'.------ > tm <- fmap (utctime_to_iso_8601 . T.posixSecondsToUTCTime) T.getPOSIXTime--- > (length tm,sum [4+1+2+1+2,1,2+1+2+1+2,1,12,1,4],sum [10,1,8,1,12,1,4]) == (37,37,37)-utctime_to_iso_8601 :: T.UTCTime -> String-utctime_to_iso_8601 = T.formatTime T.defaultTimeLocale iso_8601_fmt---- | ISO 8601 of 'Time'.------ > tm <- fmap ntpr_to_iso_8601 time--- > import System.Process {- process -}--- > rawSystem "date" ["-d",tm]------ > t = 15708783354150518784--- > s = "2015-11-26T00:22:19,366058349609+0000"--- > ntpr_to_iso_8601 (ntpi_to_ntpr t) == s-ntpr_to_iso_8601 :: Time -> String-ntpr_to_iso_8601 = utctime_to_iso_8601 . T.posixSecondsToUTCTime . ntpr_to_posixtime---- | 'Time' of ISO 8601.------ > t = 15708783354150518784--- > s = "2015-11-26T00:22:19,366058349609+0000"--- > fmap ntpr_to_ntpi (iso_8601_to_ntpr s) == Just t-iso_8601_to_ntpr :: String -> Maybe Time-iso_8601_to_ntpr = fmap (posixtime_to_ntpr . T.utcTimeToPOSIXSeconds) . iso_8601_to_utctime---- | Alias for 'ntpr_to_iso_8601'.------ > time_pp immediately == "1900-01-01T00:00:00,000000000000+0000"--- > fmap time_pp time-time_pp :: Time -> String-time_pp = ntpr_to_iso_8601

@@ -1,93 +0,0 @@--- | An abstract transport layer with implementations for @UDP@ and @TCP@ transport.-module Sound.OSC.Transport.FD where--import Control.Exception {- base -}-import Data.List {- base -}-import Data.Maybe {- base -}--import Sound.OSC.Datum {- hosc -}-import Sound.OSC.Packet {- hosc -}-import qualified Sound.OSC.Wait as Wait {- hosc -}---- | 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 ()---- | Bracket OSC communication.-withTransport :: Transport t => IO t -> (t -> IO a) -> IO a-withTransport u = bracket u close---- * Send---- | 'sendPacket' of 'Packet_Message'.-sendMessage :: Transport t => t -> Message -> IO ()-sendMessage t = sendPacket t . Packet_Message---- | 'sendPacket' of 'Packet_Bundle'.-sendBundle :: Transport t => t -> Bundle -> IO ()-sendBundle t = sendPacket t . Packet_Bundle---- * Receive---- | Variant of 'recvPacket' that runs 'packet_to_bundle'.-recvBundle :: (Transport t) => t -> IO Bundle-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---- | Variant of 'recvPacket' that runs 'packetMessages'.-recvMessages :: (Transport t) => t -> IO [Message]-recvMessages = fmap packetMessages . recvPacket---- * Timeout---- | Variant of 'recvPacket' that implements an /n/ second 'timeout'.-recvPacketTimeout :: (Transport t) => Double -> t -> IO (Maybe Packet)-recvPacketTimeout n fd = Wait.timeout_r n (recvPacket fd)---- * Wait---- | Wait for a 'Packet' where the supplied predicate is 'True',--- discarding intervening packets.-waitUntil :: (Transport t) => t -> (Packet -> Bool) -> IO Packet-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-waitFor t f = Wait.untilMaybe f (recvPacket t)---- | 'waitUntil' 'packet_is_immediate'.-waitImmediate :: Transport t => t -> IO Packet-waitImmediate t = waitUntil t packet_is_immediate---- | '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-waitAddress t s =-    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)---- | Variant of 'waitReply' that runs 'messageDatum'.-waitDatum :: Transport t => t -> Address_Pattern -> IO [Datum]-waitDatum t = fmap messageDatum . waitReply t

@@ -1,95 +0,0 @@--- | OSC over TCP implementation.-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 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.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}---- | Send packet over TCP.-tcp_send_packet :: TCP -> Packet.Packet -> IO ()-tcp_send_packet (TCP fd) p = do-  let b = Builder.encodePacket p-      n = Convert.int64_to_word32 (B.length b)-  B.hPut fd (B.append (Byte.encode_word32 n) b)-  IO.hFlush fd---- | Receive packet over TCP.-tcp_recv_packet :: TCP -> IO Packet.Packet-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)---- | Close TCP.-tcp_close :: TCP -> IO ()-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---- | Bracket UDP 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 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-  _ <- 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)---- | Create and initialise TCP.-tcp_handle :: (N.Socket -> N.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 -}-> 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---- | 'N.accept' connection at /s/ and run /f/.-tcp_server_f :: N.Socket -> (TCP -> IO ()) -> IO ()-tcp_server_f s f = do-  (fd, _) <- N.accept s-  h <- socket_to_tcp fd-  f h---- | 'sequence_' of 'repeat'.-repeatM_ :: (Monad m) => m a -> m ()-repeatM_ = sequence_ . repeat---- | 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-  repeatM_ (tcp_server_f s f)

@@ -1,99 +0,0 @@--- | OSC over UDP implementation.-module Sound.OSC.Transport.FD.UDP where--import Control.Exception {- base -}-import Data.Bifunctor {- base -}--import qualified Network.Socket as N {- network -}-import qualified Network.Socket.ByteString as C {- network -}--import qualified Sound.OSC.Coding.Decode.Binary as Binary {- hosc -}-import qualified Sound.OSC.Coding.Encode.Builder as Builder {- hosc -}-import qualified Sound.OSC.Packet as Packet {- hosc -}-import qualified Sound.OSC.Transport.FD as FD {- hosc -}---- | The UDP transport handle data type.-newtype UDP = UDP {udpSocket :: N.Socket}---- | Return the port number associated with the UDP socket.-udpPort :: Integral n => UDP -> IO n-udpPort = fmap fromIntegral . N.socketPort . udpSocket---- | Send packet over UDP using 'C.sendAll'.-upd_send_packet :: UDP -> Packet.Packet -> IO ()-upd_send_packet (UDP fd) p = C.sendAll fd (Builder.encodePacket_strict p)---- | Receive packet over UDP.-udp_recv_packet :: UDP -> IO Packet.Packet-udp_recv_packet (UDP fd) = fmap Binary.decodePacket_strict (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 = upd_send_packet-   recvPacket = udp_recv_packet-   close = udp_close---- | Bracket UDP communication.-with_udp :: IO UDP -> (UDP -> IO t) -> IO t-with_udp u = bracket u udp_close---- | Create and initialise UDP socket.-udp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO UDP-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))-  let sa = N.addrAddress i-  f fd sa-  return (UDP fd)---- | Set option, ie. 'N.Broadcast' or 'N.RecvTimeOut'.-set_udp_opt :: N.SocketOption -> Int -> UDP -> IO ()-set_udp_opt k v (UDP s) = N.setSocketOption s k v---- | Get option.-get_udp_opt :: N.SocketOption -> UDP -> IO Int-get_udp_opt k (UDP s) = N.getSocketOption s k---- | Make a 'UDP' connection.-openUDP :: String -> Int -> IO UDP-openUDP = udp_socket N.connect--{- | Trivial 'UDP' server socket.--> import Control.Concurrent {- base -}--> let u0 = udpServer "127.0.0.1" 57300-> t0 <- forkIO (FD.withTransport u0 (\fd -> forever (FD.recvMessage fd >>= print)))--> let u1 = openUDP "127.0.0.1" 57300-> FD.withTransport u1 (\fd -> FD.sendMessage fd (Packet.message "/n" []))--}-udpServer :: String -> Int -> IO UDP-udpServer = udp_socket N.bind---- | Variant of 'udpServer' that doesn't require the host address.-udp_server :: Int -> IO UDP-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))-  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 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 fd) = fmap (first Binary.decodePacket_strict) (C.recvFrom fd 8192)

@@ -1,123 +0,0 @@--- | Monad class implementing an Open Sound Control transport.-module Sound.OSC.Transport.Monad where--import Control.Monad {- base -}-import Data.List {- base -}-import Data.Maybe {- base -}--import qualified Control.Monad.Trans.Reader as R {- transformers -}-import qualified Control.Monad.IO.Class as M {- 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.Wait as Wait {- hosc -}---- | Sender monad.-class Monad m => SendOSC m where-   -- | Encode and send an OSC packet.-   sendPacket :: Packet.Packet -> m ()---- | Receiver monad.-class Monad m => RecvOSC m where-   -- | Receive and decode an OSC packet.-   recvPacket :: m Packet.Packet---- | 'DuplexOSC' is the union of 'SendOSC' and 'RecvOSC'.-class (SendOSC m,RecvOSC m) => DuplexOSC m where---- | 'Transport' is 'DuplexOSC' with a 'MonadIO' constraint.-class (DuplexOSC m,M.MonadIO m) => Transport m where---- | 'SendOSC' over 'ReaderT'.-instance (FD.Transport t,M.MonadIO io) => SendOSC (R.ReaderT t io) where-   sendPacket p = R.ReaderT (M.liftIO . flip FD.sendPacket p)---- | 'RecvOSC' over 'ReaderT'.-instance (FD.Transport t,M.MonadIO io) => RecvOSC (R.ReaderT t io) where-   recvPacket = R.ReaderT (M.liftIO . FD.recvPacket)---- | 'DuplexOSC' over 'ReaderT'.-instance (FD.Transport t,M.MonadIO io) => DuplexOSC (R.ReaderT t io) where---- | 'Transport' over 'ReaderT'.-instance (FD.Transport t,M.MonadIO io) => Transport (R.ReaderT t io) where---- | Transport connection.-type Connection t a = R.ReaderT t IO a---- | Bracket Open Sound Control communication.-withTransport :: FD.Transport t => IO t -> Connection t r -> IO r-withTransport u = FD.withTransport u . R.runReaderT---- | 'void' of 'withTransport'.-withTransport_ :: FD.Transport t => IO t -> Connection t r -> IO ()-withTransport_ u = void . withTransport u---- * Send---- | Type restricted synonym for 'sendOSC'.-sendMessage :: SendOSC m => Packet.Message -> m ()-sendMessage = sendPacket . Packet.Packet_Message---- | Type restricted synonym for 'sendOSC'.-sendBundle :: SendOSC m => Packet.Bundle -> m ()-sendBundle = sendPacket . Packet.Packet_Bundle---- * Receive---- | Variant of 'recvPacket' that runs 'packet_to_bundle'.-recvBundle :: (RecvOSC m) => m Packet.Bundle-recvBundle = fmap Packet.packet_to_bundle recvPacket---- | Variant of 'recvPacket' that runs 'packet_to_message'.-recvMessage :: (RecvOSC m) => m (Maybe Packet.Message)-recvMessage = fmap Packet.packet_to_message recvPacket---- | Erroring variant.-recvMessage_err :: RecvOSC m => m Packet.Message-recvMessage_err = fmap (fromMaybe (error "recvMessage")) recvMessage---- | Variant of 'recvPacket' that runs 'packetMessages'.-recvMessages :: (RecvOSC m) => m [Packet.Message]-recvMessages = fmap Packet.packetMessages recvPacket---- * Wait---- | Wait for a 'Packet' where the supplied predicate is 'True',--- discarding intervening packets.-waitUntil :: (RecvOSC m) => (Packet.Packet -> Bool) -> m Packet.Packet-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-waitFor f = Wait.untilMaybe f recvPacket---- | 'waitUntil' 'packet_is_immediate'.-waitImmediate :: RecvOSC m => m Packet.Packet-waitImmediate = waitUntil Packet.packet_is_immediate---- | '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-waitAddress s =-    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)---- | Variant of 'waitReply' that runs 'messageDatum'.-waitDatum :: RecvOSC m => Packet.Address_Pattern -> m [Datum.Datum]-waitDatum = fmap Packet.messageDatum . waitReply

@@ -1,26 +0,0 @@--- | Waiting (for replies).-module Sound.OSC.Wait where--import System.Timeout {- base -}---- * Timeout---- | Variant of 'timeout' where time is given in fractional seconds.-timeout_r :: Double -> IO a -> IO (Maybe a)-timeout_r = timeout . floor . (* 1000000)---- * Wait---- | Repeat action until predicate /f/ is 'True' when applied to result.-untilPredicate :: Monad m => (a -> Bool) -> m a -> m a-untilPredicate f act =-    let g p = if f p then 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

@@ -0,0 +1,8 @@+-- | Composite of "Sound.Osc.Core" and "Sound.Osc.Transport.Monad".+module Sound.Osc (module M) where++import Control.Monad.IO.Class as M (MonadIO, liftIO)+import Sound.Osc.Core as M+import Sound.Osc.Transport.Fd.Udp as M+import Sound.Osc.Transport.Fd.Tcp as M+import Sound.Osc.Transport.Monad as M

@@ -0,0 +1,9 @@+-- | 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

@@ -0,0 +1,339 @@+-- | 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 -}+import Data.Int {- base -}+import Data.Word {- base -}+import System.IO {- 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 Sound.Osc.Coding.Cast as Cast {- hosc -}+import Sound.Osc.Coding.Convert {- hosc -}++-- * Encode++-- | Type specialised 'Binary.encode' (big-endian).+encode_int8 :: Int8 -> L.ByteString+encode_int8 = Binary.encode++-- | Type specialised 'Binary.encode' (big-endian).+--+-- > encode_int16 0x0102 == L.pack [0x01,0x02]+encode_int16 :: Int16 -> L.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++-- | Encode a signed 64-bit integer (big-endian).+encode_int64 :: Int64 -> L.ByteString+encode_int64 = Binary.encode++-- | Type specialised 'Binary.encode' (big-endian).+encode_word8 :: Word8 -> L.ByteString+encode_word8 = Binary.encode++-- | Type specialised 'Binary.encode' (big-endian).+--+-- > encode_word16 0x0102 == L.pack [0x01,0x02]+encode_word16 :: Word16 -> L.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++-- | Type specialised 'Binary.encode'.+encode_word32 :: Word32 -> L.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 an unsigned 64-bit integer.+encode_word64 :: Word64 -> L.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 an un-signed 8-bit integer.+encode_u8 :: Int -> L.ByteString+encode_u8 = encode_word8 . 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++-- | 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 a signed 16-bit integer.+encode_i16 :: Int -> L.ByteString+encode_i16 = Binary.encode . int_to_int16++-- | Encode a signed 32-bit integer.+encode_i32 :: Int -> L.ByteString+encode_i32 = Binary.encode . 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++-- | 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++-- * Encode/Float++{- | Encode a 32-bit IEEE floating point number.++> encode_f32 1.0 == L.pack [63, 128, 0, 0]+-}+encode_f32 :: Float -> L.ByteString+encode_f32 = Binary.encode . Cast.f32_w32++-- | Little-endian variant of 'encode_f32'.+encode_f32_le :: Float -> L.ByteString+encode_f32_le = Put.runPut . Put.putWord32le . Cast.f32_w32++-- | Encode a 64-bit IEEE floating point number.+encode_f64 :: Double -> L.ByteString+encode_f64 = Binary.encode . Cast.f64_w64++-- | Little-endian variant of 'encode_f64'.+encode_f64_le :: Double -> L.ByteString+encode_f64_le = Put.runPut . Put.putWord64le . Cast.f64_w64++-- * 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++-- * Decode++-- | Type specialised 'Binary.decode'.+decode_word16 :: L.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++-- | Type specialised 'Binary.decode'.+decode_int16 :: L.ByteString -> Int16+decode_int16 = Binary.decode++-- | Type specialised 'Binary.decode'.+decode_word32 :: L.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++-- | Type specialised 'Binary.decode'.+decode_int64 :: L.ByteString -> Int64+decode_int64 = Binary.decode++-- | Type specialised 'Binary.decode'.+decode_word64 :: L.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 a signed 8-bit integer.+decode_i8 :: L.ByteString -> Int+decode_i8 = int8_to_int . Binary.decode++-- | Decode an unsigned 8-bit integer.+decode_u16 :: L.ByteString -> Int+decode_u16 = 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 a signed 16-bit integer.+decode_i16 :: L.ByteString -> Int+decode_i16 = 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 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++-- | 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 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_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/Float++-- | Decode a 32-bit IEEE floating point number.+decode_f32 :: L.ByteString -> Float+decode_f32 = Cast.w32_f32 . decode_word32++-- | Little-endian variant of 'decode_f32'.+decode_f32_le :: L.ByteString -> Float+decode_f32_le = Cast.w32_f32 . decode_word32_le++-- | Decode a 64-bit IEEE floating point number.+decode_f64 :: L.ByteString -> Double+decode_f64 b = Cast.w64_f64 (Binary.decode b :: Word64)++-- * Decode/Ascii++-- | Decode an Ascii string, inverse of 'encode_ascii'.+decode_ascii :: L.ByteString -> S.C.ByteString+{-# INLINE decode_ascii #-}+decode_ascii = S.C.pack . L.C.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++-- | Type-specialised reader for 'Binary.decode'.+read_word32 :: Handle -> IO Word32+read_word32 = read_decode Binary.decode 4++-- | 'read_decode' of 'decode_word32_le'.+read_word32_le :: Handle -> IO Word32+read_word32_le = read_decode decode_word32_le 4++-- | 'L.hPut' of 'encode_word32'.+write_word32 :: Handle -> Word32 -> IO ()+write_word32 h = L.hPut h . encode_word32++-- | 'L.hPut' of 'encode_word32_le'.+write_word32_le :: Handle -> Word32 -> IO ()+write_word32_le h = L.hPut h . encode_word32_le++-- * Io/Int++-- | 'decode_i8' of 'L.hGet'.+read_i8 :: Handle -> IO Int+read_i8 = read_decode decode_i8 1++-- | 'decode_i16' of 'L.hGet'.+read_i16 :: Handle -> IO Int+read_i16 = read_decode decode_i16 2++-- | 'decode_i32' of 'L.hGet'.+read_i32 :: Handle -> IO Int+read_i32 = read_decode decode_i32 4++-- | 'decode_i32_le' of 'L.hGet'.+read_i32_le :: Handle -> IO Int+read_i32_le = read_decode decode_i32_le 4++-- | 'decode_u32' of 'L.hGet'.+read_u32 :: Handle -> IO Int+read_u32 = read_decode decode_u32 4++-- | 'decode_u32_le' of 'L.hGet'.+read_u32_le :: Handle -> IO Int+read_u32_le = read_decode decode_u32_le 4++-- | 'L.hPut' of 'encode_u32'.+write_u32 :: Handle -> Int -> IO ()+write_u32 h = L.hPut h . encode_u32++-- | 'L.hPut' of 'encode_u32_le'.+write_u32_le :: Handle -> Int -> IO ()+write_u32_le h = L.hPut h . encode_u32_le++-- * Io/Float++-- | 'decode_f32' of 'L.hGet'.+read_f32 :: Handle -> IO Float+read_f32 = read_decode decode_f32 4++-- | 'decode_f32_le' of 'L.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 h = do+  n <- fmap decode_u8 (L.hGet h 1)+  fmap decode_ascii (L.hGet h n)++-- * Util++{- | Bundle header as a (strict) 'S.C.ByteString'.++> S.C.length bundleHeader_strict == 8+-}+bundleHeader_strict :: S.C.ByteString+bundleHeader_strict = S.C.pack "#bundle\0"++{- | Bundle header as a lazy ByteString.++> L.length bundleHeader == 8+-}+bundleHeader :: L.ByteString+{-# INLINE bundleHeader #-}+bundleHeader = L.C.fromChunks [bundleHeader_strict]++{- | The number of bytes required to align an Osc value to the next 4-byte boundary.++> map align [0::Int .. 7] == [0,3,2,1,0,3,2,1]+> map align [512::Int .. 519] == [0,3,2,1,0,3,2,1]+-}+align :: (Num i,Bits i) => i -> i+{-# INLINE align #-}+align n = ((n + 3) .&. complement 3) - n

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

@@ -0,0 +1,129 @@+-- | Type conversion.+module Sound.Osc.Coding.Convert where++import Data.Int {- base -}+import Data.Word {- base -}++-- * Int -> N++-- | Type specialised 'fromIntegral'+int_to_word8 :: Int -> Word8+int_to_word8 = fromIntegral++-- | Type specialised 'fromIntegral'+int_to_word32 :: Int -> Word32+int_to_word32 = fromIntegral++-- | Type specialised 'fromIntegral'.+int_to_word16 :: Int -> Word16+int_to_word16 = fromIntegral++-- | Type specialised 'fromIntegral'+int_to_int8 :: Int -> Int8+int_to_int8 = fromIntegral++-- | Type specialised 'fromIntegral'+int_to_int16 :: Int -> Int16+int_to_int16 = fromIntegral++-- | Type specialised 'fromIntegral'+int_to_int32 :: Int -> Int32+int_to_int32 = fromIntegral++-- | Type specialised 'fromIntegral'+int_to_int64 :: Int -> Int64+int_to_int64 = fromIntegral++-- * N -> Int++-- | Type specialised 'fromIntegral'+int8_to_int :: Int8 -> Int+int8_to_int = fromIntegral++-- | Type specialised 'fromIntegral'+int16_to_int :: Int16 -> Int+int16_to_int = fromIntegral++-- | Type specialised 'fromIntegral'+int32_to_int :: Int32 -> Int+int32_to_int = fromIntegral++-- | Type specialised 'fromIntegral'+int64_to_int :: Int64 -> Int+int64_to_int = fromIntegral++-- | Type specialised 'fromIntegral'+word8_to_int :: Word8 -> Int+word8_to_int = fromIntegral++-- | Type specialised 'fromIntegral'+word16_to_int :: Word16 -> Int+word16_to_int = fromIntegral++-- | Type specialised 'fromIntegral'+word32_to_int :: Word32 -> Int+word32_to_int = fromIntegral++-- * N -> N++-- | Type specialised 'fromIntegral'+word16_to_word32 :: Word16 -> Word32+word16_to_word32 = fromIntegral++-- | Type specialised 'fromIntegral'+word32_to_word16 :: Word32 -> Word16+word32_to_word16 = fromIntegral++-- | Type specialised 'fromIntegral'+word32_to_int32 :: Word32 -> Int32+word32_to_int32 = fromIntegral++-- | Type specialised 'fromIntegral'+word32_to_int64 :: Word32 -> Int64+word32_to_int64 = fromIntegral++-- | Type specialised 'fromIntegral'+word64_to_int64 :: Word64 -> Int64+word64_to_int64 = fromIntegral++-- | Type specialised 'fromIntegral'+int64_to_int32 :: Int64 -> Int32+int64_to_int32 = fromIntegral++-- | Type specialised 'fromIntegral'+int64_to_word32 :: Int64 -> Word32+int64_to_word32 = fromIntegral++-- * N -> Real++-- | Type specialised 'fromIntegral'+word64_to_double :: Word64 -> Double+word64_to_double = fromIntegral++-- * Enum++-- | Type-specialised 'toEnum' of 'fromIntegral'+word8_to_enum :: Enum e => Word8 -> e+word8_to_enum = toEnum . fromIntegral++-- | Type-specialised 'toEnum' of 'fromIntegral'+word16_to_enum :: Enum e => Word16 -> e+word16_to_enum = toEnum . fromIntegral++-- | Type-specialised 'fromIntegral' of 'fromEnum'.+enum_to_word8 :: Enum e => e -> Word8+enum_to_word8 = fromIntegral . fromEnum++-- | Type-specialised 'fromIntegral' of 'fromEnum'.+enum_to_word16 :: Enum e => e -> Word16+enum_to_word16 = fromIntegral . fromEnum++-- * Enum/Char++-- | Type-specialised 'word8_to_enum'.+word8_to_char :: Word8 -> Char+word8_to_char = word8_to_enum++-- | Type-specialised 'enum_to_word8'.+char_to_word8 :: Char -> Word8+char_to_word8 = enum_to_word8

@@ -0,0 +1,109 @@+-- | 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 -}+import qualified Data.ByteString.Lazy as B {- bytestring -}+import Data.List {- base -}+import Data.Maybe {- base -}++import Sound.Osc.Coding.Byte {- hosc -}+import Sound.Osc.Coding.Convert {- hosc -}+import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc -}+import Sound.Osc.Time {- hosc -}++-- | 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"++-- | 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++-- | 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] ++ ")")++-- | 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'))++-- | 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++-- | 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++-- | Decode an Osc 'Bundle'.+decodeBundle :: B.ByteString -> Bundle+decodeBundle b =+    let h = storage 's' b -- header (should be '#bundle')+        t = storage 't' (b_drop h b) -- time+        (TimeStamp timeStamp) = decode_datum 't' (b_drop h b)+        ms = decode_message_seq (b_drop (h+t) b)+    in Bundle timeStamp ms++-- | Decode an Osc 'Packet'.+--+-- > let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+-- > decodePacket b == Packet_Message (Message "/g_free" [Int32 0])+decodePacket :: B.ByteString -> Packet+decodePacket b =+    if bundleHeader `B.isPrefixOf` b+    then Packet_Bundle (decodeBundle b)+    else Packet_Message (decodeMessage b)++-- * UTIL++-- | 'B.take' with 'Int' count.+b_take :: Int -> B.ByteString -> B.ByteString+b_take = B.take . int_to_int64++-- | 'B.drop' with 'Int' count.+b_drop :: Int -> B.ByteString -> B.ByteString+b_drop = B.drop . int_to_int64

@@ -0,0 +1,132 @@+-- | Optimised decode function for Osc packets.+module Sound.Osc.Coding.Decode.Binary+    (get_packet+    ,decodeMessage+    ,decodeBundle+    ,decodePacket+    ,decodePacket_strict) 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.Char8 as ByteString.Lazy.Char8 {- bytestring -}++import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}+import Sound.Osc.Coding.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)++-- | 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))++-- | 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++-- | 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)++-- | 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)++-- | 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)++-- | Get a bundle. Fail if bundle header is not found in packet.+get_bundle :: Binary.Get Bundle+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++-- | Get an Osc 'Packet'.+get_packet :: Binary.Get Packet+get_packet = fmap Packet_Bundle get_bundle <|> fmap Packet_Message get_message++{-# INLINE decodeMessage #-}+{-# INLINE decodeBundle #-}+{-# INLINE decodePacket #-}+{-# INLINE decodePacket_strict #-}++{- | 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]+-}+decodeMessage :: ByteString.Lazy.ByteString -> Message+decodeMessage = Binary.runGet get_message++-- | Decode an Osc 'Bundle' from a lazy ByteString.+decodeBundle :: ByteString.Lazy.ByteString -> Bundle+decodeBundle = Binary.runGet get_bundle++{- | 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])+-}+decodePacket :: ByteString.Lazy.ByteString -> Packet+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 . (:[])

@@ -0,0 +1,74 @@+-- | 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 -}+import qualified Data.ByteString.Char8 as C {- bytestring -}+import qualified Data.ByteString.Lazy as B {- bytestring -}++import Sound.Osc.Coding.Byte {- hosc -}+import Sound.Osc.Coding.Convert {- hosc -}+import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc -}+import Sound.Osc.Time {- hosc -}++-- | Align byte string, if required.+extend :: Word8 -> B.ByteString -> B.ByteString+extend p s = B.append s (B.replicate (align (B.length s)) p)++{- | Encode Osc 'Datum'.++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 :: 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)++{- | 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]+-}+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) ]++-- | Encode Osc 'Message' as an Osc blob.+encode_message_blob :: Message -> Datum+encode_message_blob = Blob . encodeMessage++{- | 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]+-}+encodeBundle :: Bundle -> B.ByteString+encodeBundle (Bundle t 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 o =+    case o of+      Packet_Message m -> encodeMessage m+      Packet_Bundle b -> encodeBundle b

@@ -0,0 +1,110 @@+-- | Optimised encode function for Osc packets.+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 Sound.Osc.Coding.Byte as Byte {- hosc -}+import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}+import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc -}+import Sound.Osc.Time {- hosc -}++-- | Generate a list of zero bytes for padding.+padding :: Int -> [Word8]+padding n = replicate n 0++-- | Nul byte (0) and then zero padding.+nul_and_padding :: Int -> B.Builder+nul_and_padding n = B.fromWord8s (0 : padding (Byte.align n))++-- Encode a string with zero padding.+build_ascii :: Ascii -> B.Builder+build_ascii s = B.fromByteString s <> nul_and_padding (S.length s + 1)++-- Encode a string with zero padding.+build_string :: String -> B.Builder+build_string s = B.fromString s <> nul_and_padding (length s + 1)++-- 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))))++-- 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++-- Encode an Osc 'Message'.+build_message :: Message -> B.Builder+build_message (Message c l) =+    mconcat [build_string c+            ,build_ascii (descriptor l)+            ,mconcat (map build_datum l)]++-- Encode an Osc 'Bundle'.+build_bundle_ntpi :: 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)]++-- | Builder for an Osc 'Packet'.+build_packet :: Packet -> B.Builder+build_packet o =+    case o of+      Packet_Message m -> build_message m+      Packet_Bundle (Bundle t m) -> build_bundle_ntpi (ntpr_to_ntpi t) m++{-# INLINE encodePacket #-}+{-# INLINE encodeMessage #-}+{-# INLINE encodeBundle #-}+{-# INLINE encodePacket_strict #-}++-- | Encode an Osc 'Packet'.+encodePacket :: Packet -> 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++-}+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++-}+encodeBundle :: Bundle -> L.ByteString+encodeBundle = encodePacket . Packet_Bundle++-- | Encode an Osc 'Packet' to a strict 'S.ByteString'.+encodePacket_strict :: Packet -> S.ByteString+encodePacket_strict = B.toByteString . build_packet

@@ -0,0 +1,23 @@+{- | Composite of non-transport related modules.++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++-}+module Sound.Osc.Core (module M) where++import Sound.Osc.Coding.Decode.Binary as M+import Sound.Osc.Coding.Encode.Builder as M+import Sound.Osc.Datum as M+import Sound.Osc.Packet as M+import Sound.Osc.Time as M+import Sound.Osc.Time.System as M+import Sound.Osc.Time.Thread as M+import Sound.Osc.Time.Thread.MonadIO as M+import Sound.Osc.Wait as M

@@ -0,0 +1,225 @@+-- | Osc data types.+module Sound.Osc.Datum where++import Data.Int {- base -}+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 -}++-- * Datum++-- | Type enumerating Datum categories.+type DatumType = Char++-- | Type for Ascii strings (strict Char8 ByteString)+type Ascii = ByteString.Char8.ByteString++-- | Type-specialised pack.+ascii :: String -> Ascii+ascii = ByteString.Char8.pack++-- | Type-specialised unpack.+ascii_to_string :: Ascii -> String+ascii_to_string = ByteString.Char8.unpack++-- | Type for 'Word8' arrays, these are stored with an 'Int32' length prefix.+type Blob = ByteString.Lazy.ByteString++-- | Type-specialised pack.+blob_pack ::  [Word8] -> Blob+blob_pack = ByteString.Lazy.pack++-- | Type-specialised unpack.+blob_unpack :: Blob -> [Word8]+blob_unpack = ByteString.Lazy.unpack++-- | Type-specialised unpack.+blob_unpack_int :: Blob -> [Int]+blob_unpack_int = map fromIntegral . blob_unpack++-- | Four-byte midi message: port-id, status-byte, data, data.+data MidiData = MidiData !Word8 !Word8 !Word8 !Word8+    deriving (Ord, Eq, Show, Read)++midi_pack ::  [Word8] -> MidiData+midi_pack w =+  case w of+    [m1, m2, m3, m4] -> MidiData m1 m2 m3 m4+    _ -> error "midi_pack?"++-- | Type-specialised unpack.+midi_unpack_int :: MidiData -> [Int]+midi_unpack_int (MidiData m1 m2 m3 m4) = map fromIntegral [m1, m2, m3, m4]++{- | A real-valued time stamp.+For Osc proper this is an Ntp64 time in real-valued (fractional) form.+For SuperCollider Nrt programs this is elapsed time since the start of the score.+This is the primary form of timestamp used by hosc.+-}+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)++-- * Datum types++-- | List of required data types (tag, name).+osc_types_required :: [(DatumType,String)]+osc_types_required =+    [('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")+    -- ,('c',"Character")+    -- ,('r',"RGBA")+    ,('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)]+osc_types = osc_types_required ++ osc_types_optional++-- | Lookup name of type.+osc_type_name :: DatumType -> Maybe String+osc_type_name c = lookup c osc_types++-- | Erroring variant.+osc_type_name_err :: DatumType -> String+osc_type_name_err = fromMaybe (error "osc_type_name") . osc_type_name++-- | 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'++-- | 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)++-- * 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_integral :: Integral i => Datum -> Maybe i+datum_integral d =+    case d of+      Int32 x -> Just (fromIntegral x)+      Int64 x -> Just (fromIntegral x)+      _ -> Nothing++-- | 'Datum' as 'Floating' if 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_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++-- * Constructors++-- | Type generalised 'Int32'.+--+-- > int32 (1::Int32) == int32 (1::Integer)+-- > d_int32 (int32 (maxBound::Int32)) == maxBound+-- > int32 (((2::Int) ^ (64::Int))::Int) == Int32 0+int32 :: Integral n => n -> Datum+int32 = Int32 . fromIntegral++-- | Type generalised Int64.+--+-- > int64 (1::Int32) == int64 (1::Integer)+-- > d_int64 (int64 (maxBound::Int64)) == maxBound+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+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+double :: Real n => n -> Datum+double = Double . realToFrac++-- | 'AsciiString' of pack.+--+-- > string "string" == AsciiString (ByteString.Char8.pack "string")+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)++-- | 'Blob' of 'blob_pack'.+blob :: [Word8] -> Datum+blob = Blob . blob_pack++-- * Descriptor++{- | Message argument types are given by a signature.++> 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 :: [Datum] -> Ascii+descriptor = ascii . signatureFor++-- | Descriptor tags are @comma@ prefixed.+descriptor_tags :: Ascii -> Ascii+descriptor_tags = ByteString.Char8.drop 1

@@ -0,0 +1,7 @@+-- | Composite of "Sound.Osc.Core" and "Sound.Osc.Transport.Fd".+module Sound.Osc.Fd (module M) where++import Sound.Osc.Core as M+import Sound.Osc.Transport.Fd as M+import Sound.Osc.Transport.Fd.Udp as M+import Sound.Osc.Transport.Fd.Tcp as M

@@ -0,0 +1,129 @@+-- | Data types for Osc messages, bundles and packets.+module Sound.Osc.Packet where++import Sound.Osc.Datum {- hosc -}++-- * 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@.+type Address_Pattern = String++-- | An Osc message, an 'Address_Pattern' and a sequence of '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 :: Address_Pattern -> [Datum] -> Message+message a xs =+    case a of+      '/':_ -> Message a xs+      _ -> error "message: ill-formed address pattern"++messageSignature :: Message -> String+messageSignature = signatureFor . messageDatum++messageDescriptor :: Message -> Ascii+messageDescriptor = descriptor . messageDatum++-- * Bundle++{- | An Osc bundle, a 'Time' and a sequence of 'Message's.+Do not allow recursion, all contents must be messages.+-}+data Bundle =+  Bundle+  {bundleTime :: !Time+  ,bundleMessages :: ![Message]}+  deriving (Eq,Read,Show)++-- | Osc 'Bundle's can be ordered (time ascending).+instance Ord Bundle where+    compare (Bundle a _) (Bundle b _) = compare a b++-- | 'Bundle' constructor. It is an 'error' if the 'Message' list is empty.+bundle :: Time -> [Message] -> Bundle+bundle t xs =+    case xs of+      [] -> error "bundle: empty?"+      _ -> Bundle t xs++-- * Packet++-- | An Osc 'Packet' is either a 'Message' or a 'Bundle'.+data Packet =+  Packet_Message {packetMessage :: !Message} |+  Packet_Bundle {packetBundle :: !Bundle}+  deriving (Eq,Read,Show)++-- | 'Packet_Bundle' of 'bundle'.+p_bundle :: Time -> [Message] -> Packet+p_bundle t = Packet_Bundle . bundle t++-- | 'Packet_Message' of 'message'.+p_message :: Address_Pattern -> [Datum] -> Packet+p_message a = Packet_Message . message a++{- | Constant indicating a bundle to be executed immediately.  It has the Ntp64 representation of @1@.++> ntpr_to_ntpi immediately == 1+-}+immediately :: Time+immediately = 1 / 2^(32::Int)++-- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is 'immediately'.+packetTime :: Packet -> Time+packetTime = at_packet (const immediately) bundleTime++-- | Retrieve the set of 'Message's from a 'Packet'.+packetMessages :: Packet -> [Message]+packetMessages = at_packet return bundleMessages++-- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.+packet_to_bundle :: Packet -> Bundle+packet_to_bundle = at_packet (\m -> Bundle immediately [m]) id++-- | If 'Packet' is a 'Message' or a 'Bundle' with an /immediate/ time+-- tag and with one element, return the 'Message', else 'Nothing'.+packet_to_message :: Packet -> Maybe Message+packet_to_message p =+    case p of+      Packet_Bundle b ->+          case b of+            Bundle t [m] -> if t == immediately then Just m else Nothing+            _ -> Nothing+      Packet_Message m -> Just m++-- | Is 'Packet' immediate, ie. a 'Bundle' with timestamp 'immediately', or a plain Message.+packet_is_immediate :: Packet -> Bool+packet_is_immediate = (== immediately) . packetTime++-- | Variant of 'either' for 'Packet'.+at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a+at_packet f g p =+    case p of+      Packet_Message m -> f m+      Packet_Bundle b -> g b++-- * Address Query++-- | Does 'Message' have the specified 'Address_Pattern'.+message_has_address :: Address_Pattern -> Message -> Bool+message_has_address x = (== x) . messageAddress++-- | Do any of the 'Message's at 'Bundle' have the specified+-- 'Address_Pattern'.+bundle_has_address :: Address_Pattern -> Bundle -> Bool+bundle_has_address x = any (message_has_address x) . bundleMessages++-- | Does 'Packet' have the specified 'Address_Pattern', ie.+-- 'message_has_address' or 'bundle_has_address'.+packet_has_address :: Address_Pattern -> Packet -> Bool+packet_has_address x =+    at_packet (message_has_address x)+              (bundle_has_address x)

@@ -0,0 +1,256 @@+-- | A simple and unambigous text encoding for Osc.+module Sound.Osc.Text where++import Control.Monad {- base -}+import Data.Char {- base -}+import Numeric {- base -}+import Text.Printf {- base -}++import qualified Text.ParserCombinators.Parsec as P {- parsec -}++import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet  {- hosc3 -}+import Sound.Osc.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"]+-}+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'++{- | Hex encoded byte sequence.++> 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"]+-}+escapeString :: String -> String+escapeString txt =+  case txt of+    [] -> []+    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"]+-}+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)++{- | 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++> 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+-}+showMessage :: FpPrecision -> Message -> String+showMessage precision aMessage =+  unwords+  [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+-}+showBundle :: FpPrecision -> Bundle -> 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)]++-- | Printer for Packet.+showPacket :: FpPrecision -> Packet -> String+showPacket precision = at_packet (showMessage precision) (showBundle precision)++-- * Parser++-- | A character parser with no user state.+type P a = P.GenParser Char () a++-- | Run p then q, returning result of p.+(>>~) :: Monad m => m t -> m u -> m t+p >>~ q = p >>= \x -> q >> return x++-- | /p/ as lexeme, i.e. consuming any trailing white space.+lexemeP :: P t -> P t+lexemeP p = p >>~ P.many P.space++-- | Any non-space character.  Allow escaped space.+stringCharP :: P Char+stringCharP = (P.char '\\' >> P.space) P.<|> P.satisfy (\c -> not (isSpace c))++-- | Parser for string.+stringP :: P String+stringP = lexemeP (P.many1 stringCharP)++-- | Parser for Osc address.+oscAddressP :: P String+oscAddressP = do+  forwardSlash <- P.char '/'+  address <- stringP+  return (forwardSlash : address)++-- | 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))++-- | Parser for decimal digit.+digitP :: P Char+digitP = P.oneOf "0123456789"++allowNegativeP :: Num n => P n -> P n+allowNegativeP p = do+  let optionMaybe x = P.option Nothing (liftM Just x) -- hugs...+  maybeNegative <- optionMaybe (P.char '-')+  number <- p+  return (maybe number (const (negate number)) maybeNegative)++-- | Parser for non-negative integer.+nonNegativeIntegerP :: (Integral n, Read n) => P n+nonNegativeIntegerP = lexemeP (fmap read (P.many1 digitP))++-- | Parser for integer.+integerP :: (Integral n, Read n) => P n+integerP = allowNegativeP nonNegativeIntegerP++-- | 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])))++-- | Parser for non-negative float.+floatP :: (Fractional n, Read n) => P n+floatP = allowNegativeP nonNegativeFloatP++-- | Parser for hexadecimal digit.+hexdigitP :: P Char+hexdigitP = P.oneOf "0123456789abcdef"++-- | Byte parser.+byteP :: (Integral n, Read n) => P n+byteP = do+  c1 <- hexdigitP+  c2 <- hexdigitP+  case readHex [c1, c2] of+    [(r,"")] -> return r+    _ -> error "byteP?"++-- | Byte sequence parser.+byteSeqP :: (Integral n, Read n) => P [n]+byteSeqP = lexemeP (P.many1 byteP)++-- | Datum parser.+datumP :: Char -> P Datum+datumP typeChar = do+  case typeChar of+    'i' -> fmap Int32 integerP+    'f' -> fmap Float floatP+    's' -> fmap string stringP+    'b' -> fmap blob byteSeqP+    'h' -> fmap Int64 integerP+    'd' -> fmap Double floatP+    'm' -> fmap (Midi . midi_pack) (replicateM 4 byteP)+    't' -> fmap (TimeStamp . ntpi_to_ntpr) integerP+    _ -> error "datumP: type?"++-- | Message parser.+messageP :: P Message+messageP = do+  address <- oscAddressP+  typeSignature <- oscSignatureP+  datum <- mapM datumP (tail typeSignature)+  return (Message address datum)++-- | Bundle tag parser.+bundleTagP :: P String+bundleTagP = lexemeP (P.string "#bundle")++-- | Bundle parser.+bundleP :: P Bundle+bundleP = do+  _ <- bundleTagP+  timestamp <- fmap ntpi_to_ntpr integerP+  messageCount <- integerP+  messages <- replicateM messageCount messageP+  return (Bundle timestamp messages)++-- | Packet parser.+packetP :: P Packet+packetP = (fmap Packet_Bundle bundleP) P.<|> (fmap Packet_Message messageP)++-- | Run parser.+runP :: P t -> String -> t+runP p txt =+  case P.parse p "" txt of+    Left err -> error (show err)+    Right r -> r++{- | Run datum parser.++> parseDatum 'i' "-1" == Int32 (-1)+> parseDatum 'f' "-2.3" == Float (-2.3)+-}+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+-}+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+-}+parseBundle :: String -> Bundle+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+-}+parsePacket :: String -> Packet+parsePacket = runP packetP

@@ -0,0 +1,107 @@+-- | Osc related timing functions.+--   Osc timestamps are 64-bit @Ntp@ values, <http://ntp.org/>.+module Sound.Osc.Time where++import Data.Word {- base -}++import qualified Data.Time as Time {- time -}+import qualified Data.Time.Clock as Clock {- time -}+import qualified Data.Time.Clock.POSIX as Clock.Posix {- time -}++import Sound.Osc.Coding.Convert {- hosc -}++-- * 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 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.+type PosixReal = Double++-- * Time conversion++{- | Convert an NtpReal timestamp to an Ntp64 timestamp.++> ntpr_to_ntpi 0 == 0+> fmap ntpr_to_ntpi time+-}+ntpr_to_ntpi :: NtpReal -> Ntp64+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 :: Ntp64 -> NtpReal+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 :: Num n => n+ntp_posix_epoch_diff = (70 * 365 + 17) * 24 * 60 * 60++-- | Convert a PosixReal timestamp to an Ntp64 timestamp.+posix_to_ntpi :: PosixReal -> Ntp64+posix_to_ntpi t = ntpr_to_ntpi (t + ntp_posix_epoch_diff)++-- | Convert @Unix/Posix@ to @Ntp@.+posix_to_ntpr :: Num n => n -> n+posix_to_ntpr = (+) ntp_posix_epoch_diff++-- | Convert @Ntp@ to @Unix/Posix@.+ntpr_to_posix :: Num n => n -> n+ntpr_to_posix = (+) (negate ntp_posix_epoch_diff)++-- | Convert 'Ntp64' to @Unix/Posix@.+ntpi_to_posix :: Ntp64 -> PosixReal+ntpi_to_posix = ntpr_to_posix . ntpi_to_ntpr++-- | Convert 'Time' to 'Clock.Posix.POSIXTime'.+ntpr_to_posixtime :: NtpReal -> Clock.Posix.POSIXTime+ntpr_to_posixtime = realToFrac . ntpr_to_posix++-- | Convert 'Clock.Posix.POSIXTime' to 'Time'.+posixtime_to_ntpr :: Clock.Posix.POSIXTime -> NtpReal+posixtime_to_ntpr = posix_to_ntpr . realToFrac++-- * 'Data.Time' inter-operation.++-- | 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++-- | Convert 'Time.UTCTime' to @Unix/Posix@.+utc_to_posix :: Fractional n => Time.UTCTime -> n+utc_to_posix t = realToFrac (Time.diffUTCTime t posix_epoch)++-- * Clock operations++-- | utc_to_posix of Clock.getCurrentTime.+getCurrentTimeAsPosix :: IO PosixReal+getCurrentTimeAsPosix = fmap utc_to_posix Clock.getCurrentTime++{- | realToFrac of Clock.Posix.getPOSIXTime++> get_ct = getCurrentTimeAsPosix+> get_pt = getPosixTimeAsPosix+> (ct,pt) <- get_ct >>= \t0 -> get_pt >>= \t1 -> return (t0,t1)+> print (pt - ct,pt - ct < 1e-5)+-}+getPosixTimeAsPosix :: IO PosixReal+getPosixTimeAsPosix = fmap realToFrac Clock.Posix.getPOSIXTime++-- | Read current real-valued @Ntp@ timestamp.+currentTime :: IO NtpReal+currentTime = fmap posixtime_to_ntpr Clock.Posix.getPOSIXTime

@@ -0,0 +1,24 @@+-- | System time+module Sound.Osc.Time.System where++import Data.Int {- base -}+import Data.Word {- base -}++import qualified Data.Time.Clock.System as Clock.System {- time >= 1.8 -}++import Sound.Osc.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+getSystemTimeAsNtpReal = do+  tm <- Clock.System.getSystemTime+  return (fromIntegral (Clock.System.systemSeconds tm) + (fromIntegral (Clock.System.systemNanoseconds tm) * 1.0e-9))++-- | System time with fractional part in microseconds (us) instead of nanoseconds (ns).+getSystemTimeInMicroseconds :: IO (Int64, Word32)+getSystemTimeInMicroseconds = do+  tm <- Clock.System.getSystemTime+  let sec = Clock.System.systemSeconds tm+      usec = Clock.System.systemNanoseconds tm `div` 1000+  return (sec, usec)

@@ -0,0 +1,35 @@+-- | Thread operations.+module Sound.Osc.Time.Thread where++import Control.Concurrent {- base -}+import Control.Monad {- base -}++import Sound.Osc.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@.+pauseThreadLimit :: Fractional n => n+pauseThreadLimit = fromIntegral (maxBound::Int) / 1e6++-- | Pause current thread for the indicated duration (in seconds), see 'pauseThreadLimit'.+pauseThreadFor :: RealFrac n => n -> IO ()+pauseThreadFor n = when (n > 0) (threadDelay (floor (n * 1e6)))++-- | Pause current thread until the given time, see 'pauseThreadLimit'.+pauseThreadUntilTime :: RealFrac n => n -> IO ()+pauseThreadUntilTime t = pauseThreadFor . (t -) . realToFrac =<< currentTime++-- | 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')+    else pauseThreadFor n++-- | 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

@@ -0,0 +1,25 @@+-- | MonadIO lifted forms of Sound.Osc.Time.Thread functions+module Sound.Osc.Time.Thread.MonadIO where++import Control.Monad.IO.Class {- base >= 4.9 -}++import Sound.Osc.Time {- hosc -}+import Sound.Osc.Time.Thread {- hosc -}++time :: MonadIO m => m NtpReal+time = liftIO currentTime++pauseThread :: (MonadIO m,RealFrac n) => n -> m ()+pauseThread = liftIO . pauseThreadFor++wait :: MonadIO m => Double -> m ()+wait = pauseThread++pauseThreadUntil :: (MonadIO m,RealFrac n) => n -> m ()+pauseThreadUntil = liftIO . pauseThreadUntilTime++sleepThread :: (RealFrac n, MonadIO m) => n -> m ()+sleepThread = liftIO . sleepThreadFor++sleepThreadUntil :: (RealFrac n, MonadIO m) => n -> m ()+sleepThreadUntil = liftIO . sleepThreadUntilTime

@@ -0,0 +1,15 @@+-- | Timeout, implemented independently of socket timeout setting.+module Sound.Osc.Time.Timeout where++import System.Timeout {- base -}++import Sound.Osc.Packet {- hsoc -}+import Sound.Osc.Transport.Fd {- hosc -}++-- | Variant of 'timeout' where time is given in fractional seconds.+timeout_r :: Double -> IO a -> IO (Maybe a)+timeout_r = timeout . floor . (* 1000000)++-- | Variant of 'recvPacket' that implements an /n/ second 'timeout'.+recvPacketTimeout :: Transport t => Double -> t -> IO (Maybe Packet)+recvPacketTimeout n fd = timeout_r n (recvPacket fd)

@@ -0,0 +1,87 @@+-- | An abstract transport layer with implementations for @Udp@ and @Tcp@ transport.+module Sound.Osc.Transport.Fd where++import Control.Exception {- base -}+import Data.List {- base -}+import Data.Maybe {- base -}++import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc -}+import qualified Sound.Osc.Wait as Wait {- hosc -}++-- | 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 ()++-- | Bracket Osc communication.+withTransport :: Transport t => IO t -> (t -> IO a) -> IO a+withTransport u = bracket u close++-- * Send++-- | 'sendPacket' of 'Packet_Message'.+sendMessage :: Transport t => t -> Message -> IO ()+sendMessage t = sendPacket t . Packet_Message++-- | 'sendPacket' of 'Packet_Bundle'.+sendBundle :: Transport t => t -> Bundle -> IO ()+sendBundle t = sendPacket t . Packet_Bundle++-- * Receive++-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.+recvBundle :: (Transport t) => t -> IO Bundle+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++-- | 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+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+waitFor t f = Wait.untilMaybe f (recvPacket t)++-- | 'waitUntil' 'packet_is_immediate'.+waitImmediate :: Transport t => t -> IO Packet+waitImmediate t = waitUntil t packet_is_immediate++-- | '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+waitAddress t s =+    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)++-- | Variant of 'waitReply' that runs 'messageDatum'.+waitDatum :: Transport t => t -> Address_Pattern -> IO [Datum]+waitDatum t = fmap messageDatum . waitReply t

@@ -0,0 +1,95 @@+-- | Osc over Tcp implementation.+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 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.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}++-- | Send data over Tcp.+tcp_send_data :: Tcp -> B.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++-- | Send packet over Tcp.+tcp_send_packet :: Tcp -> Packet.Packet -> IO ()+tcp_send_packet tcp p = tcp_send_data tcp (Builder.encodePacket p)++-- | Receive packet over Tcp.+tcp_recv_packet :: Tcp -> IO Packet.Packet+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)++-- | Close Tcp.+tcp_close :: Tcp -> IO ()+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++-- | Bracket UDP 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 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+  _ <- 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)++-- | Create and initialise Tcp.+tcp_handle :: (N.Socket -> N.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 -}+> 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++-- | 'N.accept' connection at /s/ and run /f/.+tcp_server_f :: N.Socket -> (Tcp -> IO ()) -> IO ()+tcp_server_f s f = do+  (fd, _) <- N.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+  let repeatM_ = sequence_ . repeat+  repeatM_ (tcp_server_f s f)

@@ -0,0 +1,113 @@+-- | Osc over Udp implementation.+module Sound.Osc.Transport.Fd.Udp where++import Control.Exception {- base -}+import Control.Monad {- base -}+import Data.Bifunctor {- base -}++import qualified Data.ByteString  as B {- bytestring -}+import qualified Network.Socket as N {- network -}+import qualified Network.Socket.ByteString as C {- network -}++import qualified Sound.Osc.Coding.Decode.Binary as Binary {- hosc -}+import qualified Sound.Osc.Coding.Encode.Builder as Builder {- hosc -}+import qualified Sound.Osc.Packet as Packet {- hosc -}+import qualified Sound.Osc.Transport.Fd as Fd {- hosc -}++-- | The Udp transport handle data type.+newtype Udp = Udp {udpSocket :: N.Socket}++-- | Return the port number associated with the Udp socket.+udpPort :: Integral n => Udp -> IO n+udpPort = fmap fromIntegral . N.socketPort . udpSocket++-- | Send data over Udp using 'C.send'.+udp_send_data :: Udp -> B.ByteString -> IO ()+udp_send_data (Udp fd) d = do+  let l = B.length d+  n <- C.send fd d+  when (n /= l) (error (show ("udp_send_data", l, n)))++-- | Send data over Udp using 'C.sendAll'.+udp_sendAll_data :: Udp -> B.ByteString -> IO ()+udp_sendAll_data (Udp fd) = C.sendAll fd++-- | Send packet over Udp.+udp_send_packet :: Udp -> Packet.Packet -> 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 fd) = fmap Binary.decodePacket_strict (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++-- | Bracket Udp communication.+with_udp :: IO Udp -> (Udp -> IO t) -> IO t+with_udp u = bracket u udp_close++-- | Create and initialise Udp socket.+udp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO Udp+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))+  let sa = N.addrAddress i+  f fd sa+  return (Udp fd)++-- | Set option, ie. 'N.Broadcast' or 'N.RecvTimeOut'.+set_udp_opt :: N.SocketOption -> Int -> Udp -> IO ()+set_udp_opt k v (Udp s) = N.setSocketOption s k v++-- | Get option.+get_udp_opt :: N.SocketOption -> Udp -> IO Int+get_udp_opt k (Udp s) = N.getSocketOption s k++-- | Make a 'Udp' connection.+openUdp :: String -> Int -> IO Udp+openUdp = udp_socket N.connect++{- | Trivial 'Udp' server socket.++> import Control.Concurrent {- base -}++> let u0 = udpServer "127.0.0.1" 57300+> t0 <- forkIO (Fd.withTransport u0 (\fd -> forever (Fd.recvMessage fd >>= print >> print "Received message, continuing")))+> killThread t0++> let u1 = openUdp "127.0.0.1" 57300+> Fd.withTransport u1 (\fd -> Fd.sendMessage fd (Packet.message "/n" []))+-}+udpServer :: String -> Int -> IO Udp+udpServer = udp_socket N.bind++-- | Variant of 'udpServer' that doesn't require the host address.+udp_server :: Int -> IO Udp+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))+  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 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 fd) = fmap (first Binary.decodePacket_strict) (C.recvFrom fd 8192)

@@ -0,0 +1,123 @@+-- | Monad class implementing an Open Sound Control transport.+module Sound.Osc.Transport.Monad where++import Control.Monad {- base -}+import Control.Monad.IO.Class {- base -}+import Data.List {- base -}+import Data.Maybe {- base -}++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.Wait as Wait {- hosc -}++-- | Sender monad.+class Monad m => SendOsc m where+   -- | Encode and send an Osc packet.+   sendPacket :: Packet.Packet -> m ()++-- | Receiver monad.+class Monad m => RecvOsc m where+   -- | Receive and decode an Osc packet.+   recvPacket :: m Packet.Packet++-- | 'DuplexOsc' is the union of 'SendOsc' and 'RecvOsc'.+class (SendOsc m,RecvOsc m) => DuplexOsc m where++-- | 'Transport' is 'DuplexOsc' with a 'MonadIO' constraint.+class (DuplexOsc m,MonadIO m) => Transport m where++-- | 'SendOsc' over 'ReaderT'.+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)++-- | 'DuplexOsc' over 'ReaderT'.+instance (Fd.Transport t,MonadIO io) => DuplexOsc (R.ReaderT t io) where++-- | 'Transport' over 'ReaderT'.+instance (Fd.Transport t,MonadIO io) => Transport (R.ReaderT t io) where++-- | Transport connection.+type Connection t a = R.ReaderT t IO a++-- | Bracket Open Sound Control communication.+withTransport :: Fd.Transport t => IO t -> Connection t r -> IO r+withTransport u = Fd.withTransport u . R.runReaderT++-- | 'void' of 'withTransport'.+withTransport_ :: Fd.Transport t => IO t -> Connection t r -> IO ()+withTransport_ u = void . withTransport u++-- * Send++-- | Type restricted synonym for 'sendOsc'.+sendMessage :: SendOsc m => Packet.Message -> m ()+sendMessage = sendPacket . Packet.Packet_Message++-- | Type restricted synonym for 'sendOsc'.+sendBundle :: SendOsc m => Packet.Bundle -> m ()+sendBundle = sendPacket . Packet.Packet_Bundle++-- * Receive++-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.+recvBundle :: (RecvOsc m) => m Packet.Bundle+recvBundle = fmap Packet.packet_to_bundle recvPacket++-- | Variant of 'recvPacket' that runs 'packet_to_message'.+recvMessage :: (RecvOsc m) => m (Maybe Packet.Message)+recvMessage = fmap Packet.packet_to_message recvPacket++-- | Erroring variant.+recvMessage_err :: RecvOsc m => m Packet.Message+recvMessage_err = fmap (fromMaybe (error "recvMessage")) recvMessage++-- | Variant of 'recvPacket' that runs 'packetMessages'.+recvMessages :: (RecvOsc m) => m [Packet.Message]+recvMessages = fmap Packet.packetMessages recvPacket++-- * Wait++-- | Wait for a 'Packet' where the supplied predicate is 'True',+-- discarding intervening packets.+waitUntil :: (RecvOsc m) => (Packet.Packet -> Bool) -> m Packet.Packet+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+waitFor f = Wait.untilMaybe f recvPacket++-- | 'waitUntil' 'packet_is_immediate'.+waitImmediate :: RecvOsc m => m Packet.Packet+waitImmediate = waitUntil Packet.packet_is_immediate++-- | '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+waitAddress s =+    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)++-- | Variant of 'waitReply' that runs 'messageDatum'.+waitDatum :: RecvOsc m => Packet.Address_Pattern -> m [Datum.Datum]+waitDatum = fmap Packet.messageDatum . waitReply

@@ -0,0 +1,18 @@+-- | Waiting (for replies).+module Sound.Osc.Wait where++-- * Wait++-- | Repeat action until predicate /f/ is 'True' when applied to result.+untilPredicate :: Monad m => (a -> Bool) -> m a -> m a+untilPredicate f act =+    let g p = if f p then 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

@@ -1,21 +1,18 @@+Cabal-Version:     2.4 Name:              hosc-Version:           0.19.1+Version:           0.20 Synopsis:          Haskell Open Sound Control-Description:       @hosc@ implements a subset of the Open Sound Control-                   byte protocol, <http://opensoundcontrol.org/>.-                   .-                   See "Sound.OSC.Core" or "Sound.OSC" or "Sound.OSC.FD".-License:           GPL-3+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-2021+Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2007-2022 Author:            Rohan Drape, Stefan Kersten Maintainer:        rd@rohandrape.net Stability:         Experimental Homepage:          http://rohandrape.net/t/hosc-Tested-With:       GHC == 8.8.4+Tested-With:       GHC == 9.4.3 Build-Type:        Simple-Cabal-Version:     >= 1.10 Data-Files:        README.md  Library@@ -25,30 +22,35 @@                    bytestring,                    data-binary-ieee754,                    network >= 2.3,+                   parsec,                    time >= 1.5,                    transformers   Default-Language:Haskell2010   GHC-Options:     -Wall -fwarn-tabs-  if impl(ghc < 8.4)-    cpp-options: -DIMPORT_SEMIGROUP-  Exposed-modules: Sound.OSC-                   Sound.OSC.Coding.Byte-                   Sound.OSC.Coding.Cast-                   Sound.OSC.Coding.Convert-                   Sound.OSC.Coding.Decode.Base-                   Sound.OSC.Coding.Decode.Binary-                   Sound.OSC.Coding.Encode.Base-                   Sound.OSC.Coding.Encode.Builder-                   Sound.OSC.Core-                   Sound.OSC.Datum-                   Sound.OSC.FD-                   Sound.OSC.Packet-                   Sound.OSC.Time-                   Sound.OSC.Transport.FD-                   Sound.OSC.Transport.FD.TCP-                   Sound.OSC.Transport.FD.UDP-                   Sound.OSC.Transport.Monad-                   Sound.OSC.Wait+  Exposed-modules: Sound.Osc+                   Sound.Osc.Alias+                   Sound.Osc.Coding.Byte+                   Sound.Osc.Coding.Cast+                   Sound.Osc.Coding.Convert+                   Sound.Osc.Coding.Decode.Base+                   Sound.Osc.Coding.Decode.Binary+                   Sound.Osc.Coding.Encode.Base+                   Sound.Osc.Coding.Encode.Builder+                   Sound.Osc.Core+                   Sound.Osc.Datum+                   Sound.Osc.Fd+                   Sound.Osc.Packet+                   Sound.Osc.Text+                   Sound.Osc.Time+                   Sound.Osc.Time.System+                   Sound.Osc.Time.Thread+                   Sound.Osc.Time.Thread.MonadIO+                   Sound.Osc.Time.Timeout+                   Sound.Osc.Transport.Fd+                   Sound.Osc.Transport.Fd.Tcp+                   Sound.Osc.Transport.Fd.Udp+                   Sound.Osc.Transport.Monad+                   Sound.Osc.Wait  Source-Repository  head   Type:            git