a module for metadata sub-blocks

[wavpack.git] / Codec / Audio / WavPack / Metadata.hs

diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
new file mode 100644 (file)
index 0000000..4f98703
--- /dev/null
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE
+    ExistentialQuantification
+  , UnicodeSyntax
+  #-}
+-- | WavPack metadata sub-blocks
+module Codec.Audio.WavPack.Metadata
+    ( Metadata(..)
+    , SomeMetadata(..)
+    )
+    where
+import Data.Binary
+import Data.Binary.Put
+import Data.Bits
+import qualified Data.ByteString.Lazy as L
+import Data.Typeable
+import Prelude.Unicode
+
+class (Binary α, Eq α, Show α, Typeable α) ⇒ Metadata α where
+    metaID   ∷ α → Word8
+    metaSize ∷ α → Word32
+
+    metaSize = fromIntegral ∘ L.length ∘ runPut ∘ put
+
+data SomeMetadata = ∀α. Metadata α ⇒ SomeMetadata α
+
+instance Binary SomeMetadata where
+    put (SomeMetadata a)
+        = let size     = metaSize a
+              oddBit   = if odd size   then 0x40 else 0
+              largeBit = if size > 255 then 0x80 else 0
+              idWord   = metaID a .|. oddBit .|. largeBit
+          in
+            do putWord8 idWord
+               fail "FIXME"
+
+    get = fail "FIXME"
+
+instance Eq SomeMetadata where
+    (SomeMetadata a) == (SomeMetadata b)
+        = Just a ≡ cast b
+
+instance Show SomeMetadata where
+    show (SomeMetadata a)
+        = show a