diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -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/
diff --git a/Sound/OSC.hs b/Sound/OSC.hs
deleted file mode 100644
--- a/Sound/OSC.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Coding/Byte.hs b/Sound/OSC/Coding/Byte.hs
deleted file mode 100644
--- a/Sound/OSC/Coding/Byte.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Coding/Cast.hs b/Sound/OSC/Coding/Cast.hs
deleted file mode 100644
--- a/Sound/OSC/Coding/Cast.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Coding/Convert.hs b/Sound/OSC/Coding/Convert.hs
deleted file mode 100644
--- a/Sound/OSC/Coding/Convert.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Coding/Decode/Base.hs b/Sound/OSC/Coding/Decode/Base.hs
deleted file mode 100644
--- a/Sound/OSC/Coding/Decode/Base.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Coding/Decode/Binary.hs b/Sound/OSC/Coding/Decode/Binary.hs
deleted file mode 100644
--- a/Sound/OSC/Coding/Decode/Binary.hs
+++ /dev/null
@@ -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 . (:[])
diff --git a/Sound/OSC/Coding/Encode/Base.hs b/Sound/OSC/Coding/Encode/Base.hs
deleted file mode 100644
--- a/Sound/OSC/Coding/Encode/Base.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Coding/Encode/Builder.hs b/Sound/OSC/Coding/Encode/Builder.hs
deleted file mode 100644
--- a/Sound/OSC/Coding/Encode/Builder.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Core.hs b/Sound/OSC/Core.hs
deleted file mode 100644
--- a/Sound/OSC/Core.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Datum.hs b/Sound/OSC/Datum.hs
deleted file mode 100644
--- a/Sound/OSC/Datum.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/FD.hs b/Sound/OSC/FD.hs
deleted file mode 100644
--- a/Sound/OSC/FD.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Packet.hs b/Sound/OSC/Packet.hs
deleted file mode 100644
--- a/Sound/OSC/Packet.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Time.hs b/Sound/OSC/Time.hs
deleted file mode 100644
--- a/Sound/OSC/Time.hs
+++ /dev/null
@@ -1,183 +0,0 @@
--- | OSC related timing functions.
--- OSC timestamps are 64-bit @NTP@ values, .
-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
diff --git a/Sound/OSC/Transport/FD.hs b/Sound/OSC/Transport/FD.hs
deleted file mode 100644
--- a/Sound/OSC/Transport/FD.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Transport/FD/TCP.hs b/Sound/OSC/Transport/FD/TCP.hs
deleted file mode 100644
--- a/Sound/OSC/Transport/FD/TCP.hs
+++ /dev/null
@@ -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)
diff --git a/Sound/OSC/Transport/FD/UDP.hs b/Sound/OSC/Transport/FD/UDP.hs
deleted file mode 100644
--- a/Sound/OSC/Transport/FD/UDP.hs
+++ /dev/null
@@ -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)
diff --git a/Sound/OSC/Transport/Monad.hs b/Sound/OSC/Transport/Monad.hs
deleted file mode 100644
--- a/Sound/OSC/Transport/Monad.hs
+++ /dev/null
@@ -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
diff --git a/Sound/OSC/Wait.hs b/Sound/OSC/Wait.hs
deleted file mode 100644
--- a/Sound/OSC/Wait.hs
+++ /dev/null
@@ -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
diff --git a/Sound/Osc.hs b/Sound/Osc.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc.hs
@@ -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
diff --git a/Sound/Osc/Alias.hs b/Sound/Osc/Alias.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Alias.hs
@@ -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
diff --git a/Sound/Osc/Coding/Byte.hs b/Sound/Osc/Coding/Byte.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Coding/Byte.hs
@@ -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
diff --git a/Sound/Osc/Coding/Cast.hs b/Sound/Osc/Coding/Cast.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Coding/Cast.hs
@@ -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
diff --git a/Sound/Osc/Coding/Convert.hs b/Sound/Osc/Coding/Convert.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Coding/Convert.hs
@@ -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
diff --git a/Sound/Osc/Coding/Decode/Base.hs b/Sound/Osc/Coding/Decode/Base.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Coding/Decode/Base.hs
@@ -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
diff --git a/Sound/Osc/Coding/Decode/Binary.hs b/Sound/Osc/Coding/Decode/Binary.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Coding/Decode/Binary.hs
@@ -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 . (:[])
diff --git a/Sound/Osc/Coding/Encode/Base.hs b/Sound/Osc/Coding/Encode/Base.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Coding/Encode/Base.hs
@@ -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
diff --git a/Sound/Osc/Coding/Encode/Builder.hs b/Sound/Osc/Coding/Encode/Builder.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Coding/Encode/Builder.hs
@@ -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
diff --git a/Sound/Osc/Core.hs b/Sound/Osc/Core.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Core.hs
@@ -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
diff --git a/Sound/Osc/Datum.hs b/Sound/Osc/Datum.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Datum.hs
@@ -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
diff --git a/Sound/Osc/Fd.hs b/Sound/Osc/Fd.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Fd.hs
@@ -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
diff --git a/Sound/Osc/Packet.hs b/Sound/Osc/Packet.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Packet.hs
@@ -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)
diff --git a/Sound/Osc/Text.hs b/Sound/Osc/Text.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Text.hs
@@ -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
diff --git a/Sound/Osc/Time.hs b/Sound/Osc/Time.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Time.hs
@@ -0,0 +1,107 @@
+-- | Osc related timing functions.
+-- Osc timestamps are 64-bit @Ntp@ values, .
+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
diff --git a/Sound/Osc/Time/System.hs b/Sound/Osc/Time/System.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Time/System.hs
@@ -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)
diff --git a/Sound/Osc/Time/Thread.hs b/Sound/Osc/Time/Thread.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Time/Thread.hs
@@ -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
diff --git a/Sound/Osc/Time/Thread/MonadIO.hs b/Sound/Osc/Time/Thread/MonadIO.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Time/Thread/MonadIO.hs
@@ -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
diff --git a/Sound/Osc/Time/Timeout.hs b/Sound/Osc/Time/Timeout.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Time/Timeout.hs
@@ -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)
diff --git a/Sound/Osc/Transport/Fd.hs b/Sound/Osc/Transport/Fd.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Transport/Fd.hs
@@ -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
diff --git a/Sound/Osc/Transport/Fd/Tcp.hs b/Sound/Osc/Transport/Fd/Tcp.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Transport/Fd/Tcp.hs
@@ -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)
diff --git a/Sound/Osc/Transport/Fd/Udp.hs b/Sound/Osc/Transport/Fd/Udp.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Transport/Fd/Udp.hs
@@ -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)
diff --git a/Sound/Osc/Transport/Monad.hs b/Sound/Osc/Transport/Monad.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Transport/Monad.hs
@@ -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
diff --git a/Sound/Osc/Wait.hs b/Sound/Osc/Wait.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Osc/Wait.hs
@@ -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
diff --git a/hosc.cabal b/hosc.cabal
--- a/hosc.cabal
+++ b/hosc.cabal
@@ -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, .
- .
- 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