{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
import Control.Monad
import Data.Binary (decode, encode)
-- import Data.Binary.Get
-- import Data.Binary.Put
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Lazy as BSL
import Data.Int
-- import Data.Monoid
import Data.Serialize hiding (decode, encode)
-- import Data.Serialize.Get
-- import Data.Serialize.Put
-- import Data.Serialize.IEEE754
import Data.Word
import Test.Microspec
-- import Test.QuickCheck ()
import Test.QuickCheck.Arbitrary ()
import Vivid.OSC.Old.Util
import Vivid.SC.SynthDef.Literally
import Vivid.SC.SynthDef.Types
main :: IO ()
main = microspec $ do
describe "synthdef literal representation" $ do
describe "the whole enchilada" $ do
it "correctly does (encode . decode)" $ do
\origSDLiteral_wVariants ->
let origSDLiteral = origSDLiteral_wVariants { _synthDefVariants = [] }
encoded :: ByteString
encoded = encodeLiteralSynthDef origSDLiteral
(decoded, "") = decodeLiteralSynthDef encoded
in decoded === origSDLiteral
it "new format does (get . put)" $ \sdl ->
runGet getLiteralSynthDef' (runPut (putLiteralSynthDef' sdl)) === Right sdl
it "oldEncode == newEncode" $ \sdl_wVariants ->
let sdl = sdl_wVariants { _synthDefVariants = [] }
in (encodeLiteralSynthDef sdl)
=== runPut (putLiteralSynthDef' sdl)
describe "components" $ do
describe "pascal strings" $ do
it "put->get" $ do
\ws ->
let bs = BS.pack $ take (fromEnum (maxBound::Word8)) ws
in runGet getPString' (runPut (putPString' bs)) === Right bs
it "get->put" $ pending
describe "compared to old stuff" $ do
it "putPString' == encodePString" pending
it "getPString' == getPString" pending
describe "UGenSpecs" $ do
it "get . put" $ \us ->
runGet getUGenSpec' (runPut (putUGenSpec' us)) == Right us
it "encodeUGenSpec == putUGenSpec" $ \us ->
runPut (putUGenSpec' us)
=== encodeUGenSpec us
it "(oldGet . (old)put) == (newGet . (old)put)" $ \us ->
runGet getUGenSpec' (encodeUGenSpec us)
== Right (fst (getUGenSpec (encodeUGenSpec us)))
describe "input specs" $ do
it "get . put" $ \is ->
runGet getInputSpec' (runPut (putInputSpec' is)) === Right is
it "encodeInputSpec == putInputSpec'" $ \is ->
runPut (putInputSpec' is)
=== encodeInputSpec is
it "(oldGet . put) == (newGet . put)" $ \is ->
runGet getInputSpec' (runPut (putInputSpec' is))
=== (Right $ fst $ getInputSpec $ runPut $ putInputSpec' is)
describe "output specs" pending
describe "param names" $ do
-- It feels like this is enough to prove sameness, but
-- could actually think about it more when i'm not so
-- tired:
it "get . put" $ \pn ->
runGet getParamName' (runPut (putParamName' pn)) === Right pn
it "encodeParamName == putParamName'" $ \pn ->
runPut (putParamName' pn)
=== encodeParamName pn
it "(oldDecode . encode) == (newGet . newPut)" $ \pn ->
runGet getParamName' (runPut (putParamName' pn))
=== (Right $ fst $ getParamName $ runPut $ putParamName' pn)
describe "calc rate" $ do
it "get . put" $ \cr ->
runGet getCalcRate' (runPut (putCalcRate' cr)) == Right cr
describe "variant specs" $ do
it "get . put" $ \vs ->
let numParams = toEnum $ (length::[a]->Int) $ _variantSpec_initialParamVals vs
in runGet (getVariantSpec' numParams) (runPut (putVariantSpec' vs)) === Right vs
describe "uopToSpecialI roundtrips" pending
describe "biopToSpecialI roundtrips" pending
-- A lot of this can be removed now that we're using 'cereal'
describe "utilities" $ do
describe "wordToFloat<->floatToWord" $ do
it "word->float->word" $ do
\w -> floatToWord (wordToFloat w) === w
it "float->word->float" $ do
\f -> wordToFloat (floatToWord f) === f
describe "with put/get" $ pending
-- undefined $ runPut (putFloat (wordToFloat 2139095041))
describe "with encode/decode" $ do
it "word->float->word" $ do
\w -> w == (floatToWord
$ decode
$ BSL.fromStrict
$ BSL.toStrict
$ encode
$ wordToFloat
$ w)
it "float->word->float" $ do
\f -> f == (wordToFloat
$ decode
$ BSL.fromStrict
$ BSL.toStrict
$ encode
$ floatToWord
$ f)
describe "commands" $ do
describe "/d_load" $ do
it "unit test, with beyonc`e" pending
-- Note these might NOT be valid usens, only in the valid format
-- (e.g. you could refer to parameters that don't exist, etc)
instance Arbitrary LiteralSynthDef where
arbitrary = do
name <- (UTF8.fromString . getNonEmpty) <$> arbitrary
constants <- arbitrary
numParameters <- choose (0,100)
parameters <- replicateM numParameters arbitrary :: Gen [Float]
paramNames <- replicateM ((length::[a]->Int) parameters) (arbitrary :: Gen ParamName)
ugens <- arbitrary
numVariantSpecs <- choose (0, 10)
variantSpecs <- replicateM numVariantSpecs $
-- Needs to be same as number of params:
arbitraryVariantSpecWithNParams (toEnum numParameters)
pure $ LiteralSynthDef {
_synthDefName = name
, _synthDefConstants = constants
, _synthDefParameters = parameters
, _synthDefParamNames = paramNames
, _synthDefUGens = ugens
, _synthDefVariants = variantSpecs
}
-- Again, these might not be sensible, just syntactically valid
instance Arbitrary ParamName where
arbitrary =
ParamName
<$> ((UTF8.fromString . getNonEmpty) <$> arbitrary)
<*> arbitrary
-- todo: generate this with generics
instance Arbitrary InputSpec where
arbitrary = oneof [
InputSpec_Constant <$> arbitrary
, InputSpec_UGen
-- TODO: do we ever want to test it with an invalid number?:
<$> (getNonNegative <$> arbitrary)
<*> arbitrary
]
instance Arbitrary OutputSpec where
arbitrary = OutputSpec <$> arbitrary
-- todo: generics:
instance Arbitrary CalculationRate where
arbitrary = elements [IR, KR, AR, DR]
instance Arbitrary UGenSpec where
arbitrary = UGenSpec
<$> arbitraryPString
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
-- | Defined *instead* of an arbitrary instance because all
-- VariantSpecs come in a list, and each spec in that list
-- must have the same number of parameters
-- TODO: no, not instead of: just also
-- TODO: i think should be 'word32' not 'int32':
arbitraryVariantSpecWithNParams :: Int32 -> Gen VariantSpec
arbitraryVariantSpecWithNParams n =
VariantSpec
<$> arbitraryPString
<*> (replicateM (fromEnum n) arbitrary)
-- Might not want to keep this one (for the reason above) - todo:
instance Arbitrary VariantSpec where
arbitrary = do
n <- mod 100 <$> arbitrary
arbitraryVariantSpecWithNParams n
-- The length has to fit into one word8!:
arbitraryPString :: Gen ByteString
arbitraryPString = do
numChars <- choose (0, maxBound :: Word8)
BS.pack <$> replicateM (fromEnum numChars) arbitrary