3 , ExistentialQuantification
6 -- | WavPack metadata sub-blocks
7 module Codec.Audio.WavPack.Metadata
19 import Data.Binary.Get
20 import Data.Binary.Put
22 import qualified Data.ByteString.Lazy as L
24 import Prelude.Unicode
26 -- | Type class for every metadata sub-blocks.
27 class (Binary α, Eq α, Show α, Typeable α) ⇒ Metadata α where
28 -- | Get the metadata ID without odd-size bit nor large-block bit
31 -- | Get the size of metadata, excluding the metadata header
34 metaSize = fromIntegral ∘ L.length ∘ runPut ∘ put
35 -- | Cast a 'SubBlock' to this type of metadata (optional).
36 fromSubBlock ∷ SubBlock → Maybe α
37 fromSubBlock (SubBlock a) = cast a
38 -- | Wrap the metadata into 'SubBlock' (optional).
39 toSubBlock ∷ α → SubBlock
42 -- | An opaque sub-block container.
43 data SubBlock = ∀α. Metadata α ⇒ SubBlock α
46 instance Metadata SubBlock where
47 metaID (SubBlock a) = metaID a
48 metaSize (SubBlock a) = metaSize a
52 instance Binary SubBlock where
54 = let size = metaSize a
56 oddBit = if odd size then 0x40 else 0
57 largeBit = if size > 0x1FE then 0x80 else 0
58 idWord = metaID a .|. oddBit .|. largeBit
62 -- Don't forget about the endianness.
63 do putWord8 $ fromIntegral $ (size' `shiftR` 1) .&. 0xFF
64 putWord8 $ fromIntegral $ (size' `shiftR` 9) .&. 0xFF
65 putWord8 $ fromIntegral $ (size' `shiftR` 17) .&. 0xFF
67 putWord8 $ fromIntegral $ (size' `shiftR` 1) .&. 0xFF
69 when (odd size) $ putWord8 0
71 get = do idWord ← getWord8
72 let isOdd = idWord .&. 0x40 ≢ 0
73 isLarge = idWord .&. 0x80 ≢ 0
74 rawID = idWord .&. (complement 0x40) .&. (complement 0x80)
75 adj = if isOdd then -1 else 0
76 size ← if isLarge then
80 return $ ( (fromIntegral sz2 `shiftL` 17) .|.
81 (fromIntegral sz1 `shiftL` 9) .|.
82 (fromIntegral sz0 `shiftL` 1)
85 fmap ((+ adj) ∘ (`shiftL` 1) ∘ fromIntegral) getWord8
86 subb ← getLazyByteString $ fromIntegral (size ∷ Word32)
87 return $ runGet (getSubBlock rawID) subb
89 getSubBlock ∷ Word8 → Get SubBlock
90 getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy)
91 getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader)
92 getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer)
94 = if unknownID .&. 0x20 ≡ 0 then
95 fail ("Unknown WavPack metadata ID: " ⧺ show unknownID)
97 -- It's unknown but optional. We can safely ignore it.
98 fmap (SubBlock ∘ Unknown unknownID) getRemainingLazyByteString
100 instance Eq SubBlock where
101 (SubBlock a) == (SubBlock b)
104 instance Show SubBlock where
105 show (SubBlock a) = show a
107 -- | Dummy metadata to pad WavPack blocks.
110 -- | Must be less than 2^25 bytes long due to the limitation
111 -- of WavPack specification.
114 deriving (Eq, Show, Typeable)
116 instance Metadata Dummy where
120 instance Binary Dummy where
121 put = putLazyByteString ∘ flip L.replicate 0x00 ∘ fromIntegral ∘ dumSize
122 get = fmap (Dummy ∘ fromIntegral) remaining
124 -- | RIFF header for .wav files (before audio)
127 riffHeader ∷ L.ByteString
129 deriving (Eq, Show, Typeable)
131 instance Metadata RIFFHeader where
134 instance Binary RIFFHeader where
135 put = putLazyByteString ∘ riffHeader
136 get = fmap RIFFHeader getRemainingLazyByteString
138 -- | RIFF trailer for .wav files (after audio)
141 riffTrailer ∷ L.ByteString
143 deriving (Eq, Show, Typeable)
145 instance Metadata RIFFTrailer where
148 instance Binary RIFFTrailer where
149 put = putLazyByteString ∘ riffTrailer
150 get = fmap RIFFTrailer getRemainingLazyByteString
152 -- | Unknown but optional metadata found in the WavPack block.
155 -- | The ID of this unknown metadata without odd-size bit nor
158 -- | Raw data; must be less than 2^25 bytes long.
159 , unkData ∷ L.ByteString
161 deriving (Eq, Show, Typeable)
163 instance Metadata Unknown where
166 instance Binary Unknown where
167 put = putLazyByteString ∘ unkData