3 , ExistentialQuantification
6 -- | WavPack metadata sub-blocks
7 module Codec.Audio.WavPack.Metadata
20 import Codec.Audio.WavPack.Internal
23 import Data.Binary.Get
24 import Data.Binary.Put
26 import qualified Data.ByteString.Lazy as L
29 import qualified Data.Vector.Unboxed as UV
30 import Prelude.Unicode
32 -- | Type class for every metadata sub-blocks.
33 class (Binary α, Eq α, Show α, Typeable α) ⇒ Metadata α where
34 -- | Get the metadata ID without odd-size bit nor large-block bit
37 -- | Get the size of metadata, excluding the metadata header
40 metaSize = fromIntegral ∘ L.length ∘ runPut ∘ put
41 -- | Cast a 'SubBlock' to this type of metadata (optional).
42 fromSubBlock ∷ SubBlock → Maybe α
43 fromSubBlock (SubBlock a) = cast a
44 -- | Wrap the metadata into 'SubBlock' (optional).
45 toSubBlock ∷ α → SubBlock
48 -- | An opaque sub-block container.
49 data SubBlock = ∀α. Metadata α ⇒ SubBlock α
52 instance Metadata SubBlock where
53 metaID (SubBlock a) = metaID a
54 metaSize (SubBlock a) = metaSize a
58 instance Binary SubBlock where
60 = let size = metaSize a
62 oddBit = if odd size then 0x40 else 0
63 largeBit = if size > 0x1FE then 0x80 else 0
64 idWord = metaID a .|. oddBit .|. largeBit
68 -- Don't forget about the endianness.
69 do putWord8 $ fromIntegral $ (size' `shiftR` 1) .&. 0xFF
70 putWord8 $ fromIntegral $ (size' `shiftR` 9) .&. 0xFF
71 putWord8 $ fromIntegral $ (size' `shiftR` 17) .&. 0xFF
73 putWord8 $ fromIntegral $ (size' `shiftR` 1) .&. 0xFF
75 when (odd size) $ putWord8 0
77 get = do idWord ← getWord8
78 let isOdd = idWord .&. 0x40 ≢ 0
79 isLarge = idWord .&. 0x80 ≢ 0
80 rawID = idWord .&. (complement 0x40) .&. (complement 0x80)
81 adj = if isOdd then -1 else 0
82 size ← if isLarge then
86 return $ ( (fromIntegral sz2 `shiftL` 17) .|.
87 (fromIntegral sz1 `shiftL` 9) .|.
88 (fromIntegral sz0 `shiftL` 1)
91 fmap ((+ adj) ∘ (`shiftL` 1) ∘ fromIntegral) getWord8
92 subb ← getLazyByteString $ fromIntegral (size ∷ Word32)
93 return $ runGet (getSubBlock rawID) subb
95 getSubBlock ∷ Word8 → Get SubBlock
96 getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy )
97 getSubBlock 0x02 = fmap SubBlock (get ∷ Get DecorrTerms )
98 getSubBlock 0x03 = fmap SubBlock (get ∷ Get DecorrWeights)
99 getSubBlock 0x04 = fmap SubBlock (get ∷ Get DecorrSamples)
100 getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader )
101 getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer )
102 getSubBlock unknownID
103 = if unknownID .&. 0x20 ≡ 0 then
104 fail ("Unknown WavPack metadata ID: " ⧺ show unknownID)
106 -- It's unknown but optional. We can safely ignore it.
107 fmap (SubBlock ∘ Unknown unknownID) getRemainingLazyByteString
109 instance Eq SubBlock where
110 (SubBlock a) == (SubBlock b)
113 instance Show SubBlock where
114 show (SubBlock a) = show a
116 -- | Dummy metadata to pad WavPack blocks.
119 -- | Must be less than 2^25 bytes long due to the limitation
120 -- of WavPack specification.
123 deriving (Eq, Show, Typeable)
125 instance Metadata Dummy where
129 instance Binary Dummy where
130 put = putLazyByteString ∘ flip L.replicate 0x00 ∘ fromIntegral ∘ dumSize
131 get = fmap (Dummy ∘ fromIntegral) remaining
133 -- | Decorrelation terms and deltas.
136 -- | @[ (term, delta) ]@
137 dectVec ∷ !(UV.Vector (Int8, Int8))
139 deriving (Eq, Show, Typeable)
141 instance Metadata DecorrTerms where
143 metaSize = fromIntegral ∘ UV.length ∘ dectVec
145 instance Binary DecorrTerms where
146 put = UV.mapM_ (putWord8 ∘ packDT) ∘ dectVec
148 packDT ∷ (Int8, Int8) → Word8
150 = fromIntegral ( (term + 5 .&. 0x1F)
152 ((δ `shiftL` 5) .&. 0xE0)
154 get = do n ← remaining
155 vec ← UV.replicateM (fromIntegral n) $ fmap unpackDT getWord8
156 -- THINKME: unpack.c(read_decorr_terms) reverses the
157 -- order only when they are decoding. I don't know why so
158 -- I leave it unreversed for now.
159 return $ DecorrTerms vec
161 unpackDT ∷ Word8 → (Int8, Int8)
163 = let term = (fromIntegral $ w .&. 0x1F) - 5
164 δ = fromIntegral $ (w `shiftR` 5) .&. 0x07
168 -- | Decorrelation weights.
171 -- | For mono blocks, this is a weight vector for the single
172 -- channel. For stereo blocks, it's interleaved as A, B, A, B,
174 decwVec ∷ !(UV.Vector Int16)
176 deriving (Eq, Show, Typeable)
178 instance Metadata DecorrWeights where
180 metaSize = fromIntegral ∘ UV.length ∘ decwVec
182 instance Binary DecorrWeights where
183 put = UV.mapM_ (putWord8 ∘ packWeight) ∘ decwVec
184 get = do n ← remaining
185 vec ← UV.replicateM (fromIntegral n)
186 $ fmap unpackWeight getWord8
187 -- THINKME: the same caution as DecorrTerms, but never
188 -- try to simply reverse the vector. Think about the
190 return $ DecorrWeights vec
192 -- | Decorrelation samples
195 -- | The decorrelation sample vector stored in the metadata
196 -- as-is. Actual interpretation of the vector depends on the
197 -- number of channels and each corresponding decorrelation
199 decsVec ∷ !(UV.Vector Int32)
201 deriving (Eq, Show, Typeable)
203 instance Metadata DecorrSamples where
205 metaSize = fromIntegral ∘ (⋅ 2) ∘ UV.length ∘ decsVec
207 instance Binary DecorrSamples where
208 put = UV.mapM_ (putWord16le ∘ fromIntegral ∘ log2s) ∘ decsVec
209 get = do n ← remaining
210 vec ← UV.replicateM (fromIntegral $ n `div` 2)
211 $ fmap (exp2s ∘ fromIntegral) getWord16le
212 return $ DecorrSamples vec
214 -- | RIFF header for .wav files (before audio)
217 riffHeader ∷ L.ByteString
219 deriving (Eq, Show, Typeable)
221 instance Metadata RIFFHeader where
224 instance Binary RIFFHeader where
225 put = putLazyByteString ∘ riffHeader
226 get = fmap RIFFHeader getRemainingLazyByteString
228 -- | RIFF trailer for .wav files (after audio)
231 riffTrailer ∷ L.ByteString
233 deriving (Eq, Show, Typeable)
235 instance Metadata RIFFTrailer where
238 instance Binary RIFFTrailer where
239 put = putLazyByteString ∘ riffTrailer
240 get = fmap RIFFTrailer getRemainingLazyByteString
242 -- | Unknown but optional metadata found in the WavPack block.
245 -- | The ID of this unknown metadata without odd-size bit nor
248 -- | Raw data; must be less than 2^25 bytes long.
249 , unkData ∷ L.ByteString
251 deriving (Eq, Show, Typeable)
253 instance Metadata Unknown where
256 instance Binary Unknown where
257 put = putLazyByteString ∘ unkData
258 get = error "unsupported operation"