]> gitweb @ CieloNegro.org - wavpack.git/blobdiff - Codec/Audio/WavPack/BitString.hs
haddock comments
[wavpack.git] / Codec / Audio / WavPack / BitString.hs
index 136ddf8d7672a65fe55a13ec12b7de12e5101612..577e09f220114a978619cf2b40bffc945e03cdf5 100644 (file)
@@ -11,6 +11,7 @@ module Codec.Audio.WavPack.BitString
 
       -- * Construction
     , (∅)
+    , empty
     , singleton
 
       -- * Basic Interface
@@ -49,7 +50,35 @@ data BitString
       , rightBytes ∷ !L.ByteString
       , rightRem   ∷ !Remnant
       }
-    deriving (Eq, Show)
+    deriving Show
+
+-- | /O(n)/ The bitstrings must have finite lengths to test the
+-- equality.
+instance Eq BitString where
+    a == b = leftRem    a' ≡ leftRem    b' ∧
+             leftBytes  a' ≡ leftBytes  b' ∧
+             rightRem   a' ≡ rightRem   b'
+        where
+          a' = normalise a
+          b' = normalise b
+
+normalise ∷ BitString → BitString
+normalise bs
+    | remLen (leftRem bs) ≡ 8
+        = normalise $ bs {
+                        leftRem   = remEmpty
+                      , leftBytes = L.cons (remByte $ leftRem bs) $ leftBytes bs
+                      }
+    | remLen (rightRem bs) ≡ 8
+        = normalise $ bs {
+                        rightBytes = L.cons (remByte $ rightRem bs) $ rightBytes bs
+                      , rightRem   = remEmpty
+                      }
+    | otherwise
+        = bs {
+            leftBytes  = leftBytes bs `L.append` (L.reverse $ rightBytes bs)
+          , rightBytes = L.empty
+          }
 
 data Remnant
     = Remnant {
@@ -94,7 +123,7 @@ consRem b r
                       in
                         (# r', S.Nothing #)
     where
-      w' = (remByte r `shiftR` 1)
+      w' = (remByte r `shiftL` 1)
            .|.
            if b then 1 else 0
 
@@ -115,7 +144,7 @@ snocRem r b
 unconsRem ∷ Remnant → (# S.Maybe Bool, Remnant #)
 unconsRem r
     | remNull r = (# S.Nothing, remEmpty #)
-    | otherwise = let !b  = remByte r `testBit` 1
+    | otherwise = let !b  = remByte r `testBit` 0
                       !r' = Remnant {
                               remLen  = remLen r - 1
                             , remByte = remByte r `shiftR` 1
@@ -153,14 +182,18 @@ splitRemAt n r
     | otherwise
         = (# S.Nothing, remEmpty #)
 
--- | /O(1)/ The empty 'BitString'.
+-- | /O(1)/ The same as 'empty'.
 (∅) ∷ BitString
-(∅) = BitString {
-        leftRem    = remEmpty
-      , leftBytes  = L.empty
-      , rightBytes = L.empty
-      , rightRem   = remEmpty
-      }
+(∅) = empty
+
+-- | /O(1)/ The empty 'BitString'.
+empty ∷ BitString
+empty = BitString {
+          leftRem    = remEmpty
+        , leftBytes  = L.empty
+        , rightBytes = L.empty
+        , rightRem   = remEmpty
+        }
 
 -- | /O(1)/ Convert a 'Bool' into a 'BitString'.
 singleton ∷ Bool → BitString
@@ -250,15 +283,16 @@ uncons bs
 -- | /O(1)/ Test whether a 'BitString' is empty.
 null ∷ BitString → Bool
 null bs
-    = remLen (leftRem bs) ≡ 0
+    = remNull (leftRem bs)
       ∧
       L.null (leftBytes bs)
       ∧
       L.null (rightBytes bs)
       ∧
-      remLen (rightRem bs) ≡ 0
+      remNull (rightRem bs)
 
--- | /O(n)/ Return the number of bits in a 'BitString'.
+-- | /O(n)/ @'length' bs@ returns the number of bits in @bs@. @bs@
+-- must have a finite length.
 length ∷ Integral n ⇒ BitString → n
 length bs
     = fromIntegral $ ( fromIntegral (remLen $ leftRem bs)
@@ -280,16 +314,18 @@ fromByteString bs = BitString {
                     , rightRem   = remEmpty
                     }
 
--- | /O(n)/ Convert a 'BitString' into 'L.ByteString', padding
--- incomplete bytes to single bytes with necessary 0's at their
--- MSB. Thus the following equation does not hold when the length of
--- 'BitString' isn't multiple of 8.
+-- | /O(n)/ @'toByteString' bs@ converts @bs@ into 'L.ByteString',
+-- padding incomplete bytes to single bytes with necessary 0's at
+-- their MSB. Thus the following equation does not hold when the
+-- length of @bs@ isn't multiple of 8.
 --
 -- > fromByteString . toByteString = id
 --
 -- But the following always holds true.
 --
 -- > toByteString . fromByteString = id
+--
+-- Note that @bs@ must have a finite length.
 toByteString ∷ BitString → L.ByteString
 toByteString bs
     = L.concat [ remToStr $ leftRem bs