bits-conduit 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+100/−21 lines, 4 filesdep +criteriondep +randomdep ~basedep ~bytestringdep ~conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, random

Dependency ranges changed: base, bytestring, conduit

API changes (from Hackage documentation)

Files

• Data/Conduit/Bits.hs +36/−17
• bench.hs +47/−0
• bits-conduit.cabal +16/−3
• test.hs +1/−1

@@ -4,6 +4,10 @@   -- * Conduits
   decodeBits,
   encodeBits,
+
+  -- * Functions
+  yieldBits,
+  awaitBits,
   ) where
 
 import Control.Monad
@@ -11,32 +15,47 @@ import qualified Data.ByteString as S
 import Data.Conduit
 import qualified Data.Conduit.Binary as CB
-import Data.Conduit.Internal
 
 -- | Bitstream decoder
-decodeBits :: Monad m => Conduit S.ByteString m Bool
+decodeBits :: Monad m => GLConduit S.ByteString m Bool
 decodeBits = go where
   go = do
-    mb <- sinkToPipe CB.head
+    mb <- CB.head
     case mb of
       Nothing ->
         return ()
       Just b8 -> do
-        forM_ [0..7] $ \i -> yield $ testBit b8 i
+        yieldBits b8 8
         go
 
 -- | Bitstream encoder
-encodeBits :: Monad m => Conduit Bool m S.ByteString
-encodeBits = go 0 0 where
-  go !acc 8 = do
-    yield $ S.singleton acc
-    go 0 0
-  go !acc !i = do
-    mb <- await
+encodeBits :: Monad m => GConduit Bool m S.ByteString
+encodeBits = go where
+  go = do
+    mb <- awaitBits 8
     case mb of
-      Nothing ->
-        when (i > 0) $ yield $ S.singleton acc
-      Just b -> do
-        let n | b = acc `setBit` i
-              | otherwise = acc
-        go n (i+1)
+      Nothing -> return ()
+      Just b8 -> do
+        yield $ S.singleton b8
+        go
+
+-- | Yields specified amount of bits (LSB first)
+yieldBits :: (Bits b, Monad m) => b -> Int -> GSource m Bool
+yieldBits b n =
+  forM_ [0..n-1] $ \i -> yield $ testBit b i
+{-# INLINEABLE yieldBits #-}
+
+-- | await specified amount of bits (LSB first)
+awaitBits :: (Bits b, Monad m) => Int -> GSink Bool m (Maybe b)
+awaitBits n = go 0 0 where
+  go !acc !i
+    | i == n = return $ Just acc
+    | otherwise = do
+      mb <- await
+      case mb of
+        Nothing
+          | i == 0 -> return Nothing
+          | otherwise -> return $ Just acc
+        Just b ->
+          go (if b then acc `setBit` i else acc) (i+1)
+{-# INLINEABLE awaitBits #-}

@@ -0,0 +1,47 @@+import Control.Applicative
+import Control.Monad
+import Criterion.Main
+import qualified Data.ByteString as S
+import Data.Conduit
+import qualified Data.Conduit.List as CL
+import Data.Word
+import System.Random
+
+import Data.Conduit.Bits
+
+encode :: Bool -> Int -> IO ()
+encode b n =
+  replicateM_ n (yield b) =$= encodeBits $$ CL.sinkNull
+
+encodes :: [Bool] -> IO ()
+encodes bs =
+  forM_ bs yield =$= encodeBits $$ CL.sinkNull
+
+decode :: Word8 -> Int -> IO Int
+decode b8 n =
+  yield (S.replicate n b8) =$= decodeBits $$ CL.fold (\a _ -> a + 1) 0
+
+decodes :: S.ByteString  -> IO Int
+decodes bs =
+  yield bs =$= decodeBits $$ CL.fold (\a _ -> a + 1) 0
+
+main :: IO ()
+main = do
+  let size = 100000
+      bsize = size `div` 8
+  rb  <- replicateM size randomIO
+  rbs <- S.pack <$> replicateM bsize randomIO
+
+  defaultMain
+    [ bgroup ("encode/" ++ show size)
+      [ bench "0s" $ whnfIO $ encode False size
+      , bench "1s" $ whnfIO $ encode True  size
+      , bench "Rs" $ whnfIO $ encodes rb
+      ]
+
+    , bgroup ("decode/" ++ show size)
+      [ bench "0s" $ whnfIO $ decode 0x00 bsize
+      , bench "1s" $ whnfIO $ decode 0xFF bsize
+      , bench "Rs" $ whnfIO $ decodes rbs
+      ]
+    ]

@@ -1,5 +1,5 @@ name:                bits-conduit
-version:             0.1.0.0
+version:             0.2.0.0
 synopsis:            Bitstream support for Conduit
 description:         Bitstream support for Conduit
 license:             BSD3
@@ -7,7 +7,7 @@ author:              Hideyuki Tanaka
 maintainer:          Hideyuki Tanaka <tanaka.hideyuki@gmail.com>
 copyright:           (c) 2012, Hideyuki Tanaka
-category:            Data
+category:            Data, Conduit
 build-type:          Simple
 cabal-version:       >=1.8
 
@@ -21,7 +21,7 @@   build-depends:       base       ==4.5.*
                      , mtl        >=2.1
                      , bytestring >=0.9.2
-                     , conduit    >=0.4.2
+                     , conduit    ==0.5.*
 
 test-suite bits-conduit-test
   type:                exitcode-stdio-1.0
@@ -35,4 +35,17 @@ 
                      , hspec
                      , HUnit
+                     , bits-conduit
+
+benchmark bits-conduit-bench
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      dist
+  main-is:             ../bench.hs
+
+  build-depends:       base
+                     , bytestring
+                     , conduit
+                     , random
+
+                     , criterion >=0.6
                      , bits-conduit

@@ -16,7 +16,7 @@ import Data.Conduit.Bits
 
 main :: IO ()
-main = hspecX $ do
+main = hspec $ do
   describe "decoder" $ do
     it "decodes empty sequence" $ do
       a <- yield S.empty =$= decodeBits $$ CL.consume