wave-0.1.1: Work with WAVE and RF64 files

Copyright© 2016 Mark Karpov
LicenseBSD 3 clause
MaintainerMark Karpov <markkarpov@openmailbox.org>
Stabilityexperimental
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Codec.Audio.Wave

Contents

Description

This module provides a safe interface that allows to manipulate WAVE files in their “classic” form as well as files in the RF64 format https://tech.ebu.ch/docs/tech/tech3306-2009.pdf. RF64 adds the ability to store files larger than 4 Gb.

The main feature of the API is that it does not allow the user to duplicate information and introduce errors in that way. For example, block align may be calculated from other parameters of audio stream, thus we do not store it in the Wave record and do not allow user to specify it. We provide, however, a way to calculate it given Wave record, see waveBlockAlign. The same is done for channels. Channel mask is a more general means of providing information about number of channels and corresponding speaker positions, thus we only store channel mask in user-friendly form, but number of channels can be derived from that information.

Another feature of the library is that it does not dictate how to read/write audio data. What we give is the information about audio data and offset in file where it begins. To write data user may use a callback that receives a Handle as argument. Size of data block is deduced automatically for you. Exclusion of audio data from consideration makes the library pretty fast and open to different ways to handle audio data itself, including using foreign code (such as C).

The library provides control over all parts of WAVE file that may be of interest. In particular, it even allows to write arbitrary chunks between fmt and data chunks, although it's rarely useful (and may actually confuse buggy applications that don't know how to skip unknown chunks).

Synopsis

Types

data Wave Source #

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.

Constructors

Wave 

Fields

Instances

Eq Wave Source # 

Methods

(==) :: Wave -> Wave -> Bool #

(/=) :: Wave -> Wave -> Bool #

Data Wave Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Wave -> c Wave #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Wave #

toConstr :: Wave -> Constr #

dataTypeOf :: Wave -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Wave) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wave) #

gmapT :: (forall b. Data b => b -> b) -> Wave -> Wave #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Wave -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Wave -> r #

gmapQ :: (forall d. Data d => d -> u) -> Wave -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Wave -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Wave -> m Wave #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Wave -> m Wave #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Wave -> m Wave #

Ord Wave Source # 

Methods

compare :: Wave -> Wave -> Ordering #

(<) :: Wave -> Wave -> Bool #

(<=) :: Wave -> Wave -> Bool #

(>) :: Wave -> Wave -> Bool #

(>=) :: Wave -> Wave -> Bool #

max :: Wave -> Wave -> Wave #

min :: Wave -> Wave -> Wave #

Read Wave Source # 
Show Wave Source # 

Methods

showsPrec :: Int -> Wave -> ShowS #

show :: Wave -> String #

showList :: [Wave] -> ShowS #

Default Wave Source # 

Methods

def :: Wave #

data WaveFormat Source #

WaveFormat as flavor of WAVE file.

Constructors

WaveVanilla

Classic WAVE file, 4 Gb size limitation

WaveRF64

WAVE file with RF64 extension

Instances

Bounded WaveFormat Source # 
Enum WaveFormat Source # 
Eq WaveFormat Source # 
Data WaveFormat Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> WaveFormat -> c WaveFormat #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c WaveFormat #

toConstr :: WaveFormat -> Constr #

dataTypeOf :: WaveFormat -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c WaveFormat) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WaveFormat) #

gmapT :: (forall b. Data b => b -> b) -> WaveFormat -> WaveFormat #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> WaveFormat -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> WaveFormat -> r #

gmapQ :: (forall d. Data d => d -> u) -> WaveFormat -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> WaveFormat -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat #

Ord WaveFormat Source # 
Read WaveFormat Source # 
Show WaveFormat Source # 

data SampleFormat Source #

Sample formats with associated bit depth (when variable).

Constructors

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.

Instances

Eq SampleFormat Source # 
Data SampleFormat Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SampleFormat -> c SampleFormat #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SampleFormat #

toConstr :: SampleFormat -> Constr #

dataTypeOf :: SampleFormat -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SampleFormat) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SampleFormat) #

gmapT :: (forall b. Data b => b -> b) -> SampleFormat -> SampleFormat #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SampleFormat -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SampleFormat -> r #

gmapQ :: (forall d. Data d => d -> u) -> SampleFormat -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SampleFormat -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat #

Ord SampleFormat Source # 
Read SampleFormat Source # 
Show SampleFormat Source # 

data SpeakerPosition Source #

Speaker positions clarifying which exactly channels are packed in the WAVE file.

Constructors

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

Instances

Bounded SpeakerPosition Source # 
Enum SpeakerPosition Source # 
Eq SpeakerPosition Source # 
Data SpeakerPosition Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SpeakerPosition -> c SpeakerPosition #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SpeakerPosition #

toConstr :: SpeakerPosition -> Constr #

dataTypeOf :: SpeakerPosition -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SpeakerPosition) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SpeakerPosition) #

gmapT :: (forall b. Data b => b -> b) -> SpeakerPosition -> SpeakerPosition #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SpeakerPosition -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SpeakerPosition -> r #

gmapQ :: (forall d. Data d => d -> u) -> SpeakerPosition -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SpeakerPosition -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SpeakerPosition -> m SpeakerPosition #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SpeakerPosition -> m SpeakerPosition #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SpeakerPosition -> m SpeakerPosition #

Ord SpeakerPosition Source # 
Read SpeakerPosition Source # 
Show SpeakerPosition Source # 

data WaveException Source #

Exceptions the library can throw.

Constructors

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.

Instances

Eq WaveException Source # 
Data WaveException Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> WaveException -> c WaveException #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c WaveException #

toConstr :: WaveException -> Constr #

dataTypeOf :: WaveException -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c WaveException) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WaveException) #

gmapT :: (forall b. Data b => b -> b) -> WaveException -> WaveException #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> WaveException -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> WaveException -> r #

gmapQ :: (forall d. Data d => d -> u) -> WaveException -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> WaveException -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> WaveException -> m WaveException #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> WaveException -> m WaveException #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> WaveException -> m WaveException #

Read WaveException Source # 
Show WaveException Source # 
Exception WaveException Source # 

Derived information

waveByteRate :: Wave -> Word32 Source #

Byte rate of a given Wave file. Byte rate is the number of bytes it takes to encode one second of audio.

waveBitRate :: Wave -> Double Source #

Bit rate in kilobits per second.

waveBitsPerSample :: Wave -> Word16 Source #

Number of significant bits in every sample.

waveBlockAlign :: Wave -> Word16 Source #

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.

waveChannels :: Wave -> Word16 Source #

Total number of channels present in the audio stream.

waveDuration :: Wave -> Double Source #

Duration in seconds.

Common speaker configurations

speakerMono :: Set SpeakerPosition Source #

Front center (C).

speakerStereo :: Set SpeakerPosition Source #

Front left (L), front right (R).

speakerQuad :: Set SpeakerPosition Source #

L, R, back left (Lb), back right (Rb).

speakerSurround :: Set SpeakerPosition Source #

Surround: L, R, front center (C), back center (Cb).

speaker5_1 :: Set SpeakerPosition Source #

L, R, C, Lb, Rb, low frequency (LFE).

speaker7_1 :: Set SpeakerPosition Source #

L, R, C, Lb, Rb, front left-of-center, front right-of-center, LFE.

speaker5_1Surround :: Set SpeakerPosition Source #

L, R, C, side left (Ls), side right (Rs), LFE.

speaker7_1Surround :: Set SpeakerPosition Source #

L, R, C, Lb, Rb, Ls, Rs, LFE.

Reading

readWaveFile Source #

Arguments

:: MonadIO m 
=> FilePath

Location of file to read

-> m Wave 

Read Wave record from a WAVE file found at given path. This action throws WaveException if the file is malformed and cannot be read.

You can feed vanilla WAVE and RF64 files. The actual format is detected automatically from contents of the file, not by extension.

PCM with samples in form of integers and floats only are supported, see SampleFormat. Addition of other formats will be performed on request, please feel free to contact me at https://github.com/mrkkrp/wave/issues.

Writing

writeWaveFile Source #

Arguments

:: 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 () 

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.