diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## Wave 0.1.0 + +* Initial release. diff --git a/Codec/Audio/Wave.hs b/Codec/Audio/Wave.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/Wave.hs @@ -0,0 +1,846 @@ +-- | +-- Module : Codec.Audio.Wave +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- 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 +-- . 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 +-- . + +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 +-- . + +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) diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,74 @@ +# Wave + +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) +[![Hackage](https://img.shields.io/hackage/v/wave.svg?style=flat)](https://hackage.haskell.org/package/wave) +[![Stackage Nightly](http://stackage.org/package/wave/badge/nightly)](http://stackage.org/nightly/package/wave) +[![Stackage LTS](http://stackage.org/package/wave/badge/lts)](http://stackage.org/lts/package/wave) +[![Build Status](https://travis-ci.org/mrkkrp/wave.svg?branch=master)](https://travis-ci.org/mrkkrp/wave) +[![Coverage Status](https://coveralls.io/repos/mrkkrp/wave/badge.svg?branch=master&service=github)](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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/audio-samples/1ch-16000hz-64bit-float-x.wav b/audio-samples/1ch-16000hz-64bit-float-x.wav new file mode 100644 Binary files /dev/null and b/audio-samples/1ch-16000hz-64bit-float-x.wav differ diff --git a/audio-samples/1ch-16000hz-64bit-float.wav b/audio-samples/1ch-16000hz-64bit-float.wav new file mode 100644 Binary files /dev/null and b/audio-samples/1ch-16000hz-64bit-float.wav differ diff --git a/audio-samples/1ch-44100hz-16bit-x.wav b/audio-samples/1ch-44100hz-16bit-x.wav new file mode 100644 Binary files /dev/null and b/audio-samples/1ch-44100hz-16bit-x.wav differ diff --git a/audio-samples/1ch-44100hz-16bit.wav b/audio-samples/1ch-44100hz-16bit.wav new file mode 100644 Binary files /dev/null and b/audio-samples/1ch-44100hz-16bit.wav differ diff --git a/audio-samples/1ch-48000hz-32bit-float-x.wav b/audio-samples/1ch-48000hz-32bit-float-x.wav new file mode 100644 Binary files /dev/null and b/audio-samples/1ch-48000hz-32bit-float-x.wav differ diff --git a/audio-samples/1ch-48000hz-32bit-float.wav b/audio-samples/1ch-48000hz-32bit-float.wav new file mode 100644 Binary files /dev/null and b/audio-samples/1ch-48000hz-32bit-float.wav differ diff --git a/audio-samples/2ch-11025hz-24bit-x.wav b/audio-samples/2ch-11025hz-24bit-x.wav new file mode 100644 Binary files /dev/null and b/audio-samples/2ch-11025hz-24bit-x.wav differ diff --git a/audio-samples/2ch-11025hz-24bit.wav b/audio-samples/2ch-11025hz-24bit.wav new file mode 100644 Binary files /dev/null and b/audio-samples/2ch-11025hz-24bit.wav differ diff --git a/audio-samples/2ch-8000hz-8bit-x.wav b/audio-samples/2ch-8000hz-8bit-x.wav new file mode 100644 Binary files /dev/null and b/audio-samples/2ch-8000hz-8bit-x.wav differ diff --git a/audio-samples/2ch-8000hz-8bit.wav b/audio-samples/2ch-8000hz-8bit.wav new file mode 100644 Binary files /dev/null and b/audio-samples/2ch-8000hz-8bit.wav differ diff --git a/tests/Codec/Audio/WaveSpec.hs b/tests/Codec/Audio/WaveSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Codec/Audio/WaveSpec.hs @@ -0,0 +1,427 @@ +-- +-- Test suite for the ‘wave’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- 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) diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/wave.cabal b/wave.cabal new file mode 100644 --- /dev/null +++ b/wave.cabal @@ -0,0 +1,90 @@ +-- +-- Cabal configuration for ‘wave’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- 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 +maintainer: Mark Karpov +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