]> gitweb @ CieloNegro.org - wavpack.git/blob - Codec/Audio/WavPack/Metadata.hs
a module for metadata sub-blocks
[wavpack.git] / Codec / Audio / WavPack / Metadata.hs
1 {-# LANGUAGE
2     ExistentialQuantification
3   , UnicodeSyntax
4   #-}
5 -- | WavPack metadata sub-blocks
6 module Codec.Audio.WavPack.Metadata
7     ( Metadata(..)
8     , SomeMetadata(..)
9     )
10     where
11 import Data.Binary
12 import Data.Binary.Put
13 import Data.Bits
14 import qualified Data.ByteString.Lazy as L
15 import Data.Typeable
16 import Prelude.Unicode
17
18 class (Binary α, Eq α, Show α, Typeable α) ⇒ Metadata α where
19     metaID   ∷ α → Word8
20     metaSize ∷ α → Word32
21
22     metaSize = fromIntegral ∘ L.length ∘ runPut ∘ put
23
24 data SomeMetadata = ∀α. Metadata α ⇒ SomeMetadata α
25
26 instance Binary SomeMetadata where
27     put (SomeMetadata a)
28         = let size     = metaSize a
29               oddBit   = if odd size   then 0x40 else 0
30               largeBit = if size > 255 then 0x80 else 0
31               idWord   = metaID a .|. oddBit .|. largeBit
32           in
33             do putWord8 idWord
34                fail "FIXME"
35
36     get = fail "FIXME"
37
38 instance Eq SomeMetadata where
39     (SomeMetadata a) == (SomeMetadata b)
40         = Just a ≡ cast b
41
42 instance Show SomeMetadata where
43     show (SomeMetadata a)
44         = show a