3 , ExistentialQuantification
6 -- | WavPack metadata sub-blocks
7 module Codec.Audio.WavPack.Metadata
17 import Data.Binary.Get
18 import Data.Binary.Put
20 import qualified Data.ByteString.Lazy as L
22 import Prelude.Unicode
24 -- | Type class for every metadata sub-blocks.
25 class (Binary α, Eq α, Show α, Typeable α) ⇒ Metadata α where
26 -- | Get the metadata ID without odd-size bit nor large-block bit
29 -- | Get the size of metadata (optional).
31 metaSize = fromIntegral ∘ L.length ∘ runPut ∘ put
32 -- | Cast a 'SubBlock' to this type of metadata (optional).
33 fromSubBlock ∷ SubBlock → Maybe α
34 fromSubBlock (SubBlock a) = cast a
35 -- | Wrap the metadata into 'SubBlock' (optional).
36 toSubBlock ∷ α → SubBlock
39 -- | An opaque sub-block container.
40 data SubBlock = ∀α. Metadata α ⇒ SubBlock α
43 instance Metadata SubBlock where
44 metaID (SubBlock a) = metaID a
45 metaSize (SubBlock a) = metaSize a
49 instance Binary SubBlock where
51 = let size = metaSize a
52 oddBit = if odd size then 0x40 else 0
53 largeBit = if size > 255 then 0x80 else 0
54 idWord = metaID a .|. oddBit .|. largeBit
58 -- Don't forget about the endianness.
59 do putWord8 $ fromIntegral $ (size `shiftR` 1) .&. 0xFF
60 putWord8 $ fromIntegral $ (size `shiftR` 9) .&. 0xFF
61 putWord8 $ fromIntegral $ (size `shiftR` 17) .&. 0xFF
63 putWord8 $ fromIntegral $ (size `shiftR` 1) .&. 0xFF
65 when (odd size) $ putWord8 0
67 get = do idWord ← getWord8
68 let isOdd = idWord .&. 0x40 ≢ 0
69 isLarge = idWord .&. 0x80 ≢ 0
70 rawID = idWord .&. (complement 0x40) .&. (complement 0x80)
71 adj = if isOdd then -1 else 0
72 size ← if isLarge then
76 return $ ( (fromIntegral sz2 `shiftL` 17) .|.
77 (fromIntegral sz1 `shiftL` 9) .|.
78 (fromIntegral sz0 `shiftL` 1)
81 fmap ((+ adj) ∘ (`shiftL` 1) ∘ fromIntegral) getWord8
82 subb ← getLazyByteString $ fromIntegral (size ∷ Word32)
83 return $ runGet (getSubBlock rawID) subb
85 getSubBlock ∷ Word8 → Get SubBlock
86 getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy)
88 = if unknownID .&. 0x20 ≡ 0 then
89 fail ("Unknown WavPack metadata ID: " ⧺ show unknownID)
91 -- It's unknown but optional. We can safely ignore it.
92 fmap (SubBlock ∘ Unknown unknownID) getRemainingLazyByteString
94 instance Eq SubBlock where
95 (SubBlock a) == (SubBlock b)
98 instance Show SubBlock where
99 show (SubBlock a) = show a
101 -- | Dummy metadata to pad WavPack blocks.
104 -- | Must be less than 2^25 bytes long due to the limitation
105 -- of WavPack specification.
108 deriving (Eq, Show, Typeable)
110 instance Metadata Dummy where
114 instance Binary Dummy where
115 put = putLazyByteString ∘ flip L.replicate 0x00 ∘ fromIntegral ∘ dumSize
116 get = fmap (Dummy ∘ fromIntegral) remaining
118 -- | Unknown but optional metadata found in the WavPack block.
121 -- | The ID of this unknown metadata.
123 -- | Raw data; must be less than 2^25 bytes long.
124 , unkData ∷ L.ByteString
126 deriving (Eq, Show, Typeable)
128 instance Metadata Unknown where
130 metaSize = fromIntegral ∘ L.length ∘ unkData
132 instance Binary Unknown where
133 put = putLazyByteString ∘ unkData