findNextBlock

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

diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
index edf76f25093b9afea31f71bdb2839725d73a2b79..77901f445aedf505ab7e4ce117ae026ebdd147c7 100644 (file)
--- a/Codec/Audio/WavPack/Metadata.hs
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -6,7 +6,7 @@
 -- | WavPack metadata sub-blocks
 module Codec.Audio.WavPack.Metadata
     ( Metadata(..)
 -- | WavPack metadata sub-blocks
 module Codec.Audio.WavPack.Metadata
     ( Metadata(..)

-    , SubBlock(..)
+    , SubBlock

 
     , Dummy(..)
     , Unknown(..)
 
     , Dummy(..)
     , Unknown(..)


@@ -21,29 +21,48 @@ import qualified Data.ByteString.Lazy as L
 import Data.Typeable
 import Prelude.Unicode
 
 import Data.Typeable
 import Prelude.Unicode
 

+-- | Type class for every metadata sub-blocks.

 class (Binary α, Eq α, Show α, Typeable α) ⇒ Metadata α where
 class (Binary α, Eq α, Show α, Typeable α) ⇒ Metadata α where

+    -- | Get the metadata ID without odd-size bit nor large-block bit
+    -- (mandatory).

     metaID   ∷ α → Word8
     metaID   ∷ α → Word8

+    -- | Get the size of metadata, excluding the metadata header
+    -- (optional).

     metaSize ∷ α → Word32
     metaSize ∷ α → Word32

-

     metaSize = fromIntegral ∘ L.length ∘ runPut ∘ put
     metaSize = fromIntegral ∘ L.length ∘ runPut ∘ put

+    -- | Cast a 'SubBlock' to this type of metadata (optional).
+    fromSubBlock ∷ SubBlock → Maybe α
+    fromSubBlock (SubBlock a) = cast a
+    -- | Wrap the metadata into 'SubBlock' (optional).
+    toSubBlock ∷ α → SubBlock
+    toSubBlock = SubBlock

 
 

+-- | An opaque sub-block container.

 data SubBlock = ∀α. Metadata α ⇒ SubBlock α
 data SubBlock = ∀α. Metadata α ⇒ SubBlock α

+                deriving Typeable
+
+instance Metadata SubBlock where
+    metaID   (SubBlock a) = metaID a
+    metaSize (SubBlock a) = metaSize a
+    fromSubBlock = Just
+    toSubBlock   = id

 
 instance Binary SubBlock where
     put (SubBlock a)
         = let size     = metaSize a
 
 instance Binary SubBlock where
     put (SubBlock a)
         = let size     = metaSize a

-              oddBit   = if odd size   then 0x40 else 0
-              largeBit = if size > 255 then 0x80 else 0
+              size'    = size + 1
+              oddBit   = if odd size     then 0x40 else 0
+              largeBit = if size > 0x1FE then 0x80 else 0

               idWord   = metaID a .|. oddBit .|. largeBit
           in
             do putWord8 idWord
               idWord   = metaID a .|. oddBit .|. largeBit
           in
             do putWord8 idWord

-               if size > 255 then
+               if size > 0x1FE then

                    -- Don't forget about the endianness.
                    -- Don't forget about the endianness.

-                   do putWord8 $ fromIntegral $ (size `shiftR`  1) .&. 0xFF
-                      putWord8 $ fromIntegral $ (size `shiftR`  9) .&. 0xFF
-                      putWord8 $ fromIntegral $ (size `shiftR` 17) .&. 0xFF
+                   do putWord8 $ fromIntegral $ (size' `shiftR`  1) .&. 0xFF
+                      putWord8 $ fromIntegral $ (size' `shiftR`  9) .&. 0xFF
+                      putWord8 $ fromIntegral $ (size' `shiftR` 17) .&. 0xFF

                  else
                  else

-                      putWord8 $ fromIntegral $ (size `shiftR`  1) .&. 0xFF
+                      putWord8 $ fromIntegral $ (size' `shiftR`  1) .&. 0xFF

                put a
                when (odd size) $ putWord8 0
 
                put a
                when (odd size) $ putWord8 0
 


@@ -84,7 +103,9 @@ instance Show SubBlock where
 -- | Dummy metadata to pad WavPack blocks.
 data Dummy
     = Dummy {
 -- | Dummy metadata to pad WavPack blocks.
 data Dummy
     = Dummy {

-        dumSize ∷ !Word32
+        -- | Must be less than 2^25 bytes long due to the limitation
+        -- of WavPack specification.
+        dumSize ∷ Word32

       }
     deriving (Eq, Show, Typeable)
 
       }
     deriving (Eq, Show, Typeable)
 


@@ -99,7 +120,10 @@ instance Binary Dummy where
 -- | Unknown but optional metadata found in the WavPack block.
 data Unknown
     = Unknown {
 -- | Unknown but optional metadata found in the WavPack block.
 data Unknown
     = Unknown {

-        unkID   ∷ !Word8
+        -- | The ID of this unknown metadata without odd-size bit nor
+        -- large-block bit.
+        unkID   ∷ Word8
+        -- | Raw data; must be less than 2^25 bytes long.

       , unkData ∷ L.ByteString
       }
     deriving (Eq, Show, Typeable)
       , unkData ∷ L.ByteString
       }
     deriving (Eq, Show, Typeable)