vivid-osc-0.3.0.0: test/Test.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
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.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:
it "getOSCDatum . putOSCDatum" $ \oldD ->
let Right newD = runGet getOSCDatum (runPut $ putOSCDatum o)
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
describe "examples from the OSC 1.0 spec" $ do
it "example 1" $
encodeOSC (OSC "/oscillator/4/frequency" [OSC_F 440.0])
=== BS.pack [
0x2f, 0x6f, 0x73, 0x63
, 0x69, 0x6c, 0x6c, 0x61
, 0x74, 0x6f, 0x72, 0x2f
, 0x34, 0x2f, 0x66, 0x72
, 0x65, 0x71, 0x75, 0x65
, 0x6e, 0x63, 0x79, 0x00
, 0x2c, 0x66, 0x00, 0x00
, 0x43, 0xdc, 0x00, 0x00
]
it "example 2" $
let cmd = OSC "/foo" [OSC_I 1000, OSC_I (-1), OSC_S "hello", OSC_F 1.234, OSC_F 5.678]
out = BS.pack [
0x2f, 0x66, 0x6f, 0x6f
, 0x00, 0x00, 0x00, 0x00
, 0x2c, 0x69, 0x69, 0x73
, 0x66, 0x66, 0x00, 0x00
, 0x00, 0x00, 0x03, 0xe8
, 0xff, 0xff, 0xff, 0xff
, 0x68, 0x65, 0x6c, 0x6c
, 0x6f, 0x00, 0x00, 0x00
, 0x3f, 0x9d, 0xf3, 0xb6
, 0x40, 0xb5, 0xb2, 0x2d
]
in encodeOSC cmd === out
describe "OSCBundle" $ do
it "newDecode . newEncode" $ \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
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))
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
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 "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)
-- Huge numbers of variants
-- Some example times to parse
-- Some example numbers to parse
describe "timestamp" $ do
it "timestamp->utc" $ pending -- \t ->
-- utcToTimestamp (timestampToUTC t) === t
it "utc->timestamp" $ pending -- \u ->
-- timestampToUTC (utcToTimestamp u) === u
fromRight :: Show e => Either e x -> x
fromRight = \case
Right x -> x
Left e -> error $ show e
-- TODO: generic-random:
instance Arbitrary OSCDatum where
arbitrary = oneof [
OSC_I <$> arbitrary
-- Note no 0: OSC strings cannot contain the null character:
, OSC_S <$> nonNullBS
, OSC_F <$> arbitrary
, OSC_D <$> arbitrary
, (OSC_B . BS.pack) <$> arbitrary
, OSC_T <$> arbitrary
]
nonNullBS :: Gen ByteString
nonNullBS = BS.pack <$> listOf (choose (1, maxBound :: Word8))
newtype NonNullBS = NonNullBS ByteString
deriving (Show)
instance Arbitrary NonNullBS where
arbitrary = NonNullBS <$> nonNullBS
instance Arbitrary Timestamp where
-- Note cannot be negative:
arbitrary = (Timestamp . getNonNegative) <$> arbitrary
instance Arbitrary OSC where
arbitrary = OSC
<$> nonNullBS -- Again no '\NUL'
<*> arbitrary
instance Arbitrary OSCBundle where
arbitrary = OSCBundle
<$> arbitrary
<*> listOf (oneof [
-- TODO:
-- (Left . BS.pack) <$> arbitrary -- todo: maybe needs to be padded?
Right <$> arbitrary -- type inference is nice!
])
instance Arbitrary UTCTime where
arbitrary = undefined
-- 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:
timestampEq :: Timestamp -> Timestamp -> Bool
timestampEq (Timestamp time0) (Timestamp time1) =
abs (time0 - time1) < 0.0000001
datumEq :: OSCDatum -> OSCDatum -> Bool
datumEq a b = case (a, b) of
(OSC_T t0, OSC_T t1) -> timestampEq t0 t1
_ -> a == b
oscEq :: OSC -> OSC -> Bool
oscEq (OSC p0 args0) (OSC p1 args1) =
(p0 == p1) && argsMatch args0 args1
where
argsMatch [] [] = True
argsMatch [] (_:_) = False
argsMatch (_:_) [] = False
argsMatch (d0:rest0) (d1:rest1) =
datumEq d0 d1 && argsMatch rest0 rest1
bundleEq :: OSCBundle -> OSCBundle -> Bool
bundleEq (OSCBundle t0 msgs0) (OSCBundle t1 msgs1) =
timestampEq t0 t1 && msgsMatch msgs0 msgs1
where
msgsMatch [] [] = True
msgsMatch [] (_:_) = False
msgsMatch (_:_) [] = False
msgsMatch (Right msg0:rest0) (Right msg1:rest1) =
oscEq msg0 msg1 && msgsMatch rest0 rest1
msgsMatch (Left msg0:rest0) (Left msg1:rest1) =
(msg0 == msg1) && msgsMatch rest0 rest1
-- This is the case where one is 'Left' and one is 'Right'.
-- We could hypothetically test if they're equal.
msgsMatch (_:_rest0) (_:_rest1) = False
{-
msgsMatch (Left l:rest0) (Right r:rest1) =
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