More tests (add generative tests)

tests/Codec/Audio/WaveSpec.hs

@@ -30,15 +30,30 @@
 -- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 -- POSSIBILITY OF SUCH DAMAGE.
 
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE BangPatterns         #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE RecordWildCards      #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Codec.Audio.WaveSpec
   ( spec )
 where
 
 import Codec.Audio.Wave
+import Data.ByteString (ByteString)
+import Data.Word (Word32)
+import System.IO
+import System.IO.Temp (withSystemTempFile)
 import Test.Hspec
+import Test.QuickCheck
+import qualified Data.ByteString as B
+import qualified Data.Serialize  as S
+import qualified Data.Set        as E
+
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative
+#endif
 
 -- The test suite has two parts. In the first part we establish that the
 -- library is capable of reading various sample files. In the second part,
@@ -114,7 +129,7 @@ spec = do
       waveDataOffset      `shouldBe` 80
       waveDataSize        `shouldBe` 48140
       waveOtherChunks     `shouldBe`
-        [("PEAK","\SOH\NUL\NUL\NUL\139\214FX\205\204L?,\SOH\NUL\NUL"),("fact","\ETX/\NUL\NUL")]
+        [("fact","\ETX/\NUL\NUL"),("PEAK","\SOH\NUL\NUL\NUL\139\214FX\205\204L?,\SOH\NUL\NUL")]
       waveByteRate      w `shouldBe` 192000
       waveBitRate       w `shouldBe` 1536.0
       waveBitsPerSample w `shouldBe` 32
@@ -132,7 +147,7 @@ spec = do
       waveDataOffset      `shouldBe` 80
       waveDataSize        `shouldBe` 104080
       waveOtherChunks     `shouldBe`
-        [("PEAK","\SOH\NUL\NUL\NUL\243\215FX\205\204L?d\NUL\NUL\NUL"),("fact","\210\&2\NUL\NUL")]
+        [("fact","\210\&2\NUL\NUL"),("PEAK","\SOH\NUL\NUL\NUL\243\215FX\205\204L?d\NUL\NUL\NUL")]
       waveByteRate      w `shouldBe` 128000
       waveBitRate       w `shouldBe` 1024.0
       waveBitsPerSample w `shouldBe` 64
@@ -202,7 +217,7 @@ spec = do
       waveDataOffset      `shouldBe` 104
       waveDataSize        `shouldBe` 48140
       waveOtherChunks     `shouldBe`
-        [("PEAK","\SOH\NUL\NUL\NUL\129\DC3GX\205\204L?,\SOH\NUL\NUL"),("fact","\ETX/\NUL\NUL")]
+        [("fact","\ETX/\NUL\NUL"),("PEAK","\SOH\NUL\NUL\NUL\129\DC3GX\205\204L?,\SOH\NUL\NUL")]
       waveByteRate      w `shouldBe` 192000
       waveBitRate       w `shouldBe` 1536.0
       waveBitsPerSample w `shouldBe` 32
@@ -220,11 +235,112 @@ spec = do
       waveDataOffset      `shouldBe` 104
       waveDataSize        `shouldBe` 104080
       waveOtherChunks     `shouldBe`
-        [("PEAK","\SOH\NUL\NUL\NUL\f\DC4GX\205\204L?d\NUL\NUL\NUL"),("fact","\210\&2\NUL\NUL")]
+        [("fact","\210\&2\NUL\NUL"),("PEAK","\SOH\NUL\NUL\NUL\f\DC4GX\205\204L?d\NUL\NUL\NUL")]
       waveByteRate      w `shouldBe` 128000
       waveBitRate       w `shouldBe` 1024.0
       waveBitsPerSample w `shouldBe` 64
       waveBlockAlign    w `shouldBe` 8
       waveChannels      w `shouldBe` 1
       waveSamplesTotal  w `shouldBe` 13010
       waveDuration      w `shouldBe` 0.813125
+
+  describe "RF64 WAVE" $
+    it "" pending
+
+    -- TODO RF64, 2 channels, 8000 Hz,  8 bit
+    -- TODO RF64, 2 channels, 11025 Hz, 24 bit
+    -- TODO RF64, 1 channel, 44100 Hz, 16 bit
+    -- TODO RF64, 1 channel, 48000 Hz, 32 bit float
+    -- TODO RF64, 1 channel, 16000 Hz, 64 bit float
+
+  describe "Wave64 WAVE" $
+    it "" pending
+
+    -- TODO Wave64, 2 channels, 8000 Hz,  8 bit
+    -- TODO Wave64, 2 channels, 11025 Hz, 24 bit
+    -- TODO Wave64, 1 channel, 44100 Hz, 16 bit
+    -- TODO Wave64, 1 channel, 48000 Hz, 32 bit float
+    -- TODO Wave64, 1 channel, 16000 Hz, 64 bit float
+
+  describe "writing/reading of arbitrary WAVE files" . around withSandbox $
+    it "works" $ \path ->
+      property $ \wave -> do
+        let dataSize  = waveDataSize wave
+            dataSize' =
+              if odd (dataSize + totalExtraLength wave)
+                then dataSize + 1
+                else dataSize
+        writeWaveFile path wave (writeBytes dataSize)
+        wave' <- readWaveFile path
+        wave' `shouldBe` wave
+          { waveDataOffset  = waveDataOffset wave'
+          , waveDataSize    = dataSize'
+          , waveOtherChunks =
+              if isNonPcm (waveSampleFormat wave)
+                then factChunk wave { waveDataSize = dataSize' } :
+                     waveOtherChunks wave
+                else waveOtherChunks wave }
+
+----------------------------------------------------------------------------
+-- Instances
+
+instance Arbitrary Wave where
+  arbitrary = do
+    waveFileFormat <- pure WaveVanilla -- elements [minBound..maxBound]
+    waveSampleRate <- arbitrary
+    let normalUnsigned n = n > 0 && n <= 8
+    waveSampleFormat <- oneof
+      [ SampleFormatPcmUnsigned <$> arbitrary `suchThat` normalUnsigned
+      , SampleFormatPcmSigned   <$> arbitrary `suchThat` (>  8)
+      , pure SampleFormatIeeeFloat32Bit
+      , pure SampleFormatIeeeFloat64Bit ]
+    waveChannelMask <- arbitrary `suchThat` (not . E.null)
+    let waveDataOffset = 0
+    waveDataSize    <- getSmall <$> arbitrary
+    waveOtherChunks <- listOf $ do
+      tag  <- B.pack <$> vectorOf 4 arbitrary
+      body <- B.pack <$> arbitrary
+      return (tag, body)
+    return Wave {..}
+
+instance Arbitrary SpeakerPosition where
+  arbitrary = elements [minBound..maxBound]
+
+----------------------------------------------------------------------------
+-- Helpers
+
+-- | Make a temporary copy of @audio-samples/sample.flac@ file and provide
+-- the path to the file. Automatically remove the file when the test
+-- finishes.
+
+withSandbox :: ActionWith FilePath -> IO ()
+withSandbox action = withSystemTempFile "sample.wav" $ \path h -> do
+  hClose h
+  action path
+
+-- | Write specified number of NULL bytes to given 'Handle'.
+
+writeBytes :: Word32 -> Handle -> IO ()
+writeBytes 0  _ = return ()
+writeBytes !n h = hPutChar h '\NUL' >> writeBytes (n - 1) h
+
+-- | Construct a “fact” chunk for a given 'Wave'.
+
+factChunk :: Wave -> (ByteString, ByteString)
+factChunk wave = ("fact", body)
+  where
+    body = (S.runPut . S.putWord32le . waveSamplesTotal) wave
+
+-- | Get total length of custom chunks.
+
+totalExtraLength :: Wave -> Word32
+totalExtraLength =
+  fromIntegral . sum . fmap (B.length . snd) . waveOtherChunks
+
+-- | Determine if given 'SampleFormat' is not PCM.
+
+isNonPcm :: SampleFormat -> Bool
+isNonPcm (SampleFormatPcmUnsigned _) = False
+isNonPcm (SampleFormatPcmSigned   _) = False
+isNonPcm SampleFormatIeeeFloat32Bit  = True
+isNonPcm SampleFormatIeeeFloat64Bit  = True

wave.cabal

@@ -58,7 +58,7 @@ flag dev
 
 library
   build-depends:      base             >= 4.7    && < 5.0
-                    , bytestring       >= 0.10.8 && < 0.11
+                    , bytestring       >= 0.2    && < 0.11
                     , cereal           >= 0.3    && < 0.6
                     , containers       >= 0.5    && < 0.6
                     , data-default-class
@@ -75,9 +75,13 @@ test-suite tests
   other-modules:      Codec.Audio.WaveSpec
   hs-source-dirs:     tests
   type:               exitcode-stdio-1.0
-  build-depends:      base             >= 4.7    && < 5.0
+  build-depends:      QuickCheck       >= 2.8.2  && < 3.0
+                    , base             >= 4.7    && < 5.0
+                    , bytestring       >= 0.2    && < 0.11
+                    , cereal           >= 0.3    && < 0.6
                     , containers       >= 0.5    && < 0.6
                     , hspec            >= 2.0    && < 3.0
+                    , temporary        >= 1.1    && < 1.3
                     , wave             >= 0.1.0
   if flag(dev)
     ghc-options:      -Wall -Werror