bitstream 0.2.0.1 → 0.2.0.2
raw patch · 14 files changed
+855/−57 lines, 14 filesdep ~QuickCheckdep ~vector
Dependency ranges changed: QuickCheck, vector
Files
- AUTHORS +5/−0
- COPYING +5/−28
- ChangeLog +0/−9
- Data/Bitstream.hs +2/−2
- Data/Bitstream/Fusion.hs +1/−1
- Data/Bitstream/Fusion/Monadic.hs +1/−1
- Data/Bitstream/Generic.hs +2/−2
- Data/Bitstream/Lazy.hs +2/−1
- Data/Bitstream/Packet.hs +3/−3
- NEWS +25/−0
- Test/Bitstream.hs +337/−0
- Test/Bitstream/Lazy.hs +348/−0
- Test/Bitstream/Utils.hs +113/−0
- bitstream.cabal +11/−10
+ AUTHORS view
@@ -0,0 +1,5 @@+This is the list of contributors to the bitstream package:++* Mark Wotton <mwotton@gmail.com>+* Jaap ter Woerds <jaap.ter.woerds@gmail.com>+* PHO <pho@cielonegro.org>
COPYING view
@@ -1,29 +1,6 @@-<!-- -*- xml -*---Haskell のパッケージ "bitstream" はパブリックドメインに在ります。-The Haskell package "bitstream" is in the public domain.--See http://creativecommons.org/licenses/publicdomain/---->--<rdf:RDF xmlns="http://web.resource.org/cc/"- xmlns:dc="http://purl.org/dc/elements/1.1/"- xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">- <Work rdf:about="http://cielonegro.org/Bitstream.html">- <dc:title>bitstream</dc:title>- <dc:rights>- <Agent>- <dc:title>PHO</dc:title>- </Agent>- </dc:rights>- <license rdf:resource="http://web.resource.org/cc/PublicDomain" />- </Work>- - <License rdf:about="http://web.resource.org/cc/PublicDomain">- <permits rdf:resource="http://web.resource.org/cc/Reproduction" />- <permits rdf:resource="http://web.resource.org/cc/Distribution" />- <permits rdf:resource="http://web.resource.org/cc/DerivativeWorks" />- </License>+To the extent possible under law, PHO the author has waived all+copyright and related or neighboring rights to the bistream+package. This work is published from Japan. -</rdf:RDF>+For more information, see:+http://creativecommons.org/publicdomain/zero/1.0/
− ChangeLog
@@ -1,9 +0,0 @@-== bitstream-0.2.0.1 / 2011-08-26-* bugfix: build failure on GHC 7.2.1--== bitstream-0.2 / 2011-07-08-* bugfix: Make stream fusion actually work-* Implement fromBits / toBits-* Strict Bitstreams' bit length should only be a hint, just like stream size.-* Strict Bitstream should keep bit-length maintained-* Strict bitstrems should use unstreamPackets instead of hand-written unfoldr-based unstreamers.
Data/Bitstream.hs view
@@ -576,7 +576,7 @@ strictOr (Bitstream _ v) = SV.any or v -strictIndex ∷ (G.Bitstream (Packet d), Integral n) ⇒ Bitstream d → n → Bool+strictIndex ∷ (G.Bitstream (Packet d), Integral n, Show n) ⇒ Bitstream d → n → Bool {-# RULES "(!!) → strictIndex" [1] ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d) n. v !! n = strictIndex v n #-}@@ -597,7 +597,7 @@ = error "Data.Bitstream: empty stream" {-# INLINE indexOutOfRange #-}-indexOutOfRange ∷ Integral n ⇒ n → α+indexOutOfRange ∷ (Integral n, Show n) ⇒ n → α indexOutOfRange n = error ("Data.Bitstream: index out of range: " L.++ show n) -- | /O(n)/ Convert a strict 'BS.ByteString' into a strict
Data/Bitstream/Fusion.hs view
@@ -32,7 +32,7 @@ {-# INLINE genericDrop #-} genericDrop = M.genericDrop -genericIndex ∷ Integral n ⇒ Stream α → n → α+genericIndex ∷ (Integral n, Show n) ⇒ Stream α → n → α {-# INLINE genericIndex #-} genericIndex s = unId ∘ M.genericIndex s
Data/Bitstream/Fusion/Monadic.hs view
@@ -66,7 +66,7 @@ Skip s' → return $ Skip (s', Nothing) Done → return Done -genericIndex ∷ (Monad m, Integral n) ⇒ Stream m α → n → m α+genericIndex ∷ (Monad m, Integral n, Show n) ⇒ Stream m α → n → m α {-# INLINE [0] genericIndex #-} {-# RULES "genericIndex → (!!)" genericIndex = (!!) #-} genericIndex (Stream step s0 _) i0
Data/Bitstream/Generic.hs view
@@ -123,7 +123,7 @@ import Data.Maybe import Data.Vector.Fusion.Stream (Stream) import qualified Data.Vector.Fusion.Stream as S-import Prelude ( Bool(..), Integer, Integral(..), Num(..), ($)+import Prelude ( Bool(..), Integer, Integral(..), Num(..), Show(..), ($) , fst, flip, otherwise, snd ) import Prelude.Unicode hiding ((∈), (∉), (⧺))@@ -771,7 +771,7 @@ partition = basicPartition -- | /O(n)/ 'Bitstream' index (subscript) operator, starting from 0.-(!!) ∷ (Bitstream α, Integral n) ⇒ α → n → Bool+(!!) ∷ (Bitstream α, Integral n, Show n) ⇒ α → n → Bool {-# RULES "Bitstream (!!)/unstream fusion" ∀s n. (unstream s) !! n = genericIndex s n #-}
Data/Bitstream/Lazy.hs view
@@ -595,6 +595,7 @@ lazyIndex ∷ ( G.Bitstream (SB.Bitstream d) , Integral n+ , Show n ) ⇒ Bitstream d → n@@ -618,7 +619,7 @@ = error "Data.Bitstream.Lazy: empty stream" {-# INLINE indexOutOfRange #-}-indexOutOfRange ∷ Integral n ⇒ n → α+indexOutOfRange ∷ (Integral n, Show n) ⇒ n → α indexOutOfRange n = error ("Data.Bitstream.Lazy: index out of range: " L.++ show n) -- | /O(n)/ Convert a list of chunks, strict 'SB.Bitstream's, into a
Data/Bitstream/Packet.hs view
@@ -403,14 +403,14 @@ {-# INLINE packetAndR #-} packetAndR (Packet n o) = (0xFF `shiftL` (8-n)) ≡ o -packetIndexL ∷ Integral n ⇒ Packet Left → n → Bool+packetIndexL ∷ (Integral n, Show n) ⇒ Packet Left → n → Bool {-# RULES "(!!) → packetIndexL" [1] (!!) = packetIndexL #-} {-# INLINE packetIndexL #-} packetIndexL p i | i < 0 ∨ i ≥ length p = indexOutOfRange i | otherwise = unsafePacketIndexL p i -packetIndexR ∷ Integral n ⇒ Packet Right → n → Bool+packetIndexR ∷ (Integral n, Show n) ⇒ Packet Right → n → Bool {-# RULES "(!!) → packetIndexR" [1] (!!) = packetIndexR #-} {-# INLINE packetIndexR #-} packetIndexR p i@@ -452,7 +452,7 @@ packetOverflow = error "Data.Bitstream.Packet: packet size overflow" {-# INLINE indexOutOfRange #-}-indexOutOfRange ∷ Integral n ⇒ n → α+indexOutOfRange ∷ (Integral n, Show n) ⇒ n → α indexOutOfRange n = error ("Data.Bitstream.Packet: index out of range: " L.++ show n) -- | /O(1)/ @'full' p == 'True'@ iff @'length' p == 8@, otherwise it
+ NEWS view
@@ -0,0 +1,25 @@+# -*- org -*-+#+STARTUP: indent+#+STARTUP: fnprompt+#+STARTUP: logdone+#+OPTIONS: ^:nil+#+TODO: UNRELEASED(u) | RELEASED(r)++* RELEASED 0.2.0.2+CLOSED: [2013-01-15 Tue 18:55]+- Applied a patch by Jaap ter Woerds:+ Fix the compilation on GHC 7.4 by adding Show constraint where appropriate.+- Migrate the repository to GitHub.++* RELEASED bitstream-0.2.0.1+CLOSED: [2011-08-26 Aug 18:44]+- Applied a patch by Mark Wotton:+ Fix the compilation on GHC 7.2.1 by adding ={-# LANGUAGE BangPatterns #-}=.++* RELEASED bistream-0.2+CLOSED: [2011-07-08 Jul 13:48]+- bugfix: Make stream fusion actually work+- Implement fromBits / toBits+- Strict Bitstreams' bit length should only be a hint, just like stream size.+- Strict Bitstream should keep bit-length maintained+- Strict bitstrems should use unstreamPackets instead of hand-written unfoldr-based unstreamers.
+ Test/Bitstream.hs view
@@ -0,0 +1,337 @@+{-# LANGUAGE+ FlexibleContexts+ , OverloadedStrings+ , ScopedTypeVariables+ , UndecidableInstances+ , UnicodeSyntax+ #-}+module Main (main) where+import Data.Bitstream (Bitstream, Left, Right)+import qualified Data.Bitstream as B+import qualified Data.ByteString as BS+import Data.ByteString.Char8 ()+import Data.List+import Data.List.Unicode+import qualified Data.Monoid as M+import qualified Data.Monoid.Unicode as M+import qualified Data.Vector.Fusion.Stream as S+import Prelude.Unicode+import Test.Bitstream.Utils+import Test.QuickCheck hiding ((.&.))++type BitL = Bitstream Left+type BitR = Bitstream Right++main ∷ IO ()+main = mapM_ runTest tests++tests ∷ [Property]+tests = [ -- ∅+ conjoin+ [ property $ B.null ((B.∅) ∷ BitL)+ , property $ B.length ((B.∅) ∷ BitL) ≡ (0 ∷Int)+ , property $ B.pack [] ≡ ((B.∅) ∷ BitL)+ , property $ B.empty ≡ ((B.∅) ∷ BitL)+ ]++ , conjoin+ [ property $ B.null ((B.∅) ∷ BitR)+ , property $ B.length ((B.∅) ∷ BitR) ≡ (0 ∷ Int)+ , property $ B.pack [] ≡ ((B.∅) ∷ BitR)+ , property $ B.empty ≡ ((B.∅) ∷ BitR)+ ]++ -- singleton+ , property $ \b → B.length (B.singleton b ∷ BitL) ≡ (1 ∷ Int)+ , property $ \b → B.head (B.singleton b ∷ BitL) ≡ b+ , property $ \b → B.pack [b] ≡ (B.singleton b ∷ BitL)++ , property $ \b → B.length (B.singleton b ∷ BitR) ≡ (1 ∷ Int)+ , property $ \b → B.head (B.singleton b ∷ BitR) ≡ b+ , property $ \b → B.pack [b] ≡ (B.singleton b ∷ BitR)++ -- pack/unpack+ , conjoin+ [ property $ B.unpack (B.pack [] ∷ BitL) ≡ []+ , property $ B.unpack (B.pack [False] ∷ BitL) ≡ [False]+ , property $ B.unpack (B.pack [True ] ∷ BitL) ≡ [True ]+ ]+ , property $ \bl → B.unpack (B.pack bl ∷ BitL) ≡ bl+ , property $ \bs → B.pack (B.unpack (bs ∷ BitL)) ≡ bs++ , conjoin+ [ property $ B.unpack (B.pack [] ∷ BitR) ≡ []+ , property $ B.unpack (B.pack [False] ∷ BitR) ≡ [False]+ , property $ B.unpack (B.pack [True ] ∷ BitR) ≡ [True ]+ ]+ , property $ \bl → B.unpack (B.pack bl ∷ BitR) ≡ bl+ , property $ \bs → B.pack (B.unpack (bs ∷ BitR)) ≡ bs++ -- from/toByteString+ , property $ (B.fromByteString "UNK" ∷ BitL)+ ≡ B.pack (map n2b [ 1, 0, 1, 0, 1, 0, 1, 0+ , 0, 1, 1, 1, 0, 0, 1, 0+ , 1, 1, 0, 1, 0, 0, 1, 0 ])+ , property $ \str → B.toByteString (B.fromByteString str ∷ BitL) ≡ str+ , mapSize (⋅ 8) $ \bs → (B.length bs `rem` 8) ≡ (0 ∷ Int)+ ⟹ B.fromByteString (B.toByteString (bs ∷ BitL)) ≡ bs++ , property $ (B.fromByteString "UNK" ∷ BitR)+ ≡ B.pack (map n2b [ 0, 1, 0, 1, 0, 1, 0, 1+ , 0, 1, 0, 0, 1, 1, 1, 0+ , 0, 1, 0, 0, 1, 0, 1, 1 ])+ , property $ \str → B.toByteString (B.fromByteString str ∷ BitR) ≡ str+ , mapSize (⋅ 8) $ \bs → (B.length bs `rem` 8) ≡ (0 ∷ Int)+ ⟹ B.fromByteString (B.toByteString (bs ∷ BitR)) ≡ bs++ -- from/toBits+ , property $ (B.fromNBits (15 ∷ Int) (0xB1C3 ∷ Int) ∷ BitL)+ ≡ B.pack (map n2b [ 1, 1, 0, 0, 0, 0, 1, 1+ , 1, 0, 0, 0, 1, 1, 0 ])+ , property $ let bs ∷ BitL+ bs = B.pack (map n2b [ 1, 1, 0, 0, 0, 0, 1, 1+ , 1, 0, 0, 0, 1, 1, 0 ])+ in+ B.toBits bs ≡ (0x31C3 ∷ Int)+ , property $ \n → (n ∷ Int) ≡ B.toBits (B.fromBits n ∷ BitL)++ , property $ (B.fromNBits (15 ∷ Int) (0xB1C3 ∷ Int) ∷ BitR)+ ≡ B.pack (map n2b [ 0, 1, 1, 0, 0, 0, 1+ , 1, 1, 0, 0, 0, 0, 1, 1 ])+ , property $ let bs ∷ BitR+ bs = B.pack (map n2b [ 0, 1, 1, 0, 0, 0, 1+ , 1, 1, 0, 0, 0, 0, 1, 1 ])+ in+ B.toBits bs ≡ (0x31C3 ∷ Int)+ , property $ \n → (n ∷ Int) ≡ B.toBits (B.fromBits n ∷ BitR)++ -- stream/unstream+ , property $ \bl → B.unstream (S.fromList bl) ≡ (B.pack bl ∷ BitL)+ , property $ \bs → S.toList (B.stream bs) ≡ B.unpack (bs ∷ BitL)++ , property $ \bl → B.unstream (S.fromList bl) ≡ (B.pack bl ∷ BitR)+ , property $ \bs → S.toList (B.stream bs) ≡ B.unpack (bs ∷ BitR)++ -- direction+ , conjoin+ [ property $ B.toByteString (B.directionLToR (B.pack (map n2b [1,1,0,1,0,0,1,0, 1,0,0])))+ ≡ BS.pack [0xD2, 0x80]+ , property $ B.toByteString (B.directionRToL (B.pack (map n2b [1,1,0,1,0,0,1,0, 1,0,0])))+ ≡ BS.pack [0x4B, 0x01]+ ]+ , property $ \bs → B.directionRToL (B.directionLToR bs) ≡ bs+ , property $ \bs → B.directionLToR (B.directionRToL bs) ≡ bs++ -- show+ , conjoin+ [ property $ show (B.pack [ True , False, False, True, True+ , False, False, False, True, False+ , True , False, True , True, True ] ∷ BitL)+ ≡ "(S[00011001←][1110101←])"+ , property $ show (B.pack [ True , False, False, True, True+ , False, False, False, True, False+ , True , False, True , True, True ] ∷ BitR)+ ≡ "(S[→10011000][→1010111])"+ ]++ -- equality+ , property $ \(bl1, bl2) → ((B.pack bl1 ∷ BitL) ≡ B.pack bl2) ≡ (bl1 ≡ bl2)+ , property $ \(bl1, bl2) → ((B.pack bl1 ∷ BitR) ≡ B.pack bl2) ≡ (bl1 ≡ bl2)++ -- ordering+ , property $ \(bl1, bl2) → (B.pack bl1 ∷ BitL) `compare` B.pack bl2 ≡ bl1 `compare` bl2+ , property $ \(bl1, bl2) → (B.pack bl1 ∷ BitR) `compare` B.pack bl2 ≡ bl1 `compare` bl2++ -- monoid+ , conjoin+ [ property $ ((M.∅) ∷ BitL) ≡ B.pack (M.∅)+ , property $ ((M.∅) ∷ BitR) ≡ B.pack (M.∅)+ ]++ , property $ \(bl1, bl2) → (B.pack bl1 ∷ BitL) M.⊕ B.pack bl2 ≡ B.pack (bl1 M.⊕ bl2)+ , property $ \bls → M.mconcat (map B.pack bls ∷ [BitL]) ≡ B.pack (M.mconcat bls)++ , property $ \(bl1, bl2) → (B.pack bl1 ∷ BitR) M.⊕ B.pack bl2 ≡ B.pack (bl1 M.⊕ bl2)+ , property $ \bls → M.mconcat (map B.pack bls ∷ [BitR]) ≡ B.pack (M.mconcat bls)++ -- basic interface+ , property $ \(b, bl) → B.cons b (B.pack bl ∷ BitL) ≡ B.pack (b:bl)+ , property $ \(bl, b) → B.snoc (B.pack bl ∷ BitL) b ≡ B.pack (bl ⧺ [b])+ , property $ \(x, y) → (B.pack x ∷ BitL) B.⧺ B.pack y ≡ B.pack (x ⧺ y)+ , property $ \bl → (¬) (null bl) ⟹ B.head (B.pack bl ∷ BitL) ≡ head bl+ , property $ \bl → (¬) (null bl) ⟹ B.last (B.pack bl ∷ BitL) ≡ last bl+ , property $ \bl → (¬) (null bl) ⟹ B.tail (B.pack bl ∷ BitL) ≡ B.pack (tail bl)+ , property $ \bl → (¬) (null bl) ⟹ B.init (B.pack bl ∷ BitL) ≡ B.pack (init bl)+ , property $ \bl → let bs = B.pack bl ∷ BitL+ in case bl of+ [] → label "null" $ B.null bs+ _ → label "non-null" $ (¬) (B.null bs)+ , property $ \bl → B.length (B.pack bl ∷ BitL) ≡ length bl++ , property $ \(b, bl) → B.cons b (B.pack bl ∷ BitR) ≡ B.pack (b:bl)+ , property $ \(bl, b) → B.snoc (B.pack bl ∷ BitR) b ≡ B.pack (bl ⧺ [b])+ , property $ \(x, y) → (B.pack x ∷ BitR) B.⧺ B.pack y ≡ B.pack (x ⧺ y)+ , property $ \bl → (¬) (null bl) ⟹ B.head (B.pack bl ∷ BitR) ≡ head bl+ , property $ \bl → (¬) (null bl) ⟹ B.last (B.pack bl ∷ BitR) ≡ last bl+ , property $ \bl → (¬) (null bl) ⟹ B.tail (B.pack bl ∷ BitR) ≡ B.pack (tail bl)+ , property $ \bl → (¬) (null bl) ⟹ B.init (B.pack bl ∷ BitR) ≡ B.pack (init bl)+ , property $ \bl → let bs = B.pack bl ∷ BitR+ in case bl of+ [] → label "null" $ B.null bs+ _ → label "non-null" $ (¬) (B.null bs)+ , property $ \bl → B.length (B.pack bl ∷ BitR) ≡ length bl++ -- transformation+ , property $ \bl → B.map (¬) (B.pack bl ∷ BitL) ≡ B.pack (map (¬) bl)+ , property $ \bl → B.reverse (B.pack bl ∷ BitL) ≡ B.pack (reverse bl)++ , property $ \bl → B.map (¬) (B.pack bl ∷ BitR) ≡ B.pack (map (¬) bl)+ , property $ \bl → B.reverse (B.pack bl ∷ BitL) ≡ B.pack (reverse bl)++ -- reduction+ , property $ \(n, bl) → B.foldl doubleIf n (B.pack bl ∷ BitL) ≡ foldl doubleIf n bl+ , property $ \(n, bl) → B.foldl' doubleIf n (B.pack bl ∷ BitL) ≡ foldl doubleIf n bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldl1 xor (B.pack bl ∷ BitL) ≡ foldl1 xor bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldl1' xor (B.pack bl ∷ BitL) ≡ foldl1' xor bl+ , property $ \(n, bl) → B.foldr (flip doubleIf) n (B.pack bl ∷ BitL) ≡ foldr (flip doubleIf) n bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldr1 xor (B.pack bl ∷ BitL) ≡ foldr1 xor bl++ , property $ \(n, bl) → B.foldl doubleIf n (B.pack bl ∷ BitR) ≡ foldl doubleIf n bl+ , property $ \(n, bl) → B.foldl' doubleIf n (B.pack bl ∷ BitR) ≡ foldl doubleIf n bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldl1 xor (B.pack bl ∷ BitR) ≡ foldl1 xor bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldl1' xor (B.pack bl ∷ BitR) ≡ foldl1' xor bl+ , property $ \(n, bl) → B.foldr (flip doubleIf) n (B.pack bl ∷ BitR) ≡ foldr (flip doubleIf) n bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldr1 xor (B.pack bl ∷ BitR) ≡ foldr1 xor bl++ -- special folds+ , property $ \bls → B.concat (map B.pack bls ∷ [BitL]) ≡ B.pack (concat bls)+ , property $ \bl → let f True = [True , True , True ]+ f False = [False, False, False]+ in B.concatMap (B.pack ∘ f) (B.pack bl ∷ BitL) ≡ B.pack (concatMap f bl)+ , property $ \bl → B.and (B.pack bl ∷ BitL) ≡ and bl+ , property $ \bl → B.or (B.pack bl ∷ BitL) ≡ or bl+ , property $ \bl → B.any id (B.pack bl ∷ BitL) ≡ any id bl+ , property $ \bl → B.all id (B.pack bl ∷ BitL) ≡ all id bl++ , property $ \bls → B.concat (map B.pack bls ∷ [BitR]) ≡ B.pack (concat bls)+ , property $ \bl → let f True = [True , True , True ]+ f False = [False, False, False]+ in B.concatMap (B.pack ∘ f) (B.pack bl ∷ BitR) ≡ B.pack (concatMap f bl)+ , property $ \bl → B.and (B.pack bl ∷ BitR) ≡ and bl+ , property $ \bl → B.or (B.pack bl ∷ BitR) ≡ or bl+ , property $ \bl → B.any id (B.pack bl ∷ BitR) ≡ any id bl+ , property $ \bl → B.all id (B.pack bl ∷ BitR) ≡ all id bl++ -- scans+ , property $ \(b, bl) → B.scanl xor b (B.pack bl ∷ BitL) ≡ B.pack (scanl xor b bl)+ , property $ \bl → B.scanl1 xor (B.pack bl ∷ BitL) ≡ B.pack (scanl1 xor bl)+ , property $ \(b, bl) → B.scanr xor b (B.pack bl ∷ BitL) ≡ B.pack (scanr xor b bl)+ , property $ \bl → B.scanr1 xor (B.pack bl ∷ BitL) ≡ B.pack (scanr1 xor bl)++ , property $ \(b, bl) → B.scanl xor b (B.pack bl ∷ BitR) ≡ B.pack (scanl xor b bl)+ , property $ \bl → B.scanl1 xor (B.pack bl ∷ BitR) ≡ B.pack (scanl1 xor bl)+ , property $ \(b, bl) → B.scanr xor b (B.pack bl ∷ BitR) ≡ B.pack (scanr xor b bl)+ , property $ \bl → B.scanr1 xor (B.pack bl ∷ BitR) ≡ B.pack (scanr1 xor bl)++ -- replication+ , property $ \(n, b) → (B.replicate (n `rem` 800) b ∷ BitL) ≡ B.pack (replicate (n `rem` 800) b)+ , property $ \(n, b) → (B.replicate (n `rem` 800) b ∷ BitR) ≡ B.pack (replicate (n `rem` 800) b)++ -- unfolding+ , property $ \n → (B.unfoldr decr (abs (n `rem` 800)) ∷ BitL) ≡ B.pack (unfoldr decr (abs (n `rem` 800)))+ , property $ \(m, n) → let m' = m `rem` 800+ n' = abs (n `rem` 800)+ r = B.unfoldrN m' decr n'+ p | m' ≤ 0 = label "m ≤ 0" $ r ≡ ((B.∅) ∷ BitL)+ | m' ≤ n' = label "m ≤ n'" $ r ≡ B.pack (take m' (unfoldr decr n'))+ | otherwise = label "otherwise" $ r ≡ B.pack (unfoldr decr n')+ in p++ , property $ \n → (B.unfoldr decr (abs (n `rem` 800)) ∷ BitR) ≡ B.pack (unfoldr decr (abs (n `rem` 800)))+ , property $ \(m, n) → let m' = m `rem` 800+ n' = abs (n `rem` 800)+ r = B.unfoldrN m' decr n'+ p | m' ≤ 0 = label "m ≤ 0" $ r ≡ ((B.∅) ∷ BitR)+ | m' ≤ n' = label "m ≤ n'" $ r ≡ B.pack (take m' (unfoldr decr n'))+ | otherwise = label "otherwise" $ r ≡ B.pack (unfoldr decr n')+ in p++ -- substreams+ , property $ \(n, bl) → B.take n (B.pack bl ∷ BitL) ≡ B.pack (take n bl)+ , property $ \(n, bl) → B.drop n (B.pack bl ∷ BitL) ≡ B.pack (drop n bl)+ , property $ \bl → B.takeWhile id (B.pack bl ∷ BitL) ≡ B.pack (takeWhile id bl)+ , property $ \bl → B.dropWhile id (B.pack bl ∷ BitL) ≡ B.pack (dropWhile id bl)+ , property $ \bl → B.span id (B.pack bl ∷ BitL) ≡ fmapT2 B.pack (span id bl)+ , property $ \bl → B.break id (B.pack bl ∷ BitL) ≡ fmapT2 B.pack (break id bl)++ , property $ \(n, bl) → B.take n (B.pack bl ∷ BitR) ≡ B.pack (take n bl)+ , property $ \(n, bl) → B.drop n (B.pack bl ∷ BitR) ≡ B.pack (drop n bl)+ , property $ \bl → B.takeWhile id (B.pack bl ∷ BitR) ≡ B.pack (takeWhile id bl)+ , property $ \bl → B.dropWhile id (B.pack bl ∷ BitR) ≡ B.pack (dropWhile id bl)+ , property $ \bl → B.span id (B.pack bl ∷ BitR) ≡ fmapT2 B.pack (span id bl)+ , property $ \bl → B.break id (B.pack bl ∷ BitR) ≡ fmapT2 B.pack (break id bl)++ -- searching by equality+ , property $ \(b, bl) → (b B.∈ (B.pack bl ∷ BitL)) ≡ (b ∈ bl)+ , property $ \(b, bl) → (b B.∉ (B.pack bl ∷ BitL)) ≡ (b ∉ bl)++ , property $ \(b, bl) → (b B.∈ (B.pack bl ∷ BitR)) ≡ (b ∈ bl)+ , property $ \(b, bl) → (b B.∉ (B.pack bl ∷ BitR)) ≡ (b ∉ bl)++ -- searching with a predicate+ , property $ \bl → B.find id (B.pack bl ∷ BitL) ≡ find id bl+ , property $ \bl → B.filter id (B.pack bl ∷ BitL) ≡ B.pack (filter id bl)+ , property $ \bl → B.partition id (B.pack bl ∷ BitL) ≡ fmapT2 B.pack (partition id bl)++ , property $ \bl → B.find id (B.pack bl ∷ BitR) ≡ find id bl+ , property $ \bl → B.filter id (B.pack bl ∷ BitR) ≡ B.pack (filter id bl)+ , property $ \bl → B.partition id (B.pack bl ∷ BitR) ≡ fmapT2 B.pack (partition id bl)++ -- indexing streams+ , property $ \bl → (¬) (null bl) ⟹+ let ig = choose (0, length bl - 1)+ bs = B.pack bl ∷ BitL+ in forAll ig $ \ i → bs B.!! i ≡ bl !! i+ , property $ \(b, bl) → B.elemIndex b (B.pack bl ∷ BitL) ≡ elemIndex b bl+ , property $ \(b, bl) → B.elemIndices b (B.pack bl ∷ BitL) ≡ elemIndices b bl++ , property $ \bl → (¬) (null bl) ⟹+ let ig = choose (0, length bl - 1)+ bs = B.pack bl ∷ BitR+ in forAll ig $ \ i → bs B.!! i ≡ bl !! i+ , property $ \(b, bl) → B.elemIndex b (B.pack bl ∷ BitR) ≡ elemIndex b bl+ , property $ \(b, bl) → B.elemIndices b (B.pack bl ∷ BitR) ≡ elemIndices b bl++ -- zipping and unzipping streams+ , property $ \(bl1, bl2)+ → B.zip (B.pack bl1 ∷ BitL) (B.pack bl2)+ ≡ zip bl1 bl2+ , property $ \(bl1, bl2, bl3)+ → B.zip3 (B.pack bl1 ∷ BitL) (B.pack bl2) (B.pack bl3)+ ≡ zip3 bl1 bl2 bl3+ , property $ \(bl1, bl2, bl3, bl4)+ → B.zip4 (B.pack bl1 ∷ BitL) (B.pack bl2) (B.pack bl3) (B.pack bl4)+ ≡ zip4 bl1 bl2 bl3 bl4+ , property $ \(bl1, bl2, bl3, bl4, bl5)+ → B.zip5 (B.pack bl1 ∷ BitL) (B.pack bl2) (B.pack bl3) (B.pack bl4) (B.pack bl5)+ ≡ zip5 bl1 bl2 bl3 bl4 bl5+ , property $ \(bl1, bl2, bl3, bl4, bl5, bl6)+ → B.zip6 (B.pack bl1 ∷ BitL) (B.pack bl2) (B.pack bl3) (B.pack bl4) (B.pack bl5) (B.pack bl6)+ ≡ zip6 bl1 bl2 bl3 bl4 bl5 bl6++ , property $ \(bl1, bl2)+ → B.zip (B.pack bl1 ∷ BitR) (B.pack bl2)+ ≡ zip bl1 bl2+ , property $ \(bl1, bl2, bl3)+ → B.zip3 (B.pack bl1 ∷ BitR) (B.pack bl2) (B.pack bl3)+ ≡ zip3 bl1 bl2 bl3+ , property $ \(bl1, bl2, bl3, bl4)+ → B.zip4 (B.pack bl1 ∷ BitR) (B.pack bl2) (B.pack bl3) (B.pack bl4)+ ≡ zip4 bl1 bl2 bl3 bl4+ , property $ \(bl1, bl2, bl3, bl4, bl5)+ → B.zip5 (B.pack bl1 ∷ BitR) (B.pack bl2) (B.pack bl3) (B.pack bl4) (B.pack bl5)+ ≡ zip5 bl1 bl2 bl3 bl4 bl5+ , property $ \(bl1, bl2, bl3, bl4, bl5, bl6)+ → B.zip6 (B.pack bl1 ∷ BitR) (B.pack bl2) (B.pack bl3) (B.pack bl4) (B.pack bl5) (B.pack bl6)+ ≡ zip6 bl1 bl2 bl3 bl4 bl5 bl6+ ]
+ Test/Bitstream/Lazy.hs view
@@ -0,0 +1,348 @@+{-# LANGUAGE+ FlexibleContexts+ , OverloadedStrings+ , ScopedTypeVariables+ , UndecidableInstances+ , UnicodeSyntax+ #-}+module Main (main) where+import Data.Bitstream.Lazy (Bitstream, Left, Right)+import Data.ByteString.Lazy.Char8 ()+import qualified Data.Bitstream.Lazy as B+import qualified Data.ByteString.Lazy as BS+import Data.List+import Data.List.Unicode+import qualified Data.Monoid as M+import qualified Data.Monoid.Unicode as M+import qualified Data.Vector.Fusion.Stream as S+import Prelude.Unicode+import Test.Bitstream.Utils+import Test.QuickCheck++main ∷ IO ()+main = mapM_ runTest tests++type BitL = Bitstream Left+type BitR = Bitstream Right++tests ∷ [Property]+tests = [ -- ∅+ conjoin+ [ property $ B.null ((B.∅) ∷ BitL)+ , property $ B.length ((B.∅) ∷ BitL) ≡ (0 ∷Int)+ , property $ B.pack [] ≡ ((B.∅) ∷ BitL)+ , property $ B.empty ≡ ((B.∅) ∷ BitL)+ ]++ , conjoin+ [ property $ B.null ((B.∅) ∷ BitR)+ , property $ B.length ((B.∅) ∷ BitR) ≡ (0 ∷ Int)+ , property $ B.pack [] ≡ ((B.∅) ∷ BitR)+ , property $ B.empty ≡ ((B.∅) ∷ BitR)+ ]++ -- singleton+ , property $ \b → B.length (B.singleton b ∷ BitL) ≡ (1 ∷ Int)+ , property $ \b → B.head (B.singleton b ∷ BitL) ≡ b+ , property $ \b → B.pack [b] ≡ (B.singleton b ∷ BitL)++ , property $ \b → B.length (B.singleton b ∷ BitR) ≡ (1 ∷ Int)+ , property $ \b → B.head (B.singleton b ∷ BitR) ≡ b+ , property $ \b → B.pack [b] ≡ (B.singleton b ∷ BitR)++ -- pack/unpack+ , conjoin+ [ property $ B.unpack (B.pack [] ∷ BitL) ≡ []+ , property $ B.unpack (B.pack [False] ∷ BitL) ≡ [False]+ , property $ B.unpack (B.pack [True ] ∷ BitL) ≡ [True ]+ ]+ , property $ \bl → B.unpack (B.pack bl ∷ BitL) ≡ bl+ , property $ \bs → B.pack (B.unpack (bs ∷ BitL)) ≡ bs++ , conjoin+ [ property $ B.unpack (B.pack [] ∷ BitR) ≡ []+ , property $ B.unpack (B.pack [False] ∷ BitR) ≡ [False]+ , property $ B.unpack (B.pack [True ] ∷ BitR) ≡ [True ]+ ]+ , property $ \bl → B.unpack (B.pack bl ∷ BitR) ≡ bl+ , property $ \bs → B.pack (B.unpack (bs ∷ BitR)) ≡ bs++ -- from/toByteString+ , property $ (B.fromByteString "UNK" ∷ BitL)+ ≡ B.pack (map n2b [ 1, 0, 1, 0, 1, 0, 1, 0+ , 0, 1, 1, 1, 0, 0, 1, 0+ , 1, 1, 0, 1, 0, 0, 1, 0 ])+ , property $ \str → B.toByteString (B.fromByteString str ∷ BitL) ≡ str+ , mapSize (⋅ 8) $ \bs → (B.length bs `rem` 8) ≡ (0 ∷ Int)+ ⟹ B.fromByteString (B.toByteString (bs ∷ BitL)) ≡ bs++ , property $ (B.fromByteString "UNK" ∷ BitR)+ ≡ B.pack (map n2b [ 0, 1, 0, 1, 0, 1, 0, 1+ , 0, 1, 0, 0, 1, 1, 1, 0+ , 0, 1, 0, 0, 1, 0, 1, 1 ])+ , property $ \str → B.toByteString (B.fromByteString str ∷ BitR) ≡ str+ , mapSize (⋅ 8) $ \bs → (B.length bs `rem` 8) ≡ (0 ∷ Int)+ ⟹ B.fromByteString (B.toByteString (bs ∷ BitR)) ≡ bs++ -- from/toBits+ , property $ (B.fromNBits (15 ∷ Int) (0xB1C3 ∷ Int) ∷ BitL)+ ≡ B.pack (map n2b [ 1, 1, 0, 0, 0, 0, 1, 1+ , 1, 0, 0, 0, 1, 1, 0 ])+ , property $ let bs ∷ BitL+ bs = B.pack (map n2b [ 1, 1, 0, 0, 0, 0, 1, 1+ , 1, 0, 0, 0, 1, 1, 0 ])+ in+ B.toBits bs ≡ (0x31C3 ∷ Int)+ , property $ \n → (n ∷ Int) ≡ B.toBits (B.fromBits n ∷ BitL)++ , property $ (B.fromNBits (15 ∷ Int) (0xB1C3 ∷ Int) ∷ BitR)+ ≡ B.pack (map n2b [ 0, 1, 1, 0, 0, 0, 1+ , 1, 1, 0, 0, 0, 0, 1, 1 ])+ , property $ let bs ∷ BitR+ bs = B.pack (map n2b [ 0, 1, 1, 0, 0, 0, 1+ , 1, 1, 0, 0, 0, 0, 1, 1 ])+ in+ B.toBits bs ≡ (0x31C3 ∷ Int)+ , property $ \n → (n ∷ Int) ≡ B.toBits (B.fromBits n ∷ BitR)++ -- stream/unstream+ , property $ \bl → B.unstream (S.fromList bl) ≡ (B.pack bl ∷ BitL)+ , property $ \bs → S.toList (B.stream bs) ≡ B.unpack (bs ∷ BitL)++ , property $ \bl → B.unstream (S.fromList bl) ≡ (B.pack bl ∷ BitR)+ , property $ \bs → S.toList (B.stream bs) ≡ B.unpack (bs ∷ BitR)++ -- direction+ , conjoin+ [ property $ B.toByteString (B.directionLToR (B.pack (map n2b [1,1,0,1,0,0,1,0, 1,0,0])))+ ≡ BS.pack [0xD2, 0x80]+ , property $ B.toByteString (B.directionRToL (B.pack (map n2b [1,1,0,1,0,0,1,0, 1,0,0])))+ ≡ BS.pack [0x4B, 0x01]+ ]+ , property $ \bs → B.directionRToL (B.directionLToR bs) ≡ bs+ , property $ \bs → B.directionLToR (B.directionRToL bs) ≡ bs++ -- show+ , conjoin+ [ property $ show (B.pack [ True , False, False, True, True+ , False, False, False, True, False+ , True , False, True , True, True ] ∷ BitL)+ ≡ "[L: (S[00011001←][1110101←]) ]"+ , property $ show (B.pack [ True , False, False, True, True+ , False, False, False, True, False+ , True , False, True , True, True ] ∷ BitR)+ ≡ "[L: (S[→10011000][→1010111]) ]"+ ]++ -- equality+ , property $ \(bl1, bl2) → ((B.pack bl1 ∷ BitL) ≡ B.pack bl2) ≡ (bl1 ≡ bl2)+ , property $ \(bl1, bl2) → ((B.pack bl1 ∷ BitR) ≡ B.pack bl2) ≡ (bl1 ≡ bl2)++ -- ordering+ , property $ \(bl1, bl2) → (B.pack bl1 ∷ BitL) `compare` B.pack bl2 ≡ bl1 `compare` bl2+ , property $ \(bl1, bl2) → (B.pack bl1 ∷ BitR) `compare` B.pack bl2 ≡ bl1 `compare` bl2++ -- monoid+ , conjoin+ [ property $ ((M.∅) ∷ BitL) ≡ B.pack (M.∅)+ , property $ ((M.∅) ∷ BitR) ≡ B.pack (M.∅)+ ]++ , property $ \(bl1, bl2) → (B.pack bl1 ∷ BitL) M.⊕ B.pack bl2 ≡ B.pack (bl1 M.⊕ bl2)+ , property $ \bls → M.mconcat (map B.pack bls ∷ [BitL]) ≡ B.pack (M.mconcat bls)++ , property $ \(bl1, bl2) → (B.pack bl1 ∷ BitR) M.⊕ B.pack bl2 ≡ B.pack (bl1 M.⊕ bl2)+ , property $ \bls → M.mconcat (map B.pack bls ∷ [BitR]) ≡ B.pack (M.mconcat bls)++ -- basic interface+ , property $ \(b, bl) → B.cons b (B.pack bl ∷ BitL) ≡ B.pack (b:bl)+ , property $ \(b, bl) → B.cons' b (B.pack bl ∷ BitL) ≡ B.pack (b:bl)+ , property $ \(bl, b) → B.snoc (B.pack bl ∷ BitL) b ≡ B.pack (bl ⧺ [b])+ , property $ \(x, y) → (B.pack x ∷ BitL) B.⧺ B.pack y ≡ B.pack (x ⧺ y)+ , property $ \bl → (¬) (null bl) ⟹ B.head (B.pack bl ∷ BitL) ≡ head bl+ , property $ \bl → (¬) (null bl) ⟹ B.last (B.pack bl ∷ BitL) ≡ last bl+ , property $ \bl → (¬) (null bl) ⟹ B.tail (B.pack bl ∷ BitL) ≡ B.pack (tail bl)+ , property $ \bl → (¬) (null bl) ⟹ B.init (B.pack bl ∷ BitL) ≡ B.pack (init bl)+ , property $ \bl → let bs = B.pack bl ∷ BitL+ in case bl of+ [] → label "null" $ B.null bs+ _ → label "non-null" $ (¬) (B.null bs)+ , property $ \bl → B.length (B.pack bl ∷ BitL) ≡ length bl++ , property $ \(b, bl) → B.cons b (B.pack bl ∷ BitR) ≡ B.pack (b:bl)+ , property $ \(b, bl) → B.cons' b (B.pack bl ∷ BitR) ≡ B.pack (b:bl)+ , property $ \(bl, b) → B.snoc (B.pack bl ∷ BitR) b ≡ B.pack (bl ⧺ [b])+ , property $ \(x, y) → (B.pack x ∷ BitR) B.⧺ B.pack y ≡ B.pack (x ⧺ y)+ , property $ \bl → (¬) (null bl) ⟹ B.head (B.pack bl ∷ BitR) ≡ head bl+ , property $ \bl → (¬) (null bl) ⟹ B.last (B.pack bl ∷ BitR) ≡ last bl+ , property $ \bl → (¬) (null bl) ⟹ B.tail (B.pack bl ∷ BitR) ≡ B.pack (tail bl)+ , property $ \bl → (¬) (null bl) ⟹ B.init (B.pack bl ∷ BitR) ≡ B.pack (init bl)+ , property $ \bl → let bs = B.pack bl ∷ BitR+ in case bl of+ [] → label "null" $ B.null bs+ _ → label "non-null" $ (¬) (B.null bs)+ , property $ \bl → B.length (B.pack bl ∷ BitR) ≡ length bl++ -- transformation+ , property $ \bl → B.map (¬) (B.pack bl ∷ BitL) ≡ B.pack (map (¬) bl)+ , property $ \bl → B.reverse (B.pack bl ∷ BitL) ≡ B.pack (reverse bl)++ , property $ \bl → B.map (¬) (B.pack bl ∷ BitR) ≡ B.pack (map (¬) bl)+ , property $ \bl → B.reverse (B.pack bl ∷ BitL) ≡ B.pack (reverse bl)++ -- reduction+ , property $ \(n, bl) → B.foldl doubleIf n (B.pack bl ∷ BitL) ≡ foldl doubleIf n bl+ , property $ \(n, bl) → B.foldl' doubleIf n (B.pack bl ∷ BitL) ≡ foldl doubleIf n bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldl1 xor (B.pack bl ∷ BitL) ≡ foldl1 xor bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldl1' xor (B.pack bl ∷ BitL) ≡ foldl1' xor bl+ , property $ \(n, bl) → B.foldr (flip doubleIf) n (B.pack bl ∷ BitL) ≡ foldr (flip doubleIf) n bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldr1 xor (B.pack bl ∷ BitL) ≡ foldr1 xor bl++ , property $ \(n, bl) → B.foldl doubleIf n (B.pack bl ∷ BitR) ≡ foldl doubleIf n bl+ , property $ \(n, bl) → B.foldl' doubleIf n (B.pack bl ∷ BitR) ≡ foldl doubleIf n bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldl1 xor (B.pack bl ∷ BitR) ≡ foldl1 xor bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldl1' xor (B.pack bl ∷ BitR) ≡ foldl1' xor bl+ , property $ \(n, bl) → B.foldr (flip doubleIf) n (B.pack bl ∷ BitR) ≡ foldr (flip doubleIf) n bl+ , property $ \bl → (¬) (null bl) ⟹ B.foldr1 xor (B.pack bl ∷ BitR) ≡ foldr1 xor bl++ -- special folds+ , property $ \bls → B.concat (map B.pack bls ∷ [BitL]) ≡ B.pack (concat bls)+ , property $ \bl → let f True = [True , True , True ]+ f False = [False, False, False]+ in B.concatMap (B.pack ∘ f) (B.pack bl ∷ BitL) ≡ B.pack (concatMap f bl)+ , property $ \bl → B.and (B.pack bl ∷ BitL) ≡ and bl+ , property $ \bl → B.or (B.pack bl ∷ BitL) ≡ or bl+ , property $ \bl → B.any id (B.pack bl ∷ BitL) ≡ any id bl+ , property $ \bl → B.all id (B.pack bl ∷ BitL) ≡ all id bl++ , property $ \bls → B.concat (map B.pack bls ∷ [BitR]) ≡ B.pack (concat bls)+ , property $ \bl → let f True = [True , True , True ]+ f False = [False, False, False]+ in B.concatMap (B.pack ∘ f) (B.pack bl ∷ BitR) ≡ B.pack (concatMap f bl)+ , property $ \bl → B.and (B.pack bl ∷ BitR) ≡ and bl+ , property $ \bl → B.or (B.pack bl ∷ BitR) ≡ or bl+ , property $ \bl → B.any id (B.pack bl ∷ BitR) ≡ any id bl+ , property $ \bl → B.all id (B.pack bl ∷ BitR) ≡ all id bl++ -- scans+ , property $ \(b, bl) → B.scanl xor b (B.pack bl ∷ BitL) ≡ B.pack (scanl xor b bl)+ , property $ \bl → B.scanl1 xor (B.pack bl ∷ BitL) ≡ B.pack (scanl1 xor bl)+ , property $ \(b, bl) → B.scanr xor b (B.pack bl ∷ BitL) ≡ B.pack (scanr xor b bl)+ , property $ \bl → B.scanr1 xor (B.pack bl ∷ BitL) ≡ B.pack (scanr1 xor bl)++ , property $ \(b, bl) → B.scanl xor b (B.pack bl ∷ BitR) ≡ B.pack (scanl xor b bl)+ , property $ \bl → B.scanl1 xor (B.pack bl ∷ BitR) ≡ B.pack (scanl1 xor bl)+ , property $ \(b, bl) → B.scanr xor b (B.pack bl ∷ BitR) ≡ B.pack (scanr xor b bl)+ , property $ \bl → B.scanr1 xor (B.pack bl ∷ BitR) ≡ B.pack (scanr1 xor bl)++ -- replications+ , property $ \(n, b) → B.take (n `rem` 800) (B.iterate (¬) b ∷ BitL) ≡ B.pack (take (n `rem` 800) (iterate (¬) b))+ , property $ \(n, b) → B.take (n `rem` 800) (B.repeat b ∷ BitL) ≡ B.pack (replicate (n `rem` 800) b)+ , property $ \(n, b) → (B.replicate (n `rem` 800) b ∷ BitL) ≡ B.pack (replicate (n `rem` 800) b)+ , property $ \(n, bl) → (¬) (null bl) ⟹+ B.take (n `rem` 800) (B.cycle (B.pack bl ∷ BitL)) ≡ B.pack (take (n `rem` 800) (cycle bl))++ , property $ \(n, b) → B.take (n `rem` 800) (B.iterate (¬) b ∷ BitR) ≡ B.pack (take (n `rem` 800) (iterate (¬) b))+ , property $ \(n, b) → B.take (n `rem` 800) (B.repeat b ∷ BitR) ≡ B.pack (replicate (n `rem` 800) b)+ , property $ \(n, b) → (B.replicate (n `rem` 800) b ∷ BitR) ≡ B.pack (replicate (n `rem` 800) b)+ , property $ \(n, bl) → (¬) (null bl) ⟹+ B.take (n `rem` 800) (B.cycle (B.pack bl ∷ BitR)) ≡ B.pack (take (n `rem` 800) (cycle bl))++ -- unfolding+ , property $ \n → (B.unfoldr decr (abs (n `rem` 800)) ∷ BitL) ≡ B.pack (unfoldr decr (abs (n `rem` 800)))+ , property $ \(m, n) → let m' = m `rem` 800+ n' = abs (n `rem` 800)+ r = B.unfoldrN m' decr n'+ p | m' ≤ 0 = label "m ≤ 0" $ r ≡ ((B.∅) ∷ BitL)+ | m' ≤ n' = label "m ≤ n'" $ r ≡ B.pack (take m' (unfoldr decr n'))+ | otherwise = label "otherwise" $ r ≡ B.pack (unfoldr decr n')+ in p++ , property $ \n → (B.unfoldr decr (abs (n `rem` 800)) ∷ BitR) ≡ B.pack (unfoldr decr (abs (n `rem` 800)))+ , property $ \(m, n) → let m' = m `rem` 800+ n' = abs (n `rem` 800)+ r = B.unfoldrN m' decr n'+ p | m' ≤ 0 = label "m ≤ 0" $ r ≡ ((B.∅) ∷ BitR)+ | m' ≤ n' = label "m ≤ n'" $ r ≡ B.pack (take m' (unfoldr decr n'))+ | otherwise = label "otherwise" $ r ≡ B.pack (unfoldr decr n')+ in p++ -- substreams+ , property $ \(n, bl) → B.take n (B.pack bl ∷ BitL) ≡ B.pack (take n bl)+ , property $ \(n, bl) → B.drop n (B.pack bl ∷ BitL) ≡ B.pack (drop n bl)+ , property $ \bl → B.takeWhile id (B.pack bl ∷ BitL) ≡ B.pack (takeWhile id bl)+ , property $ \bl → B.dropWhile id (B.pack bl ∷ BitL) ≡ B.pack (dropWhile id bl)+ , property $ \bl → B.span id (B.pack bl ∷ BitL) ≡ fmapT2 B.pack (span id bl)+ , property $ \bl → B.break id (B.pack bl ∷ BitL) ≡ fmapT2 B.pack (break id bl)++ , property $ \(n, bl) → B.take n (B.pack bl ∷ BitR) ≡ B.pack (take n bl)+ , property $ \(n, bl) → B.drop n (B.pack bl ∷ BitR) ≡ B.pack (drop n bl)+ , property $ \bl → B.takeWhile id (B.pack bl ∷ BitR) ≡ B.pack (takeWhile id bl)+ , property $ \bl → B.dropWhile id (B.pack bl ∷ BitR) ≡ B.pack (dropWhile id bl)+ , property $ \bl → B.span id (B.pack bl ∷ BitR) ≡ fmapT2 B.pack (span id bl)+ , property $ \bl → B.break id (B.pack bl ∷ BitR) ≡ fmapT2 B.pack (break id bl)++ -- searching by equality+ , property $ \(b, bl) → (b B.∈ (B.pack bl ∷ BitL)) ≡ (b ∈ bl)+ , property $ \(b, bl) → (b B.∉ (B.pack bl ∷ BitL)) ≡ (b ∉ bl)++ , property $ \(b, bl) → (b B.∈ (B.pack bl ∷ BitR)) ≡ (b ∈ bl)+ , property $ \(b, bl) → (b B.∉ (B.pack bl ∷ BitR)) ≡ (b ∉ bl)++ -- searching with a predicate+ , property $ \bl → B.find id (B.pack bl ∷ BitL) ≡ find id bl+ , property $ \bl → B.filter id (B.pack bl ∷ BitL) ≡ B.pack (filter id bl)+ , property $ \bl → B.partition id (B.pack bl ∷ BitL) ≡ fmapT2 B.pack (partition id bl)++ , property $ \bl → B.find id (B.pack bl ∷ BitR) ≡ find id bl+ , property $ \bl → B.filter id (B.pack bl ∷ BitR) ≡ B.pack (filter id bl)+ , property $ \bl → B.partition id (B.pack bl ∷ BitR) ≡ fmapT2 B.pack (partition id bl)++ -- indexing streams+ , property $ \bl → (¬) (null bl) ⟹+ let ig = choose (0, length bl - 1)+ bs = B.pack bl ∷ BitL+ in forAll ig $ \ i → bs B.!! i ≡ bl !! i+ , property $ \(b, bl) → B.elemIndex b (B.pack bl ∷ BitL) ≡ elemIndex b bl+ , property $ \(b, bl) → B.elemIndices b (B.pack bl ∷ BitL) ≡ elemIndices b bl++ , property $ \bl → (¬) (null bl) ⟹+ let ig = choose (0, length bl - 1)+ bs = B.pack bl ∷ BitR+ in forAll ig $ \ i → bs B.!! i ≡ bl !! i+ , property $ \(b, bl) → B.elemIndex b (B.pack bl ∷ BitR) ≡ elemIndex b bl+ , property $ \(b, bl) → B.elemIndices b (B.pack bl ∷ BitR) ≡ elemIndices b bl++ -- zipping and unzipping streams+ , property $ \(bl1, bl2)+ → B.zip (B.pack bl1 ∷ BitL) (B.pack bl2)+ ≡ zip bl1 bl2+ , property $ \(bl1, bl2, bl3)+ → B.zip3 (B.pack bl1 ∷ BitL) (B.pack bl2) (B.pack bl3)+ ≡ zip3 bl1 bl2 bl3+ , property $ \(bl1, bl2, bl3, bl4)+ → B.zip4 (B.pack bl1 ∷ BitL) (B.pack bl2) (B.pack bl3) (B.pack bl4)+ ≡ zip4 bl1 bl2 bl3 bl4+ , property $ \(bl1, bl2, bl3, bl4, bl5)+ → B.zip5 (B.pack bl1 ∷ BitL) (B.pack bl2) (B.pack bl3) (B.pack bl4) (B.pack bl5)+ ≡ zip5 bl1 bl2 bl3 bl4 bl5+ , property $ \(bl1, bl2, bl3, bl4, bl5, bl6)+ → B.zip6 (B.pack bl1 ∷ BitL) (B.pack bl2) (B.pack bl3) (B.pack bl4) (B.pack bl5) (B.pack bl6)+ ≡ zip6 bl1 bl2 bl3 bl4 bl5 bl6++ , property $ \(bl1, bl2)+ → B.zip (B.pack bl1 ∷ BitR) (B.pack bl2)+ ≡ zip bl1 bl2+ , property $ \(bl1, bl2, bl3)+ → B.zip3 (B.pack bl1 ∷ BitR) (B.pack bl2) (B.pack bl3)+ ≡ zip3 bl1 bl2 bl3+ , property $ \(bl1, bl2, bl3, bl4)+ → B.zip4 (B.pack bl1 ∷ BitR) (B.pack bl2) (B.pack bl3) (B.pack bl4)+ ≡ zip4 bl1 bl2 bl3 bl4+ , property $ \(bl1, bl2, bl3, bl4, bl5)+ → B.zip5 (B.pack bl1 ∷ BitR) (B.pack bl2) (B.pack bl3) (B.pack bl4) (B.pack bl5)+ ≡ zip5 bl1 bl2 bl3 bl4 bl5+ , property $ \(bl1, bl2, bl3, bl4, bl5, bl6)+ → B.zip6 (B.pack bl1 ∷ BitR) (B.pack bl2) (B.pack bl3) (B.pack bl4) (B.pack bl5) (B.pack bl6)+ ≡ zip6 bl1 bl2 bl3 bl4 bl5 bl6+ ]
+ Test/Bitstream/Utils.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE+ FlexibleContexts+ , OverloadedStrings+ , ScopedTypeVariables+ , UndecidableInstances+ , UnicodeSyntax+ #-}+module Test.Bitstream.Utils where+import Control.Monad+import qualified Data.Bitstream as SB+import qualified Data.Bitstream.Generic as G+import qualified Data.Bitstream.Lazy as LB+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LS+import Prelude.Unicode+import System.Exit+import Test.QuickCheck++infixr 0 ⟹+infixr 1 .∧., .∨.++(⟹) :: Testable α => Bool -> α -> Property+(⟹) = (==>)++(.∧.) ∷ (Testable α, Testable β) ⇒ α → β → Property+(.∧.) = (.&&.)++(.∨.) ∷ (Testable α, Testable β) ⇒ α → β → Property+(.∨.) = (.||.)++uncons ∷ [α] → Maybe (α, [α])+uncons [] = Nothing+uncons (α:αs) = Just (α, αs)++instance G.Bitstream (SB.Bitstream d) ⇒ Arbitrary (SB.Bitstream d) where+ arbitrary = sized $ \ n →+ do xs ← replicateM n arbitrary+ return (SB.pack xs)++instance G.Bitstream (LB.Bitstream d) ⇒ Arbitrary (LB.Bitstream d) where+ arbitrary = sized $ \ n →+ do xs ← replicateM n arbitrary+ return (LB.pack xs)++instance Arbitrary BS.ByteString where+ arbitrary = sized $ \ n →+ do xs ← replicateM n arbitrary+ return (BS.unfoldr uncons xs)++instance Arbitrary LS.ByteString where+ arbitrary = sized $ \ n →+ do xs ← replicateM n arbitrary+ return (LS.unfoldr uncons xs)++instance ( Arbitrary α, Arbitrary β, Arbitrary γ+ , Arbitrary δ, Arbitrary ε, Arbitrary ζ+ )+ ⇒ Arbitrary (α, β, γ, δ, ε, ζ) where+ arbitrary = do α ← arbitrary+ β ← arbitrary+ γ ← arbitrary+ δ ← arbitrary+ ε ← arbitrary+ ζ ← arbitrary+ return (α, β, γ, δ, ε, ζ)++instance ( Arbitrary α, Arbitrary β, Arbitrary γ+ , Arbitrary δ, Arbitrary ε, Arbitrary ζ+ , Arbitrary η+ )+ ⇒ Arbitrary (α, β, γ, δ, ε, ζ, η) where+ arbitrary = do α ← arbitrary+ β ← arbitrary+ γ ← arbitrary+ δ ← arbitrary+ ε ← arbitrary+ ζ ← arbitrary+ η ← arbitrary+ return (α, β, γ, δ, ε, ζ, η)++runTest ∷ Property → IO ()+runTest prop+ = do r ← quickCheckResult prop+ case r of+ Success {} → return ()+ GaveUp {} → exitFailure+ Failure {} → exitFailure+ NoExpectedFailure {} → exitFailure++n2b ∷ Int → Bool+n2b 0 = False+n2b 1 = True+n2b _ = (⊥)++doubleIf ∷ Int → Bool → Int+doubleIf n True = n ⋅ 2+doubleIf n False = n++doubleIf' ∷ Int → Bool → (Int, Bool)+doubleIf' n True = (n ⋅ 2, False)+doubleIf' n False = (n , True )++decr ∷ Int → Maybe (Bool, Int)+decr 0 = Nothing+decr n = Just (n `mod` 2 ≡ 0, n-1)++xor ∷ Bool → Bool → Bool+xor False False = False+xor True True = False+xor _ _ = True++fmapT2 ∷ (a → b) → (a, a) → (b, b)+fmapT2 f (x, y) = (f x, f y)
bitstream.cabal view
@@ -6,32 +6,33 @@ fusion. This is like @bytestring@ but stores bits instead of bytes. -Version: 0.2.0.1+Version: 0.2.0.2 License: PublicDomain License-File: COPYING Author: PHO <pho at cielonegro dot org> Maintainer: PHO <pho at cielonegro dot org> Stability: experimental Homepage: http://cielonegro.org/Bitstream.html-Bug-Reports: http://static.cielonegro.org/ditz/bitstream/+Bug-Reports: https://github.com/phonohawk/bitstream/issues Category: Data-Tested-With: GHC == 7.0.1+Tested-With: GHC == 7.4.1 Cabal-Version: >= 1.10 Build-Type: Simple Extra-Source-Files:+ AUTHORS COPYING- ChangeLog+ NEWS Source-Repository head Type: git- Location: git://git.cielonegro.org/bitstream.git+ Location: git://github.com/phonohawk/bitstream.git Library Build-Depends: base == 4.*, base-unicode-symbols == 0.2.*, bytestring == 0.9.*,- vector == 0.7.*+ vector == 0.10.* Exposed-Modules: Data.Bitstream@@ -56,11 +57,11 @@ Other-Modules: Test.Bitstream.Utils Build-Depends:- QuickCheck == 2.4.*,+ QuickCheck == 2.5.*, base == 4.*, base-unicode-symbols == 0.2.*, bytestring == 0.9.*,- vector == 0.7.*+ vector == 0.10.* Default-Language: Haskell2010 GHC-Options: -Wall -fno-warn-orphans@@ -71,11 +72,11 @@ Other-Modules: Test.Bitstream.Utils Build-Depends:- QuickCheck == 2.4.*,+ QuickCheck == 2.5.*, base == 4.*, base-unicode-symbols == 0.2.*, bytestring == 0.9.*,- vector == 0.7.*+ vector == 0.10.* Default-Language: Haskell2010 GHC-Options: -Wall -fno-warn-orphans