diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,5 @@ +This is the list of contributors to the bitstream package: + +* Mark Wotton +* Jaap ter Woerds +* PHO diff --git a/COPYING b/COPYING --- a/COPYING +++ b/COPYING @@ -1,29 +1,6 @@ - - - - - bitstream - - - PHO - - - - - - - - - - +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. - +For more information, see: +http://creativecommons.org/publicdomain/zero/1.0/ diff --git a/ChangeLog b/ChangeLog deleted file mode 100644 --- a/ChangeLog +++ /dev/null @@ -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. diff --git a/Data/Bitstream.hs b/Data/Bitstream.hs --- a/Data/Bitstream.hs +++ b/Data/Bitstream.hs @@ -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 diff --git a/Data/Bitstream/Fusion.hs b/Data/Bitstream/Fusion.hs --- a/Data/Bitstream/Fusion.hs +++ b/Data/Bitstream/Fusion.hs @@ -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 diff --git a/Data/Bitstream/Fusion/Monadic.hs b/Data/Bitstream/Fusion/Monadic.hs --- a/Data/Bitstream/Fusion/Monadic.hs +++ b/Data/Bitstream/Fusion/Monadic.hs @@ -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 diff --git a/Data/Bitstream/Generic.hs b/Data/Bitstream/Generic.hs --- a/Data/Bitstream/Generic.hs +++ b/Data/Bitstream/Generic.hs @@ -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 #-} diff --git a/Data/Bitstream/Lazy.hs b/Data/Bitstream/Lazy.hs --- a/Data/Bitstream/Lazy.hs +++ b/Data/Bitstream/Lazy.hs @@ -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 diff --git a/Data/Bitstream/Packet.hs b/Data/Bitstream/Packet.hs --- a/Data/Bitstream/Packet.hs +++ b/Data/Bitstream/Packet.hs @@ -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 diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -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. diff --git a/Test/Bitstream.hs b/Test/Bitstream.hs new file mode 100644 --- /dev/null +++ b/Test/Bitstream.hs @@ -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 + ] diff --git a/Test/Bitstream/Lazy.hs b/Test/Bitstream/Lazy.hs new file mode 100644 --- /dev/null +++ b/Test/Bitstream/Lazy.hs @@ -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 + ] diff --git a/Test/Bitstream/Utils.hs b/Test/Bitstream/Utils.hs new file mode 100644 --- /dev/null +++ b/Test/Bitstream/Utils.hs @@ -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) diff --git a/bitstream.cabal b/bitstream.cabal --- a/bitstream.cabal +++ b/bitstream.cabal @@ -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 Maintainer: PHO 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