binary 0.6.0.0 → 0.6.1.0
raw patch · 4 files changed
+62/−41 lines, 4 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- binary.cabal +24/−26
- src/Data/Binary/Get/Internal.hs +7/−5
- src/Data/Binary/Put.hs +0/−4
- tests/QC.hs +31/−6
binary.cabal view
@@ -1,5 +1,5 @@ name: binary-version: 0.6.0.0+version: 0.6.1.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin <kolmodin@gmail.com>@@ -15,7 +15,7 @@ category: Data, Parsing stability: provisional build-type: Simple-cabal-version: >= 1.6+cabal-version: >= 1.8 tested-with: GHC == 7.0.4, GHC == 7.4.1, GHC == 7.6.1 extra-source-files: README index.html @@ -23,31 +23,12 @@ type: git location: git://github.com/kolmodin/binary.git -flag bytestring-in-base-flag split-base-flag applicative-in-base+flag development+ default: False library- if flag(bytestring-in-base)- -- bytestring was in base-2.0 and 2.1.1- build-depends: base >= 2.0 && < 2.2- cpp-options: -DBYTESTRING_IN_BASE- else- -- in base 1.0 and 3.0 bytestring is a separate package- build-depends: base < 2.0 || >= 3, bytestring >= 0.9-- if flag(split-base)- build-depends: base >= 3.0, containers, array- else- build-depends: base < 3.0-- if flag(applicative-in-base)- build-depends: base >= 2.0- cpp-options: -DAPPLICATIVE_IN_BASE- else- build-depends: base < 2.0+ build-depends: base >= 3.0 && < 5, bytestring >= 0.9, containers, array hs-source-dirs: src- exposed-modules: Data.Binary, Data.Binary.Put, Data.Binary.Get,@@ -62,5 +43,22 @@ ghc-options: -O2 -Wall -fliberate-case-threshold=1000 --- if impl(ghc < 6.5)--- ghc-options: -fallow-undecidable-instances+test-suite qc+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: QC.hs+ build-depends:+ array,+ base >= 3.0 && < 5,+ bytestring >= 0.9,+ containers,+ random>=1.0.1.0,+ test-framework,+ test-framework-quickcheck2,+ QuickCheck>=2.5++ if flag(development)+ ghc-options: -Wall+ hs-source-dirs: src+ else+ build-depends: binary
src/Data/Binary/Get/Internal.hs view
@@ -41,12 +41,10 @@ import Control.Applicative -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#if __GLASGOW_HASKELL__ < 704 && !defined(__HADDOCK__) -- needed for (# unboxing #) with magic hash -- Do we still need these? Works without on modern GHCs. import GHC.Base-import GHC.Word--- import GHC.Int #endif -- Kolmodin 20100427: at zurihac we discussed of having partial take a@@ -149,11 +147,15 @@ case ms of Just _ -> go (k ms) Nothing -> neverAgain (k ms)- _ -> r+ BytesRead n k -> BytesRead n (go . k)+ Done _ _ -> r+ Fail _ _ -> r neverAgain r = case r of Partial k -> neverAgain (k Nothing)- _ -> r+ BytesRead n k -> BytesRead n (neverAgain . k)+ Fail _ _ -> r+ Done _ _ -> r prompt :: B.ByteString -> Decoder a -> (B.ByteString -> Decoder a) -> Decoder a prompt inp kf ks =
src/Data/Binary/Put.hs view
@@ -61,9 +61,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -#ifdef APPLICATIVE_IN_BASE import Control.Applicative-#endif ------------------------------------------------------------------------@@ -84,14 +82,12 @@ fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w {-# INLINE fmap #-} -#ifdef APPLICATIVE_IN_BASE instance Applicative PutM where pure = return m <*> k = Put $ let PairS f w = unPut m PairS x w' = unPut k in PairS (f x) (w `mappend` w')-#endif -- Standard Writer monad, with aggressive inlining instance Monad PutM where
tests/QC.hs view
@@ -5,6 +5,7 @@ import Data.Binary.Put import Data.Binary.Get +import Control.Applicative import Control.Monad (unless) import qualified Data.ByteString as B@@ -164,6 +165,29 @@ return ((total',n):rest) +-- | We're trying to guarantee that the Decoder will not ask for more input+-- with Partial if it has been given Nothing once.+-- In this test we're making the decoder return 'Partial' to get more+-- input, and to get knownledge of the current position using 'BytesRead'.+-- Both of these operations, when used with the <|> operator, result internally+-- in that the decoder return with Partial and BytesRead multiple times,+-- in which case we need to keep track of if the user has passed Nothing to a+-- Partial in the past.+prop_partialOnlyOnce :: Property+prop_partialOnlyOnce = property $+ let result = runGetIncremental (decoder <|> decoder)+ decoder = do+ 0 <- bytesRead+ _ <- getWord8 -- this will make the decoder return with Partial+ return "shouldn't get here"+ in case result of+ -- we expect Partial followed by Fail+ Partial k -> case k Nothing of -- push down a Nothing+ Fail _ _ _ -> True+ Partial _ -> error $ "partial twice! oh noes!"+ Done _ _ _ -> error $ "we're not supposed to be done."+ _ -> error $ "not partial, error!"+ -- read too much prop_readTooMuch :: (Eq a, Binary a) => a -> Bool prop_readTooMuch x = mustThrowError $ x == a && x /= b@@ -236,19 +260,19 @@ -- refragment a lazy bytestring's chunks refragment :: [Int] -> L.ByteString -> L.ByteString-refragment [] lps = lps-refragment (x:xs) lps =+refragment [] lbs = lbs+refragment (x:xs) lbs = let x' = fromIntegral . (+1) . abs $ x- rest = refragment xs (L.drop x' lps) in- L.append (L.fromChunks [B.concat . L.toChunks . L.take x' $ lps]) rest+ rest = refragment xs (L.drop x' lbs) in+ L.append (L.fromChunks [B.concat . L.toChunks . L.take x' $ lbs]) rest -- check identity of refragmentation prop_refragment :: L.ByteString -> [Int] -> Bool-prop_refragment lps xs = lps == refragment xs lps+prop_refragment lbs xs = lbs == refragment xs lbs -- check that refragmention still hold invariant prop_refragment_inv :: L.ByteString -> [Int] -> Bool-prop_refragment_inv lps xs = invariant_lbs $ refragment xs lps+prop_refragment_inv lbs xs = invariant_lbs $ refragment xs lbs main :: IO () main = defaultMain tests@@ -283,6 +307,7 @@ [ testProperty "partial" (p prop_partial) , testProperty "fail" (p prop_fail) , testProperty "bytesRead" (p prop_bytesRead)+ , testProperty "partial only once" (p prop_partialOnlyOnce) ] , testGroup "Primitives"