wave (empty) → 0.1.0
raw patch · 18 files changed
+1475/−0 lines, 18 filesdep +QuickCheckdep +basedep +bytestringsetup-changedbinary-added
Dependencies added: QuickCheck, base, bytestring, cereal, containers, data-default-class, hspec, temporary, transformers, wave
Files
- CHANGELOG.md +3/−0
- Codec/Audio/Wave.hs +846/−0
- LICENSE.md +28/−0
- README.md +74/−0
- Setup.hs +6/−0
- audio-samples/1ch-16000hz-64bit-float-x.wav binary
- audio-samples/1ch-16000hz-64bit-float.wav binary
- audio-samples/1ch-44100hz-16bit-x.wav binary
- audio-samples/1ch-44100hz-16bit.wav binary
- audio-samples/1ch-48000hz-32bit-float-x.wav binary
- audio-samples/1ch-48000hz-32bit-float.wav binary
- audio-samples/2ch-11025hz-24bit-x.wav binary
- audio-samples/2ch-11025hz-24bit.wav binary
- audio-samples/2ch-8000hz-8bit-x.wav binary
- audio-samples/2ch-8000hz-8bit.wav binary
- tests/Codec/Audio/WaveSpec.hs +427/−0
- tests/Spec.hs +1/−0
- wave.cabal +90/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## Wave 0.1.0++* Initial release.
+ Codec/Audio/Wave.hs view
@@ -0,0 +1,846 @@+-- |+-- Module : Codec.Audio.Wave+-- Copyright : © 2016 Mark Karpov+-- License : BSD 3 clause+--+-- Maintainer : Mark Karpov <markkarpov@openmailbox.org>+-- Stability : experimental+-- Portability : portable+--+-- This module provides a safe interface that allows to manipulate WAVE+-- files in their “classic” form as well as files in the RF64 format+-- <https://tech.ebu.ch/docs/tech/tech3306-2009.pdf>. RF64 adds the ability+-- to store files larger than 4 Gb.+--+-- The main feature of the API is that it does not allow the user to+-- duplicate information and introduce errors in that way. For example,+-- block align may be calculated from other parameters of audio stream, thus+-- we do not store it in the 'Wave' record and do not allow user to specify+-- it. We provide, however, a way to calculate it given 'Wave' record, see+-- 'waveBlockAlign'. The same is done for channels. Channel mask is a more+-- general means of providing information about number of channels and+-- corresponding speaker positions, thus we only store channel mask in+-- user-friendly form, but number of channels can be derived from that+-- information.+--+-- Another feature of the library is that it does not dictate how to+-- read\/write audio data. What we give is the information about audio data+-- and offset in file where it begins. To write data user may use a callback+-- that receives a 'Handle' as argument. Size of data block is deduced+-- automatically for you. Exclusion of audio data from consideration makes+-- the library pretty fast and open to different ways to handle audio data+-- itself, including using foreign code (such as C).+--+-- The library provides control over all parts of WAVE file that may be of+-- interest. In particular, it even allows to write arbitrary chunks between+-- @fmt@ and @data@ chunks, although it's rarely useful (and may actually+-- confuse buggy applications that don't know how to skip unknown chunks).++{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++module Codec.Audio.Wave+ ( -- * Types+ Wave (..)+ , WaveFormat (..)+ , SampleFormat (..)+ , SpeakerPosition (..)+ , WaveException (..)+ -- * Derived information+ , waveByteRate+ , waveBitRate+ , waveBitsPerSample+ , waveBlockAlign+ , waveChannels+ , waveDuration+ -- * Common speaker configurations+ , speakerMono+ , speakerStereo+ , speakerQuad+ , speakerSurround+ , speaker5_1+ , speaker7_1+ , speaker5_1Surround+ , speaker7_1Surround+ -- * Reading+ , readWaveFile+ -- * Writing+ , writeWaveFile )+where++import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Data.Bits+import Data.ByteString (ByteString)+import Data.Data (Data)+import Data.Default.Class+import Data.Maybe (mapMaybe, isNothing)+import Data.Monoid ((<>))+import Data.Set (Set)+import Data.Typeable+import Data.Word+import System.IO+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++----------------------------------------------------------------------------+-- Types++-- | Representation of “essential” information about a WAVE file. Every+-- field in this record provides orthogonal piece of information, so no+-- field can be calculated from other fields. The fields are complemented by+-- the following functions that calculate some derivative parameters:+-- 'waveByteRate', 'waveBitRate', 'waveBitsPerSample', 'waveBlockAlign', and+-- 'waveChannels'.++data Wave = Wave+ { waveFileFormat :: !WaveFormat+ -- ^ This specifies format of file this 'Wave' record was extracted\/to+ -- be written to, 'WaveFormat'. Default value is: 'WaveVanilla'.+ , waveSampleRate :: !Word32+ -- ^ Sample rate in Hz, default is: 44100.+ , waveSampleFormat :: !SampleFormat+ -- ^ Sample format. The library supports signed\/unsigned integers and+ -- floats. Default value: @'SampleFormatPcmInt' 16@.+ , waveChannelMask :: !(Set SpeakerPosition)+ -- ^ The channel mask as a 'Set' of 'SpeakerPosition's. Default value is+ -- 'speakerStereo'.+ , waveDataOffset :: !Word32+ -- ^ Offset in bytes from the beginning of file where actual sample data+ -- begins. Default value: 0.+ , waveDataSize :: !Word64+ -- ^ Size of audio data in bytes. Default value: 0.+ , waveSamplesTotal :: !Word64+ -- ^ Total number of samples in the audio stream. “Samples” here mean+ -- multi-channel samples, so one second of 44.1 kHz audio will have+ -- 44100 samples regardless of the number of channels. For PCM format+ -- it's deduced from size of data-block, for other formats it's read+ -- from\/written to the “fact” chunk. Default value: 0.+ , waveOtherChunks :: [(ByteString, ByteString)]+ -- ^ Other chunks as @(tag, body)@ pairs. Only first four bytes of @tag@+ -- are significant (and it must be four bytes long, if it's too short it+ -- will be padded by null bytes). Default value: @[]@.+ } deriving (Show, Read, Eq, Ord, Typeable, Data)++instance Default Wave where+ def = Wave+ { waveFileFormat = WaveVanilla+ , waveSampleRate = 44100+ , waveSampleFormat = SampleFormatPcmInt 16+ , waveChannelMask = defaultSpeakerSet 2+ , waveDataOffset = 0+ , waveDataSize = 0+ , waveSamplesTotal = 0+ , waveOtherChunks = [] }++-- | 'WaveFormat' as flavor of WAVE file.++data WaveFormat+ = WaveVanilla -- ^ Classic WAVE file, 4 Gb size limitation+ | WaveRF64 -- ^ WAVE file with RF64 extension+ deriving (Show, Read, Eq, Ord, Bounded, Enum, Typeable, Data)++-- | Sample formats with associated bit depth (when variable).++data SampleFormat+ = SampleFormatPcmInt Word16+ -- ^ Unsigned\/signed integers, the argument is the number of bits per+ -- sample (8 bit and less are encoded as unsigned integers).+ | SampleFormatIeeeFloat32Bit+ -- ^ Samples are 32 bit floating point numbers.+ | SampleFormatIeeeFloat64Bit+ -- ^ Samples are 64 bit floating point numbers.+ deriving (Show, Read, Eq, Ord, Typeable, Data)++-- | Speaker positions clarifying which exactly channels are packed in the+-- WAVE file.++data SpeakerPosition+ = SpeakerFrontLeft -- ^ Front left+ | SpeakerFrontRight -- ^ Front right+ | SpeakerFrontCenter -- ^ Front center+ | SpeakerLowFrequency -- ^ Sub-woofer+ | SpeakerBackLeft -- ^ Back left+ | SpeakerBackRight -- ^ Back right+ | SpeakerFrontLeftOfCenter -- ^ Front left of center+ | SpeakerFrontRightOfCenter -- ^ Front right of center+ | SpeakerBackCenter -- ^ Back center+ | SpeakerSideLeft -- ^ Side left+ | SpeakerSideRight -- ^ Side right+ | SpeakerTopCenter -- ^ Top center+ | SpeakerTopFrontLeft -- ^ Top front left+ | SpeakerTopFrontCenter -- ^ Top front center+ | SpeakerTopFrontRight -- ^ Top front right+ | SpeakerTopBackLeft -- ^ Top back left+ | SpeakerTopBackCenter -- ^ Top back center+ | SpeakerTopBackRight -- ^ Top back right+ deriving (Show, Read, Eq, Ord, Bounded, Enum, Typeable, Data)++-- | Exceptions the library can throw.++data WaveException+ = BadFileFormat String FilePath+ -- ^ Format of given file doesn't look like anything familiar. The first+ -- argument is a message explaining what's wrong and the second argument+ -- is the file name.+ | NonDataChunkIsTooLong ByteString FilePath+ -- ^ The library found a chunk which is not a @data@ chunk but is way+ -- too long. The first argument is the tag of the chunk and the second+ -- argument is the file name.+ | NonPcmFormatButMissingFact FilePath+ -- ^ The specified format is non-PCM, it's vanilla WAVE, but “fact”+ -- chunk is missing.+ deriving (Show, Read, Eq, Typeable, Data)++instance Exception WaveException++-- | A RIFF chunk allowing for different representations of its body. This+-- type is not public.++data Chunk m = Chunk+ { chunkTag :: !ByteString -- ^ Four-byte chunk tag+ , chunkSize :: !Word32 -- ^ Chunk size+ , chunkBody :: !(m ByteString) -- ^ Chunk body in some form+ }++-- | A “ds64” chunk used in RF64 WAVE extension. This type is not public.++data Ds64 = Ds64+ { ds64RiffSize :: !Word64 -- ^ Size of RIFF chunk (64 bits)+ , ds64DataSize :: !Word64 -- ^ Size of data chunk (64 bits)+ , ds64SamplesTotal :: !Word64 -- ^ Total number of samples (64 bits)+ }++instance Default Ds64 where+ def = Ds64+ { ds64RiffSize = 0+ , ds64DataSize = 0+ , ds64SamplesTotal = 0+ }++-- | A helper type synonym for give up function signatures.++type GiveUp = forall a. (FilePath -> WaveException) -> IO a++-- | A helpers type synonym for the function to lift parsers.++type LiftGet = forall a. IO (Either String a) -> IO a++----------------------------------------------------------------------------+-- Derived information++-- | Byte rate of a given 'Wave' file. Byte rate is the number of bytes it+-- takes to encode one second of audio.++waveByteRate :: Wave -> Word32+waveByteRate wave =+ waveSampleRate wave * fromIntegral (waveBlockAlign wave)++-- | Bit rate in kilobits per second.++waveBitRate :: Wave -> Double+waveBitRate = (/ 125) . fromIntegral . waveByteRate++-- | Number of significant bits in every sample.++waveBitsPerSample :: Wave -> Word16+waveBitsPerSample Wave {..} =+ case waveSampleFormat of+ SampleFormatPcmInt bps -> bps+ SampleFormatIeeeFloat32Bit -> 32+ SampleFormatIeeeFloat64Bit -> 64++-- | Block alignment of samples as number of bits per sample (rounded+-- towards next multiplier of 8 if necessary) multiplied by number of+-- channels. This is how many bytes it takes to encode a single+-- multi-channel sample.++waveBlockAlign :: Wave -> Word16+waveBlockAlign wave = waveChannels wave * bytesPerSample+ where+ bytesPerSample = roundBitsPerSample (waveBitsPerSample wave) `quot` 8++-- | Total number of channels present in the audio stream.++waveChannels :: Wave -> Word16+waveChannels Wave {..} = fromIntegral (E.size waveChannelMask)++-- | Duration in seconds.++waveDuration :: Wave -> Double+waveDuration wave =+ fromIntegral (waveSamplesTotal wave) / fromIntegral (waveSampleRate wave)++----------------------------------------------------------------------------+-- Common speaker configurations++-- | Front center (C).++speakerMono :: Set SpeakerPosition+speakerMono = E.fromList [SpeakerFrontCenter]++-- | Front left (L), front right (R).++speakerStereo :: Set SpeakerPosition+speakerStereo = E.fromList [SpeakerFrontLeft,SpeakerFrontRight]++-- | L, R, back left (Lb), back right (Rb).++speakerQuad :: Set SpeakerPosition+speakerQuad = E.fromList+ [ SpeakerFrontLeft+ , SpeakerFrontRight+ , SpeakerBackLeft+ , SpeakerBackRight ]++-- | Surround: L, R, front center (C), back center (Cb).++speakerSurround :: Set SpeakerPosition+speakerSurround = E.fromList+ [ SpeakerFrontLeft+ , SpeakerFrontRight+ , SpeakerFrontCenter+ , SpeakerBackCenter ]++-- | L, R, C, Lb, Rb, low frequency (LFE).++speaker5_1 :: Set SpeakerPosition+speaker5_1 = E.fromList+ [ SpeakerFrontLeft+ , SpeakerFrontRight+ , SpeakerFrontCenter+ , SpeakerBackLeft+ , SpeakerBackRight+ , SpeakerLowFrequency ]++-- | L, R, C, Lb, Rb, front left-of-center, front right-of-center, LFE.++speaker7_1 :: Set SpeakerPosition+speaker7_1 = E.fromList+ [ SpeakerFrontLeft+ , SpeakerFrontRight+ , SpeakerFrontCenter+ , SpeakerBackLeft+ , SpeakerBackRight+ , SpeakerFrontLeftOfCenter+ , SpeakerFrontRightOfCenter+ , SpeakerLowFrequency ]++-- | L, R, C, side left (Ls), side right (Rs), LFE.++speaker5_1Surround :: Set SpeakerPosition+speaker5_1Surround = E.fromList+ [ SpeakerFrontLeft+ , SpeakerFrontRight+ , SpeakerFrontCenter+ , SpeakerSideLeft+ , SpeakerSideRight+ , SpeakerLowFrequency ]++-- | L, R, C, Lb, Rb, Ls, Rs, LFE.++speaker7_1Surround :: Set SpeakerPosition+speaker7_1Surround = E.fromList+ [ SpeakerFrontLeft+ , SpeakerFrontRight+ , SpeakerFrontCenter+ , SpeakerBackLeft+ , SpeakerBackRight+ , SpeakerSideLeft+ , SpeakerSideRight+ , SpeakerLowFrequency ]++----------------------------------------------------------------------------+-- Reading++-- | Read 'Wave' record from a WAVE file found at given path. This action+-- throws 'WaveException' if the file is malformed and cannot be read.+--+-- You can feed vanilla WAVE and RF64 files. The actual format is detected+-- automatically from contents of the file, not by extension.+--+-- PCM with samples in form of integers and floats only are supported, see+-- 'SampleFormat'. Addition of other formats will be performed on request,+-- please feel free to contact me at+-- <https://github.com/mrkkrp/wave/issues>.++readWaveFile :: MonadIO m+ => FilePath -- ^ Location of file to read+ -> m Wave+readWaveFile path = liftIO . withFile path ReadMode $ \h -> do+ let giveup f = throwIO (f path)+ liftGet m = do+ r <- m+ case r of+ Left msg -> throwIO (BadFileFormat msg path)+ Right x -> return x+ outerChunk <- liftGet (readChunk h 0)+ case chunkTag outerChunk of+ "RIFF" -> readWaveVanilla h giveup liftGet+ "RF64" -> readWaveRF64 h giveup liftGet+ _ -> giveup (BadFileFormat "Can't locate RIFF/RF64 tag")++-- | Parse classic WAVE file.++readWaveVanilla+ :: Handle -- ^ 'Handle' to read from+ -> GiveUp -- ^ How to give up+ -> LiftGet -- ^ How to lift parsers+ -> IO Wave -- ^ The result+readWaveVanilla h giveup liftGet = do+ grabWaveTag h giveup+ grabWaveChunks h giveup liftGet Nothing Nothing+ def { waveFileFormat = WaveVanilla } -- just to be explicit++-- | Parse RF64 file.++readWaveRF64+ :: Handle -- ^ 'Handle' to read from+ -> GiveUp -- ^ How to give up+ -> LiftGet -- ^ How to lift parsers+ -> IO Wave -- ^ The result+readWaveRF64 h giveup liftGet = do+ grabWaveTag h giveup+ mds64 <- liftGet (readChunk h 0xffff)+ unless (chunkTag mds64 == "ds64") $+ giveup (BadFileFormat "Can't find ds64 chunk")+ Ds64 {..} <- case chunkBody mds64 of+ Nothing -> giveup (NonDataChunkIsTooLong "ds64")+ Just body -> liftGet (return $ readDs64 body)+ grabWaveChunks h giveup liftGet (Just ds64DataSize) (Just ds64SamplesTotal)+ def { waveFileFormat = WaveRF64+ , waveSamplesTotal = 0xffffffff }++-- | Read four bytes from given 'Handle' and throw an exception if they are+-- not “WAVE”.++grabWaveTag :: Handle -> GiveUp -> IO ()+grabWaveTag h giveup = do+ waveId <- B.hGet h 4+ unless (waveId == "WAVE") $+ giveup (BadFileFormat "Can't find WAVE format tag")++-- | Read WAVE chunks.++grabWaveChunks+ :: Handle -- ^ 'Handle' to read from+ -> GiveUp -- ^ How to give up+ -> LiftGet -- ^ How to lift parsers+ -> Maybe Word64 -- ^ Size of data chunk to use if 0xffffffff is read+ -> Maybe Word64 -- ^ Number of samples to use if 0xffffffff is read+ -> Wave -- ^ Apply modifications to this 'Wave'+ -> IO Wave -- ^ The result+grabWaveChunks h giveup liftGet mdataSize msamplesTotal = go False+ where+ go seenFact wave = do+ offset <- hTell h+ Chunk {..} <- liftGet (readChunk h 0xffff)+ case (chunkTag, chunkBody) of+ ("data", _) -> do+ let nonPcm = isNonPcm (waveSampleFormat wave)+ when (nonPcm && not seenFact && isNothing msamplesTotal) $+ giveup NonPcmFormatButMissingFact+ let dataSize =+ case (chunkSize == 0xffffffff, mdataSize) of+ (True, Just dataSize') -> dataSize'+ _ -> fromIntegral chunkSize+ return wave+ { waveDataOffset = fromIntegral offset + 8+ , waveDataSize = dataSize+ , waveSamplesTotal =+ case (waveSamplesTotal wave == 0xffffffff, msamplesTotal) of+ (True, Just samplesTotal) -> samplesTotal+ _ ->+ if nonPcm+ then waveSamplesTotal wave+ else pcmSamplesTotal wave { waveDataSize = dataSize }+ , waveOtherChunks = reverse (waveOtherChunks wave) }+ (tag, Nothing) ->+ giveup (NonDataChunkIsTooLong tag)+ ("fmt ", Just body) ->+ liftGet (return $ readWaveFmt wave body) >>= go seenFact+ ("fact", Just body) -> do+ samplesTotal <- liftGet (return $ readFact body)+ go True wave { waveSamplesTotal = fromIntegral samplesTotal }+ (tag, Just body) ->+ go seenFact+ wave { waveOtherChunks = (tag, body) : waveOtherChunks wave }++-- | Read a “ds64” chunk which contains RIFF chunk\/data chunk lengths as 64+-- bit values and total number of samples.++readDs64 :: ByteString -> Either String Ds64+readDs64 bytes = flip S.runGet bytes $ do+ ds64RiffSize <- S.getWord64le+ ds64DataSize <- S.getWord64le+ ds64SamplesTotal <- S.getWord64le+ return Ds64 {..}++-- | Parse WAVE format chunk from given 'ByteString'. Return error in 'Left'+-- in case of failure.++readWaveFmt :: Wave -> ByteString -> Either String Wave+readWaveFmt wave = S.runGet $ do+ format <- S.getWord16le+ unless ( format == waveFormatPcm ||+ format == waveFormatIeeeFloat ||+ format == waveFormatExtensible ) $+ fail "Unsupported audio format specified in fmt chunk"+ let extensible = format == waveFormatExtensible+ channels <- S.getWord16le+ sampleRate <- S.getWord32le+ S.skip 4 -- byte rate (useless, we can infer it)+ S.skip 2 -- block align (useless as well)+ bps <- S.getWord16le+ hasExtSize <- not <$> S.isEmpty+ extSize <- if hasExtSize+ then S.getWord16le+ else return 0+ when (extSize < 22 && extensible) $+ fail "The format is extensible, but extra params are shorter than 22 bytes"+ bitsPerSample <- if extensible+ then S.getWord16le+ else return bps+ channelMask <- if extensible+ then fromSpeakerMask <$> S.getWord32le+ else return (defaultSpeakerSet channels)+ extGuid <- if extensible+ then S.getByteString 16+ else return $ if format == waveFormatPcm+ then ksdataformatSubtypePcm+ else ksdataformatSubtypeIeeeFloat+ when (extGuid /= ksdataformatSubtypePcm &&+ extGuid /= ksdataformatSubtypeIeeeFloat) $+ fail ("Unknown or unsupported GUID in extensible fmt chunk" ++ show extGuid)+ let ieeeFloat = extGuid == ksdataformatSubtypeIeeeFloat+ when (ieeeFloat && not (bitsPerSample == 32 || bitsPerSample == 64)) $+ fail "The sample format is IEEE Float, but bits per sample is not 32 or 64"+ return wave+ { waveSampleRate = sampleRate+ , waveSampleFormat =+ if ieeeFloat+ then if bitsPerSample == 32+ then SampleFormatIeeeFloat32Bit+ else SampleFormatIeeeFloat64Bit+ else SampleFormatPcmInt bitsPerSample+ , waveChannelMask = channelMask }++-- | Read the “fact” chunk.++readFact :: ByteString -> Either String Word32+readFact = S.runGet S.getWord32le++-- | Read a classic RIFF 'Chunk' (32 bit tag + 32 bit size).++readChunk+ :: Handle -- ^ Opened 'Handle' to read the chunk from+ -> Word32 -- ^ Maximum size of chunk we want to grab into memory+ -> IO (Either String (Chunk Maybe)) -- ^ Error message or a 'Chunk'+readChunk h maxSize = do+ bytes <- B.hGet h 8+ let echunk = flip S.runGet bytes $ do+ chunkTag <- S.getBytes 4+ chunkSize <- S.getWord32le+ let chunkBody = Nothing+ return Chunk {..}+ case echunk of+ Left msg -> return (Left msg)+ Right chunk@Chunk {..} -> do+ body <- if chunkSize <= maxSize+ then Just <$> B.hGet h (fromIntegral chunkSize)+ else return Nothing+ (return . Right) chunk { chunkBody = body }++----------------------------------------------------------------------------+-- Writing++-- | Write a WAVE file. The 'waveFileFormat' value specifies in which of the+-- supported formats the file should be written. The action uses the+-- provided callback to write WAVE audio data. 'waveDataOffset' and+-- 'waveDataSize' from 'Wave' are ignored, instead the values are inferred+-- dynamically after using the callback. Further, the function takes care of+-- the requirement that WAVE data should end on “even byte boundary”. The+-- pad byte is written for you if necessary and included in data size.+--+-- The 'waveSamplesTotal' field will be inferred for PCM (including formats+-- with samples represented as floats, i.e. always right now), so the+-- provided value is not used.+--+-- If 'Wave' specifies floating point sample format, the “fact” chunk is+-- automatically generated and written (the chunk is required for all+-- non-PCM formats by the spec), but only for vanilla WAVE.++writeWaveFile :: MonadIO m+ => FilePath -- ^ Where to save the file+ -> Wave -- ^ Parameters of the WAVE file+ -> (Handle -> IO ()) -- ^ Callback that will be used to write WAVE data+ -> m ()+writeWaveFile path wave writeData = liftIO . withFile path WriteMode $ \h ->+ case waveFileFormat wave of+ WaveVanilla -> writeWaveVanilla h wave writeData+ WaveRF64 -> writeWaveRF64 h wave writeData++-- | Write vanilla WAVE format.++writeWaveVanilla+ :: Handle -- ^ 'Handle' to write to+ -> Wave -- ^ Parameters of the WAVE file+ -> (Handle -> IO ()) -- ^ Callback that writes WAVE data+ -> IO ()+writeWaveVanilla h wave writeData = do+ let nonPcm = isNonPcm (waveSampleFormat wave)+ -- Write the outer RIFF chunk.+ beforeOuter <- hTell h+ writeChunk h (Chunk "RIFF" 0 writeNoData)+ -- Write the WAVE format tag.+ B.hPut h "WAVE"+ -- Write fmt chunk.+ writeBsChunk h "fmt " (renderFmtChunk wave)+ -- Write a dummy fact chunk if necessary.+ beforeFact <- hTell h+ when nonPcm $+ writeBsChunk h "fact" "????"+ -- Write any extra chunks if present.+ forM_ (waveOtherChunks wave) (uncurry $ writeBsChunk h)+ -- Write data chunk.+ beforeData <- hTell h+ writeChunk h (Chunk "data" 0 (Left writeData))+ -- Take care of alignment.+ rightAfterData <- hTell h+ when (odd rightAfterData) $+ B.hPut h "\0"+ -- Go back and overwrite dummy values.+ afterData <- hTell h+ let riffSize = fromIntegral (afterData - beforeOuter - 8)+ dataSize = fromIntegral (afterData - beforeData - 8)+ samplesTotal = fromIntegral $+ pcmSamplesTotal wave { waveDataSize = fromIntegral dataSize }+ when nonPcm $ do+ hSeek h AbsoluteSeek beforeFact+ writeBsChunk h "fact" (renderFactChunk samplesTotal)+ hSeek h AbsoluteSeek beforeData+ writeChunk h (Chunk "data" dataSize writeNoData)+ hSeek h AbsoluteSeek beforeOuter+ writeChunk h (Chunk "RIFF" riffSize writeNoData)++writeWaveRF64 :: Handle -> Wave -> (Handle -> IO ()) -> IO ()+writeWaveRF64 h wave writeData = do+ -- Write the outer RF64 chunk.+ beforeOuter <- hTell h+ writeChunk h (Chunk "RF64" 0xffffffff writeNoData)+ -- Write the WAVE format tag.+ B.hPut h "WAVE"+ -- Write ds64 chunk.+ beforeDs64 <- hTell h+ writeBsChunk h "ds64" (renderDs64Chunk def)+ -- Write fmt chunk.+ writeBsChunk h "fmt " (renderFmtChunk wave)+ -- Write any extra chunks if present.+ forM_ (waveOtherChunks wave) (uncurry $ writeBsChunk h)+ -- Write data chunk.+ beforeData <- hTell h+ writeChunk h (Chunk "data" 0xffffffff (Left writeData))+ -- Take care of alignment.+ rightAfterData <- hTell h+ when (odd rightAfterData) $+ B.hPut h "\0"+ -- Go back and overwrite dummy values.+ afterData <- hTell h+ let ds64RiffSize = fromIntegral (afterData - beforeOuter - 8)+ ds64DataSize = fromIntegral (afterData - beforeData - 8)+ ds64SamplesTotal = pcmSamplesTotal wave { waveDataSize = ds64DataSize }+ ds64Chunk = Ds64 {..}+ hSeek h AbsoluteSeek beforeDs64+ writeBsChunk h "ds64" (renderDs64Chunk ds64Chunk)++-- | Write no data, at all.++writeNoData :: Either (Handle -> IO ()) a+writeNoData = (Left . const . return) ()++-- | Write a chunk given its tag and body as strict 'ByteString's.++writeBsChunk+ :: Handle -- ^ 'Handle' where to write+ -> ByteString -- ^ Chunk tag+ -> ByteString -- ^ Chunk body+ -> IO ()+writeBsChunk h chunkTag body =+ let chunkSize = fromIntegral (B.length body)+ chunkBody = Right body+ in writeChunk h Chunk {..}++-- | Render a “ds64” chunk as a stirct 'ByteString'.++renderDs64Chunk :: Ds64 -> ByteString+renderDs64Chunk Ds64 {..} = S.runPut $ do+ S.putWord64le ds64RiffSize+ S.putWord64le ds64DataSize+ S.putWord64le ds64SamplesTotal++-- | Render format chunk as a strict 'ByteString' from a given 'Wave'.++renderFmtChunk :: Wave -> ByteString+renderFmtChunk wave@Wave {..} = S.runPut $ do+ let extensible = isExtensibleFmt wave+ fmt = case waveSampleFormat of+ SampleFormatPcmInt _ -> waveFormatPcm+ SampleFormatIeeeFloat32Bit -> waveFormatIeeeFloat+ SampleFormatIeeeFloat64Bit -> waveFormatIeeeFloat+ bps = waveBitsPerSample wave+ S.putWord16le (if extensible then waveFormatExtensible else fmt)+ S.putWord16le (waveChannels wave)+ S.putWord32le waveSampleRate+ S.putWord32le (waveByteRate wave)+ S.putWord16le (waveBlockAlign wave)+ S.putWord16le (roundBitsPerSample bps)+ when extensible $ do+ S.putWord16le 22+ S.putWord16le bps+ S.putWord32le (toSpeakerMask waveChannelMask)+ S.putByteString $ case waveSampleFormat of+ SampleFormatPcmInt _ -> ksdataformatSubtypePcm+ SampleFormatIeeeFloat32Bit -> ksdataformatSubtypeIeeeFloat+ SampleFormatIeeeFloat64Bit -> ksdataformatSubtypeIeeeFloat+ unless extensible $+ S.putWord16le 0++-- | Render fact chunk as a strict 'ByteString'.++renderFactChunk :: Word32 -> ByteString+renderFactChunk = S.runPut . S.putWord32le++-- | Write a RIFF 'Chunk'. It's the responsibility of the programmer to+-- ensure that specified size matches size of body that is actually written.++writeChunk+ :: Handle -- ^ Opened 'Handle' where to write the 'Chunk'+ -> Chunk (Either (Handle -> IO ())) -- ^ The 'Chunk' to write+ -> IO ()+writeChunk h Chunk {..} = do+ let bytes = S.runPut $ do+ S.putByteString (B.take 4 $ chunkTag <> B.replicate 4 0x00)+ S.putWord32le chunkSize+ B.hPut h bytes+ case chunkBody of+ Left action -> action h+ Right body -> B.hPut h body++----------------------------------------------------------------------------+-- Helpers++-- | Pulse-code modulation, vanilla WAVE.++waveFormatPcm :: Word16 -- WAVE_FORMAT_PCM+waveFormatPcm = 0x0001++-- | IEEE floats, 32 bit floating point samples.++waveFormatIeeeFloat :: Word16 -- WAVE_FORMAT_IEEE_FLOAT+waveFormatIeeeFloat = 0x0003++-- | Extensible format type.++waveFormatExtensible :: Word16+waveFormatExtensible = 0xfffe -- WAVE_FORMAT_EXTENSIBLE++-- | GUID for extensible format chunk corresponding to PCM.++ksdataformatSubtypePcm :: ByteString -- KSDATAFORMAT_SUBTYPE_PCM+ksdataformatSubtypePcm = -- 00000001-0000-0010-8000-00aa00389b71+ "\x01\x00\x00\x00\x00\x00\x10\x00\x80\x00\x00\xaa\x00\x38\x9b\x71"+-- NOTE This is binary representation of GUID, with some parts written in+-- little-endian form, see:+--+-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa373931(v=vs.85).aspx++-- | GUID for extensible format chunk corresponding to IEEE float.++ksdataformatSubtypeIeeeFloat :: ByteString -- KSDATAFORMAT_SUBTYPE_IEEE_FLOAT+ksdataformatSubtypeIeeeFloat = -- 00000003-0000-0010-8000-00aa00389b71+ "\x03\x00\x00\x00\x00\x00\x10\x00\x80\x00\x00\xaa\x00\x38\x9b\x71"++-- | 'SpeakerPosition' to corresponding bit flag, as per+-- <https://msdn.microsoft.com/en-us/library/windows/desktop/dd390971(v=vs.85).aspx>.++speakerToFlag :: SpeakerPosition -> Word32+speakerToFlag SpeakerFrontLeft = 0x1+speakerToFlag SpeakerFrontRight = 0x2+speakerToFlag SpeakerFrontCenter = 0x4+speakerToFlag SpeakerLowFrequency = 0x8+speakerToFlag SpeakerBackLeft = 0x10+speakerToFlag SpeakerBackRight = 0x20+speakerToFlag SpeakerFrontLeftOfCenter = 0x40+speakerToFlag SpeakerFrontRightOfCenter = 0x80+speakerToFlag SpeakerBackCenter = 0x100+speakerToFlag SpeakerSideLeft = 0x200+speakerToFlag SpeakerSideRight = 0x400+speakerToFlag SpeakerTopCenter = 0x800+speakerToFlag SpeakerTopFrontLeft = 0x1000+speakerToFlag SpeakerTopFrontCenter = 0x2000+speakerToFlag SpeakerTopFrontRight = 0x4000+speakerToFlag SpeakerTopBackLeft = 0x8000+speakerToFlag SpeakerTopBackCenter = 0x10000+speakerToFlag SpeakerTopBackRight = 0x20000++-- | Get speaker mask from a 'Set' of 'SpeakerPosition's.++toSpeakerMask :: Set SpeakerPosition -> Word32+toSpeakerMask = E.foldl' (.|.) 0 . E.map speakerToFlag++-- | Transform a 4-byte mask into a set of 'SpeakerPosition's.++fromSpeakerMask :: Word32 -> Set SpeakerPosition+fromSpeakerMask channelMask = E.fromList $ mapMaybe f [minBound..maxBound]+ where+ f sp = if speakerToFlag sp .&. channelMask > 0+ then Just sp+ else Nothing++-- | Get default speaker set for given number of channels.++defaultSpeakerSet :: Word16 -> Set SpeakerPosition+defaultSpeakerSet n = case n of+ 0 -> E.empty+ 1 -> speakerMono+ 2 -> speakerStereo+ 3 -> E.fromList [SpeakerFrontLeft,SpeakerFrontCenter,SpeakerFrontRight]+ 4 -> speakerSurround+ x -> E.fromList $ take (fromIntegral x) [minBound..maxBound]++-- | Does this 'Wave' record requires extensible format chunk to be used?++isExtensibleFmt :: Wave -> Bool+isExtensibleFmt wave@Wave {..} =+ waveChannels wave > 2 ||+ waveChannelMask /= defaultSpeakerSet (waveChannels wave) ||+ (waveBitsPerSample wave `rem` 8) /= 0++-- | Determine if given 'SampleFormat' is not PCM.++isNonPcm :: SampleFormat -> Bool+isNonPcm (SampleFormatPcmInt _) = False+isNonPcm SampleFormatIeeeFloat32Bit = True+isNonPcm SampleFormatIeeeFloat64Bit = True++-- | Round bits per sample to next multiplier of 8, if necessary.++roundBitsPerSample :: Word16 -> Word16+roundBitsPerSample n = if r /= 0 then (x + 1) * 8 else n+ where+ (x,r) = n `quotRem` 8++-- | Estimate total number of samples for a PCM audio stream.++pcmSamplesTotal :: Wave -> Word64+pcmSamplesTotal wave =+ waveDataSize wave `quot` fromIntegral (waveBlockAlign wave)
+ LICENSE.md view
@@ -0,0 +1,28 @@+Copyright © 2016 Mark Karpov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++* Neither the name Mark Karpov nor the names of contributors may be used to+ endorse or promote products derived from this software without specific+ prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,74 @@+# Wave++[](http://opensource.org/licenses/BSD-3-Clause)+[](https://hackage.haskell.org/package/wave)+[](http://stackage.org/nightly/package/wave)+[](http://stackage.org/lts/package/wave)+[](https://travis-ci.org/mrkkrp/wave)+[](https://coveralls.io/github/mrkkrp/wave?branch=master)++This module provides a safe interface that allows to manipulate WAVE files+in their “classic” form as well as files in+the [RF64 format](https://tech.ebu.ch/docs/tech/tech3306-2009.pdf). RF64+adds the ability to store files larger than 4 Gb.++## What++The main feature of the API is that it does not allow the user to duplicate+information and introduce errors in that way. For example, block align may+be calculated from other parameters of audio stream, thus we do not store it+in the `Wave` record and do not allow user to specify it. We provide,+however, a way to calculate it given `Wave` record, see `waveBlockAlign`.+The same is done for channels. Channel mask is a more general means of+providing information about number of channels and corresponding speaker+positions, thus we only store channel mask in user-friendly form, but number+of channels can be derived from that information.++Another feature of the library is that it does not dictate how to read/write+audio data. What we give is the information about audio data and offset in+file where it begins. To write data user may use a callback that receives a+`Handle` as argument. Size of data block is deduced automatically for you.+Exclusion of audio data from consideration makes the library pretty fast and+open to different ways to handle audio data itself, including using foreign+code (such as C).++The library provides control over all parts of WAVE file that may be of+interest. In particular, it even allows to write arbitrary chunks between+`fmt` and `data` chunks, although it's rarely useful (and may actually+confuse buggy applications that don't know how to skip unknown chunks).++Please [read the Haddocks](https://hackage.haskell.org/package/wave) for a+more detailed documentation, the usage should be trivial.++## Why++I needed a way to work with WAVE files to finish+my [`flac`](https://github.com/mrkkrp/flac) package and for analyzing input+data in WAVE format in general. The existing solutions+([`WAVE`](https://hackage.haskell.org/package/WAVE),+[`wavy`](https://hackage.haskell.org/package/wavy)) are not maintained and+poorly designed. It suffices to say that they read samples of audio stream+and put them into a *linked list*, like `[[Sample]]` (the inner linked list+is to store multi-channel data, yeah).++This `wave` package is the first serious solution in Haskell that allows to+work with WAVE data safely and efficiently.++## Limitations++The library only supports PCM format with samples represented as integers+and floating point values. Support for other formats will be added on+request, please contact me at https://github.com/mrkkrp/wave/issues.++## Contribution++Issues, bugs, and questions may be reported in [the GitHub issue tracker for+this project](https://github.com/mrkkrp/wave/issues).++Pull requests are also welcome and will be reviewed quickly.++## License++Copyright © 2016 Mark Karpov++Distributed under BSD 3 clause license.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ audio-samples/1ch-16000hz-64bit-float-x.wav view
binary file changed (absent → 104184 bytes)
+ audio-samples/1ch-16000hz-64bit-float.wav view
binary file changed (absent → 104160 bytes)
+ audio-samples/1ch-44100hz-16bit-x.wav view
binary file changed (absent → 5126 bytes)
+ audio-samples/1ch-44100hz-16bit.wav view
binary file changed (absent → 5090 bytes)
+ audio-samples/1ch-48000hz-32bit-float-x.wav view
binary file changed (absent → 48244 bytes)
+ audio-samples/1ch-48000hz-32bit-float.wav view
binary file changed (absent → 48220 bytes)
+ audio-samples/2ch-11025hz-24bit-x.wav view
binary file changed (absent → 23354 bytes)
+ audio-samples/2ch-11025hz-24bit.wav view
binary file changed (absent → 23318 bytes)
+ audio-samples/2ch-8000hz-8bit-x.wav view
binary file changed (absent → 11456 bytes)
+ audio-samples/2ch-8000hz-8bit.wav view
binary file changed (absent → 11420 bytes)
+ tests/Codec/Audio/WaveSpec.hs view
@@ -0,0 +1,427 @@+--+-- Test suite for the ‘wave’ package.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+-- notice, this list of conditions and the following disclaimer in the+-- documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+-- to endorse or promote products derived from this software without+-- specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++{-# 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.Default.Class+import Data.Word+import System.IO+import System.IO.Temp (withSystemTempFile)+import Test.Hspec+import Test.QuickCheck+import qualified Data.ByteString as B+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,+-- we generate random WAVE files and write them to temporary files, then+-- read the files back and compare. This way we ensure that 1) the library+-- supports reading arbitrary valid files 2) since reading is valid, we can+-- assume that writing is valid too if the read results looks OK.+--+-- If any problems will be discovered in the future, it's simple to extend+-- the first part of the test suite to check for those cases.++spec :: Spec+spec = do++ describe "vanilla WAVE" $ do+ it "2 channels 8000 Hz 8 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/2ch-8000hz-8bit.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 8000+ waveSampleFormat `shouldBe` SampleFormatPcmInt 8+ waveChannelMask `shouldBe` speakerStereo+ waveDataOffset `shouldBe` 44+ waveDataSize `shouldBe` 11376+ waveSamplesTotal `shouldBe` 5688+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 16000+ waveBitRate w `shouldBe` 128+ waveBitsPerSample w `shouldBe` 8+ waveBlockAlign w `shouldBe` 2+ waveChannels w `shouldBe` 2+ waveDuration w `shouldBe` 0.711++ it "2 channels 11025 Hz 24 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/2ch-11025hz-24bit.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 11025+ waveSampleFormat `shouldBe` SampleFormatPcmInt 24+ waveChannelMask `shouldBe` speakerStereo+ waveDataOffset `shouldBe` 44+ waveDataSize `shouldBe` 23274+ waveSamplesTotal `shouldBe` 3879+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 66150+ waveBitRate w `shouldBe` 529.2+ waveBitsPerSample w `shouldBe` 24+ waveBlockAlign w `shouldBe` 6+ waveChannels w `shouldBe` 2+ waveDuration w `shouldBe` 0.35183673469387755++ it "1 channel 44100 Hz 16 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-44100hz-16bit.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 44100+ waveSampleFormat `shouldBe` SampleFormatPcmInt 16+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 44+ waveDataSize `shouldBe` 5046+ waveSamplesTotal `shouldBe` 2523+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 88200+ waveBitRate w `shouldBe` 705.6+ waveBitsPerSample w `shouldBe` 16+ waveBlockAlign w `shouldBe` 2+ waveChannels w `shouldBe` 1+ waveDuration w `shouldBe` 0.0572108843537415++ it "1 channel 48000 Hz 32 bit float" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-48000hz-32bit-float.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 48000+ waveSampleFormat `shouldBe` SampleFormatIeeeFloat32Bit+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 80+ waveDataSize `shouldBe` 48140+ waveSamplesTotal `shouldBe` 12035+ waveOtherChunks `shouldBe`+ [("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+ waveBlockAlign w `shouldBe` 4+ waveChannels w `shouldBe` 1+ waveDuration w `shouldBe` 0.25072916666666667++ it "1 channel 16000 Hz 64 bit float" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-16000hz-64bit-float.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 16000+ waveSampleFormat `shouldBe` SampleFormatIeeeFloat64Bit+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 80+ waveDataSize `shouldBe` 104080+ waveSamplesTotal `shouldBe` 13010+ waveOtherChunks `shouldBe`+ [("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+ waveBlockAlign w `shouldBe` 8+ waveChannels w `shouldBe` 1+ waveDuration w `shouldBe` 0.813125++ describe "vanilla WAVE with extensible fmt chunk" $ do+ it "2 channels 8000 Hz 8 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/2ch-8000hz-8bit-x.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 8000+ waveSampleFormat `shouldBe` SampleFormatPcmInt 8+ waveChannelMask `shouldBe` speakerStereo+ waveDataOffset `shouldBe` 80+ waveDataSize `shouldBe` 11376+ waveSamplesTotal `shouldBe` 5688+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 16000+ waveBitRate w `shouldBe` 128+ waveBitsPerSample w `shouldBe` 8+ waveBlockAlign w `shouldBe` 2+ waveChannels w `shouldBe` 2+ waveDuration w `shouldBe` 0.711++ it "2 channels 11025 Hz 24 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/2ch-11025hz-24bit-x.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 11025+ waveSampleFormat `shouldBe` SampleFormatPcmInt 24+ waveChannelMask `shouldBe` speakerStereo+ waveDataOffset `shouldBe` 80+ waveDataSize `shouldBe` 23274+ waveSamplesTotal `shouldBe` 3879+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 66150+ waveBitRate w `shouldBe` 529.2+ waveBitsPerSample w `shouldBe` 24+ waveBlockAlign w `shouldBe` 6+ waveChannels w `shouldBe` 2+ waveDuration w `shouldBe` 0.35183673469387755++ it "1 channel 44100 Hz 16 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-44100hz-16bit-x.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 44100+ waveSampleFormat `shouldBe` SampleFormatPcmInt 16+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 80+ waveDataSize `shouldBe` 5046+ waveSamplesTotal `shouldBe` 2523+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 88200+ waveBitRate w `shouldBe` 705.6+ waveBitsPerSample w `shouldBe` 16+ waveBlockAlign w `shouldBe` 2+ waveChannels w `shouldBe` 1+ waveDuration w `shouldBe` 0.0572108843537415++ it "1 channel 48000 Hz 32 bit float" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-48000hz-32bit-float-x.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 48000+ waveSampleFormat `shouldBe` SampleFormatIeeeFloat32Bit+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 104+ waveDataSize `shouldBe` 48140+ waveSamplesTotal `shouldBe` 12035+ waveOtherChunks `shouldBe`+ [("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+ waveBlockAlign w `shouldBe` 4+ waveChannels w `shouldBe` 1+ waveDuration w `shouldBe` 0.25072916666666667++ it "1 channel 16000 Hz 64 bit float" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-16000hz-64bit-float-x.wav"+ waveFileFormat `shouldBe` WaveVanilla+ waveSampleRate `shouldBe` 16000+ waveSampleFormat `shouldBe` SampleFormatIeeeFloat64Bit+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 104+ waveDataSize `shouldBe` 104080+ waveSamplesTotal `shouldBe` 13010+ waveOtherChunks `shouldBe`+ [("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+ waveDuration w `shouldBe` 0.813125++ describe "RF64 WAVE" $ do+ it "2 channels 8000 Hz 8 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/2ch-8000hz-8bit.rf64"+ waveFileFormat `shouldBe` WaveRF64+ waveSampleRate `shouldBe` 8000+ waveSampleFormat `shouldBe` SampleFormatPcmInt 8+ waveChannelMask `shouldBe` speakerStereo+ waveDataOffset `shouldBe` 104+ waveDataSize `shouldBe` 11376+ waveSamplesTotal `shouldBe` 5688+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 16000+ waveBitRate w `shouldBe` 128+ waveBitsPerSample w `shouldBe` 8+ waveBlockAlign w `shouldBe` 2+ waveChannels w `shouldBe` 2+ waveDuration w `shouldBe` 0.711++ it "2 channels 11025 Hz 24 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/2ch-11025hz-24bit.rf64"+ waveFileFormat `shouldBe` WaveRF64+ waveSampleRate `shouldBe` 11025+ waveSampleFormat `shouldBe` SampleFormatPcmInt 24+ waveChannelMask `shouldBe` speakerStereo+ waveDataOffset `shouldBe` 104+ waveDataSize `shouldBe` 23274+ waveSamplesTotal `shouldBe` 3879+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 66150+ waveBitRate w `shouldBe` 529.2+ waveBitsPerSample w `shouldBe` 24+ waveBlockAlign w `shouldBe` 6+ waveChannels w `shouldBe` 2+ waveDuration w `shouldBe` 0.35183673469387755++ it "1 channel 44100 Hz 16 bit" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-44100hz-16bit.rf64"+ waveFileFormat `shouldBe` WaveRF64+ waveSampleRate `shouldBe` 44100+ waveSampleFormat `shouldBe` SampleFormatPcmInt 16+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 104+ waveDataSize `shouldBe` 5046+ waveSamplesTotal `shouldBe` 2523+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 88200+ waveBitRate w `shouldBe` 705.6+ waveBitsPerSample w `shouldBe` 16+ waveBlockAlign w `shouldBe` 2+ waveChannels w `shouldBe` 1+ waveDuration w `shouldBe` 0.0572108843537415++ it "1 channel 48000 Hz 32 bit float" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-48000hz-32bit-float.rf64"+ waveFileFormat `shouldBe` WaveRF64+ waveSampleRate `shouldBe` 48000+ waveSampleFormat `shouldBe` SampleFormatIeeeFloat32Bit+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 104+ waveDataSize `shouldBe` 48140+ waveSamplesTotal `shouldBe` 12035+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 192000+ waveBitRate w `shouldBe` 1536.0+ waveBitsPerSample w `shouldBe` 32+ waveBlockAlign w `shouldBe` 4+ waveChannels w `shouldBe` 1+ waveDuration w `shouldBe` 0.25072916666666667++ it "1 channel 16000 Hz 64 bit float" $ do+ w@Wave {..} <- readWaveFile "audio-samples/1ch-16000hz-64bit-float.rf64"+ waveFileFormat `shouldBe` WaveRF64+ waveSampleRate `shouldBe` 16000+ waveSampleFormat `shouldBe` SampleFormatIeeeFloat64Bit+ waveChannelMask `shouldBe` speakerMono+ waveDataOffset `shouldBe` 104+ waveDataSize `shouldBe` 104080+ waveSamplesTotal `shouldBe` 13010+ waveOtherChunks `shouldBe` []+ waveByteRate w `shouldBe` 128000+ waveBitRate w `shouldBe` 1024.0+ waveBitsPerSample w `shouldBe` 64+ waveBlockAlign w `shouldBe` 8+ waveChannels w `shouldBe` 1+ waveDuration w `shouldBe` 0.813125++ 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+ samplesTotal = pcmSamplesTotal wave { waveDataSize = dataSize' }+ writeWaveFile path wave (writeBytes dataSize)+ wave' <- readWaveFile path+ wave' `shouldBe` wave+ { waveDataOffset = waveDataOffset wave'+ , waveDataSize = dataSize'+ , waveSamplesTotal = samplesTotal+ , waveOtherChunks = waveOtherChunks wave }++ describe "pre-defined speaker configurations" $ do+ describe "speakerMono" $+ it "has 1 channel" $+ waveChannels def { waveChannelMask = speakerMono } `shouldBe` 1+ describe "speakerStereo" $+ it "has 2 channels" $+ waveChannels def { waveChannelMask = speakerStereo } `shouldBe` 2+ describe "speakerQuad" $+ it "has 4 channels" $+ waveChannels def { waveChannelMask = speakerQuad } `shouldBe` 4+ describe "speakerSurround" $+ it "has 4 channels" $+ waveChannels def { waveChannelMask = speakerSurround } `shouldBe` 4+ describe "speaker5_1" $+ it "has 6 channels" $+ waveChannels def { waveChannelMask = speaker5_1 } `shouldBe` 6+ describe "speaker7_1" $+ it "has 8 channels" $+ waveChannels def { waveChannelMask = speaker7_1 } `shouldBe` 8+ describe "speaker5_1Surround" $+ it "has 6 channels" $+ waveChannels def { waveChannelMask = speaker5_1Surround } `shouldBe` 6+ describe "speaker7_1" $+ it "has 8 channels" $+ waveChannels def { waveChannelMask = speaker7_1Surround } `shouldBe` 8++----------------------------------------------------------------------------+-- Instances++instance Arbitrary Wave where+ arbitrary = do+ waveFileFormat <- elements [minBound..maxBound]+ waveSampleRate <- arbitrary+ waveSampleFormat <- oneof+ [ SampleFormatPcmInt . getPositive <$> arbitrary+ , pure SampleFormatIeeeFloat32Bit+ , pure SampleFormatIeeeFloat64Bit ]+ waveChannelMask <- arbitrary `suchThat` (not . E.null)+ let waveDataOffset = 0+ waveDataSize <- getSmall <$> arbitrary+ waveSamplesTotal <- 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 :: Word64 -> Handle -> IO ()+writeBytes 0 _ = return ()+writeBytes !n h = hPutChar h '\NUL' >> writeBytes (n - 1) h++-- | Get total length of custom chunks.++totalExtraLength :: Wave -> Word64+totalExtraLength =+ fromIntegral . sum . fmap (B.length . snd) . waveOtherChunks++-- | Estimate total number of samples for a PCM audio stream.++pcmSamplesTotal :: Wave -> Word64+pcmSamplesTotal wave =+ waveDataSize wave `quot` fromIntegral (waveBlockAlign wave)
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ wave.cabal view
@@ -0,0 +1,90 @@+--+-- Cabal configuration for ‘wave’ package.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+-- notice, this list of conditions and the following disclaimer in the+-- documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+-- to endorse or promote products derived from this software without+-- specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++name: wave+version: 0.1.0+cabal-version: >= 1.10+license: BSD3+license-file: LICENSE.md+author: Mark Karpov <markkarpov@openmailbox.org>+maintainer: Mark Karpov <markkarpov@openmailbox.org>+homepage: https://github.com/mrkkrp/wave+bug-reports: https://github.com/mrkkrp/wave/issues+category: Codec, Audio+synopsis: Work with WAVE and RF64 files+build-type: Simple+description: Work with WAVE and RF64 files.+extra-doc-files: CHANGELOG.md+ , README.md+data-files: audio-samples/*.wav++source-repository head+ type: git+ location: https://github.com/mrkkrp/wave.git++flag dev+ description: Turn on development settings.+ manual: True+ default: False++library+ build-depends: base >= 4.7 && < 5.0+ , bytestring >= 0.2 && < 0.11+ , cereal >= 0.3 && < 0.6+ , containers >= 0.5 && < 0.6+ , data-default-class+ , transformers >= 0.4 && < 0.6+ exposed-modules: Codec.Audio.Wave+ if flag(dev)+ ghc-options: -Wall -Werror+ else+ ghc-options: -O2 -Wall+ default-language: Haskell2010++test-suite tests+ main-is: Spec.hs+ other-modules: Codec.Audio.WaveSpec+ hs-source-dirs: tests+ type: exitcode-stdio-1.0+ build-depends: QuickCheck >= 2.8.2 && < 3.0+ , base >= 4.7 && < 5.0+ , bytestring >= 0.2 && < 0.11+ , containers >= 0.5 && < 0.6+ , data-default-class+ , hspec >= 2.0 && < 3.0+ , temporary >= 1.1 && < 1.3+ , wave >= 0.1.0+ if flag(dev)+ ghc-options: -Wall -Werror+ else+ ghc-options: -O2 -Wall+ default-language: Haskell2010