bits-conduit (empty) → 0.1.0.0

raw patch · 5 files changed

+158/−0 lines, 5 filesdep +HUnitdep +basedep +bits-conduitsetup-changed

Dependencies added: HUnit, base, bits-conduit, bytestring, conduit, hspec, mtl

Files

Data/Conduit/Bits.hs +42/−0
LICENSE +30/−0
Setup.hs +2/−0
bits-conduit.cabal +38/−0
test.hs +46/−0

+ Data/Conduit/Bits.hs view

@@ -0,0 +1,42 @@+{-# LANGUAGE BangPatterns #-}
+
+module Data.Conduit.Bits (
+  -- * Conduits
+  decodeBits,
+  encodeBits,
+  ) where
+
+import Control.Monad
+import Data.Bits
+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 = go where
+  go = do
+    mb <- sinkToPipe CB.head
+    case mb of
+      Nothing ->
+        return ()
+      Just b8 -> do
+        forM_ [0..7] $ \i -> yield $ testBit b8 i
+        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
+    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)

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2012, Hideyuki Tanaka
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Hideyuki Tanaka nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ bits-conduit.cabal view

@@ -0,0 +1,38 @@+name:                bits-conduit
+version:             0.1.0.0
+synopsis:            Bitstream support for Conduit
+description:         Bitstream support for Conduit
+license:             BSD3
+license-file:        LICENSE
+author:              Hideyuki Tanaka
+maintainer:          Hideyuki Tanaka <tanaka.hideyuki@gmail.com>
+copyright:           (c) 2012, Hideyuki Tanaka
+category:            Data
+build-type:          Simple
+cabal-version:       >=1.8
+
+source-repository head
+  type:                git
+  location:            https://github.com/tanakh/bits-conduit.git
+
+library
+  exposed-modules:     Data.Conduit.Bits
+
+  build-depends:       base       ==4.5.*
+                     , mtl        >=2.1
+                     , bytestring >=0.9.2
+                     , conduit    >=0.4.2
+
+test-suite bits-conduit-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      dist
+  main-is:             ../test.hs
+
+  build-depends:       base
+                     , mtl
+                     , bytestring
+                     , conduit
+
+                     , hspec
+                     , HUnit
+                     , bits-conduit

+ test.hs view

@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
+
+import Control.Monad.Identity
+import Data.Bits
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import Data.Conduit
+import qualified Data.Conduit.Binary as CB
+import qualified Data.Conduit.List as CL
+import Data.Word
+import Test.Hspec.HUnit ()
+import Test.Hspec.QuickCheck
+import Test.Hspec.Monadic
+import Test.HUnit
+
+import Data.Conduit.Bits
+
+main :: IO ()
+main = hspecX $ do
+  describe "decoder" $ do
+    it "decodes empty sequence" $ do
+      a <- yield S.empty =$= decodeBits $$ CL.consume
+      [] @=? a
+
+    prop "decodes bits" $ \bs ->
+      let a = runIdentity $ yield (S.pack bs) =$= decodeBits $$ CL.consume
+      in decodeNaive bs == a
+
+  describe "encoder" $ do
+    it "encodes empty sequence" $ do
+      a <- CL.sourceNull =$= encodeBits $$ CB.take maxBound
+      L.empty @=? a
+
+    prop "encodes bits" $ \bs ->
+      let a = runIdentity $ CL.sourceList bs =$= encodeBits $$ CB.take maxBound
+      in L.pack (encodeNaive bs) == a
+
+decodeNaive :: [Word8] -> [Bool]
+decodeNaive = concatMap f where
+  f c = map (\i -> testBit c i) [0..7 :: Int]
+
+encodeNaive :: [Bool] -> [Word8]
+encodeNaive [] = []
+encodeNaive (splitAt 8 -> (cur, next)) =
+  let c = foldl (.|.) 0 (zipWith (\i b -> if b then bit i else 0) [0..] cur)
+  in c : encodeNaive next