packages feed

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 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:   .-  @-  &#123;&#45;\# LANGUAGE OverloadedStrings \#&#45;&#125;-  @-  . -  > 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