diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## Wave 0.2.1 + +* Maintenance release with more modern and minimal dependencies. + ## Wave 0.2.0 * Got rid of `data-default-class` dependency. `Wave` now is not an instance diff --git a/Codec/Audio/Wave.hs b/Codec/Audio/Wave.hs --- a/Codec/Audio/Wave.hs +++ b/Codec/Audio/Wave.hs @@ -1,73 +1,69 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} + -- | -- Module : Codec.Audio.Wave --- Copyright : © 2016–2019 Mark Karpov +-- Copyright : © 2016–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- --- This module provides a safe interface that allows to manipulate WAVE +-- This module provides a safe interface that allows us 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, and 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 the user may use a --- callback that receives a 'Handle' as an 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). +-- duplicate information and introduce errors in that way. For example, the +-- block alignment can be calculated from other parameters of an 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 a +-- 'Wave' record, see 'waveBlockAlign'. The same is true for the number of +-- channels. The channel mask is a more general means of providing the +-- information about the number of channels and the corresponding speaker +-- positions, thus we only store the channel mask. -- --- 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 DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} - +-- Another feature of the library is that it does not dictate how to read or +-- write the audio data. To write the audio data the user passes a callback +-- that receives a 'Handle' as an argument. The size of the written data +-- block is deduced automatically. This makes the library fast and open to +-- different ways of handling the audio data, including via foreign code. module Codec.Audio.Wave ( -- * Types - Wave (..) - , WaveFormat (..) - , SampleFormat (..) - , SpeakerPosition (..) - , WaveException (..) + Wave (..), + WaveFormat (..), + SampleFormat (..), + SpeakerPosition (..), + WaveException (..), + -- * Derived information - , waveByteRate - , waveBitRate - , waveBitsPerSample - , waveBlockAlign - , waveChannels - , waveDuration + waveByteRate, + waveBitRate, + waveBitsPerSample, + waveBlockAlign, + waveChannels, + waveDuration, + -- * Common speaker configurations - , speakerMono - , speakerStereo - , speakerQuad - , speakerSurround - , speaker5_1 - , speaker7_1 - , speaker5_1Surround - , speaker7_1Surround + speakerMono, + speakerStereo, + speakerQuad, + speakerSurround, + speaker5_1, + speaker7_1, + speaker5_1Surround, + speaker7_1Surround, + -- * Reading - , readWaveFile + readWaveFile, + -- * Writing - , writeWaveFile ) + writeWaveFile, + ) where import Control.Exception @@ -75,206 +71,216 @@ import Control.Monad.IO.Class import Data.Bits import Data.ByteString (ByteString) +import Data.ByteString qualified as B import Data.Data (Data) -import Data.Maybe (mapMaybe, isNothing) -import Data.Monoid ((<>)) +import Data.Maybe (isNothing, mapMaybe) +import Data.Serialize qualified as S import Data.Set (Set) +import Data.Set qualified as E 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 ---------------------------------------------------------------------------- -- 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'. - +-- | Representation of the “essential” information about a WAVE file. Every +-- field in this record is an orthogonal piece of information, so no field +-- can be calculated from other fields. The fields are complemented by the +-- functions that calculate derivative parameters: 'waveByteRate', +-- 'waveBitRate', 'waveBitsPerSample', 'waveBlockAlign', and 'waveChannels'. data Wave = Wave - { waveFileFormat :: !WaveFormat - -- ^ 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 + { -- | The format of the file this 'Wave' record was extracted\/to be + -- written to, 'WaveFormat'. Default value is: 'WaveVanilla'. + waveFileFormat :: !WaveFormat, + -- | Sample rate in Hz, default is: 44100. + waveSampleRate :: !Word32, + -- | 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 + waveSampleFormat :: !SampleFormat, + -- | 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 + waveChannelMask :: !(Set SpeakerPosition), + -- | The offset in bytes where the actual sample data begins. Default + -- value: 0. + waveDataOffset :: !Word32, + -- | Size of the audio data in bytes. Default value: 0. + waveDataSize :: !Word64, + -- | The 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) - --- | Default value of 'Wave'. - -defaultWave :: Wave -defaultWave = Wave - { waveFileFormat = WaveVanilla - , waveSampleRate = 44100 - , waveSampleFormat = SampleFormatPcmInt 16 - , waveChannelMask = defaultSpeakerSet 2 - , waveDataOffset = 0 - , waveDataSize = 0 - , waveSamplesTotal = 0 - , waveOtherChunks = [] + -- it's deduced from the size of the data block, for other formats it's + -- read from\/written to the “fact” chunk. Default value: 0. + waveSamplesTotal :: !Word64, + -- | Other chunks as @(tag, body)@ pairs. Only the 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: @[]@. + waveOtherChunks :: [(ByteString, ByteString)] } + deriving (Show, Read, Eq, Ord, Typeable, Data) --- | 'WaveFormat' as flavor of WAVE file. +-- | The default value of 'Wave'. +defaultWave :: Wave +defaultWave = + Wave + { waveFileFormat = WaveVanilla, + waveSampleRate = 44100, + waveSampleFormat = SampleFormatPcmInt 16, + waveChannelMask = defaultSpeakerSet 2, + waveDataOffset = 0, + waveDataSize = 0, + waveSamplesTotal = 0, + waveOtherChunks = [] + } +-- | 'WaveFormat' as a flavor of WAVE file. data WaveFormat - = WaveVanilla -- ^ Classic WAVE file, 4 Gb size limitation - | WaveRF64 -- ^ WAVE file with RF64 extension + = -- | Classic WAVE file, 4 Gb size limitation + WaveVanilla + | -- | WAVE file with RF64 extension + WaveRF64 deriving (Show, Read, Eq, Ord, Bounded, Enum, Typeable, Data) --- | Sample formats with associated bit depth (when variable). - +-- | Sample formats with associated bit depth. data SampleFormat - = SampleFormatPcmInt Word16 - -- ^ Unsigned\/signed integers, the argument is the number of bits per + = -- | 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. + SampleFormatPcmInt Word16 + | -- | Samples are 32 bit floating point numbers. + SampleFormatIeeeFloat32Bit + | -- | Samples are 64 bit floating point numbers. + SampleFormatIeeeFloat64Bit 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 + = -- | Front left + SpeakerFrontLeft + | -- | Front right + SpeakerFrontRight + | -- | Front center + SpeakerFrontCenter + | -- | Sub-woofer + SpeakerLowFrequency + | -- | Back left + SpeakerBackLeft + | -- | Back right + SpeakerBackRight + | -- | Front left of center + SpeakerFrontLeftOfCenter + | -- | Front right of center + SpeakerFrontRightOfCenter + | -- | Back center + SpeakerBackCenter + | -- | Side left + SpeakerSideLeft + | -- | Side right + SpeakerSideRight + | -- | Top center + SpeakerTopCenter + | -- | Top front left + SpeakerTopFrontLeft + | -- | Top front center + SpeakerTopFrontCenter + | -- | Top front right + SpeakerTopFrontRight + | -- | Top back left + SpeakerTopBackLeft + | -- | Top back center + SpeakerTopBackCenter + | -- | Top back right + SpeakerTopBackRight 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 + = -- | Format of the 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. + BadFileFormat String 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” + NonDataChunkIsTooLong ByteString FilePath + | -- | The specified format is non-PCM, it's vanilla WAVE, but the “fact” -- chunk is missing. + NonPcmFormatButMissingFact FilePath 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 + { -- | Four-byte chunk tag + chunkTag :: !ByteString, + -- | Chunk size + chunkSize :: !Word32, + -- | Chunk body in some form + chunkBody :: !(m ByteString) } -- | 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) + { -- | Size of RIFF chunk (64 bits) + ds64RiffSize :: !Word64, + -- | Size of data chunk (64 bits) + ds64DataSize :: !Word64, + -- | Total number of samples (64 bits) + ds64SamplesTotal :: !Word64 } --- | Default value of 'Ds64'. - +-- | The default value of 'Ds64'. defaultDs64 :: Ds64 -defaultDs64 = Ds64 - { ds64RiffSize = 0 - , ds64DataSize = 0 - , ds64SamplesTotal = 0 - } +defaultDs64 = + 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. - +-- | The byte rate of a given 'Wave' file. The 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. + waveSampleRate wave * fromIntegral (waveBlockAlign wave) +-- | The bit rate in kilobits per second. waveBitRate :: Wave -> Double waveBitRate = (/ 125) . fromIntegral . waveByteRate --- | Number of significant bits in every sample. - +-- | The number of significant bits in a sample. waveBitsPerSample :: Wave -> Word16 waveBitsPerSample Wave {..} = case waveSampleFormat of - SampleFormatPcmInt bps -> bps + 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 +-- | The block alignment of samples as the number of bits per sample +-- (rounded towards the next multiplier of 8 if necessary) multiplied by the +-- 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. - +-- | The total number of channels present in the audio stream. waveChannels :: Wave -> Word16 waveChannels Wave {..} = fromIntegral (E.size waveChannelMask) --- | Duration in seconds. - +-- | The duration in seconds. waveDuration :: Wave -> Double waveDuration wave = fromIntegral (waveSamplesTotal wave) / fromIntegral (waveSampleRate wave) @@ -283,97 +289,99 @@ -- 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] +speakerStereo = E.fromList [SpeakerFrontLeft, SpeakerFrontRight] -- | L, R, back left (Lb), back right (Rb). - speakerQuad :: Set SpeakerPosition -speakerQuad = E.fromList - [ SpeakerFrontLeft - , SpeakerFrontRight - , SpeakerBackLeft - , SpeakerBackRight ] +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 ] +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 ] +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 ] +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 ] +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 ] +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 +-- | Read a '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 +-- Vanilla WAVE and RF64 files are supported. The format is detected -- automatically from the 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 --- . +-- Only PCM with samples in the form of integers or floats are supported, +-- see 'SampleFormat'. -- --- Finally, if “fmt” chunk is not extensible, we try to guess channel mask --- from number of channels alone, here is how: +-- Finally, if “fmt” chunk is not extensible, we try to guess the channel +-- mask from the number of channels alone, here is how: -- -- * 1 channel: front center (C) -- * 2 channels: front left (L), front right (R) @@ -384,43 +392,56 @@ -- * 7 channels: L, R, C, LFE, back center (Cb), side left (Ls), side right (Rs) -- * 8 channels: L, R, C, LFE, Lb, Rb, Ls, Rs -- * N channels: first N items are taken from @[minBound..maxBound]@ of 'SpeakerPosition's - -readWaveFile :: MonadIO m - => FilePath -- ^ Location of file to read - -> m Wave +readWaveFile :: + (MonadIO m) => + -- | Location of file to read + FilePath -> + m Wave readWaveFile path = liftIO . withBinaryFile 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 + 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") + "RF64" -> readWaveRF64 h giveup liftGet + _ -> giveup (BadFileFormat "Can't locate RIFF/RF64 tag") -- | Parse a classic WAVE file. - -readWaveVanilla - :: Handle -- ^ 'Handle' to read from - -> GiveUp -- ^ How to give up - -> LiftGet -- ^ How to lift parsers - -> IO Wave -- ^ The result +readWaveVanilla :: + -- | 'Handle' to read from + Handle -> + -- | How to give up + GiveUp -> + -- | How to lift parsers + LiftGet -> + -- | The result + IO Wave readWaveVanilla h giveup liftGet = do grabWaveTag h giveup - grabWaveChunks h giveup liftGet Nothing Nothing - defaultWave { waveFileFormat = WaveVanilla - } + grabWaveChunks + h + giveup + liftGet + Nothing + Nothing + defaultWave + { waveFileFormat = WaveVanilla + } -- | Parse an RF64 file. - -readWaveRF64 - :: Handle -- ^ 'Handle' to read from - -> GiveUp -- ^ How to give up - -> LiftGet -- ^ How to lift parsers - -> IO Wave -- ^ The result +readWaveRF64 :: + -- | 'Handle' to read from + Handle -> + -- | How to give up + GiveUp -> + -- | How to lift parsers + LiftGet -> + -- | The result + IO Wave readWaveRF64 h giveup liftGet = do grabWaveTag h giveup mds64 <- liftGet (readChunk h 0xffff) @@ -429,14 +450,19 @@ Ds64 {..} <- case chunkBody mds64 of Nothing -> giveup (NonDataChunkIsTooLong "ds64") Just body -> liftGet (return $ readDs64 body) - grabWaveChunks h giveup liftGet (Just ds64DataSize) (Just ds64SamplesTotal) - defaultWave { waveFileFormat = WaveRF64 - , waveSamplesTotal = 0xffffffff - } - --- | Read four bytes from given 'Handle' and throw an exception if they are --- not “WAVE”. + grabWaveChunks + h + giveup + liftGet + (Just ds64DataSize) + (Just ds64SamplesTotal) + defaultWave + { waveFileFormat = WaveRF64, + waveSamplesTotal = 0xffffffff + } +-- | Read four bytes from the given 'Handle' and throw an exception if they +-- are not “WAVE”. grabWaveTag :: Handle -> GiveUp -> IO () grabWaveTag h giveup = do waveId <- B.hGet h 4 @@ -444,15 +470,21 @@ 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 :: + -- | 'Handle' to read from + Handle -> + -- | How to give up + GiveUp -> + -- | How to lift parsers + LiftGet -> + -- | Size of data chunk to use if 0xffffffff is read + Maybe Word64 -> + -- | Number of samples to use if 0xffffffff is read + Maybe Word64 -> + -- | Apply modifications to this 'Wave' + Wave -> + -- | The result + IO Wave grabWaveChunks h giveup liftGet mdataSize msamplesTotal = go False where go seenFact wave = do @@ -467,112 +499,127 @@ 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 + 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) } + 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 } + go True wave {waveSamplesTotal = fromIntegral samplesTotal} (tag, Just body) -> - go seenFact - wave { waveOtherChunks = (tag, body) : waveOtherChunks wave } + go + seenFact + wave {waveOtherChunks = (tag, body) : waveOtherChunks wave} -- | Read a “ds64” chunk which contains RIFF chunk\/data chunk lengths as 64 -- bit values and the total number of samples. - readDs64 :: ByteString -> Either String Ds64 readDs64 bytes = flip S.runGet bytes $ do - ds64RiffSize <- S.getWord64le - ds64DataSize <- S.getWord64le + ds64RiffSize <- S.getWord64le + ds64DataSize <- S.getWord64le ds64SamplesTotal <- S.getWord64le return Ds64 {..} -- | Parse the 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" + unless + ( format == waveFormatPcm + || format == waveFormatIeeeFloat + || format == waveFormatExtensible + ) + $ fail "Unsupported audio format specified in fmt chunk" let extensible = format == waveFormatExtensible - channels <- S.getWord16le + 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 + bps <- S.getWord16le hasExtSize <- not <$> S.isEmpty - extSize <- if hasExtSize - then S.getWord16le - else return 0 + 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) + 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 } + 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' +-- | Read a RIFF 'Chunk' (32 bit tag + 32 bit size). +readChunk :: + -- | Opened 'Handle' to read the chunk from + Handle -> + -- | Maximum size of chunk we want to grab into memory + Word32 -> + -- | Error message or a 'Chunk' + IO (Either String (Chunk Maybe)) readChunk h maxSize = do bytes <- B.hGet h 8 let echunk = flip S.runGet bytes $ do - chunkTag <- S.getBytes 4 + 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 } + body <- + if chunkSize <= maxSize + then Just <$> B.hGet h (fromIntegral chunkSize) + else return Nothing + (return . Right) chunk {chunkBody = body} ---------------------------------------------------------------------------- -- Writing @@ -582,34 +629,38 @@ -- 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 the data size. +-- the requirement that WAVE data should end on an “even byte boundary”. The +-- pad byte is written if necessary and included in the 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. +-- The 'waveSamplesTotal' field will be inferred, so the provided value is +-- not used. -- --- If 'Wave' specifies floating point sample format, the “fact” chunk is +-- If 'Wave' specifies the 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 :: + (MonadIO m) => + -- | Where to save the file + FilePath -> + -- | Parameters of the WAVE file + Wave -> + -- | Callback that will be used to write WAVE data + (Handle -> IO ()) -> + m () writeWaveFile path wave writeData = liftIO . withBinaryFile path WriteMode $ \h -> case waveFileFormat wave of WaveVanilla -> writeWaveVanilla h wave writeData - WaveRF64 -> writeWaveRF64 h wave writeData + WaveRF64 -> writeWaveRF64 h wave writeData -- | Write a vanilla WAVE file. - -writeWaveVanilla - :: Handle -- ^ 'Handle' to write to - -> Wave -- ^ Parameters of the WAVE file - -> (Handle -> IO ()) -- ^ Callback that writes WAVE data - -> IO () +writeWaveVanilla :: + -- | 'Handle' to write to + Handle -> + -- | Parameters of the WAVE file + Wave -> + -- | Callback that writes WAVE data + (Handle -> IO ()) -> + IO () writeWaveVanilla h wave writeData = do let nonPcm = isNonPcm (waveSampleFormat wave) -- Write the outer RIFF chunk. @@ -633,11 +684,12 @@ when (odd rightAfterData) $ B.hPut h "\0" -- Go back and overwrite dummy values. - afterData <- hTell h + afterData <- hTell h let riffSize = fromIntegral (afterData - beforeOuter - 8) dataSize = fromIntegral (afterData - beforeData - 8) - samplesTotal = fromIntegral $ - pcmSamplesTotal wave { waveDataSize = fromIntegral dataSize } + samplesTotal = + fromIntegral $ + pcmSamplesTotal wave {waveDataSize = fromIntegral dataSize} when nonPcm $ do hSeek h AbsoluteSeek beforeFact writeBsChunk h "fact" (renderFactChunk samplesTotal) @@ -647,7 +699,6 @@ writeChunk h (Chunk "RIFF" riffSize writeNoData) -- | Write an RF64 file. - writeWaveRF64 :: Handle -> Wave -> (Handle -> IO ()) -> IO () writeWaveRF64 h wave writeData = do -- Write the outer RF64 chunk. @@ -670,46 +721,45 @@ 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 {..} + 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 :: + -- | 'Handle' where to write + Handle -> + -- | Chunk tag + ByteString -> + -- | Chunk body + ByteString -> + IO () writeBsChunk h chunkTag body = let chunkSize = fromIntegral (B.length body) chunkBody = Right body - in writeChunk h Chunk {..} + 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'. - +-- | Render the 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 + SampleFormatPcmInt _ -> waveFormatPcm SampleFormatIeeeFloat32Bit -> waveFormatIeeeFloat SampleFormatIeeeFloat64Bit -> waveFormatIeeeFloat bps = waveBitsPerSample wave @@ -724,22 +774,23 @@ S.putWord16le bps S.putWord32le (toSpeakerMask waveChannelMask) S.putByteString $ case waveSampleFormat of - SampleFormatPcmInt _ -> ksdataformatSubtypePcm + SampleFormatPcmInt _ -> ksdataformatSubtypePcm SampleFormatIeeeFloat32Bit -> ksdataformatSubtypeIeeeFloat SampleFormatIeeeFloat64Bit -> ksdataformatSubtypeIeeeFloat --- | Render fact chunk as a strict 'ByteString'. - +-- | Render the 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 () +-- ensure that the specified size matches the size of the body that is +-- actually written. +writeChunk :: + -- | Opened 'Handle' where to write the 'Chunk' + Handle -> + -- | The 'Chunk' to write + Chunk (Either (Handle -> IO ())) -> + IO () writeChunk h Chunk {..} = do let bytes = S.runPut $ do S.putByteString (B.take 4 $ chunkTag <> B.replicate 4 0x00) @@ -747,118 +798,109 @@ B.hPut h bytes case chunkBody of Left action -> action h - Right body -> B.hPut h body + 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 +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 +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 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 +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] +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. + f sp = + if speakerToFlag sp .&. channelMask > 0 + then Just sp + else Nothing +-- | Get the default speaker set for a given number of channels. defaultSpeakerSet :: Word16 -> Set SpeakerPosition defaultSpeakerSet n = case n of 0 -> E.empty 1 -> speakerMono 2 -> speakerStereo - 3 -> E.fromList [SpeakerFrontLeft,SpeakerFrontRight,SpeakerFrontCenter] + 3 -> E.fromList [SpeakerFrontLeft, SpeakerFrontRight, SpeakerFrontCenter] 4 -> speakerQuad 5 -> E.insert SpeakerFrontCenter speakerQuad 6 -> speaker5_1 7 -> E.insert SpeakerBackCenter speaker5_1Surround 8 -> speaker7_1Surround - x -> E.fromList $ take (fromIntegral x) [minBound..maxBound] - --- | Does this 'Wave' record requires extensible format chunk to be used? + x -> E.fromList $ take (fromIntegral x) [minBound .. maxBound] +-- | Does this 'Wave' record require an 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. + waveChannels wave > 2 + || waveChannelMask /= defaultSpeakerSet (waveChannels wave) + || (waveBitsPerSample wave `rem` 8) /= 0 +-- | Determine if the 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. +isNonPcm (SampleFormatPcmInt _) = False +isNonPcm SampleFormatIeeeFloat32Bit = True +isNonPcm SampleFormatIeeeFloat64Bit = True +-- | Round bits per sample to the 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. + (x, r) = n `quotRem` 8 +-- | Estimate the 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 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2016–2018 Mark Karpov +Copyright © 2016–present Mark Karpov All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,68 +4,54 @@ [![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) +![CI](https://github.com/mrkkrp/wave/workflows/CI/badge.svg?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. +This library provides a safe interface that allows us 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, and 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 the user may use a callback that -receives a `Handle` as an 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). +information and introduce errors in that way. For example, the block +alignment can be calculated from other parameters of an audio stream, thus +we do not store it in the `Wave` record and do not allow the user to specify +it. We provide, however, a way to calculate it given a `Wave` record, see +`waveBlockAlign`. The same is true for the number of channels. The channel +mask is a more general means of providing the information about the number +of channels and the corresponding speaker positions, thus we only store the +channel mask. -Please [read the Haddocks](https://hackage.haskell.org/package/wave) for a -more detailed documentation, the usage should be trivial. +Another feature of the library is that it does not dictate how to read or +write the audio data. To write the audio data the user passes a callback +that receives a `Handle` as an argument. The size of the written data block +is deduced automatically. This makes the library fast and open to different +ways of handling the audio data, including via foreign code. ## Motivation -I needed a way to work with WAVE files to finish -my [`flac`](https://github.com/mrkkrp/flac) package and for analyzing input +I needed a way to work with WAVE files to finish the +[`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. +poorly designed. Suffice it to say that they read samples of audio stream +and put them in a *linked list*, like `[[Sample]]` (the inner linked list is +to store multi-channel data). ## 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. +and floating point values. ## 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. +Pull requests are also welcome. ## License -Copyright © 2016–2019 Mark Karpov +Copyright © 2016–present Mark Karpov Distributed under BSD 3 clause license. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main (main) where - -import Distribution.Simple - -main :: IO () -main = defaultMain diff --git a/tests/Codec/Audio/WaveSpec.hs b/tests/Codec/Audio/WaveSpec.hs --- a/tests/Codec/Audio/WaveSpec.hs +++ b/tests/Codec/Audio/WaveSpec.hs @@ -1,399 +1,397 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Codec.Audio.WaveSpec - ( spec ) -where +module Codec.Audio.WaveSpec (spec) where import Codec.Audio.Wave +import Data.ByteString qualified as B +import Data.Set qualified as E 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 -- 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 look OK. +-- we generate random WAVE files and write them, 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 look OK. -- -- Should any problems be discovered in the future, it's simple to extend --- the first part of the test suite to check for those cases. +-- the first part of the test suite. 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + let dataSize = waveDataSize wave dataSize' = if odd (dataSize + totalExtraLength wave) then dataSize + 1 else dataSize - samplesTotal = pcmSamplesTotal wave { waveDataSize = 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 } + wave' + `shouldBe` wave + { waveDataOffset = waveDataOffset wave', + waveDataSize = dataSize', + waveSamplesTotal = samplesTotal, + waveOtherChunks = waveOtherChunks wave + } describe "pre-defined speaker configurations" $ do - let def = Wave - { waveFileFormat = WaveVanilla - , waveSampleRate = 44100 - , waveSampleFormat = SampleFormatPcmInt 16 - , waveChannelMask = E.empty - , waveDataOffset = 0 - , waveDataSize = 0 - , waveSamplesTotal = 0 - , waveOtherChunks = [] - } + let def = + Wave + { waveFileFormat = WaveVanilla, + waveSampleRate = 44100, + waveSampleFormat = SampleFormatPcmInt 16, + waveChannelMask = E.empty, + waveDataOffset = 0, + waveDataSize = 0, + waveSamplesTotal = 0, + waveOtherChunks = [] + } describe "speakerMono" $ it "has 1 channel" $ - waveChannels def { waveChannelMask = speakerMono } `shouldBe` 1 + waveChannels def {waveChannelMask = speakerMono} `shouldBe` 1 describe "speakerStereo" $ it "has 2 channels" $ - waveChannels def { waveChannelMask = speakerStereo } `shouldBe` 2 + waveChannels def {waveChannelMask = speakerStereo} `shouldBe` 2 describe "speakerQuad" $ it "has 4 channels" $ - waveChannels def { waveChannelMask = speakerQuad } `shouldBe` 4 + waveChannels def {waveChannelMask = speakerQuad} `shouldBe` 4 describe "speakerSurround" $ it "has 4 channels" $ - waveChannels def { waveChannelMask = speakerSurround } `shouldBe` 4 + waveChannels def {waveChannelMask = speakerSurround} `shouldBe` 4 describe "speaker5_1" $ it "has 6 channels" $ - waveChannels def { waveChannelMask = speaker5_1 } `shouldBe` 6 + waveChannels def {waveChannelMask = speaker5_1} `shouldBe` 6 describe "speaker7_1" $ it "has 8 channels" $ - waveChannels def { waveChannelMask = speaker7_1 } `shouldBe` 8 + waveChannels def {waveChannelMask = speaker7_1} `shouldBe` 8 describe "speaker5_1Surround" $ it "has 6 channels" $ - waveChannels def { waveChannelMask = speaker5_1Surround } `shouldBe` 6 + waveChannels def {waveChannelMask = speaker5_1Surround} `shouldBe` 6 describe "speaker7_1" $ it "has 8 channels" $ - waveChannels def { waveChannelMask = speaker7_1Surround } `shouldBe` 8 + waveChannels def {waveChannelMask = speaker7_1Surround} `shouldBe` 8 ---------------------------------------------------------------------------- -- Instances instance Arbitrary Wave where arbitrary = do - waveFileFormat <- elements [minBound..maxBound] + waveFileFormat <- elements [minBound .. maxBound] waveSampleRate <- choose (0, 196000) - waveSampleFormat <- oneof - [ SampleFormatPcmInt <$> choose (1, 64) - , pure SampleFormatIeeeFloat32Bit - , pure SampleFormatIeeeFloat64Bit ] + waveSampleFormat <- + oneof + [ SampleFormatPcmInt <$> choose (1, 64), + 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 + tag <- B.pack <$> vectorOf 4 arbitrary body <- B.pack <$> arbitrary return (tag, body) return Wave {..} instance Arbitrary SpeakerPosition where - arbitrary = elements [minBound..maxBound] + arbitrary = elements [minBound .. maxBound] ---------------------------------------------------------------------------- -- Helpers --- | Make a temporary copy of @audio-samples/sample.flac@ file and provide +-- | Make a temporary copy of @audio-samples/sample.wav@ 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 the specified number of NULL bytes to given 'Handle'. - writeBytes :: Word64 -> Handle -> IO () -writeBytes 0 _ = return () +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 the total number of samples for a PCM audio stream. - pcmSamplesTotal :: Wave -> Word64 pcmSamplesTotal wave = waveDataSize wave `quot` fromIntegral (waveBlockAlign wave) diff --git a/wave.cabal b/wave.cabal --- a/wave.cabal +++ b/wave.cabal @@ -1,65 +1,71 @@ -name: wave -version: 0.2.0 -cabal-version: 1.18 -tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3 -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 - , audio-samples/*.rf64 +cabal-version: 2.4 +name: wave +version: 0.2.1 +license: BSD-3-Clause +license-file: LICENSE.md +maintainer: Mark Karpov +author: Mark Karpov +tested-with: ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1 +homepage: https://github.com/mrkkrp/wave +bug-reports: https://github.com/mrkkrp/wave/issues +synopsis: Work with WAVE and RF64 files +description: Work with WAVE and RF64 files. +category: Codec, Audio +build-type: Simple +data-files: + audio-samples/*.wav + audio-samples/*.rf64 +extra-doc-files: + CHANGELOG.md + README.md + source-repository head - type: git - location: https://github.com/mrkkrp/wave.git + type: git + location: https://github.com/mrkkrp/wave.git flag dev - description: Turn on development settings. - manual: True - default: False + description: Turn on development settings. + default: False + manual: True library - build-depends: base >= 4.7 && < 5.0 - , bytestring >= 0.2 && < 0.11 - , cereal >= 0.3 && < 0.6 - , containers >= 0.5 && < 0.7 - , transformers >= 0.4 && < 0.6 - exposed-modules: Codec.Audio.Wave - if flag(dev) - ghc-options: -Wall -Werror - else - ghc-options: -O2 -Wall - if flag(dev) && impl(ghc >= 8.0) - ghc-options: -Wcompat - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wnoncanonical-monad-instances - -Wnoncanonical-monadfail-instances - default-language: Haskell2010 + exposed-modules: Codec.Audio.Wave + default-language: GHC2021 + build-depends: + base >=4.15 && <5, + bytestring >=0.2 && <0.13, + cereal >=0.3 && <0.6, + containers >=0.5 && <0.7 + if flag(dev) + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages + + else + ghc-options: -O2 -Wall + 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.7 - , hspec >= 2.0 && < 3.0 - , temporary >= 1.1 && < 1.4 - , wave - build-tools: hspec-discover >= 2.0 && < 3.0 - if flag(dev) - ghc-options: -Wall -Werror - else - ghc-options: -O2 -Wall - default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-tool-depends: hspec-discover:hspec-discover >=2 && <3 + hs-source-dirs: tests + other-modules: Codec.Audio.WaveSpec + default-language: GHC2021 + build-depends: + QuickCheck >=2.8.2 && <3, + base >=4.15 && <5, + bytestring >=0.2 && <0.12, + containers >=0.5 && <0.7, + hspec >=2 && <3, + temporary >=1.1 && <1.4, + wave + + if flag(dev) + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages + + else + ghc-options: -O2 -Wall