vivid-osc 0.3.0.0 → 0.4.0.0
raw patch · 6 files changed
+230/−317 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Vivid.OSC: newtype Timestamp
- Vivid.OSC.Old: decodeOSC :: ByteString -> Either String OSC
- Vivid.OSC.Old: decodeOSCData :: [Char] -> ByteString -> Either String [OSCDatum]
- Vivid.OSC.Old: decodeOSCDatumWithPadding :: Char -> ByteString -> Either String OSCDatum
- Vivid.OSC.Old: encodeOSC :: OSC -> ByteString
- Vivid.OSC.Old: encodeOSCBundle :: OSCBundle -> ByteString
- Vivid.OSC.Old: encodeOSCDatum :: OSCDatum -> ByteString
- Vivid.OSC.Old: encodeTimestamp :: Timestamp -> ByteString
- Vivid.OSC.Old: encodedOSC_addLength :: ByteString -> ByteString
- Vivid.OSC.Old.Util: align :: (Num i, Bits i) => i -> i
- Vivid.OSC.Old.Util: doubleToWord :: Double -> Word64
- Vivid.OSC.Old.Util: floatToWord :: Float -> Word32
- Vivid.OSC.Old.Util: wordToDouble :: Word64 -> Double
- Vivid.OSC.Old.Util: wordToFloat :: Word32 -> Float
+ Vivid.OSC: data Timestamp
+ Vivid.OSC: timestampFromPOSIX :: POSIXTime -> Timestamp
+ Vivid.OSC: timestampFromUTC :: UTCTime -> Timestamp
+ Vivid.OSC: timestampToPOSIX :: Timestamp -> POSIXTime
+ Vivid.OSC: timestampToUTC :: Timestamp -> UTCTime
Files
- README.md +56/−0
- Vivid/OSC.hs +42/−10
- Vivid/OSC/Old.hs +0/−178
- Vivid/OSC/Old/Util.hs +0/−43
- test/Test.hs +118/−63
- vivid-osc.cabal +14/−23
+ README.md view
@@ -0,0 +1,56 @@+# vivid-osc++Example usage:++## Sending it over UDP++E.g. to TidalCycles, using the 'network' package:++```haskell+{-# LANGUAGE OverloadedStrings #-}+++import Network.Socket+import Network.Socket.ByteString as SB++import Vivid.OSC++main = do+ -- Boring Network.Socket setup:+ (a:_) <- getAddrInfo Nothing (Just "127.0.0.1") (Just "57120")+ s <- socket (addrFamily a) Datagram defaultProtocol+ connect s (addrAddress a)++ -- The interesting part:+ SB.send s $ encodeOSC $+ OSC "/play2" [OSC_S "cps", OSC_F 1.2, OSC_S "s", OSC_S "bd"]+```++## Receiving via UDP:++```haskell+{-# LANGUAGE OverloadedStrings #-}+++import Control.Monad (forever)+import Network.Socket+import Network.Socket.ByteString as SB++import Vivid.OSC++main = do+ -- Boring Network.Socket setup:+ (a:_) <- getAddrInfo Nothing (Just "127.0.0.1") (Just "57120")+ s <- socket (addrFamily a) Datagram defaultProtocol+ bind s (addrAddress a)++ forever $ do+ o <- decodeOSC <$> SB.recv s 4096+ case o of+ Right (OSC "/play2" [_, OSC_F vel, _, OSC_S "bd"]) ->+ putStrLn $ if vel < 1+ then "boom"+ else "BOOM!"+ _ -> putStrLn $ "Unexpected input: "++show o+```+
Vivid/OSC.hs view
@@ -27,7 +27,10 @@ , encodeTimestamp , utcToTimestamp- -- , timestampToUTC+ , timestampToUTC+ , timestampFromUTC+ , timestampToPOSIX+ , timestampFromPOSIX , addSecs , diffTimestamps@@ -62,12 +65,15 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 (unpack)+import Data.Fixed import Data.Int (Int32) import Data.Monoid import Data.Serialize hiding (encode, decode, runGet) -- import Data.Serialize.IEEE754 import qualified Data.Serialize.Get as Get-import Data.Time (UTCTime(..), fromGregorian, secondsToDiffTime, diffUTCTime)+import Data.Time (UTCTime(..), fromGregorian, secondsToDiffTime, diffUTCTime, addUTCTime)+import Data.Time.Clock.POSIX+import Data.Word -- | An OSC message, e.g. -- @@ -92,7 +98,7 @@ -- | This is stored as the number of seconds since Jan 1 1900. You can get -- it with 'Vivid.Actions.Class.getTime'-newtype Timestamp = Timestamp Double+data Timestamp = Timestamp Double -- Pico -- Word32 Word32 -- Double deriving (Show, Read, Eq, Ord) -- | TODO: a Bundle can also contain other bundles, recursively@@ -230,22 +236,48 @@ encodeTimestamp t = runPut (putOSCTimestamp t) putOSCTimestamp :: Timestamp -> Put-putOSCTimestamp (Timestamp t) =+putOSCTimestamp (Timestamp {- secs secFraction -} t) = do+ -- putWord32be secs+ -- putWord32be secFraction putWord64be $ round $ t * 2^(32::Int) getOSCTimestamp :: Get Timestamp getOSCTimestamp = do w <- {- realToFrac -} fromIntegral <$> getWord64be pure $ Timestamp $ w / 2 ** 32 -- (2^(32::Int))+ -- secs <- getWord32be+ -- secFraction <- getWord32be+ -- pure $ Timestamp secs secFraction +{-# DEPRECATED utcToTimestamp "renamed to 'timestampFromUTC'" #-} utcToTimestamp :: UTCTime -> Timestamp-utcToTimestamp utcTime =- let startOfTheCentury =- UTCTime (fromGregorian 1900 1 1) (secondsToDiffTime 0)- in Timestamp . realToFrac $ diffUTCTime utcTime startOfTheCentury+utcToTimestamp utcTime = timestampFromUTC utcTime -_timestampToUTC :: Timestamp -> UTCTime-_timestampToUTC = undefined+-- TODO: I'd like to do these 4 functions in terms of POSIX instead of UTCTime:++timestampToUTC :: Timestamp -> UTCTime+timestampToUTC (Timestamp ts) =+ -- posixSecondsToUTCTime . timestampToPOSIX+ addUTCTime (realToFrac ts) startOfTheCentury++timestampFromUTC :: UTCTime -> Timestamp+timestampFromUTC utcTime =+ -- timestampFromPOSIX . utcTimeToPOSIXSeconds+ Timestamp . realToFrac $ diffUTCTime utcTime startOfTheCentury++startOfTheCentury :: UTCTime+startOfTheCentury =+ UTCTime (fromGregorian 1900 1 1) (secondsToDiffTime 0)++timestampToPOSIX :: Timestamp -> POSIXTime+timestampToPOSIX =+ utcTimeToPOSIXSeconds . timestampToUTC++timestampFromPOSIX :: POSIXTime -> Timestamp+timestampFromPOSIX =+ timestampFromUTC . posixSecondsToUTCTime++ addSecs :: Timestamp -> Double -> Timestamp addSecs (Timestamp t) secs = Timestamp (t + secs)
− Vivid/OSC/Old.hs
@@ -1,178 +0,0 @@--- | An older implementation of the spec. I provide it here, and several--- tests, to show that the new code behaves the same. Will be removed soon.--{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}--module Vivid.OSC.Old (- encodeOSC- , encodeOSCDatum- , encodeOSCBundle- , encodeTimestamp-- , encodedOSC_addLength-- , decodeOSCData- , decodeOSC- , decodeOSCDatumWithPadding- ) where--import Vivid.OSC (OSCDatum(..), Timestamp(..), OSC(..), OSCBundle(..), toTypeChar)-import Vivid.OSC.Old.Util--import Data.Binary (encode, decode)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BS8-import qualified Data.ByteString.Lazy as BSL-import Data.Int-import Data.Monoid-import Data.Word--encodeOSC :: OSC -> ByteString-encodeOSC (OSC url args) = BSL.toStrict $ BSL.concat $ [- encodeOSCDatum (OSC_S url)- ,encodeOSCDatum (OSC_S ("," <> BS.concat (map toTypeChar args)))- ] <> map encodeOSCDatum args--encodeOSCDatum :: OSCDatum -> BSL.ByteString-encodeOSCDatum = \case- OSC_I i -> encode i- OSC_S s -> BSL.fromStrict $- s <> BS.replicate (align (BS.length s + 1) + 1) 0- OSC_F f -> encode $ floatToWord f- OSC_D d -> encode $ doubleToWord d- OSC_T timestamp ->- BSL.fromStrict $ encodeTimestamp timestamp- OSC_B b -> mconcat [- -- 4 bytes which describe the size of the blob:- encode (fromIntegral (BS.length b) :: Int32)- -- the blob itself:- , BSL.fromStrict b- -- padding:- , BSL.fromStrict (BS8.pack (replicate (align (BS.length b)) '\NUL'))- ]--encodeOSCBundle :: OSCBundle -> ByteString-encodeOSCBundle (OSCBundle time messages) = mconcat [- "#bundle\NUL"- , encodeTimestamp time- , (mconcat . map (encodedOSC_addLength . either id encodeOSC)) messages- ]--encodeTimestamp :: Timestamp -> ByteString-encodeTimestamp (Timestamp time) =- BSL.toStrict $ encode $ (round (time * 2^(32::Int)) :: Word64)---encodedOSC_addLength :: ByteString -> ByteString-encodedOSC_addLength bs =- BSL.toStrict (encode (toEnum (BS.length bs) :: Word32)) <> bs---numBytesWithoutPadding :: Char -> ByteString -> Either String Int-numBytesWithoutPadding char b = case char of- 'i' -> Right 4- 'f' -> Right 4- 't' -> Right 4- 'd' -> Right 8- 's' -> case BS.elemIndex 0 $ b of- Just x -> Right $ fromIntegral x- Nothing -> Left $ "weirdness on " <> show b- 'b' -> Right . fromIntegral $- (decode $ BSL.fromStrict $ BS.take 4 b :: Int32)- c ->- Left $ "vivid: unknown OSC character " <> show c <> ": " <> show b--numBytesWithPadding :: Char -> ByteString -> Either String Int-numBytesWithPadding char b = case char of- 'i' -> Right 4- 'f' -> Right 4- 't' -> Right 4- 'd' -> Right 8- 's' ->- case numBytesWithoutPadding 's' b of- Right nb ->- let n = nb + 1- in Right $ n + align n- Left e -> Left e- 'b' ->- case numBytesWithoutPadding 'b' b of- Right nb -> Right $ nb + align nb + 4- Left e -> Left e- c ->- Left $ "vivid: unknown OSC character " <> show c <> ": " <> show b--decodeOSCData :: [Char] -> ByteString -> Either String [OSCDatum]-decodeOSCData typeChars blob = case (typeChars, blob) of- ([], "") -> Right []- ([], leftover) -> Left $ "leftover bytes: " <> show leftover- (_:_, "") -> Left $ "leftover typechars:" <> show typeChars- (t:ypes, _) ->- case (datum, rest) of- (Right a, Right b) -> Right (a:b)- (Right _, Left b) -> Left b- (Left a, Right _) -> Left a- (Left a, Left b) -> Left $ a ++ ", " ++ b- where- datum :: Either String OSCDatum- datum = case thisBlob of- Right b -> decodeOSCDatumWithPadding t b- Left e -> Left e- thisBlob :: Either String ByteString- thisBlob = case numBytesWithPadding t blob of- Right nb -> Right $ BS.take nb blob- Left e -> Left e- rest :: Either String [OSCDatum]- rest = case numBytesWithPadding t blob of- Right nb -> decodeOSCData ypes (BS.drop nb blob)- Left e -> Left e--decodeOSC :: ByteString -> Either String OSC-decodeOSC b = case sizeAndStorage b of- Left e -> Left e- Right (sizeOfURL, storageOfURL) ->-- let (urlWithPad, allButURL) = BS.splitAt storageOfURL b- url = BS.take sizeOfURL urlWithPad- in case sizeAndStorage allButURL of- Left e -> Left e- -- typeDesc is like ",issif"- Right (sizeOfTypeDesc, storageOfTypeDesc) ->- case BS8.unpack $ BS.take sizeOfTypeDesc allButURL of- (',':typeDesc) ->- let rest = BS.drop (storageOfURL + storageOfTypeDesc) $ b- in case decodeOSCData typeDesc rest of- Right decoded -> Right $ OSC url decoded- Left e -> Left e- other -> Left $ "not understood: " ++ show other- where- sizeAndStorage :: ByteString -> Either String (Int, Int)- sizeAndStorage bs =- case (numBytesWithoutPadding 's' bs, numBytesWithPadding 's' bs) of- (Right size, Right storage) -> Right (size, storage)- (Left e0, Left e1) -> Left $ e0 ++ ", " ++ e1- (Left e, _) -> Left e- (_, Left e) -> Left e--decodeOSCDatumWithPadding :: Char -> ByteString -> Either String OSCDatum-decodeOSCDatumWithPadding char b = case char of- 'i' ->- Right $ OSC_I $ decode $ BSL.fromStrict b- 'f' ->- Right $ OSC_F $ wordToFloat $ decode $ BSL.fromStrict b- 's' ->- case numBytesWithoutPadding 's' b of- Right nb -> Right $ OSC_S $ BS.take nb b- Left e -> Left e- 'b' ->- case numBytesWithoutPadding 'b' b of- Right nb -> Right $ OSC_B $ BS.take nb $ BS.drop 4 b- Left e -> Left e- 'd' ->- Right $ OSC_D $ wordToDouble $ decode $ BSL.fromStrict b- 't' ->- Right $ OSC_T $ Timestamp $ (/(2^(32::Int))) $ realToFrac $- (decode $ BSL.fromStrict b :: Word64)- c ->- Left $ "unknown character " <> show c <> ": " <> show b
− Vivid/OSC/Old/Util.hs
@@ -1,43 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}--{-# LANGUAGE NoRebindableSyntax #-}-{-# LANGUAGE NoIncoherentInstances #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NoUndecidableInstances #-}--module Vivid.OSC.Old.Util (- align- , floatToWord- , wordToFloat- , doubleToWord- , wordToDouble- ) where--import Data.Bits ((.&.), complement, Bits)-import qualified Foreign as F-import System.IO.Unsafe (unsafePerformIO)---- from hosc:-align :: (Num i,Bits i) => i -> i-{-# INLINE align #-}-align n = ((n + 3) .&. complement 3) - n---- from data-binary-ieee754:-floatToWord :: Float -> F.Word32-floatToWord = coercionThing--wordToFloat :: F.Word32 -> Float-wordToFloat = coercionThing--doubleToWord :: Double -> F.Word64-doubleToWord = coercionThing--wordToDouble :: F.Word64 -> Double-wordToDouble = coercionThing---coercionThing :: (F.Storable a, F.Storable b) => a -> b-coercionThing x = unsafePerformIO $ F.alloca $ \buf -> do- F.poke (F.castPtr buf) x- F.peek buf-
test/Test.hs view
@@ -1,40 +1,31 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE+ BinaryLiterals+ , LambdaCase+ , OverloadedStrings+ , ViewPatterns+ #-} +import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL+import Data.Ratio import Data.Serialize hiding (runGet) -- import Data.Serialize.Get hiding (runGet) -- import qualified Data.Serialize.Get as Get -- import Data.Serialize.Put import Data.Time+import Data.Time.Clock.POSIX import Data.Word import Test.Microspec import Vivid.OSC-import Vivid.OSC.Old.Util-import qualified Vivid.OSC.Old as Old main :: IO () main = microspec $ do- describe ".utils" $ do- describe "float->word->float" $ \f ->- wordToFloat (floatToWord f) === f- describe "word->float->word" $ \w ->- floatToWord (wordToFloat w) === w- describe "double->word->double" $ \d ->- wordToDouble (doubleToWord d) === d- describe "word->Double->word" $ \w ->- doubleToWord (wordToDouble w) === w- describe "align == align'" $ \i ->- alignTo4' (i :: Int) === align i describe "OSC types" $ do describe "OSC Datum" $ do- it "newPutOSCdatum == oldPutOSCdatum" $ do- \d -> BSL.toStrict (Old.encodeOSCDatum d) == encodeOSCDatum d {- - Problem is we don't have type tag; not high priority because - we test it in 'getOSC/putOSC' etc:@@ -43,38 +34,19 @@ in datumEq newD oldD -} - it "timestamps: old encode . decode" $- \(Positive t) ->- let ts = Timestamp t- encoded = BSL.toStrict $ Old.encodeOSCDatum $ OSC_T ts- Right (OSC_T t') = Old.decodeOSCDatumWithPadding 't' encoded- in ts `timestampEq` t'- describe "examples from the OSC 1.0 spec" $ do- it "example 1" $ do- Old.encodeOSCDatum (OSC_S "OSC")- === BSL.pack (map (toEnum . fromEnum) ['O','S','C', '\NUL']) it "example 1, new" $ do encodeOSCDatum (OSC_S "OSC") === BS.pack (map (toEnum . fromEnum) ['O','S','C', '\NUL'])- it "example 2" $ do- Old.encodeOSCDatum (OSC_S "data")- === BSL.pack (map (toEnum . fromEnum) ("data"++replicate 4 '\NUL')) it "example 2, new" $ do encodeOSCDatum (OSC_S "data") === BS.pack (map (toEnum . fromEnum) ("data"++replicate 4 '\NUL')) describe "the OSC type" $ do- it "olddecode . oldencode" $ \(OSC a bs) ->- -- My old decoding of timestamps was fucked up!:- let oldO = OSC a $ filter (\case { OSC_T _ -> False ; _ -> True }) bs- in Old.decodeOSC (Old.encodeOSC oldO) === Right oldO- it "new encode == old encode" $ \o ->- encodeOSC o === Old.encodeOSC o it "decode . encode" $ \o -> let Right new = decodeOSC (encodeOSC o)- in oscEq new o+ in new `oscEq` o describe "examples from the OSC 1.0 spec" $ do it "example 1" $ encodeOSC (OSC "/oscillator/4/frequency" [OSC_F 440.0])@@ -104,36 +76,30 @@ ] in encodeOSC cmd === out describe "OSCBundle" $ do- it "newDecode . newEncode" $ \t xs ->+ it "decode . encode" $ \t xs -> let oldB = OSCBundle t (map Right xs) Right newB = decodeOSCBundle (encodeOSCBundle oldB)- in bundleEq newB oldB- it "oldEncode === newEncode" $ \b ->- Old.encodeOSCBundle b === encodeOSCBundle b+ in newB `bundleEq` oldB describe "bijections" $ do it "getOSC . putOSC" $ \origOSC -> let Right newOSC = decodeOSC (encodeOSC origOSC)- in oscEq newOSC origOSC- it "putOSCString vs old" $ \(NonNullBS s) ->- runPut (putOSCString s) === BSL.toStrict (Old.encodeOSCDatum (OSC_S s))+ in newOSC `oscEq` origOSC describe "getString . putString" $ \(NonNullBS s) -> runGet getOSCString (runPut (putOSCString s)) === Right s it "decodetimestamp . encodetimestamp" $ \t ->- fromRight (runGet getOSCTimestamp (runPut (putOSCTimestamp t))) `timestampEq` t- it "oldencode timestamp == new encode" $ \t ->- runPut (putOSCTimestamp t) === Old.encodeTimestamp t+ fromRight (runGet getOSCTimestamp (runPut (putOSCTimestamp t)))+ `timestampEq` t it "encodeOSC isRight (with the valid input we generate)" pending describe "binary blobs" $ do it "decode . encode" $ \(BS.pack -> b) -> runGet getOSCBlob (runPut (putOSCBlob b)) === Right b- describe "decodeOSCdatumswithpadding == getOSCDatum" pending+ describe "decodeOSCdatumswithpadding -== getOSCDatum" pending describe "unit tests - a few examples for each function" $ do describe "putOSCDatum" $ do describe "OSC_S" $ do it "pads an extra 4 when it's already a multiple of 4" $ encodeOSCDatum (OSC_S "four") === "four\NUL\NUL\NUL\NUL" describe "do this for every function" pending- describe "more manual test cases" pending -- binary up to the mazimum size -- very large and very small floats -- NaNs and (+/-)Infinity (floats and doubles)@@ -143,11 +109,64 @@ describe "timestamp" $ do- it "timestamp->utc" $ pending -- \t ->- -- utcToTimestamp (timestampToUTC t) === t- it "utc->timestamp" $ pending -- \u ->- -- timestampToUTC (utcToTimestamp u) === u+ it "timestamp->utc" $ \t ->+ utcToTimestamp (timestampToUTC t) `timestampEq` t+ it "utc->timestamp" $ \u ->+ timestampToUTC (utcToTimestamp u) `utcEq` u+ it "timestamp->POSIX" $ \t ->+ timestampFromPOSIX (timestampToPOSIX t) `timestampEq` t+ it "POSIX->timestamp" $ \u ->+ timestampToPOSIX (timestampFromPOSIX u) `posixEq` u ++ -- Examples from https://www.eecis.udel.edu/~mills/y2k.html:+ -- (Also in RFC 5905)+ describe "examples from the NTP time author" $ do+ let f :: Day -> Double -> Bool+ f day ts = (timestampFromUTC (UTCTime day 0)) -- can test: 0.00001+ `timestampEq` Timestamp ts+ it "first day NTP" $+ f (fromGregorian 1900 01 01) 0+ it "first day UNIX" $+ f (fromGregorian 1970 01 01) 2208988800+ it "first day UTC" $+ f (fromGregorian 1972 01 01) 2272060800+ it "last day 20th century" $+ f (fromGregorian 1999 12 31) 3155587200+ it "last day NTP era 0" $+ f (fromGregorian 2036 02 07) 4294944000++ -- From ntp.org:+ describe "hex and binary representation" $ do+ let dateWereEncoding :: UTCTime+ dateWereEncoding = read "2000-08-31 18:52:30.735861"+ it "represents a hex date properly" $+ Right (timestampFromUTC dateWereEncoding)+ === runGet getOSCTimestamp+ (BS.pack [+ -- Top 32 bits:+ 0xbd,0x59,0x27,0xee+ -- Bottom 32:+ , 0xbc,0x61,0x60,0x00+ ])+ -- Of course these should be the same, but pick your poison:+ it "represents a binary date properly" $+ Right (timestampFromUTC dateWereEncoding)+ === runGet getOSCTimestamp+ (BS.pack [+ -- Top 32:+ 0b10111101,0b01011001,0b00100111,0b11101110+ -- Bottom 32:+ , 0b10111100,0b01100001,0b01100000,0b00000000+ ])+++-- TODO:+ -- also this equals, in unix (useful for when i have conversion functions):+ -- 0x39aea96e 0x000b3a75+ -- == 0b00111001101011101010100101101110+ -- 0b00000000000010110011101001110101+ fromRight :: Show e => Either e x -> x fromRight = \case Right x -> x@@ -178,6 +197,7 @@ instance Arbitrary Timestamp where -- Note cannot be negative: arbitrary = (Timestamp . getNonNegative) <$> arbitrary+ -- Timestamp <$> arbitrary <*> arbitrary instance Arbitrary OSC where arbitrary = OSC@@ -193,14 +213,47 @@ Right <$> arbitrary -- type inference is nice! ]) +-- UTC Arbitrary instance taken from the test suite for the 'time' package:+instance Arbitrary Day where+ arbitrary = liftM ModifiedJulianDay $+ -- From the 'time' package:+ -- choose (-313698, 2973483) -- 1000-01-1 to 9999-12-31+ choose (14802, 233802) -- (900*365)+1000-01-1 to (1500*365)+1000-01-1++instance Arbitrary DiffTime where+ arbitrary = oneof [intSecs, fracSecs] -- up to 1 leap second+ where intSecs = liftM secondsToDiffTime' $ choose (0, 86400)+ fracSecs = liftM picosecondsToDiffTime' $ choose (0, 86400 * 10^12)+ secondsToDiffTime' :: Integer -> DiffTime+ secondsToDiffTime' = fromInteger+ picosecondsToDiffTime' :: Integer -> DiffTime+ picosecondsToDiffTime' x = fromRational (x % 10^12)+ instance Arbitrary UTCTime where- arbitrary = undefined+ arbitrary = liftM2 UTCTime arbitrary arbitrary --- TODO: do we need this? is there a way to encode timestamps non-lossily?:--- I would also love to get rid of this whole thing:+-- POSIXTime is an alias for NominalDiffTime:+instance Arbitrary NominalDiffTime where+ arbitrary = utcTimeToPOSIXSeconds <$> arbitrary++++runGet :: Get a -> ByteString -> Either String a+runGet = runGetWithNoLeftover+++++++++++-- TODO: I would LOVE to get rid of this whole thing: timestampEq :: Timestamp -> Timestamp -> Bool timestampEq (Timestamp time0) (Timestamp time1) =- abs (time0 - time1) < 0.0000001+ abs (time0 - time1) < 0.000000001 datumEq :: OSCDatum -> OSCDatum -> Bool datumEq a b = case (a, b) of@@ -236,10 +289,12 @@ rightMatchesLeft l r msgsMatch (Right r:rest0) (Left l:rest1) = rightMatchesLeft l r---- This is not ideal, using the encoding functions to test them-rightMatchesLeft :: Left ByteString -> Right OSC -> Bool -}-runGet :: Get a -> ByteString -> Either String a-runGet = runGetWithNoLeftover +utcEq :: UTCTime -> UTCTime -> Bool+utcEq a b =+ abs (diffUTCTime a b) < 0.00001++posixEq :: POSIXTime -> POSIXTime -> Bool+posixEq a b =+ abs (a - b) < 0.00001
vivid-osc.cabal view
@@ -1,46 +1,37 @@ name: vivid-osc-version: 0.3.0.0+version: 0.4.0.0 synopsis: Open Sound Control encode/decode description:- A small, simple, and well-tested implementation of the Open Sound Control+ Small, simple, and well-tested implementation of the Open Sound Control message format. . Example usage: .- @- {-\# LANGUAGE OverloadedStrings \#-}- @- . - > import Network.Socket- > import Network.Socket.ByteString as SB- > - > import Vivid.OSC- > - > main = do- > -- Boring Network.Socket setup:- > (a:_) <- getAddrInfo Nothing (Just "127.0.0.1") (Just "57120")- > s <- socket (addrFamily a) Datagram defaultProtocol- > connect s (addrAddress a)- > - > -- The interesting part:- > SB.send s $ encodeOSC $- > OSC "/play2" [OSC_S "cps", OSC_I 1, OSC_S "s", OSC_S "bd"]+ >>> :set -XOverloadedStrings + >>> msg = OSC "/foo" [OSC_S "bar", OSC_I 9, OSC_F 0.25, OSC_B "this-is-binary"]+ >>> :t msg+ > msg :: OSC+ >>> :t encodeOSC msg+ > encodeOSC msg :: ByteString+ >>> decodeOSC (encodeOSC msg) == Right msg+ > True+ .+ See the README.md file for examples of sending and receiving with UDP license: GPL license-file: LICENSE author: Tom Murphy maintainer: Tom Murphy category: Audio, Codec, Music, Sound+extra-source-files:+ README.md build-type: Simple cabal-version: >=1.10 - library exposed-modules: Vivid.OSC- , Vivid.OSC.Old- , Vivid.OSC.Old.Util other-extensions: LambdaCase , OverloadedStrings