lambdasound-1.0.0: test/Main.hs

module Main (main) where

import Control.Monad (join, unless)
import Control.Monad.IO.Class (liftIO)
import Data.List.NonEmpty
import Data.Massiv.Array qualified as M
import LambdaSound
import Test.Falsify.Generator qualified as Gen
import Test.Tasty
import Test.Tasty.Falsify
import System.IO.Unsafe (unsafePerformIO)

main :: IO ()
main =
  defaultMain $
    testGroup
      "LambdaSound tests"
      [ testProperty "reverse" reverseProperty,
        testProperty "associative sequence" associativeSequence,
        testProperty "associative parallel" associativeParallel,
        testProperty "distributivity of parallel and sequence" distributivityParallelSequence,
        testProperty "takeSound" takeSoundProperty,
        testProperty "dropSound" dropSoundProperty,
        testProperty "take/drop" dropTakeSoundDuality,
        testProperty "cache does not change sound" cacheDoesNotChangeSound 
      ]

genSound :: Gen (Sound T Pulse)
genSound = do
  let basicSound =
        Gen.elem $
          setDuration 1 (constant 1)
            :| [ setDuration 1 (sineWave 440),
                 setDuration 1 (harmonic sineWave 100),
                 setDuration 1 (noise 42)
               ]
  join $
    Gen.elem $
      ((<>) <$> basicSound <*> basicSound)
        :| [ (>>>) <$> basicSound <*> basicSound,
             takeSound 0.5 <$> basicSound,
             -- dropSound 0.3 <$> basicSound,
             changeTempo (** 1.2) <$> basicSound,
             amplify 2 <$> basicSound,
             reduce 2 <$> basicSound,
             raise 3 <$> basicSound
           ]

reverseProperty :: Property ()
reverseProperty = do
  sound <- genWith (\_ -> Just "Sound") genSound
  assertEquality "reverseSound failing" $
    reverseSound (reverseSound sound)
      `eqSound` sound

associativeSequence :: Property ()
associativeSequence = do
  sound1 <- gen genSound
  sound2 <- gen genSound
  sound3 <- gen genSound
  assertEquality "sequence not associative" $ (sound1 >>> (sound2 >>> sound3)) `eqSound` ((sound1 >>> sound2) >>> sound3)

associativeParallel :: Property ()
associativeParallel = do
  sound1 <- gen genSound
  sound2 <- gen genSound
  sound3 <- gen genSound
  assertEquality "parallel not associative" $ (sound1 <> (sound2 <> sound3)) `almostEqSound` ((sound1 <> sound2) <> sound3)

distributivityParallelSequence :: Property ()
distributivityParallelSequence = do
  sound1 <- setDuration 1 <$> gen genSound
  sound2 <- setDuration 1 <$> gen genSound
  sound3 <- setDuration 1 <$> gen genSound
  sound4 <- setDuration 1 <$> gen genSound
  assertEquality "parallel not associative" $
    ((sound1 >>> sound2) <> (sound3 >>> sound4))
      `almostEqSound` ((sound1 <> sound3) >>> (sound2 <> sound4))

takeSoundProperty :: Property ()
takeSoundProperty = do
  sound1 <- setDuration 1 <$> gen genSound
  sound2 <- setDuration 1 <$> gen genSound
  assertEquality "takeSound failed" $ takeSound 1 (sound1 >>> sound2) `eqSound` sound1

dropSoundProperty :: Property ()
dropSoundProperty = do
  sound1 <- setDuration 1 <$> gen genSound
  sound2 <- setDuration 1 <$> gen genSound
  assertEquality "dropSound failed" $ dropSound 1 (sound1 >>> sound2) `eqSound` sound2

dropTakeSoundDuality :: Property ()
dropTakeSoundDuality = do
  sound1 <- setDuration 1 <$> gen genSound
  sound2 <- setDuration 1 <$> gen genSound
  assertEquality "drop/take duality failed" $
    dropSound 1 (sound1 >>> sound2)
      `eqSound` reverseSound (takeSound 1 (reverseSound $ sound1 >>> sound2))

cacheDoesNotChangeSound :: Property ()
cacheDoesNotChangeSound= do
  sound <- setDuration 1 <$> gen genSound
  assertEquality "cache changed sound" $
    cache sound
      `eqSound` sound

assertEquality :: String -> IO Bool -> Property ()
assertEquality failText check = do
  let areEqual = unsafePerformIO $ liftIO check
  unless areEqual (testFailed failText)

eqSound :: Sound T Pulse -> Sound T Pulse -> IO Bool
eqSound s1 s2 = (==) <$> sampleSound (Hz 100) s1 <*> sampleSound (Hz 100) s2

almostEqSound :: Sound T Pulse -> Sound T Pulse -> IO Bool
almostEqSound s1 s2 = do
  x <- sampleSound 100 s1
  y <- sampleSound 100 s2
  let res = M.all (\a -> abs a < epsilon) $ M.zipWith (-) x y
  unless res $
    print (x,y)
  pure res
  where
    epsilon = 5e-6