{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      :  Codec.Audio.Wave
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- 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
-- <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, 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.
--
-- 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 (..),

    -- * 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.ByteString qualified as B
import Data.Data (Data)
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

----------------------------------------------------------------------------
-- Types

-- | 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
  { -- | The format of the file this 'Wave' record was extracted\/to be
    -- written to, 'WaveFormat'. Default value is: 'WaveVanilla'.
    Wave -> WaveFormat
waveFileFormat :: !WaveFormat,
    -- | Sample rate in Hz, default is: 44100.
    Wave -> Word32
waveSampleRate :: !Word32,
    -- | Sample format. The library supports signed\/unsigned integers and
    -- floats. Default value: @'SampleFormatPcmInt' 16@.
    Wave -> SampleFormat
waveSampleFormat :: !SampleFormat,
    -- | The channel mask as a 'Set' of 'SpeakerPosition's. Default value is
    -- 'speakerStereo'.
    Wave -> Set SpeakerPosition
waveChannelMask :: !(Set SpeakerPosition),
    -- | The offset in bytes where the actual sample data begins. Default
    -- value: 0.
    Wave -> Word32
waveDataOffset :: !Word32,
    -- | Size of the audio data in bytes. Default value: 0.
    Wave -> Word64
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 the size of the data block, for other formats it's
    -- read from\/written to the “fact” chunk. Default value: 0.
    Wave -> Word64
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: @[]@.
    Wave -> [(ByteString, ByteString)]
waveOtherChunks :: [(ByteString, ByteString)]
  }
  deriving (Int -> Wave -> ShowS
[Wave] -> ShowS
Wave -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Wave] -> ShowS
$cshowList :: [Wave] -> ShowS
show :: Wave -> [Char]
$cshow :: Wave -> [Char]
showsPrec :: Int -> Wave -> ShowS
$cshowsPrec :: Int -> Wave -> ShowS
Show, ReadPrec [Wave]
ReadPrec Wave
Int -> ReadS Wave
ReadS [Wave]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Wave]
$creadListPrec :: ReadPrec [Wave]
readPrec :: ReadPrec Wave
$creadPrec :: ReadPrec Wave
readList :: ReadS [Wave]
$creadList :: ReadS [Wave]
readsPrec :: Int -> ReadS Wave
$creadsPrec :: Int -> ReadS Wave
Read, Wave -> Wave -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wave -> Wave -> Bool
$c/= :: Wave -> Wave -> Bool
== :: Wave -> Wave -> Bool
$c== :: Wave -> Wave -> Bool
Eq, Eq Wave
Wave -> Wave -> Bool
Wave -> Wave -> Ordering
Wave -> Wave -> Wave
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Wave -> Wave -> Wave
$cmin :: Wave -> Wave -> Wave
max :: Wave -> Wave -> Wave
$cmax :: Wave -> Wave -> Wave
>= :: Wave -> Wave -> Bool
$c>= :: Wave -> Wave -> Bool
> :: Wave -> Wave -> Bool
$c> :: Wave -> Wave -> Bool
<= :: Wave -> Wave -> Bool
$c<= :: Wave -> Wave -> Bool
< :: Wave -> Wave -> Bool
$c< :: Wave -> Wave -> Bool
compare :: Wave -> Wave -> Ordering
$ccompare :: Wave -> Wave -> Ordering
Ord, Typeable, Typeable Wave
Wave -> DataType
Wave -> Constr
(forall b. Data b => b -> b) -> Wave -> Wave
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Wave -> u
forall u. (forall d. Data d => d -> u) -> Wave -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Wave -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Wave -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wave -> m Wave
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wave -> m Wave
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wave
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wave -> c Wave
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Wave)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wave)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wave -> m Wave
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wave -> m Wave
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wave -> m Wave
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wave -> m Wave
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wave -> m Wave
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wave -> m Wave
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Wave -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Wave -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Wave -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Wave -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Wave -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Wave -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Wave -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Wave -> r
gmapT :: (forall b. Data b => b -> b) -> Wave -> Wave
$cgmapT :: (forall b. Data b => b -> b) -> Wave -> Wave
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wave)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wave)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Wave)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Wave)
dataTypeOf :: Wave -> DataType
$cdataTypeOf :: Wave -> DataType
toConstr :: Wave -> Constr
$ctoConstr :: Wave -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wave
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wave
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wave -> c Wave
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wave -> c Wave
Data)

-- | The default value of 'Wave'.
defaultWave :: Wave
defaultWave :: Wave
defaultWave =
  Wave
    { waveFileFormat :: WaveFormat
waveFileFormat = WaveFormat
WaveVanilla,
      waveSampleRate :: Word32
waveSampleRate = Word32
44100,
      waveSampleFormat :: SampleFormat
waveSampleFormat = Word16 -> SampleFormat
SampleFormatPcmInt Word16
16,
      waveChannelMask :: Set SpeakerPosition
waveChannelMask = Word16 -> Set SpeakerPosition
defaultSpeakerSet Word16
2,
      waveDataOffset :: Word32
waveDataOffset = Word32
0,
      waveDataSize :: Word64
waveDataSize = Word64
0,
      waveSamplesTotal :: Word64
waveSamplesTotal = Word64
0,
      waveOtherChunks :: [(ByteString, ByteString)]
waveOtherChunks = []
    }

-- | 'WaveFormat' as a flavor of WAVE file.
data WaveFormat
  = -- | Classic WAVE file, 4 Gb size limitation
    WaveVanilla
  | -- | WAVE file with RF64 extension
    WaveRF64
  deriving (Int -> WaveFormat -> ShowS
[WaveFormat] -> ShowS
WaveFormat -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WaveFormat] -> ShowS
$cshowList :: [WaveFormat] -> ShowS
show :: WaveFormat -> [Char]
$cshow :: WaveFormat -> [Char]
showsPrec :: Int -> WaveFormat -> ShowS
$cshowsPrec :: Int -> WaveFormat -> ShowS
Show, ReadPrec [WaveFormat]
ReadPrec WaveFormat
Int -> ReadS WaveFormat
ReadS [WaveFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WaveFormat]
$creadListPrec :: ReadPrec [WaveFormat]
readPrec :: ReadPrec WaveFormat
$creadPrec :: ReadPrec WaveFormat
readList :: ReadS [WaveFormat]
$creadList :: ReadS [WaveFormat]
readsPrec :: Int -> ReadS WaveFormat
$creadsPrec :: Int -> ReadS WaveFormat
Read, WaveFormat -> WaveFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WaveFormat -> WaveFormat -> Bool
$c/= :: WaveFormat -> WaveFormat -> Bool
== :: WaveFormat -> WaveFormat -> Bool
$c== :: WaveFormat -> WaveFormat -> Bool
Eq, Eq WaveFormat
WaveFormat -> WaveFormat -> Bool
WaveFormat -> WaveFormat -> Ordering
WaveFormat -> WaveFormat -> WaveFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WaveFormat -> WaveFormat -> WaveFormat
$cmin :: WaveFormat -> WaveFormat -> WaveFormat
max :: WaveFormat -> WaveFormat -> WaveFormat
$cmax :: WaveFormat -> WaveFormat -> WaveFormat
>= :: WaveFormat -> WaveFormat -> Bool
$c>= :: WaveFormat -> WaveFormat -> Bool
> :: WaveFormat -> WaveFormat -> Bool
$c> :: WaveFormat -> WaveFormat -> Bool
<= :: WaveFormat -> WaveFormat -> Bool
$c<= :: WaveFormat -> WaveFormat -> Bool
< :: WaveFormat -> WaveFormat -> Bool
$c< :: WaveFormat -> WaveFormat -> Bool
compare :: WaveFormat -> WaveFormat -> Ordering
$ccompare :: WaveFormat -> WaveFormat -> Ordering
Ord, WaveFormat
forall a. a -> a -> Bounded a
maxBound :: WaveFormat
$cmaxBound :: WaveFormat
minBound :: WaveFormat
$cminBound :: WaveFormat
Bounded, Int -> WaveFormat
WaveFormat -> Int
WaveFormat -> [WaveFormat]
WaveFormat -> WaveFormat
WaveFormat -> WaveFormat -> [WaveFormat]
WaveFormat -> WaveFormat -> WaveFormat -> [WaveFormat]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WaveFormat -> WaveFormat -> WaveFormat -> [WaveFormat]
$cenumFromThenTo :: WaveFormat -> WaveFormat -> WaveFormat -> [WaveFormat]
enumFromTo :: WaveFormat -> WaveFormat -> [WaveFormat]
$cenumFromTo :: WaveFormat -> WaveFormat -> [WaveFormat]
enumFromThen :: WaveFormat -> WaveFormat -> [WaveFormat]
$cenumFromThen :: WaveFormat -> WaveFormat -> [WaveFormat]
enumFrom :: WaveFormat -> [WaveFormat]
$cenumFrom :: WaveFormat -> [WaveFormat]
fromEnum :: WaveFormat -> Int
$cfromEnum :: WaveFormat -> Int
toEnum :: Int -> WaveFormat
$ctoEnum :: Int -> WaveFormat
pred :: WaveFormat -> WaveFormat
$cpred :: WaveFormat -> WaveFormat
succ :: WaveFormat -> WaveFormat
$csucc :: WaveFormat -> WaveFormat
Enum, Typeable, Typeable WaveFormat
WaveFormat -> DataType
WaveFormat -> Constr
(forall b. Data b => b -> b) -> WaveFormat -> WaveFormat
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WaveFormat -> u
forall u. (forall d. Data d => d -> u) -> WaveFormat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WaveFormat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WaveFormat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WaveFormat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WaveFormat -> c WaveFormat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WaveFormat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WaveFormat)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WaveFormat -> m WaveFormat
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WaveFormat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WaveFormat -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> WaveFormat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WaveFormat -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WaveFormat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WaveFormat -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WaveFormat -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WaveFormat -> r
gmapT :: (forall b. Data b => b -> b) -> WaveFormat -> WaveFormat
$cgmapT :: (forall b. Data b => b -> b) -> WaveFormat -> WaveFormat
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WaveFormat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WaveFormat)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WaveFormat)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WaveFormat)
dataTypeOf :: WaveFormat -> DataType
$cdataTypeOf :: WaveFormat -> DataType
toConstr :: WaveFormat -> Constr
$ctoConstr :: WaveFormat -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WaveFormat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WaveFormat
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WaveFormat -> c WaveFormat
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WaveFormat -> c WaveFormat
Data)

-- | Sample formats with associated bit depth.
data SampleFormat
  = -- | Unsigned\/signed integers, the argument is the number of bits per
    -- sample (8 bit and less are encoded as unsigned integers).
    SampleFormatPcmInt Word16
  | -- | Samples are 32 bit floating point numbers.
    SampleFormatIeeeFloat32Bit
  | -- | Samples are 64 bit floating point numbers.
    SampleFormatIeeeFloat64Bit
  deriving (Int -> SampleFormat -> ShowS
[SampleFormat] -> ShowS
SampleFormat -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SampleFormat] -> ShowS
$cshowList :: [SampleFormat] -> ShowS
show :: SampleFormat -> [Char]
$cshow :: SampleFormat -> [Char]
showsPrec :: Int -> SampleFormat -> ShowS
$cshowsPrec :: Int -> SampleFormat -> ShowS
Show, ReadPrec [SampleFormat]
ReadPrec SampleFormat
Int -> ReadS SampleFormat
ReadS [SampleFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SampleFormat]
$creadListPrec :: ReadPrec [SampleFormat]
readPrec :: ReadPrec SampleFormat
$creadPrec :: ReadPrec SampleFormat
readList :: ReadS [SampleFormat]
$creadList :: ReadS [SampleFormat]
readsPrec :: Int -> ReadS SampleFormat
$creadsPrec :: Int -> ReadS SampleFormat
Read, SampleFormat -> SampleFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SampleFormat -> SampleFormat -> Bool
$c/= :: SampleFormat -> SampleFormat -> Bool
== :: SampleFormat -> SampleFormat -> Bool
$c== :: SampleFormat -> SampleFormat -> Bool
Eq, Eq SampleFormat
SampleFormat -> SampleFormat -> Bool
SampleFormat -> SampleFormat -> Ordering
SampleFormat -> SampleFormat -> SampleFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SampleFormat -> SampleFormat -> SampleFormat
$cmin :: SampleFormat -> SampleFormat -> SampleFormat
max :: SampleFormat -> SampleFormat -> SampleFormat
$cmax :: SampleFormat -> SampleFormat -> SampleFormat
>= :: SampleFormat -> SampleFormat -> Bool
$c>= :: SampleFormat -> SampleFormat -> Bool
> :: SampleFormat -> SampleFormat -> Bool
$c> :: SampleFormat -> SampleFormat -> Bool
<= :: SampleFormat -> SampleFormat -> Bool
$c<= :: SampleFormat -> SampleFormat -> Bool
< :: SampleFormat -> SampleFormat -> Bool
$c< :: SampleFormat -> SampleFormat -> Bool
compare :: SampleFormat -> SampleFormat -> Ordering
$ccompare :: SampleFormat -> SampleFormat -> Ordering
Ord, Typeable, Typeable SampleFormat
SampleFormat -> DataType
SampleFormat -> Constr
(forall b. Data b => b -> b) -> SampleFormat -> SampleFormat
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SampleFormat -> u
forall u. (forall d. Data d => d -> u) -> SampleFormat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SampleFormat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SampleFormat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SampleFormat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SampleFormat -> c SampleFormat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SampleFormat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SampleFormat)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SampleFormat -> m SampleFormat
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SampleFormat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SampleFormat -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SampleFormat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SampleFormat -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SampleFormat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SampleFormat -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SampleFormat -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SampleFormat -> r
gmapT :: (forall b. Data b => b -> b) -> SampleFormat -> SampleFormat
$cgmapT :: (forall b. Data b => b -> b) -> SampleFormat -> SampleFormat
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SampleFormat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SampleFormat)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SampleFormat)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SampleFormat)
dataTypeOf :: SampleFormat -> DataType
$cdataTypeOf :: SampleFormat -> DataType
toConstr :: SampleFormat -> Constr
$ctoConstr :: SampleFormat -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SampleFormat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SampleFormat
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SampleFormat -> c SampleFormat
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SampleFormat -> c SampleFormat
Data)

-- | Speaker positions clarifying which exactly channels are packed in the
-- WAVE file.
data SpeakerPosition
  = -- | 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 (Int -> SpeakerPosition -> ShowS
[SpeakerPosition] -> ShowS
SpeakerPosition -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SpeakerPosition] -> ShowS
$cshowList :: [SpeakerPosition] -> ShowS
show :: SpeakerPosition -> [Char]
$cshow :: SpeakerPosition -> [Char]
showsPrec :: Int -> SpeakerPosition -> ShowS
$cshowsPrec :: Int -> SpeakerPosition -> ShowS
Show, ReadPrec [SpeakerPosition]
ReadPrec SpeakerPosition
Int -> ReadS SpeakerPosition
ReadS [SpeakerPosition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpeakerPosition]
$creadListPrec :: ReadPrec [SpeakerPosition]
readPrec :: ReadPrec SpeakerPosition
$creadPrec :: ReadPrec SpeakerPosition
readList :: ReadS [SpeakerPosition]
$creadList :: ReadS [SpeakerPosition]
readsPrec :: Int -> ReadS SpeakerPosition
$creadsPrec :: Int -> ReadS SpeakerPosition
Read, SpeakerPosition -> SpeakerPosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpeakerPosition -> SpeakerPosition -> Bool
$c/= :: SpeakerPosition -> SpeakerPosition -> Bool
== :: SpeakerPosition -> SpeakerPosition -> Bool
$c== :: SpeakerPosition -> SpeakerPosition -> Bool
Eq, Eq SpeakerPosition
SpeakerPosition -> SpeakerPosition -> Bool
SpeakerPosition -> SpeakerPosition -> Ordering
SpeakerPosition -> SpeakerPosition -> SpeakerPosition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SpeakerPosition -> SpeakerPosition -> SpeakerPosition
$cmin :: SpeakerPosition -> SpeakerPosition -> SpeakerPosition
max :: SpeakerPosition -> SpeakerPosition -> SpeakerPosition
$cmax :: SpeakerPosition -> SpeakerPosition -> SpeakerPosition
>= :: SpeakerPosition -> SpeakerPosition -> Bool
$c>= :: SpeakerPosition -> SpeakerPosition -> Bool
> :: SpeakerPosition -> SpeakerPosition -> Bool
$c> :: SpeakerPosition -> SpeakerPosition -> Bool
<= :: SpeakerPosition -> SpeakerPosition -> Bool
$c<= :: SpeakerPosition -> SpeakerPosition -> Bool
< :: SpeakerPosition -> SpeakerPosition -> Bool
$c< :: SpeakerPosition -> SpeakerPosition -> Bool
compare :: SpeakerPosition -> SpeakerPosition -> Ordering
$ccompare :: SpeakerPosition -> SpeakerPosition -> Ordering
Ord, SpeakerPosition
forall a. a -> a -> Bounded a
maxBound :: SpeakerPosition
$cmaxBound :: SpeakerPosition
minBound :: SpeakerPosition
$cminBound :: SpeakerPosition
Bounded, Int -> SpeakerPosition
SpeakerPosition -> Int
SpeakerPosition -> [SpeakerPosition]
SpeakerPosition -> SpeakerPosition
SpeakerPosition -> SpeakerPosition -> [SpeakerPosition]
SpeakerPosition
-> SpeakerPosition -> SpeakerPosition -> [SpeakerPosition]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SpeakerPosition
-> SpeakerPosition -> SpeakerPosition -> [SpeakerPosition]
$cenumFromThenTo :: SpeakerPosition
-> SpeakerPosition -> SpeakerPosition -> [SpeakerPosition]
enumFromTo :: SpeakerPosition -> SpeakerPosition -> [SpeakerPosition]
$cenumFromTo :: SpeakerPosition -> SpeakerPosition -> [SpeakerPosition]
enumFromThen :: SpeakerPosition -> SpeakerPosition -> [SpeakerPosition]
$cenumFromThen :: SpeakerPosition -> SpeakerPosition -> [SpeakerPosition]
enumFrom :: SpeakerPosition -> [SpeakerPosition]
$cenumFrom :: SpeakerPosition -> [SpeakerPosition]
fromEnum :: SpeakerPosition -> Int
$cfromEnum :: SpeakerPosition -> Int
toEnum :: Int -> SpeakerPosition
$ctoEnum :: Int -> SpeakerPosition
pred :: SpeakerPosition -> SpeakerPosition
$cpred :: SpeakerPosition -> SpeakerPosition
succ :: SpeakerPosition -> SpeakerPosition
$csucc :: SpeakerPosition -> SpeakerPosition
Enum, Typeable, Typeable SpeakerPosition
SpeakerPosition -> DataType
SpeakerPosition -> Constr
(forall b. Data b => b -> b) -> SpeakerPosition -> SpeakerPosition
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SpeakerPosition -> u
forall u. (forall d. Data d => d -> u) -> SpeakerPosition -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpeakerPosition -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpeakerPosition -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SpeakerPosition -> m SpeakerPosition
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpeakerPosition -> m SpeakerPosition
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpeakerPosition
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpeakerPosition -> c SpeakerPosition
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpeakerPosition)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpeakerPosition)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpeakerPosition -> m SpeakerPosition
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpeakerPosition -> m SpeakerPosition
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpeakerPosition -> m SpeakerPosition
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpeakerPosition -> m SpeakerPosition
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SpeakerPosition -> m SpeakerPosition
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SpeakerPosition -> m SpeakerPosition
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SpeakerPosition -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SpeakerPosition -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SpeakerPosition -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SpeakerPosition -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpeakerPosition -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpeakerPosition -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpeakerPosition -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpeakerPosition -> r
gmapT :: (forall b. Data b => b -> b) -> SpeakerPosition -> SpeakerPosition
$cgmapT :: (forall b. Data b => b -> b) -> SpeakerPosition -> SpeakerPosition
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpeakerPosition)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpeakerPosition)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpeakerPosition)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpeakerPosition)
dataTypeOf :: SpeakerPosition -> DataType
$cdataTypeOf :: SpeakerPosition -> DataType
toConstr :: SpeakerPosition -> Constr
$ctoConstr :: SpeakerPosition -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpeakerPosition
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpeakerPosition
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpeakerPosition -> c SpeakerPosition
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpeakerPosition -> c SpeakerPosition
Data)

-- | Exceptions the library can throw.
data WaveException
  = -- | 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.
    NonDataChunkIsTooLong ByteString FilePath
  | -- | The specified format is non-PCM, it's vanilla WAVE, but the “fact”
    -- chunk is missing.
    NonPcmFormatButMissingFact FilePath
  deriving (Int -> WaveException -> ShowS
[WaveException] -> ShowS
WaveException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WaveException] -> ShowS
$cshowList :: [WaveException] -> ShowS
show :: WaveException -> [Char]
$cshow :: WaveException -> [Char]
showsPrec :: Int -> WaveException -> ShowS
$cshowsPrec :: Int -> WaveException -> ShowS
Show, ReadPrec [WaveException]
ReadPrec WaveException
Int -> ReadS WaveException
ReadS [WaveException]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WaveException]
$creadListPrec :: ReadPrec [WaveException]
readPrec :: ReadPrec WaveException
$creadPrec :: ReadPrec WaveException
readList :: ReadS [WaveException]
$creadList :: ReadS [WaveException]
readsPrec :: Int -> ReadS WaveException
$creadsPrec :: Int -> ReadS WaveException
Read, WaveException -> WaveException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WaveException -> WaveException -> Bool
$c/= :: WaveException -> WaveException -> Bool
== :: WaveException -> WaveException -> Bool
$c== :: WaveException -> WaveException -> Bool
Eq, Typeable, Typeable WaveException
WaveException -> DataType
WaveException -> Constr
(forall b. Data b => b -> b) -> WaveException -> WaveException
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WaveException -> u
forall u. (forall d. Data d => d -> u) -> WaveException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WaveException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WaveException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WaveException -> m WaveException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveException -> m WaveException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WaveException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WaveException -> c WaveException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WaveException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WaveException)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveException -> m WaveException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveException -> m WaveException
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveException -> m WaveException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WaveException -> m WaveException
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WaveException -> m WaveException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WaveException -> m WaveException
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WaveException -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WaveException -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> WaveException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WaveException -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WaveException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WaveException -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WaveException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WaveException -> r
gmapT :: (forall b. Data b => b -> b) -> WaveException -> WaveException
$cgmapT :: (forall b. Data b => b -> b) -> WaveException -> WaveException
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WaveException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WaveException)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WaveException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WaveException)
dataTypeOf :: WaveException -> DataType
$cdataTypeOf :: WaveException -> DataType
toConstr :: WaveException -> Constr
$ctoConstr :: WaveException -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WaveException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WaveException
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WaveException -> c WaveException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WaveException -> c WaveException
Data)

instance Exception WaveException

-- | A RIFF chunk allowing for different representations of its body. This
-- type is not public.
data Chunk m = Chunk
  { -- | Four-byte chunk tag
    forall (m :: * -> *). Chunk m -> ByteString
chunkTag :: !ByteString,
    -- | Chunk size
    forall (m :: * -> *). Chunk m -> Word32
chunkSize :: !Word32,
    -- | Chunk body in some form
    forall (m :: * -> *). Chunk m -> m ByteString
chunkBody :: !(m ByteString)
  }

-- | A “ds64” chunk used in RF64 WAVE extension. This type is not public.
data Ds64 = Ds64
  { -- | Size of RIFF chunk (64 bits)
    Ds64 -> Word64
ds64RiffSize :: !Word64,
    -- | Size of data chunk (64 bits)
    Ds64 -> Word64
ds64DataSize :: !Word64,
    -- | Total number of samples (64 bits)
    Ds64 -> Word64
ds64SamplesTotal :: !Word64
  }

-- | The default value of 'Ds64'.
defaultDs64 :: Ds64
defaultDs64 :: Ds64
defaultDs64 =
  Ds64
    { ds64RiffSize :: Word64
ds64RiffSize = Word64
0,
      ds64DataSize :: Word64
ds64DataSize = Word64
0,
      ds64SamplesTotal :: Word64
ds64SamplesTotal = Word64
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

-- | 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 -> Word32
waveByteRate Wave
wave =
  Wave -> Word32
waveSampleRate Wave
wave forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Wave -> Word16
waveBlockAlign Wave
wave)

-- | The bit rate in kilobits per second.
waveBitRate :: Wave -> Double
waveBitRate :: Wave -> Double
waveBitRate = (forall a. Fractional a => a -> a -> a
/ Double
125) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wave -> Word32
waveByteRate

-- | The number of significant bits in a sample.
waveBitsPerSample :: Wave -> Word16
waveBitsPerSample :: Wave -> Word16
waveBitsPerSample Wave {[(ByteString, ByteString)]
Word32
Word64
Set SpeakerPosition
SampleFormat
WaveFormat
waveOtherChunks :: [(ByteString, ByteString)]
waveSamplesTotal :: Word64
waveDataSize :: Word64
waveDataOffset :: Word32
waveChannelMask :: Set SpeakerPosition
waveSampleFormat :: SampleFormat
waveSampleRate :: Word32
waveFileFormat :: WaveFormat
waveOtherChunks :: Wave -> [(ByteString, ByteString)]
waveSamplesTotal :: Wave -> Word64
waveDataSize :: Wave -> Word64
waveDataOffset :: Wave -> Word32
waveChannelMask :: Wave -> Set SpeakerPosition
waveSampleFormat :: Wave -> SampleFormat
waveSampleRate :: Wave -> Word32
waveFileFormat :: Wave -> WaveFormat
..} =
  case SampleFormat
waveSampleFormat of
    SampleFormatPcmInt Word16
bps -> Word16
bps
    SampleFormat
SampleFormatIeeeFloat32Bit -> Word16
32
    SampleFormat
SampleFormatIeeeFloat64Bit -> Word16
64

-- | 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 -> Word16
waveBlockAlign Wave
wave = Wave -> Word16
waveChannels Wave
wave forall a. Num a => a -> a -> a
* Word16
bytesPerSample
  where
    bytesPerSample :: Word16
bytesPerSample = Word16 -> Word16
roundBitsPerSample (Wave -> Word16
waveBitsPerSample Wave
wave) forall a. Integral a => a -> a -> a
`quot` Word16
8

-- | The total number of channels present in the audio stream.
waveChannels :: Wave -> Word16
waveChannels :: Wave -> Word16
waveChannels Wave {[(ByteString, ByteString)]
Word32
Word64
Set SpeakerPosition
SampleFormat
WaveFormat
waveOtherChunks :: [(ByteString, ByteString)]
waveSamplesTotal :: Word64
waveDataSize :: Word64
waveDataOffset :: Word32
waveChannelMask :: Set SpeakerPosition
waveSampleFormat :: SampleFormat
waveSampleRate :: Word32
waveFileFormat :: WaveFormat
waveOtherChunks :: Wave -> [(ByteString, ByteString)]
waveSamplesTotal :: Wave -> Word64
waveDataSize :: Wave -> Word64
waveDataOffset :: Wave -> Word32
waveChannelMask :: Wave -> Set SpeakerPosition
waveSampleFormat :: Wave -> SampleFormat
waveSampleRate :: Wave -> Word32
waveFileFormat :: Wave -> WaveFormat
..} = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Set a -> Int
E.size Set SpeakerPosition
waveChannelMask)

-- | The duration in seconds.
waveDuration :: Wave -> Double
waveDuration :: Wave -> Double
waveDuration Wave
wave =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral (Wave -> Word64
waveSamplesTotal Wave
wave) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Wave -> Word32
waveSampleRate Wave
wave)

----------------------------------------------------------------------------
-- Common speaker configurations

-- | Front center (C).
speakerMono :: Set SpeakerPosition
speakerMono :: Set SpeakerPosition
speakerMono = forall a. Ord a => [a] -> Set a
E.fromList [SpeakerPosition
SpeakerFrontCenter]

-- | Front left (L), front right (R).
speakerStereo :: Set SpeakerPosition
speakerStereo :: Set SpeakerPosition
speakerStereo = forall a. Ord a => [a] -> Set a
E.fromList [SpeakerPosition
SpeakerFrontLeft, SpeakerPosition
SpeakerFrontRight]

-- | L, R, back left (Lb), back right (Rb).
speakerQuad :: Set SpeakerPosition
speakerQuad :: Set SpeakerPosition
speakerQuad =
  forall a. Ord a => [a] -> Set a
E.fromList
    [ SpeakerPosition
SpeakerFrontLeft,
      SpeakerPosition
SpeakerFrontRight,
      SpeakerPosition
SpeakerBackLeft,
      SpeakerPosition
SpeakerBackRight
    ]

-- | Surround: L, R, front center (C), back center (Cb).
speakerSurround :: Set SpeakerPosition
speakerSurround :: Set SpeakerPosition
speakerSurround =
  forall a. Ord a => [a] -> Set a
E.fromList
    [ SpeakerPosition
SpeakerFrontLeft,
      SpeakerPosition
SpeakerFrontRight,
      SpeakerPosition
SpeakerFrontCenter,
      SpeakerPosition
SpeakerBackCenter
    ]

-- | L, R, C, Lb, Rb, low frequency (LFE).
speaker5_1 :: Set SpeakerPosition
speaker5_1 :: Set SpeakerPosition
speaker5_1 =
  forall a. Ord a => [a] -> Set a
E.fromList
    [ SpeakerPosition
SpeakerFrontLeft,
      SpeakerPosition
SpeakerFrontRight,
      SpeakerPosition
SpeakerFrontCenter,
      SpeakerPosition
SpeakerBackLeft,
      SpeakerPosition
SpeakerBackRight,
      SpeakerPosition
SpeakerLowFrequency
    ]

-- | L, R, C, Lb, Rb, front left-of-center, front right-of-center, LFE.
speaker7_1 :: Set SpeakerPosition
speaker7_1 :: Set SpeakerPosition
speaker7_1 =
  forall a. Ord a => [a] -> Set a
E.fromList
    [ SpeakerPosition
SpeakerFrontLeft,
      SpeakerPosition
SpeakerFrontRight,
      SpeakerPosition
SpeakerFrontCenter,
      SpeakerPosition
SpeakerBackLeft,
      SpeakerPosition
SpeakerBackRight,
      SpeakerPosition
SpeakerFrontLeftOfCenter,
      SpeakerPosition
SpeakerFrontRightOfCenter,
      SpeakerPosition
SpeakerLowFrequency
    ]

-- | L, R, C, side left (Ls), side right (Rs), LFE.
speaker5_1Surround :: Set SpeakerPosition
speaker5_1Surround :: Set SpeakerPosition
speaker5_1Surround =
  forall a. Ord a => [a] -> Set a
E.fromList
    [ SpeakerPosition
SpeakerFrontLeft,
      SpeakerPosition
SpeakerFrontRight,
      SpeakerPosition
SpeakerFrontCenter,
      SpeakerPosition
SpeakerSideLeft,
      SpeakerPosition
SpeakerSideRight,
      SpeakerPosition
SpeakerLowFrequency
    ]

-- | L, R, C, Lb, Rb, Ls, Rs, LFE.
speaker7_1Surround :: Set SpeakerPosition
speaker7_1Surround :: Set SpeakerPosition
speaker7_1Surround =
  forall a. Ord a => [a] -> Set a
E.fromList
    [ SpeakerPosition
SpeakerFrontLeft,
      SpeakerPosition
SpeakerFrontRight,
      SpeakerPosition
SpeakerFrontCenter,
      SpeakerPosition
SpeakerBackLeft,
      SpeakerPosition
SpeakerBackRight,
      SpeakerPosition
SpeakerSideLeft,
      SpeakerPosition
SpeakerSideRight,
      SpeakerPosition
SpeakerLowFrequency
    ]

----------------------------------------------------------------------------
-- Reading

-- | 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.
--
-- Vanilla WAVE and RF64 files are supported. The format is detected
-- automatically from the contents of the file, not by extension.
--
-- 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 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)
--     * 3 channels: L, R, C
--     * 4 channels: L, R, back left (Lb), back right (Rb)
--     * 5 channels: L, R, C, Lb, Rb
--     * 6 channels: L, R, C, LFE, Lb, Rb
--     * 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) =>
  -- | Location of file to read
  FilePath ->
  m Wave
readWaveFile :: forall (m :: * -> *). MonadIO m => [Char] -> m Wave
readWaveFile [Char]
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile [Char]
path IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
  let giveup :: ([Char] -> e) -> IO a
giveup [Char] -> e
f = forall e a. Exception e => e -> IO a
throwIO ([Char] -> e
f [Char]
path)
      liftGet :: IO (Either [Char] b) -> IO b
liftGet IO (Either [Char] b)
m = do
        Either [Char] b
r <- IO (Either [Char] b)
m
        case Either [Char] b
r of
          Left [Char]
msg -> forall e a. Exception e => e -> IO a
throwIO ([Char] -> [Char] -> WaveException
BadFileFormat [Char]
msg [Char]
path)
          Right b
x -> forall (m :: * -> *) a. Monad m => a -> m a
return b
x
  Chunk Maybe
outerChunk <- forall {b}. IO (Either [Char] b) -> IO b
liftGet (Handle -> Word32 -> IO (Either [Char] (Chunk Maybe))
readChunk Handle
h Word32
0)
  case forall (m :: * -> *). Chunk m -> ByteString
chunkTag Chunk Maybe
outerChunk of
    ByteString
"RIFF" -> Handle
-> GiveUp -> (forall {b}. IO (Either [Char] b) -> IO b) -> IO Wave
readWaveVanilla Handle
h forall {e} {a}. Exception e => ([Char] -> e) -> IO a
giveup forall {b}. IO (Either [Char] b) -> IO b
liftGet
    ByteString
"RF64" -> Handle
-> GiveUp -> (forall {b}. IO (Either [Char] b) -> IO b) -> IO Wave
readWaveRF64 Handle
h forall {e} {a}. Exception e => ([Char] -> e) -> IO a
giveup forall {b}. IO (Either [Char] b) -> IO b
liftGet
    ByteString
_ -> forall {e} {a}. Exception e => ([Char] -> e) -> IO a
giveup ([Char] -> [Char] -> WaveException
BadFileFormat [Char]
"Can't locate RIFF/RF64 tag")

-- | Parse a classic WAVE file.
readWaveVanilla ::
  -- | 'Handle' to read from
  Handle ->
  -- | How to give up
  GiveUp ->
  -- | How to lift parsers
  LiftGet ->
  -- | The result
  IO Wave
readWaveVanilla :: Handle
-> GiveUp -> (forall {b}. IO (Either [Char] b) -> IO b) -> IO Wave
readWaveVanilla Handle
h GiveUp
giveup forall {b}. IO (Either [Char] b) -> IO b
liftGet = do
  Handle -> GiveUp -> IO ()
grabWaveTag Handle
h GiveUp
giveup
  Handle
-> GiveUp
-> (forall {b}. IO (Either [Char] b) -> IO b)
-> Maybe Word64
-> Maybe Word64
-> Wave
-> IO Wave
grabWaveChunks
    Handle
h
    GiveUp
giveup
    forall {b}. IO (Either [Char] b) -> IO b
liftGet
    forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing
    Wave
defaultWave
      { waveFileFormat :: WaveFormat
waveFileFormat = WaveFormat
WaveVanilla
      }

-- | Parse an RF64 file.
readWaveRF64 ::
  -- | 'Handle' to read from
  Handle ->
  -- | How to give up
  GiveUp ->
  -- | How to lift parsers
  LiftGet ->
  -- | The result
  IO Wave
readWaveRF64 :: Handle
-> GiveUp -> (forall {b}. IO (Either [Char] b) -> IO b) -> IO Wave
readWaveRF64 Handle
h GiveUp
giveup forall {b}. IO (Either [Char] b) -> IO b
liftGet = do
  Handle -> GiveUp -> IO ()
grabWaveTag Handle
h GiveUp
giveup
  Chunk Maybe
mds64 <- forall {b}. IO (Either [Char] b) -> IO b
liftGet (Handle -> Word32 -> IO (Either [Char] (Chunk Maybe))
readChunk Handle
h Word32
0xffff)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (m :: * -> *). Chunk m -> ByteString
chunkTag Chunk Maybe
mds64 forall a. Eq a => a -> a -> Bool
== ByteString
"ds64") forall a b. (a -> b) -> a -> b
$
    GiveUp
giveup ([Char] -> [Char] -> WaveException
BadFileFormat [Char]
"Can't find ds64 chunk")
  Ds64 {Word64
ds64SamplesTotal :: Word64
ds64DataSize :: Word64
ds64RiffSize :: Word64
ds64SamplesTotal :: Ds64 -> Word64
ds64DataSize :: Ds64 -> Word64
ds64RiffSize :: Ds64 -> Word64
..} <- case forall (m :: * -> *). Chunk m -> m ByteString
chunkBody Chunk Maybe
mds64 of
    Maybe ByteString
Nothing -> GiveUp
giveup (ByteString -> [Char] -> WaveException
NonDataChunkIsTooLong ByteString
"ds64")
    Just ByteString
body -> forall {b}. IO (Either [Char] b) -> IO b
liftGet (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] Ds64
readDs64 ByteString
body)
  Handle
-> GiveUp
-> (forall {b}. IO (Either [Char] b) -> IO b)
-> Maybe Word64
-> Maybe Word64
-> Wave
-> IO Wave
grabWaveChunks
    Handle
h
    GiveUp
giveup
    forall {b}. IO (Either [Char] b) -> IO b
liftGet
    (forall a. a -> Maybe a
Just Word64
ds64DataSize)
    (forall a. a -> Maybe a
Just Word64
ds64SamplesTotal)
    Wave
defaultWave
      { waveFileFormat :: WaveFormat
waveFileFormat = WaveFormat
WaveRF64,
        waveSamplesTotal :: Word64
waveSamplesTotal = Word64
0xffffffff
      }

-- | Read four bytes from the given 'Handle' and throw an exception if they
-- are not “WAVE”.
grabWaveTag :: Handle -> GiveUp -> IO ()
grabWaveTag :: Handle -> GiveUp -> IO ()
grabWaveTag Handle
h GiveUp
giveup = do
  ByteString
waveId <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
4
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
waveId forall a. Eq a => a -> a -> Bool
== ByteString
"WAVE") forall a b. (a -> b) -> a -> b
$
    GiveUp
giveup ([Char] -> [Char] -> WaveException
BadFileFormat [Char]
"Can't find WAVE format tag")

-- | Read WAVE chunks.
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 :: Handle
-> GiveUp
-> (forall {b}. IO (Either [Char] b) -> IO b)
-> Maybe Word64
-> Maybe Word64
-> Wave
-> IO Wave
grabWaveChunks Handle
h GiveUp
giveup forall {b}. IO (Either [Char] b) -> IO b
liftGet Maybe Word64
mdataSize Maybe Word64
msamplesTotal = Bool -> Wave -> IO Wave
go Bool
False
  where
    go :: Bool -> Wave -> IO Wave
go Bool
seenFact Wave
wave = do
      Integer
offset <- Handle -> IO Integer
hTell Handle
h
      Chunk {Maybe ByteString
Word32
ByteString
chunkBody :: Maybe ByteString
chunkSize :: Word32
chunkTag :: ByteString
chunkBody :: forall (m :: * -> *). Chunk m -> m ByteString
chunkSize :: forall (m :: * -> *). Chunk m -> Word32
chunkTag :: forall (m :: * -> *). Chunk m -> ByteString
..} <- forall {b}. IO (Either [Char] b) -> IO b
liftGet (Handle -> Word32 -> IO (Either [Char] (Chunk Maybe))
readChunk Handle
h Word32
0xffff)
      case (ByteString
chunkTag, Maybe ByteString
chunkBody) of
        (ByteString
"data", Maybe ByteString
_) -> do
          let nonPcm :: Bool
nonPcm = SampleFormat -> Bool
isNonPcm (Wave -> SampleFormat
waveSampleFormat Wave
wave)
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
nonPcm Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
seenFact Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Word64
msamplesTotal) forall a b. (a -> b) -> a -> b
$
            GiveUp
giveup [Char] -> WaveException
NonPcmFormatButMissingFact
          let dataSize :: Word64
dataSize =
                case (Word32
chunkSize forall a. Eq a => a -> a -> Bool
== Word32
0xffffffff, Maybe Word64
mdataSize) of
                  (Bool
True, Just Word64
dataSize') -> Word64
dataSize'
                  (Bool, Maybe Word64)
_ -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
chunkSize
          forall (m :: * -> *) a. Monad m => a -> m a
return
            Wave
wave
              { waveDataOffset :: Word32
waveDataOffset = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset forall a. Num a => a -> a -> a
+ Word32
8,
                waveDataSize :: Word64
waveDataSize = Word64
dataSize,
                waveSamplesTotal :: Word64
waveSamplesTotal = case (Wave -> Word64
waveSamplesTotal Wave
wave forall a. Eq a => a -> a -> Bool
== Word64
0xffffffff, Maybe Word64
msamplesTotal) of
                  (Bool
True, Just Word64
samplesTotal) -> Word64
samplesTotal
                  (Bool, Maybe Word64)
_ ->
                    if Bool
nonPcm
                      then Wave -> Word64
waveSamplesTotal Wave
wave
                      else Wave -> Word64
pcmSamplesTotal Wave
wave {waveDataSize :: Word64
waveDataSize = Word64
dataSize},
                waveOtherChunks :: [(ByteString, ByteString)]
waveOtherChunks = forall a. [a] -> [a]
reverse (Wave -> [(ByteString, ByteString)]
waveOtherChunks Wave
wave)
              }
        (ByteString
tag, Maybe ByteString
Nothing) ->
          GiveUp
giveup (ByteString -> [Char] -> WaveException
NonDataChunkIsTooLong ByteString
tag)
        (ByteString
"fmt ", Just ByteString
body) ->
          forall {b}. IO (Either [Char] b) -> IO b
liftGet (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Wave -> ByteString -> Either [Char] Wave
readWaveFmt Wave
wave ByteString
body) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Wave -> IO Wave
go Bool
seenFact
        (ByteString
"fact", Just ByteString
body) -> do
          Word32
samplesTotal <- forall {b}. IO (Either [Char] b) -> IO b
liftGet (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] Word32
readFact ByteString
body)
          Bool -> Wave -> IO Wave
go Bool
True Wave
wave {waveSamplesTotal :: Word64
waveSamplesTotal = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
samplesTotal}
        (ByteString
tag, Just ByteString
body) ->
          Bool -> Wave -> IO Wave
go
            Bool
seenFact
            Wave
wave {waveOtherChunks :: [(ByteString, ByteString)]
waveOtherChunks = (ByteString
tag, ByteString
body) forall a. a -> [a] -> [a]
: Wave -> [(ByteString, ByteString)]
waveOtherChunks Wave
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 :: ByteString -> Either [Char] Ds64
readDs64 ByteString
bytes = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Get a -> ByteString -> Either [Char] a
S.runGet ByteString
bytes forall a b. (a -> b) -> a -> b
$ do
  Word64
ds64RiffSize <- Get Word64
S.getWord64le
  Word64
ds64DataSize <- Get Word64
S.getWord64le
  Word64
ds64SamplesTotal <- Get Word64
S.getWord64le
  forall (m :: * -> *) a. Monad m => a -> m a
return Ds64 {Word64
ds64SamplesTotal :: Word64
ds64DataSize :: Word64
ds64RiffSize :: Word64
ds64SamplesTotal :: Word64
ds64DataSize :: Word64
ds64RiffSize :: Word64
..}

-- | Parse the WAVE format chunk from given 'ByteString'. Return error in
-- 'Left' in case of failure.
readWaveFmt :: Wave -> ByteString -> Either String Wave
readWaveFmt :: Wave -> ByteString -> Either [Char] Wave
readWaveFmt Wave
wave = forall a. Get a -> ByteString -> Either [Char] a
S.runGet forall a b. (a -> b) -> a -> b
$ do
  Word16
format <- Get Word16
S.getWord16le
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    ( Word16
format forall a. Eq a => a -> a -> Bool
== Word16
waveFormatPcm
        Bool -> Bool -> Bool
|| Word16
format forall a. Eq a => a -> a -> Bool
== Word16
waveFormatIeeeFloat
        Bool -> Bool -> Bool
|| Word16
format forall a. Eq a => a -> a -> Bool
== Word16
waveFormatExtensible
    )
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Unsupported audio format specified in fmt chunk"
  let extensible :: Bool
extensible = Word16
format forall a. Eq a => a -> a -> Bool
== Word16
waveFormatExtensible
  Word16
channels <- Get Word16
S.getWord16le
  Word32
sampleRate <- Get Word32
S.getWord32le
  Int -> Get ()
S.skip Int
4 -- byte rate (useless, we can infer it)
  Int -> Get ()
S.skip Int
2 -- block align (useless as well)
  Word16
bps <- Get Word16
S.getWord16le
  Bool
hasExtSize <- Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
S.isEmpty
  Word16
extSize <-
    if Bool
hasExtSize
      then Get Word16
S.getWord16le
      else forall (m :: * -> *) a. Monad m => a -> m a
return Word16
0
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
extSize forall a. Ord a => a -> a -> Bool
< Word16
22 Bool -> Bool -> Bool
&& Bool
extensible) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"The format is extensible, but extra params are shorter than 22 bytes"
  Word16
bitsPerSample <-
    if Bool
extensible
      then Get Word16
S.getWord16le
      else forall (m :: * -> *) a. Monad m => a -> m a
return Word16
bps
  Set SpeakerPosition
channelMask <-
    if Bool
extensible
      then Word32 -> Set SpeakerPosition
fromSpeakerMask forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
S.getWord32le
      else forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Set SpeakerPosition
defaultSpeakerSet Word16
channels)
  ByteString
extGuid <-
    if Bool
extensible
      then Int -> Get ByteString
S.getByteString Int
16
      else
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          if Word16
format forall a. Eq a => a -> a -> Bool
== Word16
waveFormatPcm
            then ByteString
ksdataformatSubtypePcm
            else ByteString
ksdataformatSubtypeIeeeFloat
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( ByteString
extGuid forall a. Eq a => a -> a -> Bool
/= ByteString
ksdataformatSubtypePcm
        Bool -> Bool -> Bool
&& ByteString
extGuid forall a. Eq a => a -> a -> Bool
/= ByteString
ksdataformatSubtypeIeeeFloat
    )
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Unknown or unsupported GUID in extensible fmt chunk" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ByteString
extGuid)
  let ieeeFloat :: Bool
ieeeFloat = ByteString
extGuid forall a. Eq a => a -> a -> Bool
== ByteString
ksdataformatSubtypeIeeeFloat
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
ieeeFloat Bool -> Bool -> Bool
&& Bool -> Bool
not (Word16
bitsPerSample forall a. Eq a => a -> a -> Bool
== Word16
32 Bool -> Bool -> Bool
|| Word16
bitsPerSample forall a. Eq a => a -> a -> Bool
== Word16
64)) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"The sample format is IEEE Float, but bits per sample is not 32 or 64"
  forall (m :: * -> *) a. Monad m => a -> m a
return
    Wave
wave
      { waveSampleRate :: Word32
waveSampleRate = Word32
sampleRate,
        waveSampleFormat :: SampleFormat
waveSampleFormat =
          if Bool
ieeeFloat
            then
              if Word16
bitsPerSample forall a. Eq a => a -> a -> Bool
== Word16
32
                then SampleFormat
SampleFormatIeeeFloat32Bit
                else SampleFormat
SampleFormatIeeeFloat64Bit
            else Word16 -> SampleFormat
SampleFormatPcmInt Word16
bitsPerSample,
        waveChannelMask :: Set SpeakerPosition
waveChannelMask = Set SpeakerPosition
channelMask
      }

-- | Read the “fact” chunk.
readFact :: ByteString -> Either String Word32
readFact :: ByteString -> Either [Char] Word32
readFact = forall a. Get a -> ByteString -> Either [Char] a
S.runGet Get Word32
S.getWord32le

-- | 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 :: Handle -> Word32 -> IO (Either [Char] (Chunk Maybe))
readChunk Handle
h Word32
maxSize = do
  ByteString
bytes <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
8
  let echunk :: Either [Char] (Chunk Maybe)
echunk = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Get a -> ByteString -> Either [Char] a
S.runGet ByteString
bytes forall a b. (a -> b) -> a -> b
$ do
        ByteString
chunkTag <- Int -> Get ByteString
S.getBytes Int
4
        Word32
chunkSize <- Get Word32
S.getWord32le
        let chunkBody :: Maybe a
chunkBody = forall a. Maybe a
Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
return Chunk {Word32
ByteString
forall a. Maybe a
chunkBody :: forall a. Maybe a
chunkSize :: Word32
chunkTag :: ByteString
chunkBody :: Maybe ByteString
chunkSize :: Word32
chunkTag :: ByteString
..}
  case Either [Char] (Chunk Maybe)
echunk of
    Left [Char]
msg -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Char]
msg)
    Right chunk :: Chunk Maybe
chunk@Chunk {Maybe ByteString
Word32
ByteString
chunkBody :: Maybe ByteString
chunkSize :: Word32
chunkTag :: ByteString
chunkBody :: forall (m :: * -> *). Chunk m -> m ByteString
chunkSize :: forall (m :: * -> *). Chunk m -> Word32
chunkTag :: forall (m :: * -> *). Chunk m -> ByteString
..} -> do
      Maybe ByteString
body <-
        if Word32
chunkSize forall a. Ord a => a -> a -> Bool
<= Word32
maxSize
          then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
B.hGet Handle
h (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
chunkSize)
          else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) Chunk Maybe
chunk {chunkBody :: Maybe ByteString
chunkBody = Maybe ByteString
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 an “even byte boundary”. The
-- pad byte is written if necessary and included in the data size.
--
-- The 'waveSamplesTotal' field will be inferred, so the provided value is
-- not used.
--
-- 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) =>
  -- | 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 :: forall (m :: * -> *).
MonadIO m =>
[Char] -> Wave -> (Handle -> IO ()) -> m ()
writeWaveFile [Char]
path Wave
wave Handle -> IO ()
writeData = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile [Char]
path IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
  case Wave -> WaveFormat
waveFileFormat Wave
wave of
    WaveFormat
WaveVanilla -> Handle -> Wave -> (Handle -> IO ()) -> IO ()
writeWaveVanilla Handle
h Wave
wave Handle -> IO ()
writeData
    WaveFormat
WaveRF64 -> Handle -> Wave -> (Handle -> IO ()) -> IO ()
writeWaveRF64 Handle
h Wave
wave Handle -> IO ()
writeData

-- | Write a vanilla WAVE file.
writeWaveVanilla ::
  -- | 'Handle' to write to
  Handle ->
  -- | Parameters of the WAVE file
  Wave ->
  -- | Callback that writes WAVE data
  (Handle -> IO ()) ->
  IO ()
writeWaveVanilla :: Handle -> Wave -> (Handle -> IO ()) -> IO ()
writeWaveVanilla Handle
h Wave
wave Handle -> IO ()
writeData = do
  let nonPcm :: Bool
nonPcm = SampleFormat -> Bool
isNonPcm (Wave -> SampleFormat
waveSampleFormat Wave
wave)
  -- Write the outer RIFF chunk.
  Integer
beforeOuter <- Handle -> IO Integer
hTell Handle
h
  Handle -> Chunk (Either (Handle -> IO ())) -> IO ()
writeChunk Handle
h (forall (m :: * -> *).
ByteString -> Word32 -> m ByteString -> Chunk m
Chunk ByteString
"RIFF" Word32
0 forall a. Either (Handle -> IO ()) a
writeNoData)
  -- Write the WAVE format tag.
  Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
"WAVE"
  -- Write fmt chunk.
  Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h ByteString
"fmt " (Wave -> ByteString
renderFmtChunk Wave
wave)
  -- Write a dummy fact chunk if necessary.
  Integer
beforeFact <- Handle -> IO Integer
hTell Handle
h
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nonPcm forall a b. (a -> b) -> a -> b
$
    Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h ByteString
"fact" ByteString
"????"
  -- Write any extra chunks if present.
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Wave -> [(ByteString, ByteString)]
waveOtherChunks Wave
wave) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h)
  -- Write data chunk.
  Integer
beforeData <- Handle -> IO Integer
hTell Handle
h
  Handle -> Chunk (Either (Handle -> IO ())) -> IO ()
writeChunk Handle
h (forall (m :: * -> *).
ByteString -> Word32 -> m ByteString -> Chunk m
Chunk ByteString
"data" Word32
0 (forall a b. a -> Either a b
Left Handle -> IO ()
writeData))
  -- Take care of alignment.
  Integer
rightAfterData <- Handle -> IO Integer
hTell Handle
h
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Integral a => a -> Bool
odd Integer
rightAfterData) forall a b. (a -> b) -> a -> b
$
    Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
"\0"
  -- Go back and overwrite dummy values.
  Integer
afterData <- Handle -> IO Integer
hTell Handle
h
  let riffSize :: Word32
riffSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
afterData forall a. Num a => a -> a -> a
- Integer
beforeOuter forall a. Num a => a -> a -> a
- Integer
8)
      dataSize :: Word32
dataSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
afterData forall a. Num a => a -> a -> a
- Integer
beforeData forall a. Num a => a -> a -> a
- Integer
8)
      samplesTotal :: Word32
samplesTotal =
        forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
          Wave -> Word64
pcmSamplesTotal Wave
wave {waveDataSize :: Word64
waveDataSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dataSize}
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nonPcm forall a b. (a -> b) -> a -> b
$ do
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
beforeFact
    Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h ByteString
"fact" (Word32 -> ByteString
renderFactChunk Word32
samplesTotal)
  Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
beforeData
  Handle -> Chunk (Either (Handle -> IO ())) -> IO ()
writeChunk Handle
h (forall (m :: * -> *).
ByteString -> Word32 -> m ByteString -> Chunk m
Chunk ByteString
"data" Word32
dataSize forall a. Either (Handle -> IO ()) a
writeNoData)
  Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
beforeOuter
  Handle -> Chunk (Either (Handle -> IO ())) -> IO ()
writeChunk Handle
h (forall (m :: * -> *).
ByteString -> Word32 -> m ByteString -> Chunk m
Chunk ByteString
"RIFF" Word32
riffSize forall a. Either (Handle -> IO ()) a
writeNoData)

-- | Write an RF64 file.
writeWaveRF64 :: Handle -> Wave -> (Handle -> IO ()) -> IO ()
writeWaveRF64 :: Handle -> Wave -> (Handle -> IO ()) -> IO ()
writeWaveRF64 Handle
h Wave
wave Handle -> IO ()
writeData = do
  -- Write the outer RF64 chunk.
  Integer
beforeOuter <- Handle -> IO Integer
hTell Handle
h
  Handle -> Chunk (Either (Handle -> IO ())) -> IO ()
writeChunk Handle
h (forall (m :: * -> *).
ByteString -> Word32 -> m ByteString -> Chunk m
Chunk ByteString
"RF64" Word32
0xffffffff forall a. Either (Handle -> IO ()) a
writeNoData)
  -- Write the WAVE format tag.
  Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
"WAVE"
  -- Write ds64 chunk.
  Integer
beforeDs64 <- Handle -> IO Integer
hTell Handle
h
  Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h ByteString
"ds64" (Ds64 -> ByteString
renderDs64Chunk Ds64
defaultDs64)
  -- Write fmt chunk.
  Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h ByteString
"fmt " (Wave -> ByteString
renderFmtChunk Wave
wave)
  -- Write any extra chunks if present.
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Wave -> [(ByteString, ByteString)]
waveOtherChunks Wave
wave) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h)
  -- Write data chunk.
  Integer
beforeData <- Handle -> IO Integer
hTell Handle
h
  Handle -> Chunk (Either (Handle -> IO ())) -> IO ()
writeChunk Handle
h (forall (m :: * -> *).
ByteString -> Word32 -> m ByteString -> Chunk m
Chunk ByteString
"data" Word32
0xffffffff (forall a b. a -> Either a b
Left Handle -> IO ()
writeData))
  -- Take care of alignment.
  Integer
rightAfterData <- Handle -> IO Integer
hTell Handle
h
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Integral a => a -> Bool
odd Integer
rightAfterData) forall a b. (a -> b) -> a -> b
$
    Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
"\0"
  -- Go back and overwrite dummy values.
  Integer
afterData <- Handle -> IO Integer
hTell Handle
h
  let ds64RiffSize :: Word64
ds64RiffSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
afterData forall a. Num a => a -> a -> a
- Integer
beforeOuter forall a. Num a => a -> a -> a
- Integer
8)
      ds64DataSize :: Word64
ds64DataSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
afterData forall a. Num a => a -> a -> a
- Integer
beforeData forall a. Num a => a -> a -> a
- Integer
8)
      ds64SamplesTotal :: Word64
ds64SamplesTotal = Wave -> Word64
pcmSamplesTotal Wave
wave {waveDataSize :: Word64
waveDataSize = Word64
ds64DataSize}
      ds64Chunk :: Ds64
ds64Chunk = Ds64 {Word64
ds64SamplesTotal :: Word64
ds64DataSize :: Word64
ds64RiffSize :: Word64
ds64SamplesTotal :: Word64
ds64DataSize :: Word64
ds64RiffSize :: Word64
..}
  Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
beforeDs64
  Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h ByteString
"ds64" (Ds64 -> ByteString
renderDs64Chunk Ds64
ds64Chunk)

-- | Write no data at all.
writeNoData :: Either (Handle -> IO ()) a
writeNoData :: forall a. Either (Handle -> IO ()) a
writeNoData = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) ()

-- | Write a chunk given its tag and body as strict 'ByteString's.
writeBsChunk ::
  -- | 'Handle' where to write
  Handle ->
  -- | Chunk tag
  ByteString ->
  -- | Chunk body
  ByteString ->
  IO ()
writeBsChunk :: Handle -> ByteString -> ByteString -> IO ()
writeBsChunk Handle
h ByteString
chunkTag ByteString
body =
  let chunkSize :: Word32
chunkSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
body)
      chunkBody :: Either a ByteString
chunkBody = forall a b. b -> Either a b
Right ByteString
body
   in Handle -> Chunk (Either (Handle -> IO ())) -> IO ()
writeChunk Handle
h Chunk {Word32
ByteString
forall {a}. Either a ByteString
chunkBody :: forall {a}. Either a ByteString
chunkSize :: Word32
chunkTag :: ByteString
chunkBody :: Either (Handle -> IO ()) ByteString
chunkSize :: Word32
chunkTag :: ByteString
..}

-- | Render a “ds64” chunk as a stirct 'ByteString'.
renderDs64Chunk :: Ds64 -> ByteString
renderDs64Chunk :: Ds64 -> ByteString
renderDs64Chunk Ds64 {Word64
ds64SamplesTotal :: Word64
ds64DataSize :: Word64
ds64RiffSize :: Word64
ds64SamplesTotal :: Ds64 -> Word64
ds64DataSize :: Ds64 -> Word64
ds64RiffSize :: Ds64 -> Word64
..} = Put -> ByteString
S.runPut forall a b. (a -> b) -> a -> b
$ do
  Putter Word64
S.putWord64le Word64
ds64RiffSize
  Putter Word64
S.putWord64le Word64
ds64DataSize
  Putter Word64
S.putWord64le Word64
ds64SamplesTotal

-- | Render the format chunk as a strict 'ByteString' from a given 'Wave'.
renderFmtChunk :: Wave -> ByteString
renderFmtChunk :: Wave -> ByteString
renderFmtChunk wave :: Wave
wave@Wave {[(ByteString, ByteString)]
Word32
Word64
Set SpeakerPosition
SampleFormat
WaveFormat
waveOtherChunks :: [(ByteString, ByteString)]
waveSamplesTotal :: Word64
waveDataSize :: Word64
waveDataOffset :: Word32
waveChannelMask :: Set SpeakerPosition
waveSampleFormat :: SampleFormat
waveSampleRate :: Word32
waveFileFormat :: WaveFormat
waveOtherChunks :: Wave -> [(ByteString, ByteString)]
waveSamplesTotal :: Wave -> Word64
waveDataSize :: Wave -> Word64
waveDataOffset :: Wave -> Word32
waveChannelMask :: Wave -> Set SpeakerPosition
waveSampleFormat :: Wave -> SampleFormat
waveSampleRate :: Wave -> Word32
waveFileFormat :: Wave -> WaveFormat
..} = Put -> ByteString
S.runPut forall a b. (a -> b) -> a -> b
$ do
  let extensible :: Bool
extensible = Wave -> Bool
isExtensibleFmt Wave
wave
      fmt :: Word16
fmt = case SampleFormat
waveSampleFormat of
        SampleFormatPcmInt Word16
_ -> Word16
waveFormatPcm
        SampleFormat
SampleFormatIeeeFloat32Bit -> Word16
waveFormatIeeeFloat
        SampleFormat
SampleFormatIeeeFloat64Bit -> Word16
waveFormatIeeeFloat
      bps :: Word16
bps = Wave -> Word16
waveBitsPerSample Wave
wave
  Putter Word16
S.putWord16le (if Bool
extensible then Word16
waveFormatExtensible else Word16
fmt)
  Putter Word16
S.putWord16le (Wave -> Word16
waveChannels Wave
wave)
  Putter Word32
S.putWord32le Word32
waveSampleRate
  Putter Word32
S.putWord32le (Wave -> Word32
waveByteRate Wave
wave)
  Putter Word16
S.putWord16le (Wave -> Word16
waveBlockAlign Wave
wave)
  Putter Word16
S.putWord16le (Word16 -> Word16
roundBitsPerSample Word16
bps)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
extensible forall a b. (a -> b) -> a -> b
$ do
    Putter Word16
S.putWord16le Word16
22
    Putter Word16
S.putWord16le Word16
bps
    Putter Word32
S.putWord32le (Set SpeakerPosition -> Word32
toSpeakerMask Set SpeakerPosition
waveChannelMask)
    Putter ByteString
S.putByteString forall a b. (a -> b) -> a -> b
$ case SampleFormat
waveSampleFormat of
      SampleFormatPcmInt Word16
_ -> ByteString
ksdataformatSubtypePcm
      SampleFormat
SampleFormatIeeeFloat32Bit -> ByteString
ksdataformatSubtypeIeeeFloat
      SampleFormat
SampleFormatIeeeFloat64Bit -> ByteString
ksdataformatSubtypeIeeeFloat

-- | Render the fact chunk as a strict 'ByteString'.
renderFactChunk :: Word32 -> ByteString
renderFactChunk :: Word32 -> ByteString
renderFactChunk = Put -> ByteString
S.runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter Word32
S.putWord32le

-- | Write a RIFF 'Chunk'. It's the responsibility of the programmer to
-- 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 :: Handle -> Chunk (Either (Handle -> IO ())) -> IO ()
writeChunk Handle
h Chunk {Word32
Either (Handle -> IO ()) ByteString
ByteString
chunkBody :: Either (Handle -> IO ()) ByteString
chunkSize :: Word32
chunkTag :: ByteString
chunkBody :: forall (m :: * -> *). Chunk m -> m ByteString
chunkSize :: forall (m :: * -> *). Chunk m -> Word32
chunkTag :: forall (m :: * -> *). Chunk m -> ByteString
..} = do
  let bytes :: ByteString
bytes = Put -> ByteString
S.runPut forall a b. (a -> b) -> a -> b
$ do
        Putter ByteString
S.putByteString (Int -> ByteString -> ByteString
B.take Int
4 forall a b. (a -> b) -> a -> b
$ ByteString
chunkTag forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
B.replicate Int
4 Word8
0x00)
        Putter Word32
S.putWord32le Word32
chunkSize
  Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
bytes
  case Either (Handle -> IO ()) ByteString
chunkBody of
    Left Handle -> IO ()
action -> Handle -> IO ()
action Handle
h
    Right ByteString
body -> Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
body

----------------------------------------------------------------------------
-- Helpers

-- | Pulse-code modulation, vanilla WAVE.
waveFormatPcm :: Word16 -- WAVE_FORMAT_PCM
waveFormatPcm :: Word16
waveFormatPcm = Word16
0x0001

-- | IEEE floats, 32 bit floating point samples.
waveFormatIeeeFloat :: Word16 -- WAVE_FORMAT_IEEE_FLOAT
waveFormatIeeeFloat :: Word16
waveFormatIeeeFloat = Word16
0x0003

-- | Extensible format type.
waveFormatExtensible :: Word16
waveFormatExtensible :: Word16
waveFormatExtensible = Word16
0xfffe -- WAVE_FORMAT_EXTENSIBLE

-- | GUID for extensible format chunk corresponding to PCM.
ksdataformatSubtypePcm :: ByteString -- KSDATAFORMAT_SUBTYPE_PCM
ksdataformatSubtypePcm :: ByteString
ksdataformatSubtypePcm =
  -- 00000001-0000-0010-8000-00aa00389b71
  ByteString
"\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 :: ByteString
ksdataformatSubtypeIeeeFloat =
  -- 00000003-0000-0010-8000-00aa00389b71
  ByteString
"\x03\x00\x00\x00\x00\x00\x10\x00\x80\x00\x00\xaa\x00\x38\x9b\x71"

-- | 'SpeakerPosition' to corresponding bit flag, as per
-- <https://msdn.microsoft.com/en-us/library/windows/desktop/dd390971(v=vs.85).aspx>.
speakerToFlag :: SpeakerPosition -> Word32
speakerToFlag :: SpeakerPosition -> Word32
speakerToFlag SpeakerPosition
SpeakerFrontLeft = Word32
0x1
speakerToFlag SpeakerPosition
SpeakerFrontRight = Word32
0x2
speakerToFlag SpeakerPosition
SpeakerFrontCenter = Word32
0x4
speakerToFlag SpeakerPosition
SpeakerLowFrequency = Word32
0x8
speakerToFlag SpeakerPosition
SpeakerBackLeft = Word32
0x10
speakerToFlag SpeakerPosition
SpeakerBackRight = Word32
0x20
speakerToFlag SpeakerPosition
SpeakerFrontLeftOfCenter = Word32
0x40
speakerToFlag SpeakerPosition
SpeakerFrontRightOfCenter = Word32
0x80
speakerToFlag SpeakerPosition
SpeakerBackCenter = Word32
0x100
speakerToFlag SpeakerPosition
SpeakerSideLeft = Word32
0x200
speakerToFlag SpeakerPosition
SpeakerSideRight = Word32
0x400
speakerToFlag SpeakerPosition
SpeakerTopCenter = Word32
0x800
speakerToFlag SpeakerPosition
SpeakerTopFrontLeft = Word32
0x1000
speakerToFlag SpeakerPosition
SpeakerTopFrontCenter = Word32
0x2000
speakerToFlag SpeakerPosition
SpeakerTopFrontRight = Word32
0x4000
speakerToFlag SpeakerPosition
SpeakerTopBackLeft = Word32
0x8000
speakerToFlag SpeakerPosition
SpeakerTopBackCenter = Word32
0x10000
speakerToFlag SpeakerPosition
SpeakerTopBackRight = Word32
0x20000

-- | Get speaker mask from a 'Set' of 'SpeakerPosition's.
toSpeakerMask :: Set SpeakerPosition -> Word32
toSpeakerMask :: Set SpeakerPosition -> Word32
toSpeakerMask = forall a b. (a -> b -> a) -> a -> Set b -> a
E.foldl' forall a. Bits a => a -> a -> a
(.|.) Word32
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> Set a -> Set b
E.map SpeakerPosition -> Word32
speakerToFlag

-- | Transform a 4-byte mask into a set of 'SpeakerPosition's.
fromSpeakerMask :: Word32 -> Set SpeakerPosition
fromSpeakerMask :: Word32 -> Set SpeakerPosition
fromSpeakerMask Word32
channelMask = forall a. Ord a => [a] -> Set a
E.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SpeakerPosition -> Maybe SpeakerPosition
f [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
  where
    f :: SpeakerPosition -> Maybe SpeakerPosition
f SpeakerPosition
sp =
      if SpeakerPosition -> Word32
speakerToFlag SpeakerPosition
sp forall a. Bits a => a -> a -> a
.&. Word32
channelMask forall a. Ord a => a -> a -> Bool
> Word32
0
        then forall a. a -> Maybe a
Just SpeakerPosition
sp
        else forall a. Maybe a
Nothing

-- | Get the default speaker set for a given number of channels.
defaultSpeakerSet :: Word16 -> Set SpeakerPosition
defaultSpeakerSet :: Word16 -> Set SpeakerPosition
defaultSpeakerSet Word16
n = case Word16
n of
  Word16
0 -> forall a. Set a
E.empty
  Word16
1 -> Set SpeakerPosition
speakerMono
  Word16
2 -> Set SpeakerPosition
speakerStereo
  Word16
3 -> forall a. Ord a => [a] -> Set a
E.fromList [SpeakerPosition
SpeakerFrontLeft, SpeakerPosition
SpeakerFrontRight, SpeakerPosition
SpeakerFrontCenter]
  Word16
4 -> Set SpeakerPosition
speakerQuad
  Word16
5 -> forall a. Ord a => a -> Set a -> Set a
E.insert SpeakerPosition
SpeakerFrontCenter Set SpeakerPosition
speakerQuad
  Word16
6 -> Set SpeakerPosition
speaker5_1
  Word16
7 -> forall a. Ord a => a -> Set a -> Set a
E.insert SpeakerPosition
SpeakerBackCenter Set SpeakerPosition
speaker5_1Surround
  Word16
8 -> Set SpeakerPosition
speaker7_1Surround
  Word16
x -> forall a. Ord a => [a] -> Set a
E.fromList forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x) [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

-- | Does this 'Wave' record require an extensible format chunk to be used?
isExtensibleFmt :: Wave -> Bool
isExtensibleFmt :: Wave -> Bool
isExtensibleFmt wave :: Wave
wave@Wave {[(ByteString, ByteString)]
Word32
Word64
Set SpeakerPosition
SampleFormat
WaveFormat
waveOtherChunks :: [(ByteString, ByteString)]
waveSamplesTotal :: Word64
waveDataSize :: Word64
waveDataOffset :: Word32
waveChannelMask :: Set SpeakerPosition
waveSampleFormat :: SampleFormat
waveSampleRate :: Word32
waveFileFormat :: WaveFormat
waveOtherChunks :: Wave -> [(ByteString, ByteString)]
waveSamplesTotal :: Wave -> Word64
waveDataSize :: Wave -> Word64
waveDataOffset :: Wave -> Word32
waveChannelMask :: Wave -> Set SpeakerPosition
waveSampleFormat :: Wave -> SampleFormat
waveSampleRate :: Wave -> Word32
waveFileFormat :: Wave -> WaveFormat
..} =
  Wave -> Word16
waveChannels Wave
wave forall a. Ord a => a -> a -> Bool
> Word16
2
    Bool -> Bool -> Bool
|| Set SpeakerPosition
waveChannelMask forall a. Eq a => a -> a -> Bool
/= Word16 -> Set SpeakerPosition
defaultSpeakerSet (Wave -> Word16
waveChannels Wave
wave)
    Bool -> Bool -> Bool
|| (Wave -> Word16
waveBitsPerSample Wave
wave forall a. Integral a => a -> a -> a
`rem` Word16
8) forall a. Eq a => a -> a -> Bool
/= Word16
0

-- | Determine if the given 'SampleFormat' is not PCM.
isNonPcm :: SampleFormat -> Bool
isNonPcm :: SampleFormat -> Bool
isNonPcm (SampleFormatPcmInt Word16
_) = Bool
False
isNonPcm SampleFormat
SampleFormatIeeeFloat32Bit = Bool
True
isNonPcm SampleFormat
SampleFormatIeeeFloat64Bit = Bool
True

-- | Round bits per sample to the next multiplier of 8, if necessary.
roundBitsPerSample :: Word16 -> Word16
roundBitsPerSample :: Word16 -> Word16
roundBitsPerSample Word16
n = if Word16
r forall a. Eq a => a -> a -> Bool
/= Word16
0 then (Word16
x forall a. Num a => a -> a -> a
+ Word16
1) forall a. Num a => a -> a -> a
* Word16
8 else Word16
n
  where
    (Word16
x, Word16
r) = Word16
n forall a. Integral a => a -> a -> (a, a)
`quotRem` Word16
8

-- | Estimate the total number of samples for a PCM audio stream.
pcmSamplesTotal :: Wave -> Word64
pcmSamplesTotal :: Wave -> Word64
pcmSamplesTotal Wave
wave =
  Wave -> Word64
waveDataSize Wave
wave forall a. Integral a => a -> a -> a
`quot` forall a b. (Integral a, Num b) => a -> b
fromIntegral (Wave -> Word16
waveBlockAlign Wave
wave)