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