summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTomMurphy <>2018-10-11 04:11:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-10-11 04:11:00 (GMT)
commit9871123659cd69fe16d1ca6355e821c7bf305c49 (patch)
tree3a33fa583cf2b2aaab401f750a26b5d49693a879
parent44d5ff650e71a527dc8a02b72ea1b3aa09213f97 (diff)
version 0.4.0.00.4.0.0
-rw-r--r--README.md56
-rw-r--r--Vivid/OSC.hs52
-rw-r--r--Vivid/OSC/Old.hs178
-rw-r--r--Vivid/OSC/Old/Util.hs43
-rw-r--r--test/Test.hs181
-rw-r--r--vivid-osc.cabal37
6 files changed, 230 insertions, 317 deletions
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..906c559
--- /dev/null
+++ b/README.md
@@ -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
+```
+
diff --git a/Vivid/OSC.hs b/Vivid/OSC.hs
index 315784b..85aa0a4 100644
--- a/Vivid/OSC.hs
+++ b/Vivid/OSC.hs
@@ -27,7 +27,10 @@ module Vivid.OSC (
, encodeTimestamp
, utcToTimestamp
- -- , timestampToUTC
+ , timestampToUTC
+ , timestampFromUTC
+ , timestampToPOSIX
+ , timestampFromPOSIX
, addSecs
, diffTimestamps
@@ -62,12 +65,15 @@ import Control.Monad
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 @@ data OSCDatum
-- | 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 :: Timestamp -> ByteString
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
+
+-- 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
+
-_timestampToUTC :: Timestamp -> UTCTime
-_timestampToUTC = undefined
addSecs :: Timestamp -> Double -> Timestamp
addSecs (Timestamp t) secs = Timestamp (t + secs)
diff --git a/Vivid/OSC/Old.hs b/Vivid/OSC/Old.hs
deleted file mode 100644
index f7c33a7..0000000
--- a/Vivid/OSC/Old.hs
+++ /dev/null
@@ -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
diff --git a/Vivid/OSC/Old/Util.hs b/Vivid/OSC/Old/Util.hs
deleted file mode 100644
index 44c3761..0000000
--- a/Vivid/OSC/Old/Util.hs
+++ /dev/null
@@ -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
-
diff --git a/test/Test.hs b/test/Test.hs
index de14592..5845a1d 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -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 @@ main = microspec $ do
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 @@ main = microspec $ do
]
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,10 +109,63 @@ main = microspec $ do
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
@@ -178,6 +197,7 @@ instance Arbitrary NonNullBS where
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 @@ instance Arbitrary OSCBundle where
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
+
+-- POSIXTime is an alias for NominalDiffTime:
+instance Arbitrary NominalDiffTime where
+ arbitrary = utcTimeToPOSIXSeconds <$> arbitrary
+
+
+
+runGet :: Get a -> ByteString -> Either String a
+runGet = runGetWithNoLeftover
--- 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:
+
+
+
+
+
+
+
+
+
+-- 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 @@ bundleEq (OSCBundle t0 msgs0) (OSCBundle t1 msgs1) =
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
diff --git a/vivid-osc.cabal b/vivid-osc.cabal
index 142bb56..f8172ef 100644
--- a/vivid-osc.cabal
+++ b/vivid-osc.cabal
@@ -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