Merge pull request #2 from Quantumplation/hotfix/bugfixes

Hotfix/bugfixes

src/Data/Binary/Succinct/Blob.hs

@@ -1,7 +1,14 @@
 module Data.Binary.Succinct.Blob
   ( Blob(..)
   , runPut
-  , blob
+  -- guts
+  , metaBitCount
+  , shapeBitCount
+  , contentByteCount
+  , inspectMeta
+  , inspectShape
+  , inspectContent
+  , inspectBlob
   ) where
 
 import Control.Monad (replicateM_)
@@ -15,7 +22,9 @@ import Data.ByteString.Lazy as Lazy
 import qualified Data.Vector.Storable as Storable
 import HaskellWorks.Data.BalancedParens.RangeMinMax as BP
 import HaskellWorks.Data.RankSelect.CsPoppy as CsPoppy
+import HaskellWorks.Data.RankSelect.Base.Rank0
 import Data.Vector.Storable.ByteString
+import HaskellWorks.Data.BalancedParens
 
 import Data.Binary.Succinct.Put
 import Data.Binary.Succinct.Orphans ()
@@ -49,20 +58,61 @@ runPutM ma = case unPutM ma' (S 0 0 0 0) of
 runPut :: Put -> Blob
 runPut = snd . runPutM
 
-rank1_ :: Rank1 v => v -> Word64 -> Word64
+rank1_ :: Rank1 v => v -> Int -> Word64
 rank1_ s i
   | i <= 0 = 0
-  | otherwise = rank1 s i
+  | otherwise = rank1 s (fromIntegral i)
 
-access :: Rank1 v => v -> Word64 -> Bool
+rank0_ :: Rank0 v => v -> Int -> Word64
+rank0_ s i
+  | i <= 0 = 0
+  | otherwise = rank0 s (fromIntegral i)
+
+access :: Rank1 v => v -> Int -> Bool
 access s i = toEnum $ fromIntegral $ rank1_ s i - rank1_ s (i - 1)
 
--- currently segfaults
-blob :: Blob -> String
-blob (Blob m s _c) = do
-  i <- [0..fromIntegral $ Storable.length (csPoppyBits m)*64-1]
+-- Compute how many bits the shape index takes up
+--   We use findClose on the first paren to tell us where the last meaningful paren is
+shapeBitCount :: Blob -> Int
+shapeBitCount (Blob _ s _) = case findClose s 1 of
+  Just n -> fromIntegral n
+  Nothing -> 0
+
+-- Compute how many bytes the content takes up
+contentByteCount :: Blob -> Int
+contentByteCount (Blob _ _ c) = Strict.length c
+
+-- Compute how many bits are non-garbage in our meta index
+metaBitCount :: Blob -> Int
+metaBitCount b = contentByteCount b + shapeBitCount b
+
+-- Print out a string of S's and D's, corresponding to Shape or Data, from the meta index
+inspectMeta :: Blob -> String
+inspectMeta b@(Blob m _ _) = do
+  i <- [1..(metaBitCount b)]
+  case access m i of
+    True -> "S"
+    False -> "D"
+
+-- Print out the balanced parentheses representation of our shape index
+inspectShape :: Blob -> String
+inspectShape b@(Blob _ s _) = do
+  i <- [1..(shapeBitCount b)]
+  case access s i of
+    True  -> "("
+    False -> ")"
+
+-- Print out our raw content buffer
+-- Can't figure out how to print strict bytestrings nicely...
+inspectContent :: Blob -> String
+inspectContent (Blob _ _ _) = undefined 
+
+-- Print out a representation of the entire blob, interleaving shape and content
+inspectBlob :: Blob -> String
+inspectBlob b@(Blob m s c) = do
+  i <- [1..(metaBitCount b)]
   case access m i of
-    True -> case access s (rank1_ m i) of
-      False -> "("
-      True -> ")"
-    False -> "D" -- data
+    True  -> case access s (fromIntegral $ rank1_ m i) of
+      True  -> "("
+      False -> ")"
+    False -> "{" ++ show (Strict.index c $ (fromIntegral $ rank0_ m i) - 1) ++ "}"

src/Data/Binary/Succinct/Put.hs

@@ -88,7 +88,7 @@ meta m = PutM $ \(S o1 d1 o2 d2) -> case S.runPutMBuilder (runCoding m go o1 d1)
 
 shape :: Coding S.PutM a -> PutM a
 shape m = PutM $ \(S o1 d1 o2 d2) -> case S.runPutMBuilder (runCoding m go o2 d2) of
-  ((a, o2', d2'), b) -> Result a (S o1 d1 o2' d2') (W b mempty mempty)
+  ((a, o2', d2'), b) -> Result a (S o1 d1 o2' d2') (W mempty b mempty)
   where
     go :: a -> Int -> Word8 -> S.PutM (a, Int, Word8)
     go a o2' d2' = pure (a, o2', d2')
@@ -114,7 +114,7 @@ putParen p = do
   shape $ putLSB p
 
 putParens :: Put -> Put
-putParens p = putParen False *> p <* putParen True
+putParens p = putParen True *> p <* putParen False
 
 put8 :: Word8 -> Put
 put8 w = meta (putLSB False) *> content (putWord8 w)