hosc 0.14.1 → 0.21.1
raw patch · 52 files changed
Files
- README +0/−24
- README.md +39/−0
- Sound/OSC.hs +0/−8
- Sound/OSC/Class.hs +0/−31
- Sound/OSC/Coding.hs +0/−48
- Sound/OSC/Coding/Byte.hs +0/−104
- Sound/OSC/Coding/Cast.hs +0/−43
- Sound/OSC/Coding/Decode/Base.hs +0/−104
- Sound/OSC/Coding/Decode/Binary.hs +0/−128
- Sound/OSC/Coding/Encode/Base.hs +0/−56
- Sound/OSC/Coding/Encode/Builder.hs +0/−95
- Sound/OSC/Core.hs +0/−22
- Sound/OSC/Datum.hs +0/−63
- Sound/OSC/FD.hs +0/−7
- Sound/OSC/Normalise.hs +0/−64
- Sound/OSC/Time.hs +0/−111
- Sound/OSC/Transport/FD.hs +0/−98
- Sound/OSC/Transport/FD/TCP.hs +0/−43
- Sound/OSC/Transport/FD/UDP.hs +0/−67
- Sound/OSC/Transport/Monad.hs +0/−114
- Sound/OSC/Type.hs +0/−377
- Sound/OSC/Wait.hs +0/−28
- Sound/Osc.hs +7/−0
- Sound/Osc/Coding/Byte.hs +410/−0
- Sound/Osc/Coding/Cast.hs +72/−0
- Sound/Osc/Coding/Convert.hs +129/−0
- Sound/Osc/Coding/Decode/Base.hs +122/−0
- Sound/Osc/Coding/Decode/Binary.hs +152/−0
- Sound/Osc/Coding/Encode/Base.hs +117/−0
- Sound/Osc/Coding/Encode/Builder.hs +115/−0
- Sound/Osc/Core.hs +21/−0
- Sound/Osc/Datum.hs +264/−0
- Sound/Osc/Fd.hs +6/−0
- Sound/Osc/Packet.hs +142/−0
- Sound/Osc/Text.hs +279/−0
- Sound/Osc/Time.hs +116/−0
- Sound/Osc/Time/System.hs +25/−0
- Sound/Osc/Time/Thread.hs +39/−0
- Sound/Osc/Time/Thread/MonadIO.hs +25/−0
- Sound/Osc/Time/Timeout.hs +15/−0
- Sound/Osc/Transport/Fd.hs +101/−0
- Sound/Osc/Transport/Fd/Socket.hs +40/−0
- Sound/Osc/Transport/Fd/Tcp.hs +101/−0
- Sound/Osc/Transport/Fd/Udp.hs +119/−0
- Sound/Osc/Transport/Monad.hs +128/−0
- Sound/Osc/Wait.hs +18/−0
- benchmarks/Sound/OSC/NFData.hs +0/−26
- benchmarks/benchmark.hs +0/−32
- contrib/LICENSE +674/−0
- hosc.cabal +43/−79
- tests/Sound/OSC/Arbitrary.hs +0/−43
- tests/test.hs +0/−23
− README
@@ -1,24 +0,0 @@-hosc - haskell open sound control------------------------------------[hosc][hosc] provides `Sound.OSC`, a [haskell][hs]-module implementing a subset of the [Open Sound Control][osc] byte protocol.--© [rohan drape][rd], [stefan kersten][sk] and others, 2006-2013,-[gpl][gpl]. with contributions by:--- [alex mclean][am]-- [henning thielemann][ht]--see the [darcs][darcs] [history][hosc-history] for details--[hosc]: http://rd.slavepianos.org/?t=hosc-[hs]: http://haskell.org/-[osc]: http://opensoundcontrol.org/-[rd]: http://rd.slavepianos.org/-[sk]: http://space.k-hornz.de/-[am]: http://yaxu.org/-[ht]: http://www.henning-thielemann.de/Research.html-[darcs]: http://darcs.net/-[gpl]: http://gnu.org/copyleft/-[hosc-history]: http://rd.slavepianos.org/r/d/darcsweb.cgi?r=hosc
+ README.md view
@@ -0,0 +1,39 @@+hosc - haskell open sound control+---------------------------------++[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++© [Rohan Drape][rd], [Stefan Kersten][sk] and others, 2007-2024,+[Gpl-3][gpl-3]. with contributions by:++- [Alex McLean][am]+- [Henning Thielemann][ht]++Please see the [history](http://rohandrape.net/?t=hosc&q=history) for details++[hosc]: http://rohandrape.net/?t=hosc+[hs]: http://haskell.org/+[osc]: https://opensoundcontrol.stanford.edu/+[hsc3]: http://rohandrape.net/?t=hsc3+[sc3]: http://audiosynth.com/+[rd]: http://rohandrape.net/+[sk]: http://space.k-hornz.de/+[am]: http://yaxu.org/+[ht]: http://www.henning-thielemann.de/Research.html+[gpl]: http://gnu.org/copyleft/+[gpl-3]: http://gnu.org/licenses/gpl-3.0.html++* * *++```+$ make doctest+Examples: 110 Tried: 110 Errors: 0 Failures: 0+$+```
− Sound/OSC.hs
@@ -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
− Sound/OSC/Class.hs
@@ -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
− Sound/OSC/Coding.hs
@@ -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
− Sound/OSC/Coding/Byte.hs
@@ -1,104 +0,0 @@--- | Byte-level coding utility functions.-module Sound.OSC.Coding.Byte where--import Data.Binary {- base -}-import Data.Bits {- base -}-import qualified Data.ByteString as S.B {- bytestring -}-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 Data.Int {- base -}--import Sound.OSC.Coding.Cast-import Sound.OSC.Type---- | Encode a signed 8-bit integer.-encode_i8 :: Int -> B.ByteString-encode_i8 n = encode (fromIntegral n :: Int8)---- | Encode a signed 16-bit integer.-encode_i16 :: Int -> B.ByteString-encode_i16 n = encode (fromIntegral n :: Int16)---- | Encode a signed 32-bit integer.-encode_i32 :: Int -> B.ByteString-encode_i32 n = encode (fromIntegral n :: Int32)---- | Encode an unsigned 16-bit integer.-encode_u32 :: Int -> B.ByteString-encode_u32 n = encode (fromIntegral n :: Word32)---- | Encode a signed 64-bit integer.-encode_i64 :: Int64 -> B.ByteString-encode_i64 = encode---- | Encode an unsigned 64-bit integer.-encode_u64 :: Word64 -> B.ByteString-encode_u64 = encode---- | Encode a 32-bit IEEE floating point number.-encode_f32 :: Float -> B.ByteString-encode_f32 = encode . f32_w32---- | Encode a 64-bit IEEE floating point number.-encode_f64 :: Double -> B.ByteString-encode_f64 = encode . f64_w64---- | Encode an ASCII string.-encode_str :: ASCII -> B.ByteString-{-# INLINE encode_str #-}-encode_str = B.pack . S.B.unpack---- | Decode a signed 8-bit integer.-decode_i8 :: B.ByteString -> Int-decode_i8 b = fromIntegral (decode b :: Int8)---- | Decode a signed 16-bit integer.-decode_i16 :: B.ByteString -> Int-decode_i16 b = fromIntegral (decode b :: Int16)---- | Decode a signed 32-bit integer.-decode_i32 :: B.ByteString -> Int-decode_i32 b = fromIntegral (decode b :: Int32)---- | Decode an unsigned 32-bit integer.-decode_u32 :: B.ByteString -> Int-decode_u32 b = fromIntegral (decode b :: Word32)---- | Decode a signed 64-bit integer.-decode_i64 :: B.ByteString -> Int64-decode_i64 = decode---- | Decode an unsigned 64-bit integer.-decode_u64 :: B.ByteString -> Word64-decode_u64 = decode---- | Decode a 32-bit IEEE floating point number.-decode_f32 :: B.ByteString -> Float-decode_f32 b = w32_f32 (decode b :: Word32)---- | Decode a 64-bit IEEE floating point number.-decode_f64 :: B.ByteString -> Double-decode_f64 b = w64_f64 (decode b :: Word64)---- | Decode an ASCII string.-decode_str :: B.ByteString -> ASCII-{-# INLINE decode_str #-}-decode_str = S.C.pack . C.unpack---- | 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 :: B.ByteString-{-# INLINE bundleHeader #-}-bundleHeader = 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
− Sound/OSC/Coding/Cast.hs
@@ -1,43 +0,0 @@--- | 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--import qualified Data.Binary.IEEE754 as I {- data-binary-ieee754 -}-import Data.Char {- base -}-import Data.Word {- base -}---- | 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 (fromIntegral . ord) s ++ [0]---- | Inverse of 'str_cstr'.-cstr_str :: [Word8] -> String-cstr_str = map (chr . fromIntegral) . takeWhile (/= 0)---- | 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---- | Inverse of 'str_pstr'.-pstr_str :: [Word8] -> String-pstr_str = map (chr . fromIntegral) . drop 1
− Sound/OSC/Coding/Decode/Base.hs
@@ -1,104 +0,0 @@--- | Base-level decode function for OSC packets (slow). 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-import Sound.OSC.Time-import Sound.OSC.Type---- The plain byte count of an OSC value.-size :: Datum_Type -> B.ByteString -> Int-size ty b =- case ty of- 'i' -> 4- 'f' -> 4- 'd' -> 8- 't' -> 8 -- timetag- 'm' -> 4 -- MIDI message- 's' -> fromIntegral (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 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_str (b_take (size 's' b) b))- 'b' -> Blob (b_take (size 'b' b) (B.drop 4 b))- 't' -> TimeStamp (ntpi_to_ntpr (decode_u64 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 (fromIntegral (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 OSC messages, each one headed by its length-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 tag- (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]--- > in decodePacket b == Message "/g_free" [Int 0]-decodePacket :: B.ByteString -> Packet-decodePacket b =- if bundleHeader `B.isPrefixOf` b- then Packet_Bundle (decodeBundle b)- else Packet_Message (decodeMessage b)--b_take :: Int -> B.ByteString -> B.ByteString-b_take = B.take . fromIntegral--b_drop :: Int -> B.ByteString -> B.ByteString-b_drop = B.drop . fromIntegral
− Sound/OSC/Coding/Decode/Binary.hs
@@ -1,128 +0,0 @@--- | Optimised decode function for OSC packets.-module Sound.OSC.Coding.Decode.Binary- (getPacket- ,decodePacket- ,decodePacket_strict) where--import Control.Applicative {- base -}-import Control.Monad (when) {- base -}-import Data.Binary.Get {- 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 Data.Int {- base -}-import Data.Word {- base -}--import Sound.OSC.Coding.Byte-import Sound.OSC.Time-import Sound.OSC.Type---- | Isolate an action to operating within a fixed block of bytes. The--- action is required to consume all the bytes that it is isolated to.-isolate' :: Word32 -> Get a -> Get a-isolate' n m = do- s <- get_bytes n- case runGetOrFail m s of- Left (_, _, e) -> fail e- Right (s', _, a) ->- if B.null s'- then return a- else fail "isolate': not all bytes consumed"---- | Get a 32 bit integer in big-endian byte order.-getInt32be :: Get Int32-getInt32be = fromIntegral <$> getWord32be---- | Get a 64 bit integer in big-endian byte order.-getInt64be :: Get Int64-getInt64be = fromIntegral <$> getWord64be---- | Get an aligned OSC string.-get_string :: Get String-get_string = do- s <- getLazyByteStringNul- skip (fromIntegral (align (B.length s + 1)))- return $ C.unpack s---- | Get an aligned OSC string.-get_ascii :: Get ASCII-get_ascii = do- s <- getLazyByteStringNul- skip (fromIntegral (align (B.length s + 1)))- return (S.C.pack (C.unpack s))---- | Get binary data prefixed by byte count.-get_bytes :: Word32 -> Get B.ByteString-get_bytes n = do- b <- getLazyByteString (fromIntegral n)- if n /= fromIntegral (B.length b)- then fail "get_bytes: end of stream"- else skip (fromIntegral (align n))- return b---- | Get an OSC datum.-get_datum :: Datum_Type -> Get Datum-get_datum ty =- case ty of- 'i' -> Int32 <$> fromIntegral <$> getInt32be- 'h' -> Int64 <$> fromIntegral <$> getInt64be- 'f' -> Float <$> realToFrac <$> I.getFloat32be- 'd' -> Double <$> I.getFloat64be- 's' -> ASCII_String <$> get_ascii- 'b' -> Blob <$> (get_bytes =<< getWord32be)- 't' -> TimeStamp <$> ntpi_to_ntpr <$> getWord64be- 'm' -> do b0 <- getWord8- b1 <- getWord8- b2 <- getWord8- b3 <- getWord8- return $ Midi (MIDI b0 b1 b2 b3)- _ -> fail ("get_datum: illegal type " ++ show ty)---- | Get an OSC 'Message'.-get_message :: 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- _ -> fail "get_message: invalid type descriptor string"---- | Get a sequence of OSC 'Message's, each one headed by its length.-get_message_seq :: Get [Message]-get_message_seq = do- b <- isEmpty- if b- then return []- else do- p <- flip isolate' get_message =<< getWord32be- ps <- get_message_seq- return (p:ps)---- | Get a bundle. Fail if bundle header is not found in packet.-get_bundle :: Get Bundle-get_bundle = do- h <- getByteString (S.C.length bundleHeader_strict)- when (h /= bundleHeader_strict) (fail "get_bundle: not a bundle")- t <- ntpi_to_ntpr <$> getWord64be- ps <- get_message_seq- return $ Bundle t ps---- | Get an OSC 'Packet'.-getPacket :: Get Packet-getPacket = (Packet_Bundle <$> get_bundle) <|> (Packet_Message <$> get_message)---- | 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.ByteString -> Packet-{-# INLINE decodePacket #-}-decodePacket = runGet getPacket---- | Decode an OSC packet from a strict ByteString.-decodePacket_strict :: S.C.ByteString -> Packet-{-# INLINE decodePacket_strict #-}-decodePacket_strict = runGet getPacket . B.fromChunks . (:[])
− Sound/OSC/Coding/Encode/Base.hs
@@ -1,56 +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 (encodeMessage- ,encodeBundle- ,encodePacket) 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---- Align a 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_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_u64 $ ntpr_to_ntpi t- ASCII_String s -> extend 0 (B.snoc (encode_str s) 0)- Midi (MIDI b0 b1 b2 b3) -> B.pack [b0,b1,b2,b3]- Blob b -> let n = encode_i32 (fromIntegral (B.length b))- in B.append n (extend 0 b)---- | Encode an 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_message_blob :: Message -> Datum-encode_message_blob = Blob . encodeMessage---- | Encode an 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'.-encodePacket :: Packet -> B.ByteString-encodePacket o =- case o of- Packet_Message m -> encodeMessage m- Packet_Bundle b -> encodeBundle b
− Sound/OSC/Coding/Encode/Builder.hs
@@ -1,95 +0,0 @@--- | Optimised encode function for OSC packets.-module Sound.OSC.Coding.Encode.Builder- (build_packet- ,encodeMessage- ,encodeBundle- ,encodePacket- ,encodePacket_strict) where--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---- Generate a list of zero bytes for padding.-padding :: Integral i => i -> [Word8]-padding n = replicate (fromIntegral n) 0---- 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)))---- 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)))---- 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)))---- Encode an OSC datum.-build_datum :: Datum -> B.Builder-build_datum d =- case d of- Int32 i -> B.fromInt32be (fromIntegral i)- Int64 i -> B.fromInt64be (fromIntegral i)- Float n -> B.fromWord32be (I.floatToWord (realToFrac n))- Double n -> B.fromWord64be (I.doubleToWord n)- TimeStamp t -> B.fromWord64be (fromIntegral (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 :: NTPi -> [Message] -> B.Builder-build_bundle_ntpi t l =- mconcat [B.fromLazyByteString bundleHeader- ,B.fromWord64be t- ,mconcat $ map (build_bytes . B.toLazyByteString . build_message) l]---- | Builder monoid 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 encodeMessage #-}-{-# INLINE encodeBundle #-}-{-# INLINE encodePacket #-}-{-# INLINE encodePacket_strict #-}---- | Encode an OSC 'Message'.-encodeMessage :: Message -> L.ByteString-encodeMessage = B.toLazyByteString . build_packet . Packet_Message---- | Encode an OSC 'Bundle'.-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-encodePacket :: Packet -> L.ByteString-encodePacket = B.toLazyByteString . build_packet---- | Encode an Packet packet to a strict ByteString.-encodePacket_strict :: Packet -> S.ByteString-encodePacket_strict = B.toByteString . build_packet
− Sound/OSC/Core.hs
@@ -1,22 +0,0 @@--- | 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-module Sound.OSC.Core (module M) where--import Sound.OSC.Class as M-import Sound.OSC.Coding as M-import Sound.OSC.Datum as M-import Sound.OSC.Normalise as M-import Sound.OSC.Time as M-import Sound.OSC.Type as M-import Sound.OSC.Wait as M
− Sound/OSC/Datum.hs
@@ -1,63 +0,0 @@--- | 'Datum' related functions.-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.Word {- base -}--import Sound.OSC.Type---- | 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 (C.pack "string")) == Just (C.pack "string")-datum_ascii :: Datum -> Maybe ASCII-datum_ascii = d_get---- | 'C.unpack' of 'd_get'.------ > datum_string (d_put (C.pack "string")) == Just "string"-datum_string :: Datum -> Maybe String-datum_string = fmap C.unpack . datum_ascii---- | Type specialised 'd_get'.-datum_blob :: Datum -> Maybe B.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 (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 =- 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]- _ -> Nothing
− Sound/OSC/FD.hs
@@ -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
− Sound/OSC/Normalise.hs
@@ -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-
− Sound/OSC/Time.hs
@@ -1,111 +0,0 @@--- | 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---- | @Unix/Posix@ epoch time in real-valued (fractional) form.-type UT = Double---- * Time conversion---- | Convert a real-valued NTP timestamp to an 'NTPi' timestamp.-ntpr_to_ntpi :: RealFrac n => n -> NTPi-ntpr_to_ntpi t = round (t * 2^(32::Int))---- | Convert an 'NTPi' timestamp to a real-valued NTP timestamp.-ntpi_to_ntpr :: Fractional n => NTPi -> n-ntpi_to_ntpr t = fromIntegral t / 2^(32::Int)---- | Difference (in seconds) between /NTP/ and /UT/ epochs.------ > ntp_ut_epoch_diff / (24 * 60 * 60) == 25567-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 -> NTPi-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 :: NTPi -> UT-ntpi_to_ut = ntpr_to_ut . ntpi_to_ntpr---- * '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.------ > do {ct <- fmap utc_to_ut T.getCurrentTime--- > ;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)---- * 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,Ord n,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
− Sound/OSC/Transport/FD.hs
@@ -1,98 +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.Class-import Sound.OSC.Type-import Sound.OSC.Wait---- | Abstract over the underlying transport protocol.-class Transport t where- -- | Encode and send an OSC packet.- sendOSC :: OSC o => t -> o -> 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---- | Type restricted synonym for 'sendOSC'.-sendMessage :: Transport t => t -> Message -> IO ()-sendMessage = sendOSC---- | Type restricted synonym for 'sendOSC'.-sendBundle :: Transport t => t -> Bundle -> IO ()-sendBundle = sendOSC---- * Receive---- | Variant of 'recvPacket' that runs 'fromPacket'.-recvOSC :: (Transport t,OSC o) => t -> IO (Maybe o)-recvOSC = fmap fromPacket . recvPacket---- | 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 = 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)---- | 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)---- | '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
− Sound/OSC/Transport/FD/TCP.hs
@@ -1,43 +0,0 @@--- | OSC over TCP implementation.-module Sound.OSC.Transport.FD.TCP where--import qualified Data.ByteString.Lazy as B {- bytestring -}-import Control.Monad {- base -}-import Network {- network -}-import System.IO {- base -}--import Sound.OSC.Class-import Sound.OSC.Coding-import Sound.OSC.Coding.Byte-import Sound.OSC.Transport.FD---- | The TCP transport handle data type.-data TCP = TCP {tcpHandle :: Handle}--instance Transport TCP where- sendOSC (TCP fd) msg =- do let b = encodeOSC msg- n = fromIntegral (B.length b)- B.hPut fd (B.append (encode_u32 n) b)- hFlush fd- recvPacket (TCP fd) =- do b0 <- B.hGet fd 4- b1 <- B.hGet fd (fromIntegral (decode_u32 b0))- return (decodePacket b1)- close (TCP fd) = hClose fd---- | Make a 'TCP' connection.-openTCP :: String -> Int -> IO TCP-openTCP host =- liftM TCP .- connectTo host .- 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- f (TCP fd)- return ())
− Sound/OSC/Transport/FD/UDP.hs
@@ -1,67 +0,0 @@--- | OSC over UDP implementation.-module Sound.OSC.Transport.FD.UDP where--import Control.Monad {- base -}-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.Transport.FD---- | The UDP transport handle data type.-data UDP = UDP {udpSocket :: N.Socket}---- | Return the port number associated with the UDP socket.-udpPort :: Integral n => UDP -> IO n-udpPort (UDP fd) = fmap fromIntegral (N.socketPort fd)--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---- | 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- a <- N.inet_addr host- let sa = N.SockAddrInet (fromIntegral port) a- f fd sa- return (UDP fd)---- | Make a 'UDP' connection.------ > let t = openUDP "127.0.0.1" 57110--- > in withTransport t (\fd -> recvT 0.5 fd >>= print)-openUDP :: String -> Int -> IO UDP-openUDP = udp_socket N.connect--- N.setSocketOption fd N.RecvTimeOut 1000---- | Trivial 'UDP' server socket.------ > import Control.Concurrent------ > let {f fd = forever (recvMessage fd >>= print)--- > ;t = udpServer "127.0.0.1" 57300}--- > in void (forkIO (withTransport t f))------ > 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---- | Send variant to send to specified address.-sendTo :: OSC o => UDP -> o -> N.SockAddr -> IO ()-sendTo (UDP fd) o a = do- -- C.L.sendTo does not exist- void (C.sendTo fd (encodeOSC o) a)---- | Recv variant to collect message source address.-recvFrom :: UDP -> IO (Packet, N.SockAddr)-recvFrom (UDP fd) = do- -- C.L.recvFrom does not exist- (s,a) <- C.recvFrom fd 8192- return (decodePacket s,a)
− Sound/OSC/Transport/Monad.hs
@@ -1,114 +0,0 @@--- | Monad class implementing an Open Sound Control transport.-module Sound.OSC.Transport.Monad where--import Control.Monad (liftM) {- base -}-import Control.Monad.Trans.Reader {- transformers -}-import Control.Monad.IO.Class as M {- transformers -}-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---- | Sender monad.-class Monad m => SendOSC m where- -- | Encode and send an OSC packet.- sendOSC :: OSC o => o -> m ()---- | Receiver monad.-class Monad m => RecvOSC m where- -- | Receive and decode an OSC packet.- recvPacket :: m 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--instance (T.Transport t,MonadIO io) => SendOSC (ReaderT t io) where- sendOSC o = ReaderT (M.liftIO . flip T.sendOSC o)--instance (T.Transport t,MonadIO io) => RecvOSC (ReaderT t io) where- recvPacket = ReaderT (M.liftIO . T.recvPacket)--instance (T.Transport t,MonadIO io) => DuplexOSC (ReaderT t io) where--instance (T.Transport t,MonadIO io) => Transport (ReaderT t io) where---- | Transport connection.-type Connection t a = ReaderT t IO a---- | Bracket Open Sound Control communication.-withTransport :: T.Transport t => IO t -> Connection t a -> IO a-withTransport u = T.withTransport u . runReaderT---- * Send---- | Type restricted synonym for 'sendOSC'.-sendMessage :: SendOSC m => Message -> m ()-sendMessage = sendOSC---- | Type restricted synonym for 'sendOSC'.-sendBundle :: SendOSC m => Bundle -> m ()-sendBundle = sendOSC---- * Receive---- | Variant of 'recvPacket' that runs 'fromPacket'.-recvOSC :: (RecvOSC m,OSC o) => m (Maybe o)-recvOSC = liftM fromPacket recvPacket---- | Variant of 'recvPacket' that runs 'packet_to_bundle'.-recvBundle :: (RecvOSC m) => m Bundle-recvBundle = liftM packet_to_bundle recvPacket---- | Variant of 'recvPacket' that runs 'packet_to_message'.-recvMessage :: (RecvOSC m) => m (Maybe Message)-recvMessage = liftM packet_to_message recvPacket---- | Variant of 'recvPacket' that runs 'packetMessages'.-recvMessages :: (RecvOSC m) => m [Message]-recvMessages = liftM packetMessages recvPacket---- * Wait---- | Wait for a 'Packet' where the supplied predicate is 'True',--- discarding intervening packets.-waitUntil :: (RecvOSC m) => (Packet -> Bool) -> m Packet-waitUntil f = untilPredicate f recvPacket---- | Wait for a 'Packet' where the supplied function does not give--- 'Nothing', discarding intervening packets.-waitFor :: (RecvOSC m) => (Packet -> Maybe a) -> m a-waitFor f = untilMaybe f recvPacket---- | 'waitUntil' 'packet_is_immediate'.-waitImmediate :: RecvOSC m => m Packet-waitImmediate = waitUntil packet_is_immediate---- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or--- immediate mode 'Bundle' with one element.-waitMessage :: RecvOSC m => m Message-waitMessage = waitFor packet_to_message---- | A 'waitFor' for variant using 'packet_has_address' to match on--- the 'Address_Pattern' of incoming 'Packets'.-waitAddress :: RecvOSC m => Address_Pattern -> m Packet-waitAddress s =- let f o = if packet_has_address s o then Just o else Nothing- in waitFor f---- | Variant on 'waitAddress' that returns matching 'Message'.-waitReply :: RecvOSC m => Address_Pattern -> m Message-waitReply s =- let f = fromMaybe (error "waitReply: message not located?") .- find (message_has_address s) .- packetMessages- in liftM f (waitAddress s)---- | Variant of 'waitReply' that runs 'messageDatum'.-waitDatum :: RecvOSC m => Address_Pattern -> m [Datum]-waitDatum = liftM messageDatum . waitReply
− Sound/OSC/Type.hs
@@ -1,377 +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---- | 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---- | Pretty printer for 'Time' (truncate to 4 decimal places).------ > timePP (1/3) == "0.3333"-timePP :: Time -> String-timePP t = showGFloat (Just 4) t ""---- | 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 :: Datum -> String-datumPP d =- case d of- Int32 n -> show n- Int64 n -> show n- Float n -> show n- Double n -> show n- ASCII_String s -> show (C.unpack s)- Blob s -> show s- TimeStamp t -> timePP t- Midi (MIDI p q r s) -> vecPP [p,q,r,s]---- | Pretty printer for 'Message'.-messagePP :: Message -> String-messagePP (Message a d) =- let d' = map datumPP d- in unwords ("#message" : a : d')---- | Pretty printer for 'Bundle'.-bundlePP :: Bundle -> String-bundlePP (Bundle t m) =- let m' = intersperse ";" (map messagePP m)- in unwords ("#bundle" : timePP t : m')---- | Pretty printer for 'Packet'.-packetPP :: Packet -> String-packetPP p =- case p of- Packet_Message m -> messagePP m- Packet_Bundle b -> bundlePP 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"
− Sound/OSC/Wait.hs
@@ -1,28 +0,0 @@--- | Waiting (for replies).-module Sound.OSC.Wait where--import System.Timeout {- base -}---- * Timeout---- | Real valued variant of 'timeout'.-timeout_r :: Double -> IO a -> IO (Maybe a)-timeout_r t = timeout (floor (t * 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 rec else return p- rec = act >>= g- in rec---- | 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
+ Sound/Osc.hs view
@@ -0,0 +1,7 @@+-- | 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.Socket as M+import Sound.Osc.Transport.Monad as M
+ Sound/Osc/Coding/Byte.hs view
@@ -0,0 +1,410 @@+{- | 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 GHC.ByteOrder {- base -}++import qualified Data.Binary as Binary {- binary -}+import qualified Data.Binary.Get as Binary.Get {- binary -}+import qualified Data.Binary.Put as Binary.Put {- binary -}++import qualified Data.ByteString as ByteString {- bytestring -}+import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}+import qualified Data.ByteString.Internal as ByteString.Internal {- bytestring -}+import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}+import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8 {- bytestring -}+import qualified Data.ByteString.Unsafe as ByteString.Unsafe {- bytestring -}++import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}++-- * Encode++-- | Type specialised 'Binary.encode' (big-endian).+encode_int8 :: Int8 -> ByteString.Lazy.ByteString+encode_int8 = Binary.encode++{- | Type specialised 'Binary.encode' (big-endian).++>>> encode_int16 0x0102 == ByteString.Lazy.pack [0x01,0x02]+True+-}+encode_int16 :: Int16 -> ByteString.Lazy.ByteString+encode_int16 = Binary.encode++{- | Little-endian.++>>> encode_int16_le 0x0102 == ByteString.Lazy.pack [0x02,0x01]+True+-}+encode_int16_le :: Int16 -> ByteString.Lazy.ByteString+encode_int16_le = Binary.Put.runPut . Binary.Put.putInt16le++-- | Encode a signed 64-bit integer (big-endian).+encode_int64 :: Int64 -> ByteString.Lazy.ByteString+encode_int64 = Binary.encode++-- | Type specialised 'Binary.encode' (big-endian).+encode_word8 :: Word8 -> ByteString.Lazy.ByteString+encode_word8 = Binary.encode++{- | Type specialised 'Binary.encode' (big-endian).++>>> encode_word16 0x0102 == ByteString.Lazy.pack [0x01,0x02]+True+-}+encode_word16 :: Word16 -> ByteString.Lazy.ByteString+encode_word16 = Binary.encode++{- | Little-endian.++>>> encode_word16_le 0x0102 == ByteString.Lazy.pack [0x02,0x01]+True+-}+encode_word16_le :: Word16 -> ByteString.Lazy.ByteString+encode_word16_le = Binary.Put.runPut . Binary.Put.putWord16le++-- | Type specialised 'Binary.encode'.+encode_word32 :: Word32 -> ByteString.Lazy.ByteString+encode_word32 = Binary.encode++-- | Little-endian variant of 'encode_word32'.+encode_word32_le :: Word32 -> ByteString.Lazy.ByteString+encode_word32_le = Binary.Put.runPut . Binary.Put.putWord32le++-- | Encode an unsigned 64-bit integer.+encode_word64 :: Word64 -> ByteString.Lazy.ByteString+encode_word64 = Binary.encode++-- * Encode/Int++-- | Encode a signed 8-bit integer.+encode_i8 :: Int -> ByteString.Lazy.ByteString+encode_i8 = encode_int8 . Convert.int_to_int8++-- | Encode an un-signed 8-bit integer.+encode_u8 :: Int -> ByteString.Lazy.ByteString+encode_u8 = encode_word8 . Convert.int_to_word8++{- | Encode an un-signed 16-bit integer.++>>> encode_u16 0x0102 == ByteString.Lazy.pack [1,2]+True+-}+encode_u16 :: Int -> ByteString.Lazy.ByteString+encode_u16 = encode_word16 . Convert.int_to_word16++{- | Little-endian.++>>> encode_u16_le 0x0102 == ByteString.Lazy.pack [2,1]+True+-}+encode_u16_le :: Int -> ByteString.Lazy.ByteString+encode_u16_le = encode_word16_le . Convert.int_to_word16++-- | Encode a signed 16-bit integer.+encode_i16 :: Int -> ByteString.Lazy.ByteString+encode_i16 = Binary.encode . Convert.int_to_int16++-- | Encode a signed 32-bit integer.+encode_i32 :: Int -> ByteString.Lazy.ByteString+encode_i32 = Binary.encode . Convert.int_to_int32++{- | Encode an unsigned 32-bit integer.++>>> ByteString.Lazy.unpack (encode_u32 0x01020304)+[1,2,3,4]+-}+encode_u32 :: Int -> ByteString.Lazy.ByteString+encode_u32 = encode_word32 . Convert.int_to_word32++{- | Little-endian.++>>> ByteString.Lazy.unpack (encode_u32_le 0x01020304)+[4,3,2,1]+-}+encode_u32_le :: Int -> ByteString.Lazy.ByteString+encode_u32_le = encode_word32_le . Convert.int_to_word32++-- * Encode/Float++{- | Encode a 32-bit IEEE floating point number.++>>> ByteString.Lazy.unpack (encode_f32 3.141)+[64,73,6,37]+-}+encode_f32 :: Float -> ByteString.Lazy.ByteString+encode_f32 = Binary.Put.runPut . Binary.Put.putFloatbe++{- | Little-endian variant of 'encode_f32'.++>>> ByteString.Lazy.unpack (encode_f32_le 3.141)+[37,6,73,64]+-}+encode_f32_le :: Float -> ByteString.Lazy.ByteString+encode_f32_le = Binary.Put.runPut . Binary.Put.putFloatle++{- | Encode a 64-bit IEEE floating point number.++>>> ByteString.Lazy.unpack (encode_f64 3.141)+[64,9,32,196,155,165,227,84]+-}+encode_f64 :: Double -> ByteString.Lazy.ByteString+encode_f64 = Binary.Put.runPut . Binary.Put.putDoublebe++{- | Little-endian variant of 'encode_f64'.++>>> ByteString.Lazy.unpack (encode_f64_le 3.141)+[84,227,165,155,196,32,9,64]+-}+encode_f64_le :: Double -> ByteString.Lazy.ByteString+encode_f64_le = Binary.Put.runPut . Binary.Put.putDoublele++-- * Encode/Ascii++-- | Encode an Ascii string (Ascii at Datum is an alias for a Char8 Bytetring).+encode_ascii :: ByteString.Char8.ByteString -> ByteString.Lazy.ByteString+encode_ascii = ByteString.Lazy.pack . ByteString.unpack++-- * Decode++-- | Type specialised 'Binary.decode'.+decode_word16 :: ByteString.Lazy.ByteString -> Word16+decode_word16 = Binary.decode++-- | Little-endian variant of 'decode_word16'.+decode_word16_le :: ByteString.Lazy.ByteString -> Word16+decode_word16_le = Binary.Get.runGet Binary.Get.getWord16le++-- | Type specialised 'Binary.decode'.+decode_int16 :: ByteString.Lazy.ByteString -> Int16+decode_int16 = Binary.decode++-- | Type specialised 'Binary.decode'.+decode_word32 :: ByteString.Lazy.ByteString -> Word32+decode_word32 = Binary.decode++-- | Little-endian variant of 'decode_word32'.+decode_word32_le :: ByteString.Lazy.ByteString -> Word32+decode_word32_le = Binary.Get.runGet Binary.Get.getWord32le++-- | Type specialised 'Binary.decode'.+decode_int64 :: ByteString.Lazy.ByteString -> Int64+decode_int64 = Binary.decode++-- | Type specialised 'Binary.decode'.+decode_word64 :: ByteString.Lazy.ByteString -> Word64+decode_word64 = Binary.decode++-- * Decode/Int++-- | Decode an un-signed 8-bit integer.+decode_u8 :: ByteString.Lazy.ByteString -> Int+decode_u8 = Convert.word8_to_int . ByteString.Lazy.head++-- | Decode a signed 8-bit integer.+decode_i8 :: ByteString.Lazy.ByteString -> Int+decode_i8 = Convert.int8_to_int . Binary.decode++-- | Decode an unsigned 8-bit integer.+decode_u16 :: ByteString.Lazy.ByteString -> Int+decode_u16 = Convert.word16_to_int . decode_word16++-- | Little-endian variant of 'decode_u16'.+decode_u16_le :: ByteString.Lazy.ByteString -> Int+decode_u16_le = Convert.word16_to_int . decode_word16_le++-- | Decode a signed 16-bit integer.+decode_i16 :: ByteString.Lazy.ByteString -> Int+decode_i16 = Convert.int16_to_int . decode_int16++-- | Little-endian variant of 'decode_i16'.+decode_i16_le :: ByteString.Lazy.ByteString -> Int+decode_i16_le = decode_i16 . ByteString.Lazy.reverse++{- | Decode a signed 32-bit integer.++>>> decode_i32 (ByteString.Lazy.pack [0x00,0x00,0x03,0xe7]) == 0x03e7+True+-}+decode_i32 :: ByteString.Lazy.ByteString -> Int+decode_i32 = Convert.int32_to_int . Binary.decode++{- | Little-endian variant of 'decode_i32'.++>>> decode_i32_le (ByteString.Lazy.pack [0xe7,0x03,0x00,0x00]) == 0x03e7+True+-}+decode_i32_le :: ByteString.Lazy.ByteString -> Int+decode_i32_le = decode_i32 . ByteString.Lazy.reverse++{- | Decode an unsigned 32-bit integer.++>>> decode_u32 (ByteString.Lazy.pack [1,2,3,4]) == 0x01020304+True+-}+decode_u32 :: ByteString.Lazy.ByteString -> Int+decode_u32 = Convert.word32_to_int . decode_word32++{- | Little-endian variant of decode_u32.++>>> decode_u32_le (ByteString.Lazy.pack [1,2,3,4]) == 0x04030201+True+-}+decode_u32_le :: ByteString.Lazy.ByteString -> Int+decode_u32_le = Convert.word32_to_int . decode_word32_le++-- * Decode/Float++{- | Decode a 32-bit IEEE floating point number.++>>> decode_f32 (ByteString.Lazy.pack [64,73,6,37])+3.141+-}+decode_f32 :: ByteString.Lazy.ByteString -> Float+decode_f32 = Binary.Get.runGet Binary.Get.getFloatbe++-- | Little-endian variant of 'decode_f32'.+decode_f32_le :: ByteString.Lazy.ByteString -> Float+decode_f32_le = Binary.Get.runGet Binary.Get.getFloatle++-- | Decode a 64-bit IEEE floating point number.+decode_f64 :: ByteString.Lazy.ByteString -> Double+decode_f64 = Binary.Get.runGet Binary.Get.getDoublebe++-- * Decode/Ascii++-- | Decode an Ascii string, inverse of 'encode_ascii'.+decode_ascii :: ByteString.Lazy.ByteString -> ByteString.Char8.ByteString+{-# INLINE decode_ascii #-}+decode_ascii = ByteString.Char8.pack . ByteString.Lazy.Char8.unpack++-- * IO++-- | Read /n/ bytes from /h/ and run /f/.+read_decode :: (ByteString.Lazy.ByteString -> t) -> Int -> Handle -> IO t+read_decode f n = fmap f . flip ByteString.Lazy.hGet n++-- | Type-specialised reader for 'Binary.decode'.+read_word32 :: Handle -> IO Word32+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++-- | 'ByteString.Lazy.hPut' of 'encode_word32'.+write_word32 :: Handle -> Word32 -> IO ()+write_word32 h = ByteString.Lazy.hPut h . encode_word32++-- | 'ByteString.Lazy.hPut' of 'encode_word32_le'.+write_word32_le :: Handle -> Word32 -> IO ()+write_word32_le h = ByteString.Lazy.hPut h . encode_word32_le++-- * Io/Int++-- | 'decode_i8' of 'ByteString.Lazy.hGet'.+read_i8 :: Handle -> IO Int+read_i8 = read_decode decode_i8 1++-- | 'decode_i16' of 'ByteString.Lazy.hGet'.+read_i16 :: Handle -> IO Int+read_i16 = read_decode decode_i16 2++-- | 'decode_i32' of 'ByteString.Lazy.hGet'.+read_i32 :: Handle -> IO Int+read_i32 = read_decode decode_i32 4++-- | 'decode_i32_le' of 'ByteString.Lazy.hGet'.+read_i32_le :: Handle -> IO Int+read_i32_le = read_decode decode_i32_le 4++-- | 'decode_u32' of 'ByteString.Lazy.hGet'.+read_u32 :: Handle -> IO Int+read_u32 = read_decode decode_u32 4++-- | 'decode_u32_le' of 'ByteString.Lazy.hGet'.+read_u32_le :: Handle -> IO Int+read_u32_le = read_decode decode_u32_le 4++-- | 'ByteString.Lazy.hPut' of 'encode_u32'.+write_u32 :: Handle -> Int -> IO ()+write_u32 h = ByteString.Lazy.hPut h . encode_u32++-- | 'ByteString.Lazy.hPut' of 'encode_u32_le'.+write_u32_le :: Handle -> Int -> IO ()+write_u32_le h = ByteString.Lazy.hPut h . encode_u32_le++-- * Io/Float++-- | 'decode_f32' of 'ByteString.Lazy.hGet'.+read_f32 :: Handle -> IO Float+read_f32 = read_decode decode_f32 4++-- | 'decode_f32_le' of 'ByteString.Lazy.hGet'.+read_f32_le :: Handle -> IO Float+read_f32_le = read_decode decode_f32_le 4++-- * Io/Ascii++-- | Read u8 length prefixed Ascii string (pascal string).+read_pstr :: Handle -> IO ByteString.Char8.ByteString+read_pstr h = do+ n <- fmap decode_u8 (ByteString.Lazy.hGet h 1)+ fmap decode_ascii (ByteString.Lazy.hGet h n)++-- * Util++{- | Bundle header as a (strict) 'ByteString.Char8.ByteString'.++>>> ByteString.Char8.length bundleHeader_strict+8+-}+bundleHeader_strict :: ByteString.Char8.ByteString+bundleHeader_strict = ByteString.Char8.pack "#bundle\0"++{- | Bundle header as a lazy ByteString.++>>> ByteString.Lazy.length bundleHeader+8+-}+bundleHeader :: ByteString.Lazy.ByteString+{-# INLINE bundleHeader #-}+bundleHeader = ByteString.Lazy.Char8.fromChunks [bundleHeader_strict]++{- | The number of bytes required to align an Osc value to the next 4-byte boundary.++>>> map align [0::Int .. 7]+[0,3,2,1,0,3,2,1]++>>> map align [512::Int .. 519]+[0,3,2,1,0,3,2,1]+-}+align :: (Num i, Bits i) => i -> i+{-# INLINE align #-}+align n = ((n + 3) .&. complement 3) - n++-- * ByteString++-- | Is machine little endian?+isLittleEndian :: Bool+isLittleEndian = GHC.ByteOrder.targetByteOrder == GHC.ByteOrder.LittleEndian++-- | Byte-swap byte string in four-byte segments.+byteStringSwap32BitWords :: ByteString.ByteString -> ByteString.ByteString+byteStringSwap32BitWords xs =+ ByteString.Internal.unsafePackLenBytes+ (ByteString.length xs `quot` 4 * 4)+ [ ByteString.Unsafe.unsafeIndex xs $ i * 4 + j+ | i <- [0 .. ByteString.length xs `quot` 4 - 1]+ , j <- [3, 2, 1, 0]+ ]++-- | If target is little-endian, swap bytes to be in network order, else identity.+byteString32BitNetworkOrder :: ByteString.ByteString -> ByteString.ByteString+byteString32BitNetworkOrder x = if isLittleEndian then byteStringSwap32BitWords x else x
+ Sound/Osc/Coding/Cast.hs view
@@ -0,0 +1,72 @@+-- | Bit-level type casts and byte layout string typecasts.+module Sound.Osc.Coding.Cast where++import Data.Char {- base -}+import Data.Word {- base -}++import Sound.Osc.Coding.Byte {- hosc3 -}+import Sound.Osc.Coding.Convert {- hosc -}++{- | The IEEE byte representation of a float.++>>> f32_w32 pi+1078530011++>>> f32_w32 (-7913907.5)+3404825447++>>> 23 ^ 7+3404825447+-}+f32_w32 :: Float -> Word32+f32_w32 = decode_word32 . encode_f32++{- | Inverse of 'f32_w32'.++>>> w32_f32 1078530011+3.1415927++>>> w32_f32 (23 ^ 7)+-7913907.5+-}+w32_f32 :: Word32 -> Float+w32_f32 = decode_f32 . encode_word32++{- | The IEEE byte representation of a double.+++>>> f64_w64 pi+4614256656552045848++>>> f64_w64 1.6822072834e-314+3404825447+-}+f64_w64 :: Double -> Word64+f64_w64 = decode_word64 . encode_f64++{- | Inverse of 'f64_w64'.++>>> w64_f64 4614256656552045848+3.141592653589793++>>> w64_f64 (23 ^ 7)+1.6822072834e-314+-}+w64_f64 :: Word64 -> Double+w64_f64 = decode_f64 . encode_word64++-- | 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
+ Sound/Osc/Coding/Convert.hs view
@@ -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
+ Sound/Osc/Coding/Decode/Base.hs view
@@ -0,0 +1,122 @@+{- | 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' ->+ case B.unpack (B.take 4 b) of+ [b0, b1, b2, b3] -> midi (b0, b1, b2, b3)+ _ -> error "decode_datum: illegal midi data"+ _ -> error ("decode_datum: illegal type (" ++ [ty] ++ ")")++-- | Decode a sequence of Osc datum given a type descriptor string.+decode_datum_seq :: Ascii -> B.ByteString -> [Datum]+decode_datum_seq cs b =+ let swap (x, y) = (y, x)+ cs' = C.unpack cs+ f b' c = swap (B.splitAt (int_to_int64 (storage c b')) b')+ in zipWith decode_datum cs' (snd (mapAccumL f b cs'))++-- | Decode an Osc 'Message'.+decodeMessage :: B.ByteString -> Message+decodeMessage b =+ let n = storage 's' b+ cmd = decode_datum 's' b+ m = storage 's' (b_drop n b)+ in case (cmd, decode_datum 's' (b_drop n b)) of+ (AsciiString cmd', AsciiString dsc) ->+ let arg = decode_datum_seq (descriptor_tags dsc) (b_drop (n + m) b)+ in Message (C.unpack cmd') arg+ _ -> error "decodeMessage"++-- | Decode a sequence of length prefixed (Int32) Osc messages.+decode_message_seq :: B.ByteString -> [Message]+decode_message_seq b =+ let s = decode_i32 b+ m = decodeMessage (b_drop 4 b)+ nxt = decode_message_seq (b_drop (4 + s) b)+ in if B.length b == 0 then [] else m : nxt++-- | Decode an Osc 'Bundle'.+decodeBundle :: B.ByteString -> BundleOf Message+decodeBundle b =+ let h = storage 's' b -- header (should be '#bundle')+ t = storage 't' (b_drop h b) -- time+ in case decode_datum 't' (b_drop h b) of+ TimeStamp timeStamp -> Bundle timeStamp (decode_message_seq (b_drop (h + t) b))+ _ -> error "decodeBundle"++{- | Decode an Osc 'Packet'.++>>> let b = B.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+>>> decodePacket b == Packet_Message (Message "/g_free" [Int32 0])+True+-}+decodePacket :: B.ByteString -> PacketOf Message+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
+ Sound/Osc/Coding/Decode/Binary.hs view
@@ -0,0 +1,152 @@+-- | Optimised decode function for Osc packets.+module Sound.Osc.Coding.Decode.Binary (+ get_packet,+ decodeMessage,+ decodeBundle,+ decodePacket,+ decodePacket_strict,+ decodeMessageOr,+ decodeBundleOr,+ decodePacketOr,+) where++import Control.Applicative {- base -}+import Control.Monad {- base -}+import Data.Word {- base -}++import qualified Data.Binary.Get as Binary {- binary -}++import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}+import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}+import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8 {- bytestring -}++import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}+import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}+import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc -}+import qualified Sound.Osc.Time as Time {- hosc -}++-- | Get an aligned Osc string.+get_string :: Binary.Get String+get_string = do+ s <- Binary.getLazyByteStringNul+ Binary.skip (Convert.int64_to_int (Byte.align (ByteString.Lazy.length s + 1)))+ return (ByteString.Lazy.Char8.unpack s)++-- | Get an aligned Osc string.+get_ascii :: Binary.Get Ascii+get_ascii = do+ s <- Binary.getLazyByteStringNul+ Binary.skip (Convert.int64_to_int (Byte.align (ByteString.Lazy.length s + 1)))+ return (ByteString.Char8.pack (ByteString.Lazy.Char8.unpack s))++-- | Get binary data prefixed by byte count.+get_bytes :: Word32 -> Binary.Get ByteString.Lazy.ByteString+get_bytes n = do+ b <- Binary.getLazyByteString (Convert.word32_to_int64 n)+ if n /= Convert.int64_to_word32 (ByteString.Lazy.length b)+ then fail "get_bytes: end of stream"+ else Binary.skip (Convert.word32_to_int (Byte.align n))+ return b++-- | Get an Osc datum.+get_datum :: DatumType -> Binary.Get Datum+get_datum ty =+ case ty of+ 'i' -> fmap Int32 Binary.getInt32be+ 'h' -> fmap Int64 Binary.getInt64be+ 'f' -> fmap Float Binary.getFloatbe+ 'd' -> fmap Double Binary.getDoublebe+ 's' -> fmap AsciiString get_ascii+ 'b' -> fmap Blob (get_bytes =<< Binary.getWord32be)+ 't' -> fmap (TimeStamp . Time.ntpi_to_ntpr) Binary.getWord64be+ 'm' -> fmap Midi (liftM4 MidiData Binary.getWord8 Binary.getWord8 Binary.getWord8 Binary.getWord8)+ _ -> fail ("get_datum: illegal type " ++ show ty)++-- | Get an Osc 'Message', fail if type descriptor is invalid.+get_message :: Binary.Get Message+get_message = do+ cmd <- get_string+ dsc <- get_ascii+ case ByteString.Char8.unpack dsc of+ ',' : tags -> do+ arg <- mapM get_datum tags+ return (Message cmd arg)+ e -> fail ("get_message: invalid type descriptor string: " ++ e)++-- | 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 . Convert.word32_to_int =<< Binary.getWord32be+ ps <- get_message_seq+ return (p : ps)++-- | Get a bundle. Fail if bundle header is not found in packet.+get_bundle :: Binary.Get (BundleOf Message)+get_bundle = do+ h <- Binary.getByteString (ByteString.Char8.length Byte.bundleHeader_strict)+ when (h /= Byte.bundleHeader_strict) (fail "get_bundle: not a bundle")+ t <- fmap Time.ntpi_to_ntpr Binary.getWord64be+ fmap (Bundle t) get_message_seq++-- | Get an Osc 'Packet'.+get_packet :: Binary.Get (PacketOf Message)+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]+True+-}+decodeMessage :: ByteString.Lazy.ByteString -> Message+decodeMessage = Binary.runGet get_message++-- | Decode an Osc 'Bundle' from a lazy ByteString.+decodeBundle :: ByteString.Lazy.ByteString -> BundleOf Message+decodeBundle = Binary.runGet get_bundle++-- | Run decoder and report any error.+runDecoder :: Binary.Get t -> ByteString.Lazy.Char8.ByteString -> Either String t+runDecoder f p =+ case Binary.runGetOrFail f p of+ Left (_, _, err) -> Left err+ Right (_, _, decoded) -> Right decoded++{- | Decode an Osc packet from a lazy ByteString.++>>> let b = ByteString.Lazy.pack [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+>>> decodePacket b == Packet_Message (Message "/g_free" [Int32 0])+True+-}+decodePacket :: ByteString.Lazy.ByteString -> PacketOf Message+decodePacket = Binary.runGet get_packet++-- | Decode an Osc packet from a strict Char8 ByteString.+decodePacket_strict :: ByteString.Char8.ByteString -> PacketOf Message+decodePacket_strict = Binary.runGet get_packet . ByteString.Lazy.fromChunks . (: [])++{- | Either decode Osc message or return an error message.+Prevents application halt for non-valid message/bundle/packet arrives.++>>> let b = ByteString.Lazy.pack [1,2,3,2,1]+>>> decodePacketOr b+Left "not enough bytes"+-}+decodeMessageOr :: ByteString.Lazy.ByteString -> Either String Message+decodeMessageOr = runDecoder get_message++decodeBundleOr :: ByteString.Lazy.ByteString -> Either String Bundle+decodeBundleOr = runDecoder get_bundle++decodePacketOr :: ByteString.Lazy.ByteString -> Either String Packet+decodePacketOr = runDecoder get_packet
+ Sound/Osc/Coding/Encode/Base.hs view
@@ -0,0 +1,117 @@+{- | 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]+True++>>> encode_datum (Float 1) == B.pack [63, 128, 0, 0]+True++>>> encode_datum (Float 2) == B.pack [64, 0, 0, 0]+True++>>> encode_datum (Float 3) == B.pack [64, 64, 0, 0]+True++>>> encode_datum (Float 4) == B.pack [64, 128, 0, 0]+True++>>> encode_datum (Float 5) == B.pack [64, 160, 0, 0]+True++>>> encode_datum (Int32 65536) == B.pack [0, 1, 0, 0]+True++>>> encode_datum (Int32 (-65536)) == B.pack [255, 255, 0, 0]+True+-}+encode_datum :: Datum -> B.ByteString+encode_datum dt =+ case dt of+ Int32 i -> encode i+ Int64 i -> encode i+ Float f -> encode_f32 f+ Double d -> encode_f64 d+ TimeStamp t -> encode_word64 $ ntpr_to_ntpi t+ AsciiString s -> extend 0 (B.snoc (encode_ascii s) 0)+ Midi (MidiData b0 b1 b2 b3) -> B.pack [b0, b1, b2, b3]+ Blob b ->+ let n = encode (int64_to_int32 (B.length b))+ in B.append n (extend 0 b)++{- | Encode Osc 'Message'.++>>> blob_unpack (encodeMessage (Message "/x" []))+[47,120,0,0,44,0,0,0]++>>> blob_unpack (encodeMessage (Message "/y" [float 3.141]))+[47,121,0,0,44,102,0,0,64,73,6,37]++>>> let m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1]+>>> let e = blob_unpack (encodeMessage m)+>>> length e+40++>>> take 20 e+[47,110,95,115,101,116,0,0,44,105,115,102,115,102,0,0,255,255,255,255]+-}+encodeMessage :: Message -> B.ByteString+encodeMessage (Message c l) =+ B.concat+ [ encode_datum (AsciiString (C.pack c))+ , encode_datum (AsciiString (descriptor l))+ , B.concat (map encode_datum l)+ ]++-- | Encode Osc 'Message' as an Osc blob.+encode_message_blob :: Message -> Datum+encode_message_blob = Blob . encodeMessage++{- | Encode Osc 'Bundle'.++>>> blob_unpack (encodeBundle (Bundle immediately [Message "/x" []]))+[35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,8,47,120,0,0,44,0,0,0]++>>> let m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1]+>>> let b = Bundle 0.0 [m]+>>> let e = blob_unpack (encodeBundle b)+>>> length e+60++>> take 20 e+[35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,0,0,0,0,40]+-}+encodeBundle :: BundleOf Message -> B.ByteString+encodeBundle (Bundle t m) =+ B.concat+ [ bundleHeader+ , encode_word64 (ntpr_to_ntpi t)+ , B.concat (map (encode_datum . encode_message_blob) m)+ ]++-- | Encode Osc 'Packet'.+encodePacket :: PacketOf Message -> B.ByteString+encodePacket o =+ case o of+ Packet_Message m -> encodeMessage m+ Packet_Bundle b -> encodeBundle b
+ Sound/Osc/Coding/Encode/Builder.hs view
@@ -0,0 +1,115 @@+-- | 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 Blaze.ByteString.Builder as B {- bytestring -}+import qualified Blaze.ByteString.Builder.Char8 as B {- bytestring -}+import qualified Data.ByteString as S {- bytestring -}+import qualified Data.ByteString.Lazy as L {- bytestring -}++import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}+import qualified Sound.Osc.Coding.Cast as Cast {- hosc -}+import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}+import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc -}+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 (Cast.f32_w32 n)+ Double n -> B.fromWord64be (Cast.f64_w64 n)+ TimeStamp t -> B.fromWord64be (ntpr_to_ntpi t)+ AsciiString s -> build_ascii s+ Midi (MidiData b0 b1 b2 b3) -> B.fromWord8s [b0, b1, b2, b3]+ Blob b -> build_bytes b++-- Encode an Osc 'Message'.+build_message :: Message -> B.Builder+build_message (Message c l) =+ mconcat+ [ build_string c+ , build_ascii (descriptor l)+ , mconcat (map build_datum l)+ ]++-- 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 :: PacketOf Message -> B.Builder+build_packet o =+ case o of+ Packet_Message m -> build_message m+ Packet_Bundle (Bundle t m) -> build_bundle_ntpi (ntpr_to_ntpi t) m++{-# INLINE encodePacket #-}+{-# INLINE encodeMessage #-}+{-# INLINE encodeBundle #-}+{-# INLINE encodePacket_strict #-}++-- | Encode an Osc 'Packet'.+encodePacket :: PacketOf Message -> L.ByteString+encodePacket = B.toLazyByteString . build_packet++{- | Encode an Osc 'Message', ie. 'encodePacket' of 'Packet_Message'.++>>> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+>>> encodeMessage (Message "/g_free" [Int32 0]) == L.pack m+True+-}+encodeMessage :: Message -> L.ByteString+encodeMessage = encodePacket . Packet_Message++{- | Encode an Osc 'Bundle', ie. 'encodePacket' of 'Packet_Bundle'.++>>> let m = [47,103,95,102,114,101,101,0,44,105,0,0,0,0,0,0]+>>> let b = [35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,16] ++ m+>>> encodeBundle (Bundle immediately [Message "/g_free" [Int32 0]]) == L.pack b+True+-}+encodeBundle :: BundleOf Message -> L.ByteString+encodeBundle = encodePacket . Packet_Bundle++-- | Encode an Osc 'Packet' to a strict 'S.ByteString'.+encodePacket_strict :: PacketOf Message -> S.ByteString+encodePacket_strict = B.toByteString . build_packet
+ Sound/Osc/Core.hs view
@@ -0,0 +1,21 @@+{- | Composite of non-transport related modules.++Provides the 'Datum', 'Message', 'Time', 'Bundle' and 'Packet' types+and the coding functions 'encodePacket' and 'decodePacket'.++>>> let o = bundle immediately [message "/g_free" [Int32 0]]+>>> let e = encodeBundle o+>>> decodePacket e == Packet_Bundle o+True+-}+module Sound.Osc.Core (module M) where++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
+ Sound/Osc/Datum.hs view
@@ -0,0 +1,264 @@+-- | Osc data types.+module Sound.Osc.Datum where++import Data.Int {- base -}+import Data.Maybe {- base -}+import Data.Word {- base -}++import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}+import qualified Data.ByteString.Lazy as ByteString.Lazy {- 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 pack.+blob_pack_int :: [Int] -> Blob+blob_pack_int = ByteString.Lazy.pack . map fromIntegral++-- | Type-specialised unpack.+blob_unpack :: Blob -> [Word8]+blob_unpack = ByteString.Lazy.unpack++-- | 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 pack.+midi_pack_int :: [Int] -> MidiData+midi_pack_int = midi_pack . map fromIntegral++-- | Type-specialised unpack.+midi_unpack_int :: MidiData -> [Int]+midi_unpack_int (MidiData m1 m2 m3 m4) = map fromIntegral [m1, m2, m3, m4]++{- | 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]+True+-}+datum_integral :: Integral i => Datum -> Maybe i+datum_integral d =+ case d of+ Int32 x -> Just (fromIntegral x)+ Int64 x -> Just (fromIntegral x)+ _ -> Nothing++{- | 'Datum' as 'Floating' if Int32, Int64, Float, Double or TimeStamp.++>>> let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]+>>> mapMaybe datum_floating d == replicate 5 (5::Double)+True+-}+datum_floating :: Floating n => Datum -> Maybe n+datum_floating d =+ case d of+ Int32 n -> Just (fromIntegral n)+ Int64 n -> Just (fromIntegral n)+ Float n -> Just (realToFrac n)+ Double n -> Just (realToFrac n)+ TimeStamp n -> Just (realToFrac n)+ _ -> Nothing++-- * Constructors++{- | Type generalised 'Int32'.++>>> int32 (1::Int32) == int32 (1::Integer)+True++>>> d_int32 (int32 (maxBound::Int32)) == maxBound+True++>>> int32 (((2::Int) ^ (64::Int))::Int) == Int32 0+True+-}+int32 :: Integral n => n -> Datum+int32 = Int32 . fromIntegral++{- | Type generalised Int64.++>>> int64 (1::Int32) == int64 (1::Integer)+True++>>> d_int64 (int64 (maxBound::Int64)) == maxBound+True+-}+int64 :: Integral n => n -> Datum+int64 = Int64 . fromIntegral++{- | Type generalised Float.++>>> float (1::Int) == float (1::Double)+True++>>> floatRange (undefined::Float)+(-125,128)++>>> isInfinite (d_float (float (encodeFloat 1 256 :: Double)))+True+-}+float :: Real n => n -> Datum+float = Float . realToFrac++{- | Type generalised Double.++>>> double (1::Int) == double (1::Double)+True++>>> double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77+True+-}+double :: Real n => n -> Datum+double = Double . realToFrac++{- | 'AsciiString' of pack.++>>> string "string" == AsciiString (ByteString.Char8.pack "string")+True+-}+string :: String -> Datum+string = AsciiString . ascii++{- | Four-tuple variant of 'Midi' '.' 'MidiData'.++>>> midi (0,0,0,0) == Midi (MidiData 0 0 0 0)+True+-}+midi :: (Word8, Word8, Word8, Word8) -> Datum+midi (p, q, r, s) = Midi (MidiData p q r s)++-- | 'Blob' of 'blob_pack'.+blob :: [Word8] -> Datum+blob = Blob . blob_pack++-- * 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"+True+-}+descriptor :: [Datum] -> Ascii+descriptor = ascii . signatureFor++-- | Descriptor tags are @comma@ prefixed.+descriptor_tags :: Ascii -> Ascii+descriptor_tags = ByteString.Char8.drop 1
+ Sound/Osc/Fd.hs view
@@ -0,0 +1,6 @@+-- | 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.Socket as M
+ Sound/Osc/Packet.hs view
@@ -0,0 +1,142 @@+-- | 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.+The type parameter specifies the element type.+Ordinarily this is Message, which does not allow recursion.+-}+data BundleOf t = Bundle+ { bundleTime :: !Time+ , bundleMessages :: ![t]+ }+ deriving (Eq, Read, Show)++type Bundle = BundleOf Message++-- | Osc 'Bundle's can be ordered (time ascending).+instance Eq t => Ord (BundleOf t) where+ compare (Bundle a _) (Bundle b _) = compare a b++-- | 'Bundle' constructor. It is an 'error' if the 'Message' list is empty.+bundle :: Time -> [t] -> BundleOf t+bundle t xs =+ case xs of+ [] -> error "bundle: empty?"+ _ -> Bundle t xs++-- * Packet++-- | An Osc 'Packet' is either a 'Message' or a 'Bundle t'.+data PacketOf t+ = Packet_Message {packetMessage :: !Message}+ | Packet_Bundle {packetBundle :: !(BundleOf t)}+ deriving (Eq, Read, Show)++type Packet = PacketOf Message++-- | 'Packet_Bundle' of 'bundle'.+p_bundle :: Time -> [t] -> PacketOf t+p_bundle t = Packet_Bundle . bundle t++-- | 'Packet_Message' of 'message'.+p_message :: Address_Pattern -> [Datum] -> PacketOf t+p_message a = Packet_Message . message a++{- | Constant indicating a bundle to be executed immediately.+It has the Ntp64 representation of @1@.++>>> immediately == (1 / (2 ^ 32))+True+-}+immediately :: Time+immediately = 1 / 2 ^ (32 :: Int)++-- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is 'immediately'.+packetTime :: PacketOf t -> Time+packetTime = at_packet (const immediately) bundleTime++-- | Retrieve the set of 'Message's from a 'Packet'.+packetMessages :: PacketOf Message -> [Message]+packetMessages = at_packet return bundleMessages++-- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.+packet_to_bundle :: PacketOf Message -> BundleOf Message+packet_to_bundle = at_packet (\m -> Bundle immediately [m]) id++{- | If 'Packet' is a 'Message' or a 'Bundle' with an /immediate/ time+tag and with one element, return the 'Message', else 'Nothing'.+-}+packet_to_message :: PacketOf Message -> Maybe Message+packet_to_message p =+ case p of+ Packet_Bundle b ->+ case b of+ Bundle t [m] -> if t == immediately then Just m else Nothing+ _ -> Nothing+ Packet_Message m -> Just m++-- | Is 'Packet' immediate, ie. a 'Bundle' with timestamp 'immediately', or a plain Message.+packet_is_immediate :: PacketOf t -> Bool+packet_is_immediate = (== immediately) . packetTime++-- | Variant of 'either' for 'Packet'.+at_packet :: (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a+at_packet f g p =+ case p of+ Packet_Message m -> f m+ Packet_Bundle b -> g b++-- * 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 Message' have the specified+'Address_Pattern'.+-}+bundle_has_address :: Address_Pattern -> BundleOf Message -> Bool+bundle_has_address x = any (message_has_address x) . bundleMessages++{- | Does 'Packet' have the specified 'Address_Pattern', ie.+'message_has_address' or 'bundle_has_address'.+-}+packet_has_address :: Address_Pattern -> PacketOf Message -> Bool+packet_has_address x =+ at_packet+ (message_has_address x)+ (bundle_has_address x)
+ Sound/Osc/Text.hs view
@@ -0,0 +1,279 @@+-- | 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 Safe {- safe -}++import qualified Text.ParserCombinators.Parsec as P {- parsec -}++import Sound.Osc.Datum {- hosc -}+import Sound.Osc.Packet {- hosc3 -}+import qualified Sound.Osc.Time as Time {- hosc3 -}++-- | Precision value for floating point numbers.+type FpPrecision = Maybe Int++{- | Variant of 'showFFloat' that deletes trailing zeros.++>>> map (showFloatWithPrecision (Just 4)) [1, 2.0, pi]+["1.0","2.0","3.1416"]+-}+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).++>>> map escapeString ["str", "str ", "st r", "s\tr", "s\\tr", "\nstr"]+["str","str\\ ","st\\ r","s\\\tr","s\\\\tr","\\\nstr"]+-}+escapeString :: String -> String+escapeString txt =+ case txt of+ [] -> []+ c : txt' -> if c `elem` "\\\t\n " then '\\' : c : escapeString txt' else c : escapeString txt'++{- | Printer for Datum.++>>> let aDatumSeq = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60),blob [12,16], TimeStamp 100.0]+>>> map (showDatum (Just 5)) aDatumSeq+["1","1.2","str","00904060","0c10","429496729600"]+-}+showDatum :: FpPrecision -> Datum -> String+showDatum p d =+ case d of+ Int32 n -> show n+ Int64 n -> show n+ Float n -> showFloatWithPrecision p n+ Double n -> showFloatWithPrecision p n+ AsciiString s -> escapeString (ascii_to_string s)+ Blob s -> showBytes (blob_unpack_int s)+ TimeStamp t -> show (Time.ntpr_to_ntpi t)+ Midi m -> showBytes (midi_unpack_int m)++{- | Printer for Message.++>>> let aMessage = Message "/addr" [Int32 1, Int64 2, Float 3, Double 4, string "five", blob [6, 7], midi (8, 9, 10, 11)]+>>> showMessage (Just 4) aMessage+"/addr ,ihfdsbm 1 2 3.0 4.0 five 0607 08090a0b"++>>> let aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3], Message "/s_new" [string "sine", Int32 (-1), Int32 1, Int32 1]]+>>> map (showMessage (Just 4)) aMessageSeq+["/c_set ,if 1 2.3","/s_new ,siii sine -1 1 1"]+-}+showMessage :: FpPrecision -> Message -> String+showMessage precision aMessage =+ unwords+ [ messageAddress aMessage+ , messageSignature aMessage+ , unwords (map (showDatum precision) (messageDatum aMessage))+ ]++{- | Printer for Bundle++>>> let aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]+>>> showBundle (Just 4) aBundle+"#bundle 4294967296 2 /c_set ,ifhd 1 2.3 4 5.6 /memset ,sb addr 0708"+-}+showBundle :: FpPrecision -> BundleOf Message -> String+showBundle precision aBundle =+ let messages = bundleMessages aBundle+ in unwords+ [ "#bundle"+ , show (Time.ntpr_to_ntpi (bundleTime aBundle))+ , show (length messages)+ , unwords (map (showMessage precision) messages)+ ]++-- | Printer for Packet.+showPacket :: FpPrecision -> PacketOf Message -> 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 . Time.ntpi_to_ntpr) integerP+ _ -> error "datumP: type?"++-- | Message parser.+messageP :: P Message+messageP = do+ address <- oscAddressP+ typeSignature <- oscSignatureP+ datum <- mapM datumP (Safe.tailNote "messageP" typeSignature)+ return (Message address datum)++-- | Bundle tag parser.+bundleTagP :: P String+bundleTagP = lexemeP (P.string "#bundle")++-- | Bundle parser.+bundleP :: P (BundleOf Message)+bundleP = do+ _ <- bundleTagP+ timestamp <- fmap Time.ntpi_to_ntpr integerP+ messageCount <- integerP+ messages <- replicateM messageCount messageP+ return (Bundle timestamp messages)++-- | Packet parser.+packetP :: P (PacketOf Message)+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)+True++>>> parseDatum 'f' "-2.3" == Float (-2.3)+True+-}+parseDatum :: Char -> String -> Datum+parseDatum typ = runP (datumP typ)++{- | Run message parser.++>>> let aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]+>>> map (parseMessage . showMessage (Just 4)) aMessageSeq == aMessageSeq+True+-}+parseMessage :: String -> Message+parseMessage = runP messageP++{- | Run bundle parser.++>>> let aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]+>>> parseBundle (showBundle (Just 4) aBundle) == aBundle+True+-}+parseBundle :: String -> BundleOf Message+parseBundle = runP bundleP++{- | Run packet parser.++>>> let aPacket = Packet_Bundle (Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]])+>>> parsePacket (showPacket (Just 4) aPacket) == aPacket+True+-}+parsePacket :: String -> PacketOf Message+parsePacket = runP packetP
+ Sound/Osc/Time.hs view
@@ -0,0 +1,116 @@+{- | Osc related timing functions.+ Osc timestamps are 64-bit @Ntp@ values, <http://ntp.org/>.+-}+module Sound.Osc.Time where++import Data.Word {- base -}++import qualified Data.Time as Time {- time -}+import qualified Data.Time.Clock as Clock {- time -}+import qualified Data.Time.Clock.POSIX as Clock.Posix {- time -}++import Sound.Osc.Coding.Convert {- hosc -}++-- * Temporal types++{- | Type for binary (integeral) representation of a 64-bit Ntp timestamp (ie. ntpi).+ The Ntp epoch is January 1, 1900.+ Ntp v4 also includes a 128-bit format, which is not used by Osc.+-}+type Ntp64 = Word64++-- | @Ntp@ time in real-valued (fractional) form.+type NtpReal = Double++{- | @Unix/Posix@ time in real-valued (fractional) form.+ The Unix/Posix epoch is January 1, 1970.+-}+type PosixReal = Double++-- * Time conversion++{- | Convert an NtpReal timestamp to an Ntp64 timestamp.++>>> ntpr_to_ntpi 0+0++> fmap ntpr_to_ntpi time+-}+ntpr_to_ntpi :: NtpReal -> Ntp64+ntpr_to_ntpi t = round (t * (2 ^ (32 :: Int)))++{- | Convert an 'Ntp64' timestamp to a real-valued Ntp timestamp.++>>> ntpi_to_ntpr 0+0.0+-}+ntpi_to_ntpr :: Ntp64 -> NtpReal+ntpi_to_ntpr t = word64_to_double t / 2 ^ (32 :: Int)++{- | Difference (in seconds) between /Ntp/ and /Posix/ epochs.++>>> ntp_posix_epoch_diff / (24 * 60 * 60)+25567.0++>>> 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
+ Sound/Osc/Time/System.hs view
@@ -0,0 +1,25 @@+-- | 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 qualified Sound.Osc.Time as Time {- hosc -}++{- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored.+ getSystemTime is typically much faster than getCurrentTime, however it is not available in Hugs.+-}+getSystemTimeAsNtpReal :: IO Time.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)
+ Sound/Osc/Time/Thread.hs view
@@ -0,0 +1,39 @@+-- | Thread operations.+module Sound.Osc.Time.Thread where++import Control.Concurrent {- base -}+import Control.Monad {- base -}++import qualified Sound.Osc.Time as Time {- hosc -}++{- | The 'pauseThread' limit (in seconds).+ Values larger than this require a different thread delay mechanism, see 'sleepThread'.+ The value is the number of microseconds in @maxBound::Int@.+-}+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 =<< Time.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 =<< Time.currentTime
+ Sound/Osc/Time/Thread/MonadIO.hs view
@@ -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 qualified Sound.Osc.Time as Time {- hosc -}+import qualified Sound.Osc.Time.Thread as Time.Thread {- hosc -}++time :: MonadIO m => m Time.NtpReal+time = liftIO Time.currentTime++pauseThread :: (MonadIO m, RealFrac n) => n -> m ()+pauseThread = liftIO . Time.Thread.pauseThreadFor++wait :: MonadIO m => Double -> m ()+wait = pauseThread++pauseThreadUntil :: (MonadIO m, RealFrac n) => n -> m ()+pauseThreadUntil = liftIO . Time.Thread.pauseThreadUntilTime++sleepThread :: (RealFrac n, MonadIO m) => n -> m ()+sleepThread = liftIO . Time.Thread.sleepThreadFor++sleepThreadUntil :: (RealFrac n, MonadIO m) => n -> m ()+sleepThreadUntil = liftIO . Time.Thread.sleepThreadUntilTime
+ Sound/Osc/Time/Timeout.hs view
@@ -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 (PacketOf Message))+recvPacketTimeout n fd = timeout_r n (recvPacket fd)
+ Sound/Osc/Transport/Fd.hs view
@@ -0,0 +1,101 @@+-- | 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 -> PacketOf Message -> IO ()++ -- | Receive and decode an Osc packet.+ recvPacket :: t -> IO (PacketOf Message)++ -- | Receive and either decode an Osc packet.+ recvPacketOr :: t -> IO (Either String Packet)++ -- | Close an existing connection.+ close :: t -> IO ()++-- | Bracket Osc communication.+withTransport :: Transport t => IO t -> (t -> IO a) -> IO a+withTransport u = bracket u close++-- * 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 -> BundleOf Message -> IO ()+sendBundle t = sendPacket t . Packet_Bundle++-- * Receive++-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.+recvBundle :: (Transport t) => t -> IO (BundleOf Message)+recvBundle = fmap packet_to_bundle . recvPacket++-- | Variant of 'recvPacket' that runs 'packet_to_message'.+recvMessage :: (Transport t) => t -> IO (Maybe Message)+recvMessage = fmap packet_to_message . recvPacket++-- | Erroring variant.+recvMessage_err :: (Transport t) => t -> IO Message+recvMessage_err = fmap (fromMaybe (error "recvMessage")) . recvMessage++-- | Variant of 'recvPacket' that runs 'packetMessages'.+recvMessages :: (Transport t) => t -> IO [Message]+recvMessages = fmap packetMessages . recvPacket++-- * Wait++{- | Wait for a 'Packet' where the supplied predicate is 'True',+discarding intervening packets.+-}+waitUntil :: (Transport t) => t -> (PacketOf Message -> Bool) -> IO (PacketOf Message)+waitUntil t f = Wait.untilPredicate f (recvPacket t)++{- | Wait for a 'Packet' where the supplied function does not give+'Nothing', discarding intervening packets.+-}+waitFor :: (Transport t) => t -> (PacketOf Message -> Maybe a) -> IO a+waitFor t f = Wait.untilMaybe f (recvPacket t)++-- | 'waitUntil' 'packet_is_immediate'.+waitImmediate :: Transport t => t -> IO (PacketOf Message)+waitImmediate t = waitUntil t packet_is_immediate++{- | 'waitFor' 'packet_to_message', ie. an incoming 'Message' or+immediate mode 'Bundle' with one element.+-}+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 (PacketOf Message)+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
+ Sound/Osc/Transport/Fd/Socket.hs view
@@ -0,0 +1,40 @@+-- | Osc over Udp/Tcp implementation.+module Sound.Osc.Transport.Fd.Socket where++import qualified Sound.Osc.Transport.Fd as Fd {- hosc -}+import qualified Sound.Osc.Transport.Fd.Tcp as Fd.Tcp {- hosc -}+import qualified Sound.Osc.Transport.Fd.Udp as Fd.Udp {- hosc -}++-- | Protocol, either Udp or Tcp+data OscProtocol = Udp | Tcp+ deriving (Eq, Read, Show)++-- | Hostname+type OscHostname = String++-- | Port number+type OscPort = Int++-- | Socket address+type OscSocketAddress = (OscProtocol, OscHostname, OscPort)++-- | Socket+data OscSocket = OscUdpSocket Fd.Udp.Udp | OscTcpSocket Fd.Tcp.Tcp++-- | Open socket at address+openOscSocket :: OscSocketAddress -> IO OscSocket+openOscSocket address =+ case address of+ (Tcp, hostname, port) -> fmap OscTcpSocket (Fd.Tcp.openTcp hostname port)+ (Udp, hostname, port) -> fmap OscUdpSocket (Fd.Udp.openUdp hostname port)++-- | 'OscSocket' is an instance of 'Fd.Transport'.+instance Fd.Transport OscSocket where+ sendPacket (OscTcpSocket fd) = Fd.Tcp.tcp_send_packet fd+ sendPacket (OscUdpSocket fd) = Fd.Udp.udp_send_packet fd+ recvPacket (OscTcpSocket fd) = Fd.Tcp.tcp_recv_packet fd+ recvPacket (OscUdpSocket fd) = Fd.Udp.udp_recv_packet fd+ recvPacketOr (OscTcpSocket fd) = Fd.Tcp.tcp_recv_packet_or fd+ recvPacketOr (OscUdpSocket fd) = Fd.Udp.udp_recv_packet_or fd+ close (OscTcpSocket fd) = Fd.Tcp.tcp_close fd+ close (OscUdpSocket fd) = Fd.Udp.udp_close fd
+ Sound/Osc/Transport/Fd/Tcp.hs view
@@ -0,0 +1,101 @@+-- | Osc over Tcp implementation.+module Sound.Osc.Transport.Fd.Tcp where++import qualified Control.Exception as Exception {- base -}+import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}+import qualified Network.Socket as Socket {- network -}+import qualified System.IO as Io {- base -}++import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}+import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}+import qualified Sound.Osc.Coding.Decode.Binary as Decode.Binary {- hosc -}+import qualified Sound.Osc.Coding.Encode.Builder as Encode.Builder {- hosc -}+import qualified Sound.Osc.Packet as Packet {- hosc -}+import qualified Sound.Osc.Transport.Fd as Fd {- hosc -}++-- | The Tcp transport handle data type.+newtype Tcp = Tcp {tcpHandle :: Io.Handle}++-- | Send data over Tcp.+tcp_send_data :: Tcp -> ByteString.Lazy.ByteString -> IO ()+tcp_send_data (Tcp fd) d = do+ let n = Convert.int64_to_word32 (ByteString.Lazy.length d)+ ByteString.Lazy.hPut fd (ByteString.Lazy.append (Byte.encode_word32 n) d)+ Io.hFlush fd++-- | Send packet over Tcp.+tcp_send_packet :: Tcp -> Packet.PacketOf Packet.Message -> IO ()+tcp_send_packet tcp p = tcp_send_data tcp (Encode.Builder.encodePacket p)++-- | Receive packet over Tcp.+tcp_recv_packet :: Tcp -> IO (Packet.PacketOf Packet.Message)+tcp_recv_packet (Tcp fd) = do+ b0 <- ByteString.Lazy.hGet fd 4+ b1 <- ByteString.Lazy.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0))+ return (Decode.Binary.decodePacket b1)++tcp_recv_packet_or :: Tcp -> IO (Either String Packet.Packet)+tcp_recv_packet_or (Tcp fd) = do+ b0 <- ByteString.Lazy.hGet fd 4+ b1 <- ByteString.Lazy.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0))+ return (Decode.Binary.decodePacketOr b1)++-- | Close Tcp.+tcp_close :: Tcp -> IO ()+tcp_close = Io.hClose . tcpHandle++-- | 'Tcp' is an instance of 'Transport'.+instance Fd.Transport Tcp where+ sendPacket = tcp_send_packet+ recvPacket = tcp_recv_packet+ recvPacketOr = tcp_recv_packet_or+ close = tcp_close++-- | Bracket Tcp communication.+with_tcp :: IO Tcp -> (Tcp -> IO t) -> IO t+with_tcp u = Exception.bracket u tcp_close++-- | Create and initialise Tcp socket.+tcp_socket :: (Socket.Socket -> Socket.SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket.Socket+tcp_socket f host port = do+ fd <- Socket.socket Socket.AF_INET Socket.Stream 0+ let hints = Socket.defaultHints {Socket.addrFamily = Socket.AF_INET} -- localhost=ipv4+ i : _ <- Socket.getAddrInfo (Just hints) host (Just (show port))+ let sa = Socket.addrAddress i+ _ <- f fd sa+ return fd++-- | Convert 'Socket.Socket' to 'Tcp'.+socket_to_tcp :: Socket.Socket -> IO Tcp+socket_to_tcp fd = fmap Tcp (Socket.socketToHandle fd Io.ReadWriteMode)++-- | Create and initialise Tcp.+tcp_handle :: (Socket.Socket -> Socket.SockAddr -> IO ()) -> String -> Int -> IO Tcp+tcp_handle f host port = tcp_socket f (Just host) port >>= socket_to_tcp++{- | Make a 'Tcp' connection.++> import Sound.Osc.Datum+> import Sound.Osc.Time+> let t = openTcp "127.0.0.1" 57110+> let m1 = Packet.message "/dumpOsc" [Int32 1]+> let m2 = Packet.message "/g_new" [Int32 1]+> Fd.withTransport t (\fd -> let f = Fd.sendMessage fd in f m1 >> pauseThread 0.25 >> f m2)+-}+openTcp :: String -> Int -> IO Tcp+openTcp = tcp_handle Socket.connect++-- | 'Socket.accept' connection at /s/ and run /f/.+tcp_server_f :: Socket.Socket -> (Tcp -> IO ()) -> IO ()+tcp_server_f s f = do+ (fd, _) <- Socket.accept s+ h <- socket_to_tcp fd+ f h++-- | A trivial 'Tcp' /Osc/ server.+tcp_server :: Int -> (Tcp -> IO ()) -> IO ()+tcp_server port f = do+ s <- tcp_socket Socket.bind Nothing port+ Socket.listen s 1+ let repeatM_ = sequence_ . repeat+ repeatM_ (tcp_server_f s f)
+ Sound/Osc/Transport/Fd/Udp.hs view
@@ -0,0 +1,119 @@+-- | 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 Data.ByteString.Lazy as BL {- 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.PacketOf Packet.Message -> IO ()+udp_send_packet udp = udp_sendAll_data udp . Builder.encodePacket_strict++-- | Receive packet over Udp.+udp_recv_packet :: Udp -> IO (Packet.PacketOf Packet.Message)+udp_recv_packet (Udp fd) = fmap Binary.decodePacket_strict (C.recv fd 8192)++udp_recv_packet_or :: Udp -> IO (Either String Packet.Packet)+udp_recv_packet_or (Udp fd) = Binary.decodePacketOr . BL.fromStrict <$> C.recv fd 8192++-- | Close Udp.+udp_close :: Udp -> IO ()+udp_close (Udp fd) = N.close fd++-- | 'Udp' is an instance of 'Fd.Transport'.+instance Fd.Transport Udp where+ sendPacket = udp_send_packet+ recvPacket = udp_recv_packet+ recvPacketOr = udp_recv_packet_or+ 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++> 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.PacketOf Packet.Message -> N.SockAddr -> IO ()+sendTo (Udp fd) p = C.sendAllTo fd (Builder.encodePacket_strict p)++-- | Recv variant to collect message source address.+recvFrom :: Udp -> IO (Packet.PacketOf Packet.Message, N.SockAddr)+recvFrom (Udp fd) = fmap (first Binary.decodePacket_strict) (C.recvFrom fd 8192)
+ Sound/Osc/Transport/Monad.hs view
@@ -0,0 +1,128 @@+-- | 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.Packet as Packet {- hosc -}+import qualified Sound.Osc.Transport.Fd as Fd {- hosc -}+import qualified Sound.Osc.Wait as Wait {- hosc -}++-- | Sender monad.+class Monad m => SendOsc m where+ -- | Encode and send an Osc packet.+ sendPacket :: Packet.PacketOf Packet.Message -> m ()++-- | Receiver monad.+class Monad m => RecvOsc m where+ -- | Receive and decode an Osc packet.+ recvPacket :: m (Packet.PacketOf Packet.Message)++-- | 'DuplexOsc' is the union of 'SendOsc' and 'RecvOsc'.+class (SendOsc m, RecvOsc m) => DuplexOsc m++-- | 'Transport' is 'DuplexOsc' with a 'MonadIO' constraint.+class (DuplexOsc m, MonadIO m) => Transport m++-- | 'SendOsc' over 'ReaderT'.+instance (Fd.Transport t, MonadIO io) => SendOsc (R.ReaderT t io) where+ sendPacket p = R.ReaderT (liftIO . flip Fd.sendPacket p)++-- | '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)++-- | 'Transport' over 'ReaderT'.+instance (Fd.Transport t, MonadIO io) => Transport (R.ReaderT t io)++-- | 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.BundleOf Packet.Message -> m ()+sendBundle = sendPacket . Packet.Packet_Bundle++-- * Receive++-- | Variant of 'recvPacket' that runs 'packet_to_bundle'.+recvBundle :: (RecvOsc m) => m (Packet.BundleOf Packet.Message)+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.PacketOf Packet.Message -> Bool) -> m (Packet.PacketOf Packet.Message)+waitUntil f = Wait.untilPredicate f recvPacket++{- | Wait for a 'Packet' where the supplied function does not give 'Nothing',+discarding intervening packets.+-}+waitFor :: (RecvOsc m) => (Packet.PacketOf Packet.Message -> Maybe a) -> m a+waitFor f = Wait.untilMaybe f recvPacket++-- | 'waitUntil' 'packet_is_immediate'.+waitImmediate :: RecvOsc m => m (Packet.PacketOf Packet.Message)+waitImmediate = waitUntil Packet.packet_is_immediate++{- | 'waitFor' 'packet_to_message',+ie. an incoming 'Message' or immediate mode 'Bundle' with one element.+-}+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.PacketOf Packet.Message)+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
+ Sound/Osc/Wait.hs view
@@ -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
− benchmarks/Sound/OSC/NFData.hs
@@ -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` ()
− benchmarks/benchmark.hs
@@ -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
+ contrib/LICENSE view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++ Each version is given a distinguishing version number. If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
hosc.cabal view
@@ -1,93 +1,57 @@+Cabal-Version: 2.4 Name: hosc-Version: 0.14.1+Version: 0.21.1 Synopsis: Haskell 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".-License: GPL+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, 2006-2013+Copyright: (c) Rohan Drape, Stefan Kersten and others, 2007-2024 Author: Rohan Drape, Stefan Kersten-Maintainer: rd@slavepianos.org+Maintainer: rd@rohandrape.net Stability: Experimental-Homepage: http://rd.slavepianos.org/?t=hosc-Tested-With: GHC == 7.6.1+Homepage: http://rohandrape.net/t/hosc+Tested-With: GHC == 9.10.1 Build-Type: Simple-Cabal-Version: >= 1.8-Data-Files: README+Data-Files: README.md Library- Build-Depends: base == 4.*,- binary >= 0.6,+ Build-Depends: base >= 4.8 && < 5,+ binary >= 0.7.2, blaze-builder >= 0.3, bytestring,- data-binary-ieee754, network >= 2.3,- time,+ parsec,+ safe,+ time >= 1.5, 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.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.Normalise- 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+ Default-Language:Haskell2010+ GHC-Options: -Wall -Wno-x-partial -Wno-incomplete-uni-patterns+ 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.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.Socket+ Sound.Osc.Transport.Fd.Tcp+ Sound.Osc.Transport.Fd.Udp+ Sound.Osc.Transport.Monad+ 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.14.*- , 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.14.*- , 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+ Type: git+ Location: https://gitlab.com/rd--/hosc
− tests/Sound/OSC/Arbitrary.hs
@@ -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)- ]
− tests/test.hs
@@ -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