hosc 0.15 → 0.16

raw patch · 32 files changed

+1158/−909 lines, 32 filesdep −QuickCheckdep −criteriondep −deepseqdep ~basedep ~bytestringdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies removed: QuickCheck, criterion, deepseq, hosc, test-framework, test-framework-quickcheck2

Dependency ranges changed: base, bytestring, time

API changes (from Hackage documentation)

Files

• README +2/−3
• Sound/OSC/Class.hs +0/−31
• Sound/OSC/Coding.hs +0/−48
• Sound/OSC/Coding/Byte.hs +145/−29
• Sound/OSC/Coding/Cast.hs +5/−9
• Sound/OSC/Coding/Class.hs +47/−0
• Sound/OSC/Coding/Convert.hs +54/−0
• Sound/OSC/Coding/Decode/Base.hs +8/−3
• Sound/OSC/Coding/Decode/Binary.hs +29/−12
• Sound/OSC/Coding/Encode/Base.hs +13/−14
• Sound/OSC/Coding/Encode/Builder.hs +26/−19
• Sound/OSC/Core.hs +15/−17
• Sound/OSC/Datum.hs +254/−43
• Sound/OSC/Datum/Datem.hs +129/−0
• Sound/OSC/Datum/Normalise.hs +65/−0
• Sound/OSC/Datum/Unpack.hs +44/−0
• Sound/OSC/Normalise.hs +0/−64
• Sound/OSC/Packet.hs +136/−0
• Sound/OSC/Packet/Class.hs +30/−0
• Sound/OSC/Packet/Coerce.hs +13/−0
• Sound/OSC/Time.hs +64/−6
• Sound/OSC/Transport/FD.hs +8/−8
• Sound/OSC/Transport/FD/TCP.hs +21/−10
• Sound/OSC/Transport/FD/UDP.hs +14/−5
• Sound/OSC/Transport/Monad.hs +13/−4
• Sound/OSC/Type.hs +0/−399
• Sound/OSC/Wait.hs +8/−10
• benchmarks/Sound/OSC/NFData.hs +0/−26
• benchmarks/benchmark.hs +0/−32
• hosc.cabal +15/−51
• tests/Sound/OSC/Arbitrary.hs +0/−43
• tests/test.hs +0/−23

@@ -5,12 +5,11 @@ module implementing a subset of the [Open Sound Control][osc] byte protocol. hosc is required by the [hsc3][hsc3] haskell [supercollider][sc3] bindings. -There are a number of related projects:+See also:  - [hosc-json](?t=hosc-json): JSON text encoding of OSC-- [hosc-utils](?t=hosc-utils): command line utilities -© [rohan drape][rd], [stefan kersten][sk] and others, 2007-2014,+© [rohan drape][rd], [stefan kersten][sk] and others, 2007-2017, [gpl][gpl]. with contributions by:  - [alex mclean][am]

@@ -1,31 +0,0 @@--- | Typeclass for encoding and decoding OSC packets.-module Sound.OSC.Class where--import Sound.OSC.Type-import Sound.OSC.Coding---- | A type-class for values that can be translated to and from OSC--- 'Packet's.-class OSC o where-    toPacket :: o -> Packet -- ^ Translation to 'Packet'.-    fromPacket :: Packet -> Maybe o -- ^ Translation from 'Packet'.--instance OSC Message where-    toPacket = Packet_Message-    fromPacket = packet_to_message--instance OSC Bundle where-    toPacket = Packet_Bundle-    fromPacket = Just . packet_to_bundle--instance OSC Packet where-    toPacket = id-    fromPacket = Just---- | 'encodePacket' '.' 'toPacket'.-encodeOSC :: (Coding c,OSC o) => o -> c-encodeOSC = encodePacket . toPacket---- | 'fromPacket' '.' 'decodePacket'.-decodeOSC :: (Coding c,OSC o) => c -> Maybe o-decodeOSC = fromPacket . decodePacket

@@ -1,48 +0,0 @@-{-# LANGUAGE FlexibleInstances,TypeSynonymInstances #-}--- | A type-class to provide coding operations to different data types---   using the same function names.-module Sound.OSC.Coding where--import qualified Data.ByteString as S {- bytestring -}-import qualified Data.ByteString.Lazy as B {- bytestring -}-import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -}--import Sound.OSC.Type-import qualified Sound.OSC.Coding.Decode.Binary as Binary-import qualified Sound.OSC.Coding.Encode.Builder as Builder---- | Converting from and to binary packet representations.-class Coding a where-    encodePacket :: Packet -> a -- ^ Decode an OSC packet.-    decodePacket :: a -> Packet -- ^ Encode an OSC packet.--instance Coding S.ByteString where-    encodePacket = Builder.encodePacket_strict-    decodePacket = Binary.decodePacket_strict--instance Coding B.ByteString where-    encodePacket = Builder.encodePacket-    decodePacket = Binary.decodePacket--instance Coding String where-    encodePacket = C.unpack . encodePacket-    decodePacket = decodePacket . C.pack---- | An 'encodePacket' and 'decodePacket' pair over 'B.ByteString'.-type Coder = (Packet -> B.ByteString,B.ByteString -> Packet)---- | 'encodePacket' '.' 'Packet_Message'.-encodeMessage :: Coding c => Message -> c-encodeMessage = encodePacket . Packet_Message---- | 'encodePacket' '.' 'Packet_Bundle'.-encodeBundle :: Coding c => Bundle -> c-encodeBundle = encodePacket . Packet_Bundle---- | 'packet_to_message' '.' 'decodePacket'.-decodeMessage :: Coding c => c -> Maybe Message-decodeMessage = packet_to_message . decodePacket---- | 'packet_to_bundle' '.' 'decodePacket'.-decodeBundle :: Coding c => c -> Bundle-decodeBundle = packet_to_bundle . decodePacket

@@ -1,98 +1,214 @@ -- | Byte-level coding utility functions.+--   Plain forms are big-endian, little-endian forms have @_le@ suffix. module Sound.OSC.Coding.Byte where -import Data.Binary {- base -} 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 Data.Int {- base -} -import Sound.OSC.Coding.Cast-import Sound.OSC.Type+import qualified Sound.OSC.Coding.Cast as Cast {- hosc -}+import Sound.OSC.Coding.Convert {- hosc -} +-- * Encode+ -- | Encode a signed 8-bit integer. encode_i8 :: Int -> L.ByteString-encode_i8 n = encode (fromIntegral n :: Int8)+encode_i8 = Binary.encode . int_to_int8  -- | Encode an un-signed 8-bit integer. encode_u8 :: Int -> L.ByteString-encode_u8 n = encode (fromIntegral n :: Word8)+encode_u8 = Binary.encode . int_to_word8 +-- | Type specialised 'Binary.encode'.+--+-- > encode_w16 0x0102 == L.pack [1,2]+encode_w16 :: Word16 -> L.ByteString+encode_w16 = Binary.encode++-- | Little-endian.+--+-- > encode_w16_le 0x0102 == L.pack [2,1]+encode_w16_le :: Word16 -> L.ByteString+encode_w16_le = Put.runPut . Put.putWord16le++-- | Encode an un-signed 16-bit integer.+--+-- > encode_u16 0x0102 == L.pack [1,2]+encode_u16 :: Int -> L.ByteString+encode_u16 = encode_w16 . int_to_word16++-- | Little-endian.+--+-- > encode_u16_le 0x0102 == L.pack [2,1]+encode_u16_le :: Int -> L.ByteString+encode_u16_le = encode_w16_le . int_to_word16+ -- | Encode a signed 16-bit integer. encode_i16 :: Int -> L.ByteString-encode_i16 n = encode (fromIntegral n :: Int16)+encode_i16 = Binary.encode . int_to_int16  -- | Encode a signed 32-bit integer. encode_i32 :: Int -> L.ByteString-encode_i32 n = encode (fromIntegral n :: Int32)+encode_i32 = Binary.encode . int_to_int32 --- | Encode an unsigned 16-bit integer.+-- | Type specialised 'Binary.encode'.+encode_w32 :: Word32 -> L.ByteString+encode_w32 = Binary.encode++-- | Encode an unsigned 32-bit integer.+--+-- > encode_u32 0x01020304 == L.pack [1,2,3,4] encode_u32 :: Int -> L.ByteString-encode_u32 n = encode (fromIntegral n :: Word32)+encode_u32 = encode_w32 . int_to_word32 +-- | Little-endian variant of 'encode_w32'.+encode_w32_le :: Word32 -> L.ByteString+encode_w32_le = Put.runPut . Put.putWord32le++-- | Little-endian.+--+-- > encode_u32_le 0x01020304 == L.pack [4,3,2,1]+encode_u32_le :: Int -> L.ByteString+encode_u32_le = encode_w32_le . int_to_word32+ -- | Encode a signed 64-bit integer. encode_i64 :: Int64 -> L.ByteString-encode_i64 = encode+encode_i64 = Binary.encode  -- | Encode an unsigned 64-bit integer. encode_u64 :: Word64 -> L.ByteString-encode_u64 = encode+encode_u64 = Binary.encode  -- | Encode a 32-bit IEEE floating point number. encode_f32 :: Float -> L.ByteString-encode_f32 = encode . f32_w32+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 = encode . f64_w64+encode_f64 = Binary.encode . Cast.f64_w64 --- | Encode an ASCII string.-encode_str :: ASCII -> L.ByteString+-- | Encode an ASCII string (ASCII at Datum is an alias for a Char8 Bytetring).+encode_str :: S.C.ByteString -> L.ByteString {-# INLINE encode_str #-} encode_str = L.pack . S.unpack +-- * Decode+ -- | Decode an un-signed 8-bit integer. decode_u8 :: L.ByteString -> Int-decode_u8 = fromIntegral . L.head+decode_u8 = word8_to_int . L.head  -- | Decode a signed 8-bit integer. decode_i8 :: L.ByteString -> Int-decode_i8 b = fromIntegral (decode b :: Int8)+decode_i8 = int8_to_int . Binary.decode +-- | Type specialised 'Binary.decode'.+decode_word16 :: L.ByteString -> Word16+decode_word16 = 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_word16'.+decode_word16_le :: L.ByteString -> Word16+decode_word16_le = Get.runGet Get.getWord16le++-- | Little-endian variant of 'decode_u16'.+decode_u16_le :: L.ByteString -> Int+decode_u16_le = word16_to_int . decode_word16_le++-- | Type specialised 'Binary.decode'.+decode_int16 :: L.ByteString -> Int16+decode_int16 = Binary.decode+ -- | Decode a signed 16-bit integer. decode_i16 :: L.ByteString -> Int-decode_i16 b = fromIntegral (decode b :: Int16)+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.ByteString -> Int-decode_i32 b = fromIntegral (decode b :: Int32)+decode_i32 = int32_to_int . Binary.decode +-- | Type specialised 'Binary.decode'.+decode_word32 :: L.ByteString -> Word32+decode_word32 = Binary.decode+ -- | Decode an unsigned 32-bit integer.+--+-- > decode_u32 (L.pack [1,2,3,4]) == 0x01020304 decode_u32 :: L.ByteString -> Int-decode_u32 b = fromIntegral (decode b :: Word32)+decode_u32 = word32_to_int . decode_word32 --- | Decode a signed 64-bit integer.+-- | Little-endian variant of 'decode_word32'.+decode_word32_le :: L.ByteString -> Word32+decode_word32_le = Get.runGet Get.getWord32le++-- | 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++-- | Type specialised 'Binary.decode'. decode_i64 :: L.ByteString -> Int64-decode_i64 = decode+decode_i64 = Binary.decode --- | Decode an unsigned 64-bit integer.+-- | Type specialised 'Binary.decode'. decode_u64 :: L.ByteString -> Word64-decode_u64 = decode+decode_u64 = Binary.decode  -- | Decode a 32-bit IEEE floating point number. decode_f32 :: L.ByteString -> Float-decode_f32 b = w32_f32 (decode b :: Word32)+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 = w64_f64 (decode b :: Word64)+decode_f64 b = Cast.w64_f64 (Binary.decode b :: Word64) --- | Decode an ASCII string.-decode_str :: L.ByteString -> ASCII+-- | Decode an ASCII string, inverse of 'encode_str'.+decode_str :: L.ByteString -> S.C.ByteString {-# INLINE decode_str #-} decode_str = S.C.pack . L.C.unpack++-- * IO++-- | 'decode_u32' of 'L.hGet'.+read_u32 :: Handle -> IO Int+read_u32 = fmap decode_u32 . flip L.hGet 4++-- | 'decode_u32_le' of 'L.hGet'.+read_u32_le :: Handle -> IO Int+read_u32_le = fmap decode_u32_le . flip L.hGet 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  -- | Bundle header as a (strict) 'S.C.ByteString'. bundleHeader_strict :: S.C.ByteString

@@ -1,13 +1,11 @@ -- | Bit-level type casts and byte layout string typecasts.-module Sound.OSC.Coding.Cast (f32_w32,w32_f32-                             ,f64_w64,w64_f64-                             ,str_cstr,cstr_str-                             ,str_pstr,pstr_str) where+module Sound.OSC.Coding.Cast where -import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -} import Data.Char {- base -} import Data.Word {- base -} +import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}+ -- | The IEEE byte representation of a float. f32_w32 :: Float -> Word32 f32_w32 = I.floatToWord@@ -24,8 +22,7 @@ w64_f64 :: Word64 -> Double w64_f64 = I.wordToDouble --- | Transform a haskell string into a C string (a null suffixed byte---   string).+-- | Transform a haskell string into a C string (a null suffixed byte string). str_cstr :: String -> [Word8] str_cstr s = map (fromIntegral . ord) s ++ [0] @@ -33,8 +30,7 @@ cstr_str :: [Word8] -> String cstr_str = map (chr . fromIntegral) . takeWhile (/= 0) --- | Transform a haskell string to a pascal string (a length prefixed---   byte string).+-- | Transform a haskell string to a pascal string (a length prefixed byte string). str_pstr :: String -> [Word8] str_pstr s = fromIntegral (length s) : map (fromIntegral . ord) s 

@@ -0,0 +1,47 @@+-- | A type-class to provide coding operations to different data types+--   using the same function names.+module Sound.OSC.Coding.Class where++import qualified Data.ByteString as Strict {- bytestring -}+import qualified Data.ByteString.Lazy as Lazy {- bytestring -}++import Sound.OSC.Packet {- hosc -}+import qualified Sound.OSC.Coding.Decode.Binary as Binary {- hosc -}+import qualified Sound.OSC.Coding.Encode.Builder as Builder {- hosc -}++-- | Converting from and to binary packet representations.+class Coding a where+    encodePacket :: Packet -> a -- ^ Decode an OSC packet.+    decodePacket :: a -> Packet -- ^ Encode an OSC packet.++instance Coding Strict.ByteString where+    encodePacket = Builder.encodePacket_strict+    decodePacket = Binary.decodePacket_strict++instance Coding Lazy.ByteString where+    encodePacket = Builder.encodePacket+    decodePacket = Binary.decodePacket++{-+{-# LANGUAGE FlexibleInstances #-}+import qualified Data.ByteString.Lazy.Char8 as Char8 {- bytestring -}+instance Coding String where+    encodePacket = Char8.unpack . encodePacket+    decodePacket = decodePacket . Char8.pack+-}++-- | 'encodePacket' '.' 'Packet_Message'.+encodeMessage :: Coding c => Message -> c+encodeMessage = encodePacket . Packet_Message++-- | 'encodePacket' '.' 'Packet_Bundle'.+encodeBundle :: Coding c => Bundle -> c+encodeBundle = encodePacket . Packet_Bundle++-- | 'packet_to_message' '.' 'decodePacket'.+decodeMessage :: Coding c => c -> Maybe Message+decodeMessage = packet_to_message . decodePacket++-- | 'packet_to_bundle' '.' 'decodePacket'.+decodeBundle :: Coding c => c -> Bundle+decodeBundle = packet_to_bundle . decodePacket

@@ -0,0 +1,54 @@+-- | Type conversion.+module Sound.OSC.Coding.Convert where++import Data.Int {- base -}+import Data.Word {- base -}++-- | 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'+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'+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+

@@ -10,9 +10,10 @@ import Data.List {- base -} import Data.Maybe {- base -} -import Sound.OSC.Coding.Byte-import Sound.OSC.Time-import Sound.OSC.Type+import Sound.OSC.Coding.Byte {- 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@@ -97,8 +98,12 @@     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 . fromIntegral +-- | 'B.drop' with 'Int' count. b_drop :: Int -> B.ByteString -> B.ByteString b_drop = B.drop . fromIntegral

@@ -1,6 +1,8 @@ -- | Optimised decode function for OSC packets. module Sound.OSC.Coding.Decode.Binary-    (getPacket+    (get_packet+    ,decodeMessage+    ,decodeBundle     ,decodePacket     ,decodePacket_strict) where @@ -14,9 +16,10 @@ import Data.Int {- base -} import Data.Word {- base -} -import Sound.OSC.Coding.Byte-import Sound.OSC.Time-import Sound.OSC.Type+import Sound.OSC.Coding.Byte {- hosc -}+import Sound.OSC.Datum {- hosc -}+import Sound.OSC.Packet {- hosc -}+import Sound.OSC.Time {- hosc -}  -- | Get a 32 bit integer in big-endian byte order. getInt32be :: G.Get Int32@@ -67,7 +70,7 @@                 return $ Midi (MIDI b0 b1 b2 b3)       _ -> fail ("get_datum: illegal type " ++ show ty) --- | Get an OSC 'Message'.+-- | Get an OSC 'Message', fail if type descriptor is invalid. get_message :: G.Get Message get_message = do     cmd <- get_string@@ -99,18 +102,32 @@     return $ Bundle t ps  -- | Get an OSC 'Packet'.-getPacket :: G.Get Packet-getPacket = (Packet_Bundle <$> get_bundle) <|> (Packet_Message <$> get_message)+get_packet :: G.Get Packet+get_packet = (Packet_Bundle <$> get_bundle) <|> (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]--- > in decodeOSC b == Message "/g_free" [Int 0]+-- > decodePacket b == Packet_Message (Message "/g_free" [Int32 0]) decodePacket :: B.ByteString -> Packet-{-# INLINE decodePacket #-}-decodePacket = G.runGet getPacket+decodePacket = G.runGet get_packet  -- | Decode an OSC packet from a strict ByteString. decodePacket_strict :: S.C.ByteString -> Packet-{-# INLINE decodePacket_strict #-}-decodePacket_strict = G.runGet getPacket . B.fromChunks . (:[])+decodePacket_strict = G.runGet get_packet . B.fromChunks . (:[])

@@ -1,22 +1,21 @@--- | Base-level encode function for OSC packets (slow).  For ordinary---   use see 'Sound.OSC.Coding.Encode.Builder'.-module Sound.OSC.Coding.Encode.Base (encodeMessage-                                    ,encodeBundle-                                    ,encodePacket) where+-- | 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-import Sound.OSC.Type-import Sound.OSC.Time+import Sound.OSC.Coding.Byte {- hosc -}+import Sound.OSC.Datum {- hosc -}+import Sound.OSC.Packet {- hosc -}+import Sound.OSC.Time {- hosc -} --- Align a byte string if required.+-- | 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 an OSC datum.+-- | Encode OSC 'Datum'. encode_datum :: Datum -> B.ByteString encode_datum dt =     case dt of@@ -30,25 +29,25 @@       Blob b -> let n = encode_i32 (fromIntegral (B.length b))                 in B.append n (extend 0 b) --- | Encode an OSC 'Message'.+-- | 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 an OSC 'Message' as an OSC blob.+-- | Encode OSC 'Message' as an OSC blob. encode_message_blob :: Message -> Datum encode_message_blob = Blob . encodeMessage --- | Encode an OSC 'Bundle'.+-- | Encode OSC 'Bundle'. encodeBundle :: Bundle -> B.ByteString encodeBundle (Bundle t m) =     B.concat [bundleHeader              ,encode_u64 (ntpr_to_ntpi t)              ,B.concat (map (encode_datum . encode_message_blob) m)] --- | Encode an OSC 'Packet'.+-- | Encode OSC 'Packet'. encodePacket :: Packet -> B.ByteString encodePacket o =     case o of

@@ -6,35 +6,40 @@     ,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 Data.Monoid (mappend, mconcat) {- base -}-import Data.Word (Word8) {- base -} -import Sound.OSC.Coding.Byte (align, bundleHeader)-import Sound.OSC.Time-import Sound.OSC.Type+import qualified Sound.OSC.Coding.Byte as Byte {- hosc -}+import Sound.OSC.Datum {- hosc -}+import Sound.OSC.Packet {- hosc -}+import Sound.OSC.Time {- hosc -} --- Generate a list of zero bytes for padding.+-- | Generate a list of zero bytes for padding. padding :: Integral i => i -> [Word8] padding n = replicate (fromIntegral 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 `mappend` B.fromWord8s (0:padding (align (S.length s + 1)))+build_ascii s = B.fromByteString s `mappend` nul_and_padding (S.length s + 1)  -- Encode a string with zero padding. build_string :: String -> B.Builder-build_string s = B.fromString s `mappend` B.fromWord8s (0:padding (align (length s + 1)))+build_string s = B.fromString s `mappend` 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 (fromIntegral (L.length s))                 `mappend` B.fromLazyByteString s-                `mappend` B.fromWord8s (padding (align (L.length s)))+                `mappend` B.fromWord8s (padding (Byte.align (L.length s)))  -- Encode an OSC datum. build_datum :: Datum -> B.Builder@@ -54,16 +59,16 @@ build_message (Message c l) =     mconcat [build_string c             ,build_ascii (descriptor l)-            ,mconcat $ map build_datum l]+            ,mconcat (map build_datum l)]  -- Encode an OSC 'Bundle'. build_bundle_ntpi :: NTPi -> [Message] -> B.Builder build_bundle_ntpi t l =-    mconcat [B.fromLazyByteString bundleHeader+    mconcat [B.fromLazyByteString Byte.bundleHeader             ,B.fromWord64be t-            ,mconcat $ map (build_bytes . B.toLazyByteString . build_message) l]+            ,mconcat (map (build_bytes . B.toLazyByteString . build_message) l)] --- | Builder monoid for an OSC 'Packet'.+-- | Builder for an OSC 'Packet'. build_packet :: Packet -> B.Builder build_packet o =     case o of@@ -75,7 +80,12 @@ {-# INLINE encodePacket #-} {-# INLINE encodePacket_strict #-} --- | Encode an OSC 'Message'.+{- | Encode an OSC 'Message'.++> let b = L.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+> encodeMessage (Message "/g_free" [Int32 0]) == b++-} encodeMessage :: Message -> L.ByteString encodeMessage = B.toLazyByteString . build_packet . Packet_Message @@ -83,13 +93,10 @@ encodeBundle :: Bundle -> L.ByteString encodeBundle = B.toLazyByteString . build_packet . Packet_Bundle --- | Encode an OSC 'Packet' to a lazy 'L.ByteString'.------ > let b = L.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]--- > in encodeOSC (Message "/g_free" [Int 0]) == b+-- | Encode an OSC 'Packet'. encodePacket :: Packet -> L.ByteString encodePacket = B.toLazyByteString . build_packet --- | Encode an Packet packet to a strict ByteString.+-- | Encode an OSC 'Packet' to a strict 'S.ByteString'. encodePacket_strict :: Packet -> S.ByteString encodePacket_strict = B.toByteString . build_packet

@@ -1,22 +1,20 @@--- | Composite of non-transport related modules.------ Provides the 'Datum', 'Message', 'Bundle' and 'Packet' types and--- the 'Datem', 'OSC' and 'Coding' type-classes.------ The basic constructors are 'message' and 'bundle', the basic coding--- functions are 'encodePacket' and 'decodePacket'.------ > import Sound.OSC.Core--- >--- > let {o = bundle immediately [message "/g_free" [Int32 0]]--- >     ;e = encodeBundle o :: String}--- > in decodeBundle e == o+{- | 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.Class as M-import Sound.OSC.Coding as M+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.Normalise as M+import Sound.OSC.Packet as M import Sound.OSC.Time as M-import Sound.OSC.Type as M import Sound.OSC.Wait as M

@@ -1,64 +1,275 @@--- | 'Datum' related functions.+-- | Data type for OSC datum. module Sound.OSC.Datum where -import qualified Data.ByteString.Lazy as B {- bytestring -}-import qualified Data.ByteString.Char8 as C {- bytestring -} import Data.Int {- base -}+import Data.List {- base -}+import Data.Maybe {- base -} import Data.Word {- base -}+import Numeric {- base -} -import Sound.OSC.Type+import qualified Data.ByteString.Lazy as Lazy {- bytestring -}+import qualified Data.ByteString.Char8 as Char8 {- bytestring -} --- | Type specialised 'd_get'.+import Sound.OSC.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} -- ie. NTPr+           | Midi {d_midi :: MIDI}+             deriving (Eq,Read,Show)++-- | 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)++-- | 'Datum' as 'Integral' if Int32 or Int64. ----- > map datum_int32 [Int32 1,Float 1] == [Just 1,Nothing]-datum_int32 :: Datum -> Maybe Int32-datum_int32 = d_get+-- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]+-- > in 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 --- | Type specialised 'd_get'.-datum_int64 :: Datum -> Maybe Int64-datum_int64 = d_get+-- | 'Datum' as 'Floating' if Int32, Int64, Float, Double or TimeStamp.+--+-- > let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]+-- > in Data.Maybe.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 --- | Type specialised 'd_get'.-datum_float :: Datum -> Maybe Float-datum_float = d_get+-- | 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 specialised 'd_get'.-datum_double :: Datum -> Maybe Double-datum_double = d_get+-- | Type generalised Int64.+--+-- > int64 (1::Int32) == int64 (1::Integer)+-- > d_int64 (int64 (maxBound::Int64)) == maxBound+int64 :: Integral n => n -> Datum+int64 = Int64 . fromIntegral --- | Type specialised 'd_get'.+-- | Type generalised Float. ----- > datum_ascii (d_put (C.pack "string")) == Just (C.pack "string")-datum_ascii :: Datum -> Maybe ASCII-datum_ascii = d_get+-- > 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 --- | 'C.unpack' of 'd_get'.+-- | Type generalised Double. ----- > datum_string (d_put (C.pack "string")) == Just "string"--- > map datum_string [string "string",Int32 5] == [Just "string",Nothing]-datum_string :: Datum -> Maybe String-datum_string = fmap C.unpack . datum_ascii+-- > double (1::Int) == double (1::Double)+-- > double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77+double :: Real n => n -> Datum+double = Double . realToFrac --- | Type specialised 'd_get'.-datum_blob :: Datum -> Maybe B.ByteString-datum_blob = d_get+-- | 'ASCII_String' of 'Char8.pack'.+--+-- > string "string" == ASCII_String (Char8.pack "string")+string :: String -> Datum+string = ASCII_String . Char8.pack --- | 'Maybe' variant of 'd_timestamp'.-datum_timestamp :: Datum -> Maybe Time-datum_timestamp d = case d of {TimeStamp x -> Just x;_ -> Nothing}+-- | 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) --- | Type specialised 'd_get'.-datum_midi :: Datum -> Maybe MIDI-datum_midi = d_get+-- * Descriptor --- | 'Datum' as sequence of 'Word8' if 'ASCII_String', 'Blob' or 'Midi'.+-- | Message argument types are given by a descriptor. ----- > let d = [string "5",Blob (B.pack [53]),midi (0x00,0x90,0x40,0x60)]--- > in Data.Maybe.mapMaybe datum_sequence d == [[53],[53],[0,144,64,96]]-datum_sequence :: Datum -> Maybe [Word8]-datum_sequence d =+-- > Char8.unpack (descriptor [Int32 1,Float 1,string "1"]) == ",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 => Maybe Int -> 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 -> String+timePP = floatPP++-- | Pretty printer for vectors.+--+-- > vecPP [1::Int,2,3] == "<1,2,3>"+vecPP :: Show a => [a] -> String+vecPP v = '<' : intercalate "," (map show v) ++ ">"++{- | Pretty printer for 'Datum'.++> let d = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60)]+> in map (datumPP (Just 5)) d ==  ["1","1.2","\"str\"","<0,144,64,96>"]++-}+datumPP :: FP_Precision -> Datum -> String+datumPP p d =     case d of-      ASCII_String s -> Just (map (fromIntegral . fromEnum) (C.unpack s))-      Blob s -> Just (B.unpack s)-      Midi (MIDI p q r s) -> Just [p,q,r,s]+      Int32 n -> show n+      Int64 n -> show n+      Float n -> floatPP p n+      Double n -> floatPP p n+      ASCII_String s -> show (Char8.unpack s)+      Blob s -> show s+      TimeStamp t -> timePP p t+      Midi (MIDI b1 b2 b3 b4) -> vecPP [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++-- | Variant of 'read'.+readMaybe :: (Read a) => String -> Maybe a+readMaybe s =+    case reads s of+      [(x, "")] -> Just x       _ -> Nothing++-- | 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

@@ -0,0 +1,129 @@+-- | A class for translating to and from 'Datum'.+module Sound.OSC.Datum.Datem where++import qualified Data.ByteString.Lazy as Lazy {- bytestring -}+import qualified Data.ByteString.Char8 as Char8 {- bytestring -}+import Data.Int {- base -}+import Data.Maybe {- base -}+import Data.Word {- base -}++import Sound.OSC.Datum {- hosc -}+import Sound.OSC.Time {- hosc -}++{- | Class for translating to and from 'Datum'.+     There are instances for the direct 'Datum' field types.++> d_put (1::Int32) == Int32 1+> d_put (1::Int64) == Int64 1+> d_put (1::Float) == Float 1+> d_put (1::Double) == Double 1+> d_put (Char8.pack "str") == ASCII_String (Char8.pack "str")+> d_put (Lazy.pack [37,37]) == Blob (blob_pack [37,37])+> d_put (MIDI 0 0 0 0) == Midi (MIDI 0 0 0 0)++There are also instances for standard Haskell types.++> d_put (1::Int) == Int64 1+> d_put (1::Integer) == Int64 1++-}+class Datem a where+    d_put :: a -> Datum -- ^ Function to wrap value in 'Datum'.+    d_get :: Datum -> Maybe a -- ^ Function to extract value from 'Datum'.++instance Datem Int32 where+    d_put = Int32+    d_get d = case d of {Int32 x -> Just x;_ -> Nothing}++instance Datem Int64 where+    d_put = Int64+    d_get d = case d of {Int64 x -> Just x;_ -> Nothing}++instance Datem Int where+    d_put = Int64 . fromIntegral+    d_get = datum_integral++instance Datem Integer where+    d_put = Int64 . fromIntegral+    d_get = datum_integral++instance Datem Float where+    d_put = Float+    d_get d = case d of {Float x -> Just x;_ -> Nothing}++instance Datem Double where+    d_put = Double+    d_get d = case d of {Double x -> Just x;_ -> Nothing}++instance Datem Char8.ByteString where+    d_put = ASCII_String+    d_get d = case d of {ASCII_String x -> Just x;_ -> Nothing}++instance Datem Lazy.ByteString where+    d_put = Blob+    d_get d = case d of {Blob x -> Just x;_ -> Nothing}++instance Datem MIDI where+    d_put = Midi+    d_get d = case d of {Midi x -> Just x;_ -> Nothing}++-- | Error variant of 'd_get'.+d_get_err :: Datem a => Datum -> a+d_get_err = fromMaybe (error "d_get") . d_get++-- * Type specialised++-- | Type specialised 'd_get'.+--+-- > map datum_int32 [Int32 1,Float 1] == [Just 1,Nothing]+datum_int32 :: Datum -> Maybe Int32+datum_int32 = d_get++-- | Type specialised 'd_get'.+datum_int64 :: Datum -> Maybe Int64+datum_int64 = d_get++-- | Type specialised 'd_get'.+datum_float :: Datum -> Maybe Float+datum_float = d_get++-- | Type specialised 'd_get'.+datum_double :: Datum -> Maybe Double+datum_double = d_get++-- | Type specialised 'd_get'.+--+-- > datum_ascii (d_put (Char8.pack "string")) == Just (Char8.pack "string")+datum_ascii :: Datum -> Maybe ASCII+datum_ascii = d_get++-- | 'Char8.unpack' of 'd_get'.+--+-- > datum_string (d_put (Char8.pack "string")) == Just "string"+-- > map datum_string [string "string",Int32 5] == [Just "string",Nothing]+datum_string :: Datum -> Maybe String+datum_string = fmap Char8.unpack . datum_ascii++-- | Type specialised 'd_get'.+datum_blob :: Datum -> Maybe Lazy.ByteString+datum_blob = d_get++-- | 'Maybe' variant of 'd_timestamp'.+datum_timestamp :: Datum -> Maybe Time+datum_timestamp d = case d of {TimeStamp x -> Just x;_ -> Nothing}++-- | Type specialised 'd_get'.+datum_midi :: Datum -> Maybe MIDI+datum_midi = d_get++-- | 'Datum' as sequence of 'Word8' if 'ASCII_String', 'Blob' or 'Midi'.+--+-- > let d = [string "5",Blob (Lazy.pack [53]),midi (0x00,0x90,0x40,0x60)]+-- > in Data.Maybe.mapMaybe datum_sequence d == [[53],[53],[0,144,64,96]]+datum_sequence :: Datum -> Maybe [Word8]+datum_sequence d =+    case d of+      ASCII_String s -> Just (map (fromIntegral . fromEnum) (Char8.unpack s))+      Blob s -> Just (Lazy.unpack s)+      Midi (MIDI p q r s) -> Just [p,q,r,s]+      _ -> Nothing

@@ -0,0 +1,65 @@+-- | Datum normalisation.+module Sound.OSC.Datum.Normalise where++import Sound.OSC.Datum {- hosc -}+import Sound.OSC.Packet as O {- hosc -}++-- | Lift 'O.Int32' to 'O.Int64' and 'O.Float' to 'O.Double'.+--+-- > map normalise_datum [Int32 1,Float 1] == [Int64 1,Double 1]+normalise_datum :: Datum -> Datum+normalise_datum d =+    case d of+      Int32 n -> Int64 (fromIntegral n)+      Float n -> Double (realToFrac n)+      _ -> d++-- | A normalised 'O.Message' has only 'O.Int64' and 'O.Double'+-- numerical values.+--+-- > let m = message "/m" [Int32 0,Float 0]+-- > in normalise_message m == message "/m" [Int64 0,Double 0]+normalise_message :: Message -> Message+normalise_message = message_coerce normalise_datum++-- | A normalised 'O.Bundle' has only 'O.Int64' and 'O.Double'+-- numerical values.+normalise_bundle :: Bundle -> Bundle+normalise_bundle = bundle_coerce normalise_datum++-- * Coercion++-- | Map a normalising function over datum at an OSC 'Message'.+message_coerce :: (Datum -> Datum) -> Message -> Message+message_coerce f (Message s xs) = Message s (map f xs)++-- | Map a normalising function over datum at an OSC 'Bundle'.+bundle_coerce :: (Datum -> Datum) -> Bundle -> Bundle+bundle_coerce f (Bundle t xs) = Bundle t (map (message_coerce f) xs)++-- * Promotion++-- | Coerce 'Int32', 'Int64' and 'Float' to 'Double'.+--+-- > map datum_promote [Int32 5,Float 5] == [Double 5,Double 5]+datum_promote :: Datum -> Datum+datum_promote d =+    case d of+      Int32 n -> Double (fromIntegral n)+      Int64 n -> Double (fromIntegral n)+      Float n -> Double (realToFrac n)+      _ -> d++-- | 'O.Datum' as 'O.Int64' if 'O.Int32', 'O.Int64', 'O.Float' or+-- 'O.Double'.+--+-- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5,string "5"]+-- > in map datum_floor d == [Int64 5,Int64 5,Int64 5,Int64 5,string "5"]+datum_floor :: Datum -> Datum+datum_floor d =+    case d of+      Int32 x -> Int64 (fromIntegral x)+      Float x -> Int64 (fromInteger (floor x))+      Double x -> Int64 (fromInteger (floor x))+      _ -> d+

@@ -0,0 +1,44 @@+-- | Unpack 'Datum' lists into tuples.+module Sound.OSC.Datum.Unpack where++import Data.Int {- base -}++import Sound.OSC.Datum {- hosc -}++-- * S = strict++-- | Strictly unpack to (s,f).+unpackS_sf :: [Datum] -> Maybe (String,Float)+unpackS_sf dat =+    case dat of+      [ASCII_String d1,Float d2] -> Just (ascii_to_string d1,d2)+      _ -> Nothing++-- | Strictly unpack to (i,f).+unpackS_if :: [Datum] -> Maybe (Int32,Float)+unpackS_if dat =+    case dat of+      [Int32 d1,Float d2] -> Just (d1,d2)+      _ -> Nothing++-- * C = coerce++-- | Casting unpack to (s,d).+unpackC_sf :: [Datum] -> Maybe (String,Double)+unpackC_sf dat =+    case dat of+      [ASCII_String d1,d2] ->+        case datum_floating d2 of+          Just d2' -> Just (ascii_to_string d1,d2')+          Nothing -> Nothing+      _ -> Nothing++-- | Casting unpack to (i,d).+unpackC_if :: [Datum] -> Maybe (Int,Double)+unpackC_if dat =+    case dat of+      [d1,d2] ->+          case (datum_integral d1,datum_floating d2) of+            (Just d1',Just d2') -> Just (d1',d2')+            _ -> Nothing+      _ -> Nothing

@@ -1,64 +0,0 @@--- | Datum normalisation.-module Sound.OSC.Normalise where--import Sound.OSC.Type as O---- | Lift 'O.Int32' to 'O.Int64' and 'O.Float' to 'O.Double'.------ > map normalise_datum [Int32 1,Float 1] == [Int64 1,Double 1]-normalise_datum :: Datum -> Datum-normalise_datum d =-    case d of-      Int32 n -> Int64 (fromIntegral n)-      Float n -> Double (realToFrac n)-      _ -> d---- | A normalised 'O.Message' has only 'O.Int64' and 'O.Double'--- numerical values.------ > let m = message "/m" [Int32 0,Float 0]--- > in normalise_message m == message "/m" [Int64 0,Double 0]-normalise_message :: Message -> Message-normalise_message = message_coerce normalise_datum---- | A normalised 'O.Bundle' has only 'O.Int64' and 'O.Double'--- numerical values.-normalise_bundle :: Bundle -> Bundle-normalise_bundle = bundle_coerce normalise_datum---- * Coercion---- | Map a normalising function over datum at an OSC 'Message'.-message_coerce :: (Datum -> Datum) -> Message -> Message-message_coerce f (Message s xs) = Message s (map f xs)---- | Map a normalising function over datum at an OSC 'Bundle'.-bundle_coerce :: (Datum -> Datum) -> Bundle -> Bundle-bundle_coerce f (Bundle t xs) = Bundle t (map (message_coerce f) xs)---- * Promotion---- | Coerce 'Int32', 'Int64' and 'Float' to 'Double'.------ > map datum_promote [Int32 5,Float 5] == [Double 5,Double 5]-datum_promote :: Datum -> Datum-datum_promote d =-    case d of-      Int32 n -> Double (fromIntegral n)-      Int64 n -> Double (fromIntegral n)-      Float n -> Double (realToFrac n)-      _ -> d---- | 'O.Datum' as 'O.Int64' if 'O.Int32', 'O.Int64', 'O.Float' or--- 'O.Double'.------ > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5,string "5"]--- > in map datum_floor d == [Int64 5,Int64 5,Int64 5,Int64 5,string "5"]-datum_floor :: Datum -> Datum-datum_floor d =-    case d of-      Int32 x -> Int64 (fromIntegral x)-      Float x -> Int64 (fromInteger (floor x))-      Double x -> Int64 (fromInteger (floor x))-      _ -> d-

@@ -0,0 +1,136 @@+-- | Data types for OSC messages, bundles and packets.+module Sound.OSC.Packet where++import Data.List {- base -}++import Sound.OSC.Datum {- hosc3 -}+import Sound.OSC.Time {- hosc3 -}++-- * Message++-- | OSC address pattern.  This is strictly an ASCII value, but it is+-- very common to pattern match on addresses and matching on+-- 'C.ByteString' requires @OverloadedStrings@.+type Address_Pattern = String++-- | An OSC message.+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.+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' '.' 'bundle'.+p_bundle :: Time -> [Message] -> Packet+p_bundle t = Packet_Bundle . bundle t++-- | 'Packet_Message' '.' '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 :: FP_Precision -> Message -> String+messagePP p (Message a d) =+    let d' = map (datumPP p) d+    in unwords ("#message" : 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 ("#bundle" : 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

@@ -0,0 +1,30 @@+-- | Typeclass for encoding and decoding OSC packets.+module Sound.OSC.Packet.Class where++import Sound.OSC.Coding.Class {- hosc -}+import Sound.OSC.Packet {- hosc -}++-- | A type-class for values that can be translated to and from OSC 'Packet's.+class OSC o where+    toPacket :: o -> Packet -- ^ Translation to 'Packet'.+    fromPacket :: Packet -> Maybe o -- ^ Translation from 'Packet'.++instance OSC Message where+    toPacket = Packet_Message+    fromPacket = packet_to_message++instance OSC Bundle where+    toPacket = Packet_Bundle+    fromPacket = Just . packet_to_bundle++instance OSC Packet where+    toPacket = id+    fromPacket = Just++-- | 'encodePacket' '.' 'toPacket'.+encodeOSC :: (Coding c,OSC o) => o -> c+encodeOSC = encodePacket . toPacket++-- | 'fromPacket' '.' 'decodePacket'.+decodeOSC :: (Coding c,OSC o) => c -> Maybe o+decodeOSC = fromPacket . decodePacket

@@ -0,0 +1,13 @@+-- | Packet coercion.+module Sound.OSC.Packet.Coerce where++import Sound.OSC.Datum {- hosc -}+import Sound.OSC.Packet as O {- hosc -}++-- | Map a normalising function over datum at an OSC 'Message'.+message_coerce :: (Datum -> Datum) -> Message -> Message+message_coerce f (Message s xs) = Message s (map f xs)++-- | Map a normalising function over datum at an OSC 'Bundle'.+bundle_coerce :: (Datum -> Datum) -> Bundle -> Bundle+bundle_coerce f (Bundle t xs) = Bundle t (map (message_coerce f) xs)

@@ -1,27 +1,35 @@--- | OSC related timing functions.  OSC timestamps are @NTP@ values,--- <http://ntp.org/>.+-- | OSC related timing functions.+--   OSC timestamps are @NTP@ values, <http://ntp.org/>. module Sound.OSC.Time where  import Control.Concurrent {- base -} import Control.Monad {- base -} import Control.Monad.IO.Class {- transformers -} import Data.Word {- base -}+ import qualified Data.Time as T {- time -} import qualified Data.Time.Clock.POSIX as T {- time -} -import Sound.OSC.Type- -- * Temporal types  -- | Type for integer (binary) representation of @NTP@ time. type NTPi = Word64 +-- | @NTP@ time in real-valued (fractional) form (ie. @ntpr@).+type Time = Double++-- | Constant indicating a bundle to be executed immediately.+immediately :: Time+immediately = 1 / 2^(32::Int)+ -- | @Unix/Posix@ epoch time in real-valued (fractional) form. type UT = Double  -- * Time conversion  -- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp.+--+-- > fmap ntpr_to_ntpi time ntpr_to_ntpi :: RealFrac n => n -> NTPi ntpr_to_ntpi t = round (t * 2^(32::Int)) @@ -51,6 +59,14 @@ ntpi_to_ut :: NTPi -> 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.@@ -72,7 +88,7 @@ -- >    ;pt <- fmap realToFrac T.getPOSIXTime -- >    ;print (pt - ct,pt - ct < 1e-5)} time :: MonadIO m => m Time-time = liftIO (fmap (ut_to_ntpr . realToFrac) T.getPOSIXTime)+time = liftIO (fmap posixtime_to_ntpr T.getPOSIXTime)  -- * Thread operations. @@ -84,7 +100,7 @@  -- | Pause current thread for the indicated duration (in seconds), see --   'pauseThreadLimit'.-pauseThread :: (MonadIO m,Ord n,RealFrac n) => n -> m ()+pauseThread :: (MonadIO m,RealFrac n) => n -> m () pauseThread n = when (n > 0) (liftIO (threadDelay (floor (n * 1e6))))  -- | Type restricted 'pauseThread'.@@ -109,3 +125,45 @@ -- 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])+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]+--+-- > ntpr_to_iso_8601 (ntpi_to_ntpr 15708783354150518784)+ntpr_to_iso_8601 :: Time -> String+ntpr_to_iso_8601 = utctime_to_iso_8601 . T.posixSecondsToUTCTime . ntpr_to_posixtime++-- | 'Time' of ISO 8601.+--+-- > fmap ntpr_to_ntpi (iso_8601_to_ntpr "2015-11-26T00:22:19,366058349609+0000")+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'.+--+-- > fmap time_pp time+time_pp :: Time -> String+time_pp = ntpr_to_iso_8601

@@ -1,14 +1,14 @@--- | An abstract transport layer with implementations for @UDP@ and--- @TCP@ transport.+-- | 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.Class-import Sound.OSC.Type-import Sound.OSC.Wait+import Sound.OSC.Datum {- hosc -}+import Sound.OSC.Packet {- hosc -}+import Sound.OSC.Packet.Class {- hosc -}+import qualified Sound.OSC.Wait as Wait {- hosc -}  -- | Abstract over the underlying transport protocol. class Transport t where@@ -55,19 +55,19 @@  -- | 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)+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 = untilPredicate f (recvPacket t)+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 = untilMaybe f (recvPacket t)+waitFor t f = Wait.untilMaybe f (recvPacket t)  -- | 'waitUntil' 'packet_is_immediate'. waitImmediate :: Transport t => t -> IO Packet

@@ -3,17 +3,18 @@  import qualified Data.ByteString.Lazy as B {- bytestring -} import Control.Monad {- base -}-import Network {- network -}+import qualified Network as N {- network -} import System.IO {- base -} -import Sound.OSC.Class-import Sound.OSC.Coding-import Sound.OSC.Coding.Byte-import Sound.OSC.Transport.FD+import Sound.OSC.Coding.Class {- hosc -}+import Sound.OSC.Coding.Byte {- hosc -}+import Sound.OSC.Transport.FD {- hosc -}+import Sound.OSC.Packet.Class {- hosc -}  -- | The TCP transport handle data type. data TCP = TCP {tcpHandle :: Handle} +-- | 'TCP' is an instance of 'Transport'. instance Transport TCP where    sendOSC (TCP fd) msg =       do let b = encodeOSC msg@@ -26,18 +27,28 @@          return (decodePacket b1)    close (TCP fd) = hClose fd --- | Make a 'TCP' connection.+{- | Make a 'TCP' connection.++> import Sound.OSC.Core+> import Sound.OSC.Transport.FD+> import Sound.OSC.Transport.FD.TCP+> let t = openTCP "127.0.0.1" 57110+> let m1 = message "/dumpOSC" [Int32 1]+> let m2 = message "/g_new" [Int32 1]+> withTransport t (\fd -> let f = sendMessage fd in f m1 >> f m2)++-} openTCP :: String -> Int -> IO TCP openTCP host =     liftM TCP .-    connectTo host .-    PortNumber .+    N.connectTo host .+    N.PortNumber .     fromIntegral  -- | A trivial 'TCP' /OSC/ server. tcpServer' :: Int -> (TCP -> IO ()) -> IO () tcpServer' p f = do-  s <- listenOn (PortNumber (fromIntegral p))-  (sequence_ . repeat) (do (fd, _, _) <- accept s+  s <- N.listenOn (N.PortNumber (fromIntegral p))+  (sequence_ . repeat) (do (fd, _, _) <- N.accept s                            f (TCP fd)                            return ())

@@ -5,9 +5,9 @@ import qualified Network.Socket as N {- network -} import qualified Network.Socket.ByteString as C {- network -} -import Sound.OSC.Class-import Sound.OSC.Coding-import Sound.OSC.Type+import Sound.OSC.Coding.Class+import Sound.OSC.Packet+import Sound.OSC.Packet.Class import Sound.OSC.Transport.FD  -- | The UDP transport handle data type.@@ -17,11 +17,12 @@ udpPort :: Integral n => UDP -> IO n udpPort (UDP fd) = fmap fromIntegral (N.socketPort fd) +-- | 'UDP' is an instance of 'Transport'. instance Transport UDP where    -- C.L.send is not implemented for W32    sendOSC (UDP fd) msg = void (C.send fd (encodeOSC msg))    recvPacket (UDP fd) = liftM decodePacket (C.recv fd 8192)-   close (UDP fd) = N.sClose fd+   close (UDP fd) = N.close fd  -- | Create and initialise UDP socket. udp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO UDP@@ -32,6 +33,14 @@   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. -- -- > let t = openUDP "127.0.0.1" 57110@@ -51,7 +60,7 @@ -- > let t = openUDP "127.0.0.1" 57300 -- > in withTransport t (\fd -> sendMessage fd (message "/n" [])) udpServer :: String -> Int -> IO UDP-udpServer = udp_socket N.bindSocket+udpServer = udp_socket N.bind  -- | Send variant to send to specified address. sendTo :: OSC o => UDP -> o -> N.SockAddr -> IO ()

@@ -7,10 +7,11 @@ import Data.List {- base -} import Data.Maybe {- base -} -import Sound.OSC.Class-import qualified Sound.OSC.Transport.FD as T-import Sound.OSC.Type-import Sound.OSC.Wait+import Sound.OSC.Datum {- hosc -}+import qualified Sound.OSC.Transport.FD as T {- hosc -}+import Sound.OSC.Packet {- hosc -}+import Sound.OSC.Packet.Class {- hosc -}+import Sound.OSC.Wait {- hosc -}  -- | Sender monad. class Monad m => SendOSC m where@@ -28,14 +29,18 @@ -- | 'Transport' is 'DuplexOSC' with a 'MonadIO' constraint. class (DuplexOSC m,MonadIO m) => Transport m where +-- | 'SendOSC' over 'ReaderT'. instance (T.Transport t,MonadIO io) => SendOSC (ReaderT t io) where    sendOSC o = ReaderT (M.liftIO . flip T.sendOSC o) +-- | 'RecvOSC' over 'ReaderT'. instance (T.Transport t,MonadIO io) => RecvOSC (ReaderT t io) where    recvPacket = ReaderT (M.liftIO . T.recvPacket) +-- | 'DuplexOSC' over 'ReaderT'. instance (T.Transport t,MonadIO io) => DuplexOSC (ReaderT t io) where +-- | 'Transport' over 'ReaderT'. instance (T.Transport t,MonadIO io) => Transport (ReaderT t io) where  -- | Transport connection.@@ -68,6 +73,10 @@ -- | Variant of 'recvPacket' that runs 'packet_to_message'. recvMessage :: (RecvOSC m) => m (Maybe Message) recvMessage = liftM packet_to_message recvPacket++-- | Erroring variant.+recvMessage_err :: RecvOSC m => m Message+recvMessage_err = fmap (fromMaybe (error "recvMessage")) recvMessage  -- | Variant of 'recvPacket' that runs 'packetMessages'. recvMessages :: (RecvOSC m) => m [Message]

@@ -1,399 +0,0 @@--- | Alegbraic data types for OSC datum and packets.-module Sound.OSC.Type where--import qualified Data.ByteString.Lazy as B {- bytestring -}-import qualified Data.ByteString.Char8 as C {- bytestring -}-import Data.Int {- base -}-import Data.List {- base -}-import Data.Word {- base -}-import Numeric {- base -}---- * Time---- | @NTP@ time in real-valued (fractional) form.-type Time = Double---- | Constant indicating a bundle to be executed immediately.-immediately :: Time-immediately = 1 / 2^(32::Int)---- * Datum---- | Type enumerating Datum categories.-type Datum_Type = Char---- | Type for ASCII strings (strict 'Char'8 'C.ByteString').-type ASCII = C.ByteString---- | Type-specialised 'C.pack'.-ascii :: String -> ASCII-ascii = C.pack---- | Type-specialised 'C.unpack'.-ascii_to_string :: ASCII -> String-ascii_to_string = C.unpack---- | Four-byte midi message.-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 :: B.ByteString}-           | TimeStamp {d_timestamp :: Time}-           | Midi {d_midi :: MIDI}-             deriving (Eq,Read,Show)---- | Single character identifier of an OSC datum.-datum_tag :: Datum -> Datum_Type-datum_tag dt =-    case dt of-      Int32 _ -> 'i'-      Int64 _ -> 'h'-      Float _ -> 'f'-      Double _ -> 'd'-      ASCII_String _ -> 's'-      Blob _ -> 'b'-      TimeStamp _ -> 't'-      Midi _ -> 'm'---- | 'Datum' as 'Integral' if 'Sound.OSC.Type.Int32' or--- 'Sound.OSC.Type.Int64'.------ > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]--- > in 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 'Sound.OSC.Type.Int32',--- 'Sound.OSC.Type.Int64', 'Sound.OSC.Type.Float',--- 'Sound.OSC.Type.Double' or 'TimeStamp'.------ > let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]--- > in Data.Maybe.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---- | Class for translating to and from 'Datum'.  There are instances--- for the direct 'Datum' field types.------ > d_put (1::Int32) == Int32 1--- > d_put (1::Int64) == Int64 1--- > d_put (1::Float) == Float 1--- > d_put (1::Double) == Double 1--- > d_put (C.pack "str") == ASCII_String (C.pack "str")--- > d_put (B.pack [37,37]) == Blob (B.pack [37,37])--- > d_put (MIDI 0 0 0 0) == Midi (MIDI 0 0 0 0)------ There are also instances for standard Haskell types.------ > d_put (1::Int) == Int64 1--- > d_put (1::Integer) == Int64 1-class Datem a where-    d_put :: a -> Datum-    d_get :: Datum -> Maybe a--instance Datem Int32 where-    d_put = Int32-    d_get d = case d of {Int32 x -> Just x;_ -> Nothing}--instance Datem Int64 where-    d_put = Int64-    d_get d = case d of {Int64 x -> Just x;_ -> Nothing}--instance Datem Int where-    d_put = Int64 . fromIntegral-    d_get = datum_integral--instance Datem Integer where-    d_put = Int64 . fromIntegral-    d_get = datum_integral--instance Datem Float where-    d_put = Float-    d_get d = case d of {Float x -> Just x;_ -> Nothing}--instance Datem Double where-    d_put = Double-    d_get d = case d of {Double x -> Just x;_ -> Nothing}--instance Datem C.ByteString where-    d_put = ASCII_String-    d_get d = case d of {ASCII_String x -> Just x;_ -> Nothing}--instance Datem B.ByteString where-    d_put = Blob-    d_get d = case d of {Blob x -> Just x;_ -> Nothing}--instance Datem MIDI where-    d_put = Midi-    d_get d = case d of {Midi x -> Just x;_ -> Nothing}---- | Type generalised 'Sound.OSC.Type.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 'Sound.OSC.Type.Int64'.------ > int64 (1::Int32) == int64 (1::Integer)--- > d_int64 (int64 (maxBound::Int64)) == maxBound-int64 :: Integral n => n -> Datum-int64 = Int64 . fromIntegral---- | Type generalised 'Sound.OSC.Type.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 'Sound.OSC.Type.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 'C.pack'.------ > string "string" == ASCII_String (C.pack "string")-string :: String -> Datum-string = ASCII_String . C.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)---- * Message---- | OSC address pattern.  This is strictly an ASCII value, but it is--- very common to pattern match on addresses and matching on--- 'C.ByteString' requires @OverloadedStrings@.-type Address_Pattern = String---- | An OSC message.-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"---- | Message argument types are given by a descriptor.------ > C.unpack (descriptor [Int32 1,Float 1,string "1"]) == ",ifs"-descriptor :: [Datum] -> ASCII-descriptor l = C.pack (',' : map datum_tag l)---- | Descriptor tags are @comma@ prefixed.-descriptor_tags :: ASCII -> ASCII-descriptor_tags = C.drop 1---- * Bundle---- | An OSC bundle.-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' '.' 'bundle'.-p_bundle :: Time -> [Message] -> Packet-p_bundle t = Packet_Bundle . bundle t---- | 'Packet_Message' '.' '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---- | 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 => Maybe Int -> 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 -> String-timePP = floatPP---- | Pretty printer for vectors.------ > vecPP [1::Int,2,3] == "<1,2,3>"-vecPP :: Show a => [a] -> String-vecPP v = '<' : intercalate "," (map show v) ++ ">"---- | Pretty printer for 'Datum'.------ > let d = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60)]--- > in map datumPP d ==  ["1","1.2","\"str\"","<0,144,64,96>"]-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 -> show (C.unpack s)-      Blob s -> show s-      TimeStamp t -> timePP p t-      Midi (MIDI b1 b2 b3 b4) -> vecPP [b1,b2,b3,b4]---- | Pretty printer for 'Message'.-messagePP :: FP_Precision -> Message -> String-messagePP p (Message a d) =-    let d' = map (datumPP p) d-    in unwords ("#message" : 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 ("#bundle" : 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---- * Parser---- | Variant of 'read'.-readMaybe :: (Read a) => String -> Maybe a-readMaybe s =-    case reads s of-      [(x, "")] -> Just x-      _ -> Nothing---- | 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 (B.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 . C.pack) . readMaybe-      'b' -> fmap (Blob . B.pack) . readMaybe-      't' -> error "parse_datum: timestamp"-      'm' -> fmap midi . readMaybe-      _ -> error "parse_datum: type"

@@ -11,18 +11,16 @@  -- * Wait --- | Repeat action until predicate /f/ is 'True' when applied to--- result.+-- | 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 rec else return p-        rec = act >>= g-    in rec+    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.+-- | 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 = case f p of {Nothing -> rec;Just r -> return r}-        rec = act >>= g-    in rec+    let g p = case f p of {Nothing -> recur;Just r -> return r}+        recur = act >>= g+    in recur

@@ -1,26 +0,0 @@-module Sound.OSC.NFData () where--import Control.DeepSeq (NFData(..)) {- deepseq -}-import Sound.OSC.Type--instance NFData Datum where-    rnf (Int32 x1) = rnf x1 `seq` ()-    rnf (Float x1) = rnf x1 `seq` ()-    rnf (Double x1) = rnf x1 `seq` ()-    rnf (ASCII_String x1) = rnf x1 `seq` ()-    rnf (Blob x1) = rnf x1 `seq` ()-    rnf (TimeStamp x1) = rnf x1 `seq` ()-    rnf (Midi x1) = rnf x1 `seq` ()--instance NFData MIDI where-    rnf (MIDI x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()--instance NFData Message where-    rnf (Message x1 x2) = rnf x1 `seq` rnf x2 `seq` ()--instance NFData Bundle where-    rnf (Bundle x1 x2)  = rnf x1 `seq` rnf x2 `seq` ()--instance NFData Packet where-    rnf (Packet_Message x1) = rnf x1 `seq` ()-    rnf (Packet_Bundle x1) = rnf x1 `seq` ()

@@ -1,32 +0,0 @@-import Criterion.Main {- criterion -}-import qualified Data.ByteString.Lazy as B {- bytestring -}--import Sound.OSC-import qualified Sound.OSC.Coding.Decode.Binary as Binary-import qualified Sound.OSC.Coding.Encode.Builder as Builder-import qualified Sound.OSC.Coding.Decode.Base as Decode-import qualified Sound.OSC.Coding.Encode.Base as Encode-import Sound.OSC.NFData ()--type EncodingFunc = Bundle -> B.ByteString-type DecodingFunc = B.ByteString -> Packet--main :: IO ()-main =-    defaultMain [-        bgroup "encodeOSC" [-            bench "Encode"  (nf (Encode.encodeBundle :: EncodingFunc) b)-          , bench "Builder" (nf (Builder.encodeBundle :: EncodingFunc) b)-          ]-      , bgroup "decodeOSC" [-            bench "Decode" (nf (Decode.decodePacket :: DecodingFunc) p)-          , bench "Binary" (nf (Binary.decodePacket :: DecodingFunc) p)-          ]-      ]-    where-        m = Message "/fooblah" [Float 42.0-                               ,Int32 16-                               ,string "yeah"-                               ,Blob (B.pack [0..128])]-        b = Bundle pi (replicate 12 m)-        p = Encode.encodeBundle b

@@ -1,34 +1,25 @@ Name:              hosc-Version:           0.15+Version:           0.16 Synopsis:          Haskell Open Sound Control-Description:       @hosc@ implements a subset of the /Open Sound Control/+Description:       @hosc@ implements a subset of the Open Sound Control                    byte protocol, <http://opensoundcontrol.org/>.                    .-                   "Sound.OSC.Core" implements the actual protocol.-                   .-                   "Sound.OSC.Transport.FD" implements a-                   /file descriptor/ based transport layer for @UDP@-                   and @TCP@.-                   .-                   "Sound.OSC.Transport.Monad" implements a-                   monadic interface to the @FD@ transport layer.-                   .-                   Composite modules are at "Sound.OSC" and "Sound.OSC.FD".+                   See "Sound.OSC.Core" or "Sound.OSC" or "Sound.OSC.FD". License:           GPL Category:          Sound-Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2007-2014+Copyright:         (c) Rohan Drape, Stefan Kersten and others, 2007-2017 Author:            Rohan Drape, Stefan Kersten Maintainer:        rd@slavepianos.org Stability:         Experimental Homepage:          http://rd.slavepianos.org/t/hosc-Tested-With:       GHC == 7.8.2+Tested-With:       GHC == 8.0.1 Build-Type:        Simple Cabal-Version:     >= 1.8 Data-Files:        README  Library-  Build-Depends:   base == 4.*,-                   binary >=  0.7.2,+  Build-Depends:   base >= 4.7 && < 5,+                   binary >= 0.7.2,                    blaze-builder >= 0.3,                    bytestring,                    data-binary-ieee754,@@ -37,57 +28,30 @@                    transformers   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Sound.OSC-                   Sound.OSC.Class-                   Sound.OSC.Coding                    Sound.OSC.Coding.Byte                    Sound.OSC.Coding.Cast+                   Sound.OSC.Coding.Class+                   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.Datum.Datem+                   Sound.OSC.Datum.Normalise+                   Sound.OSC.Datum.Unpack                    Sound.OSC.FD-                   Sound.OSC.Normalise+                   Sound.OSC.Packet+                   Sound.OSC.Packet.Class+                   Sound.OSC.Packet.Coerce                    Sound.OSC.Time                    Sound.OSC.Transport.FD                    Sound.OSC.Transport.FD.TCP                    Sound.OSC.Transport.FD.UDP                    Sound.OSC.Transport.Monad-                   Sound.OSC.Type                    Sound.OSC.Wait  Source-Repository  head   Type:            darcs   Location:        http://rd.slavepianos.org/sw/hosc/--Benchmark hosc-benchmark-  Type: exitcode-stdio-1.0-  Hs-Source-Dirs: benchmarks-  Main-Is: benchmark.hs-  Other-Modules:-      Sound.OSC.NFData-  Build-Depends:-      base == 4.*-    , hosc == 0.15.*-    , bytestring-    , criterion-    , deepseq-  GHC-Options:      -Wall -fwarn-tabs -rtsopts -fno-warn-orphans-  GHC-Prof-Options: -Wall -fwarn-tabs -rtsopts -auto-all--Test-Suite hosc-test-  Type: exitcode-stdio-1.0-  Hs-Source-Dirs: tests-  Main-Is: test.hs-  Other-Modules:-      Sound.OSC.Arbitrary-  Build-Depends:-      base == 4.*-    , bytestring >= 0.10-    , hosc == 0.15.*-    , QuickCheck >= 2-    , test-framework >= 0.2-    , test-framework-quickcheck2 >= 0.2-  GHC-Options:      -Wall -fwarn-tabs -rtsopts -fno-warn-orphans-  GHC-Prof-Options: -Wall -fwarn-tabs -rtsopts -auto-all

@@ -1,43 +0,0 @@-module Sound.OSC.Arbitrary () where--import Control.Applicative {- base -}-import qualified Data.ByteString.Char8 as C {- bytestring -}-import qualified Data.ByteString.Lazy as B {- bytestring -}-import Test.QuickCheck {- QuickCheck -}--import Sound.OSC---- Avoid floating point representation/conversion errors-genTime :: Gen Time-genTime = ntpi_to_ntpr <$> arbitrary--genString :: Gen String-genString = resize 128 (listOf (arbitrary `suchThat` (/= '\0')))--genASCII :: Gen ASCII-genASCII = fmap C.pack genString--genMIDI :: Gen MIDI-genMIDI = do-  (p,q,r,s) <- arbitrary-  return (MIDI p q r s)--instance Arbitrary Datum where-    arbitrary = oneof [-        Int32 <$> arbitrary-      , Float <$> realToFrac <$> (arbitrary :: Gen Float)-      , Double <$> arbitrary-      , ASCII_String <$> genASCII-      , Blob <$> B.pack <$> resize 128 arbitrary-      , TimeStamp <$> genTime-      , Midi <$> genMIDI-      ]--genMessage :: Gen Message-genMessage = message <$> ("/"++) <$> genString <*> resize 32 (listOf1 arbitrary)--instance Arbitrary Packet where-    arbitrary = oneof [-        Packet_Message <$> genMessage-      , p_bundle <$> genTime <*> resize 32 (listOf1 genMessage)-      ]

@@ -1,23 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--import           Sound.OSC.Arbitrary ()-import qualified Sound.OSC.Coding.Decode.Base as DecodeBase-import qualified Sound.OSC.Coding.Encode.Base as EncodeBase-import qualified Sound.OSC.Coding.Decode.Binary as DecodeBinary-import qualified Sound.OSC.Coding.Encode.Builder as EncodeBuilder-import           Sound.OSC.Type (Packet)-import           Test.Framework (Test, defaultMain)-import           Test.Framework.Providers.QuickCheck2 (testProperty)--tests :: [Test]-tests =-    [ testProperty "encodePacket (Builder)" $ \(osc :: Packet) ->-        EncodeBuilder.encodePacket osc == EncodeBase.encodePacket osc-    , testProperty "encodePacket/decodePacket" $ \(osc :: Packet) ->-        DecodeBase.decodePacket (EncodeBase.encodePacket osc) == osc-    , testProperty "decodePacket (Get)" $ \(osc :: Packet) ->-        DecodeBinary.decodePacket (EncodeBase.encodePacket osc) == osc-    ]--main :: IO ()-main = defaultMain tests