binary-strict 0.4.8.3 → 0.4.8.4
raw patch · 9 files changed
+111/−195 lines, 9 filesdep −containersdep ~arraydep ~basedep ~bytestringsetup-changed
Dependencies removed: containers
Dependency ranges changed: array, base, bytestring, mtl
Files
- CHANGELOG.md +5/−0
- LICENSE +22/−22
- Setup.hs +2/−0
- Setup.lhs +0/−3
- binary-strict.cabal +42/−34
- src/Data/Binary/BitBuilder.hs +6/−4
- src/Data/Binary/Strict/BitGet.hs +34/−2
- src/Data/Binary/Strict/Common.h +0/−96
- tests/BitGetTest.hs +0/−34
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for binary-low-level++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c) Lennart Kolmodin+Copyright (c) 2020, Dominic Steinitz All rights reserved. Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:+modification, are permitted provided that the following conditions are met: -1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer. -2. 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.+ * 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. -3. Neither the name of the author nor the names of his contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.+ * Neither the name of Dominic Steinitz 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 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 AUTHORS 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.+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
− Setup.lhs
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
binary-strict.cabal view
@@ -1,34 +1,42 @@-name: binary-strict-version: 0.4.8.3-license: BSD3-license-file: LICENSE-author: Lennart Kolmodin <kolmodin@dtek.chalmers.se>-maintainer: Dominic Steinitz <dominic@steinitz.org>-homepage: https://github.com/idontgetoutmuch/binary-low-level-description: This is a strict version of the Get monad from the binary- package. It's pretty much just a copy and paste job from the- original source code. The binary team are currently unsure- about their future plans w.r.t. strictness, so this is just a- stop gap measure. See- <http://www.haskell.org/haskellwiki/DealingWithBinaryData> for- documentation.-synopsis: Binary deserialisation using strict ByteStrings-category: Data, Parsing-build-depends: base<5, containers, array, bytestring>=0.9-stability: provisional-tested-with: GHC == 7.10.2-exposed-modules: Data.Binary.BitPut- Data.Binary.Strict.ByteSet- Data.Binary.Strict.BitGet,- Data.Binary.Strict.BitUtil- Data.Binary.Strict.Get,- Data.Binary.Strict.Class- Data.Binary.Strict.IncrementalGet,- Data.Binary.Strict.Util- Data.Binary.BitBuilder-extensions: CPP, FlexibleContexts-hs-source-dirs: src-extra-source-files: tests/BitGetTest.hs, src/Data/Binary/Strict/Common.h-ghc-options: -Wall -fno-warn-name-shadowing-build-type: Simple-build-depends: mtl >= 2.1 && <2.3+cabal-version: >=1.10+name: binary-strict+version: 0.4.8.4+synopsis: Binary deserialisation using strict ByteStrings+description: This is a strict version of the Get monad from the binary+ package. It's pretty much just a copy and paste job+ from the original source code. The binary team are+ currently unsure about their future plans+ w.r.t. strictness, so this is just a stop gap+ measure. See+ <http://www.haskell.org/haskellwiki/DealingWithBinaryData>+ for documentation.+bug-reports: https://github.com/idontgetoutmuch/binary-low-level+license: BSD3+license-file: LICENSE+author: Lennart Kolmodin <kolmodin@dtek.chalmers.se>+maintainer: Dominic Steinitz <dominic@steinitz.org>+copyright: Dominic Steinitz, Lennart Kolmodin+category: Data, Parsing+build-type: Simple+extra-source-files: CHANGELOG.md++library+ exposed-modules: Data.Binary.BitBuilder,+ Data.Binary.BitPut,+ Data.Binary.Strict.Class,+ Data.Binary.Strict.BitGet,+ Data.Binary.Strict.IncrementalGet,+ Data.Binary.Strict.Get,+ Data.Binary.Strict.BitUtil,+ Data.Binary.Strict.ByteSet,+ Data.Binary.Strict.Util+ other-extensions: CPP,+ FlexibleInstances,+ MultiParamTypeClasses,+ UndecidableInstances+ build-depends: base >=4.12 && <4.13,+ bytestring >=0.10 && <0.11,+ mtl >=2.2 && <2.3,+ array >=0.5 && <0.6+ hs-source-dirs: src+ default-language: Haskell2010
src/Data/Binary/BitBuilder.hs view
@@ -35,8 +35,8 @@ , flush ) where -import Foreign hiding (unsafePerformIO)-import Data.Monoid+import Foreign+import Data.Semigroup (Semigroup((<>))) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import System.IO.Unsafe (unsafePerformIO)@@ -80,9 +80,11 @@ instance Show BitBuilder where show = const "<BitBuilder>" +instance Semigroup BitBuilder where+ (<>) = append+ instance Monoid BitBuilder where mempty = empty- mappend = append ------------------------------------------------------------------------ @@ -226,7 +228,7 @@ -- | Sequence an IO operation on the buffer unsafeLiftIO :: (Buffer -> IO Buffer) -> BitBuilder-unsafeLiftIO f = BitBuilder $ \ k buf -> inlinePerformIO $ do+unsafeLiftIO f = BitBuilder $ \ k buf -> unsafePerformIO $ do buf' <- f buf return (k buf') {-# INLINE unsafeLiftIO #-}
src/Data/Binary/Strict/BitGet.hs view
@@ -38,12 +38,18 @@ , getLeftByteString , getRightByteString - -- ** Interpreting some number of bits as an integer+ -- ** Interpreting some number of bits as an unsigned integer , getAsWord8 , getAsWord16 , getAsWord32 , getAsWord64 + -- ** Interpreting some number of bits as a signed integer+ , getAsInt8+ , getAsInt16+ , getAsInt32+ , getAsInt64+ -- ** Parsing particular types , getWord8 , getWord16le@@ -64,7 +70,6 @@ import qualified Data.ByteString.Internal as BI import Data.Binary.Strict.BitUtil import Foreign-import Data.Bits #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) import GHC.Base@@ -212,6 +217,33 @@ s <- readN BRight n id >>= return . leftPad 8 return $! DECWORD64BE(s) {-# INLINE getWord64be #-}++-- | Reads an 'Int8', sign-extending the input if it has+-- fewer than 8 bits.+getAsInt8 :: Int -> BitGet Int8+getAsInt8 n = fmap (signExtendRightAlignedWord n) (getAsWord8 n)++-- | Reads an 'Int16' in big endian format, sign-extending the input if it has+-- fewer than 16 bits.+getAsInt16 :: Int -> BitGet Int16+getAsInt16 n = fmap (signExtendRightAlignedWord n) (getAsWord16 n)++-- | Reads an 'Int32' in big endian format, sign-extending the input if it has+-- fewer than 32 bits.+getAsInt32 :: Int -> BitGet Int32+getAsInt32 n = fmap (signExtendRightAlignedWord n) (getAsWord32 n)++-- | Reads an 'Int64' in big endian format, sign-extending the input if it has+-- fewer than 64 bits.+getAsInt64 :: Int -> BitGet Int64+getAsInt64 n = fmap (signExtendRightAlignedWord n) (getAsWord64 n)++-- Assumes but does not verify that a and b have the same finite size.+signExtendRightAlignedWord :: (FiniteBits a, FiniteBits b, Integral a, Integral b) => Int -> a -> b+signExtendRightAlignedWord n x = fromIntegral (x `shiftL` shift) `shiftR` shift+ where+ shift = finiteBitSize x - n+{-# INLINE signExtendRightAlignedWord #-} shiftl_w16 :: Word16 -> Int -> Word16 shiftl_w32 :: Word32 -> Int -> Word32
− src/Data/Binary/Strict/Common.h
@@ -1,96 +0,0 @@-#define GETHOSTWORD(name, m, type) \-name :: m type ; \-name = getPtr (sizeOf (undefined :: type))--#define GETHOSTWORDS(m) \-GETHOSTWORD(getWord8, m, Word8); \-GETHOSTWORD(getWordhost, m, Word) ; \-GETHOSTWORD(getWord16host, m, Word16) ; \-GETHOSTWORD(getWord32host, m, Word32) ; \-GETHOSTWORD(getWord64host, m, Word64) ; \--#define DECWORD16LE(s) \- ((fromIntegral (s `B.index` 1) `shiftl_w16` 8) .|. \- (fromIntegral (s `B.index` 0) ) )--#define DECWORD16BE(s) \- ((fromIntegral (s `B.index` 0) `shiftl_w16` 8) .|. \- (fromIntegral (s `B.index` 1) ) )--#define DECWORD32BE(s) \- ((fromIntegral (s `B.index` 0) `shiftl_w32` 24) .|. \- (fromIntegral (s `B.index` 1) `shiftl_w32` 16) .|. \- (fromIntegral (s `B.index` 2) `shiftl_w32` 8) .|. \- (fromIntegral (s `B.index` 3) ) )--#define DECWORD32LE(s) \- ((fromIntegral (s `B.index` 3) `shiftl_w32` 24) .|. \- (fromIntegral (s `B.index` 2) `shiftl_w32` 16) .|. \- (fromIntegral (s `B.index` 1) `shiftl_w32` 8) .|. \- (fromIntegral (s `B.index` 0) ) )--#define DECWORD64BE(s) \- ((fromIntegral (s `B.index` 0) `shiftl_w64` 56) .|. \- (fromIntegral (s `B.index` 1) `shiftl_w64` 48) .|. \- (fromIntegral (s `B.index` 2) `shiftl_w64` 40) .|. \- (fromIntegral (s `B.index` 3) `shiftl_w64` 32) .|. \- (fromIntegral (s `B.index` 4) `shiftl_w64` 24) .|. \- (fromIntegral (s `B.index` 5) `shiftl_w64` 16) .|. \- (fromIntegral (s `B.index` 6) `shiftl_w64` 8) .|. \- (fromIntegral (s `B.index` 7) ) )--#define DECWORD64LE(s) \- ((fromIntegral (s `B.index` 7) `shiftl_w64` 56) .|. \- (fromIntegral (s `B.index` 6) `shiftl_w64` 48) .|. \- (fromIntegral (s `B.index` 5) `shiftl_w64` 40) .|. \- (fromIntegral (s `B.index` 4) `shiftl_w64` 32) .|. \- (fromIntegral (s `B.index` 3) `shiftl_w64` 24) .|. \- (fromIntegral (s `B.index` 2) `shiftl_w64` 16) .|. \- (fromIntegral (s `B.index` 1) `shiftl_w64` 8) .|. \- (fromIntegral (s `B.index` 0) ) )--#define GETWORD16LE(name, m, f) \-name :: m Word16 ; \-name = do { \- s <- f 2; \- return $! DECWORD16LE(s) }--#define GETWORD16BE(name, m, f) \-name :: m Word16 ; \-name = do { \- s <- f 2; \- return $! DECWORD16BE(s) }--#define GETWORD32LE(name, m, f) \-name :: m Word32 ; \-name = do { \- s <- f 4; \- return $! DECWORD32LE(s) }--#define GETWORD32BE(name, m, f) \-name :: m Word32 ; \-name = do { \- s <- f 4; \- return $! DECWORD32BE(s) }--#define GETWORD64LE(name, m, f) \-name :: m Word64 ; \-name = do { \- s <- f 8; \- return $! DECWORD64LE(s) }--#define GETWORD64BE(name, m, f) \-name :: m Word64 ; \-name = do { \- s <- f 8; \- return $! DECWORD64BE(s) }--#define GETWORDS(m, f) \-GETWORD16LE(getWord16le, m, f); \-GETWORD16BE(getWord16be, m, f); \-GETWORD32LE(getWord32le, m, f); \-GETWORD32BE(getWord32be, m, f); \-GETWORD64LE(getWord64le, m, f); \-GETWORD64BE(getWord64be, m, f);--
− tests/BitGetTest.hs
@@ -1,34 +0,0 @@-module Main where--import qualified Data.ByteString as B-import Data.Word--import qualified Data.Binary.Strict.BitGet as BG--t :: (Eq a, Show a) => [Word8] -> BG.BitGet a -> a -> Bool-t bytes m v = if result == v then True else error (show (bytes, v, result)) where- Right result = BG.runBitGet (B.pack bytes) m--tests = [- t [1] BG.getWord8 1- , t [128] BG.getBit True- , t [64] BG.getBit False- , t [1, 0] BG.getWord16be 256- , t [1, 2] BG.getWord16be 258- , t [1, 0] BG.getWord16le 1- , t [2, 1] BG.getWord16le 258- , t [192, 0] (BG.getBit >> BG.getWord8) 128- , t [193, 0] (BG.getBit >> BG.getWord8) 130- , t [193, 42] (sequence (take 8 $ repeat BG.getBit) >> BG.getWord8) 42- , t [193] (BG.getAsWord8 3) 6- , t [193] (BG.getAsWord8 4) 12- , t [193, 128] (BG.skip 4 >> BG.getAsWord8 4) 1- , t [193, 128] (BG.skip 8 >> BG.getAsWord8 4) 8- , t [1, 2, 3, 0] (BG.getAsWord32 24) 66051- , t [1, 2, 3, 0] (BG.getAsWord32 8) 1- , t [1, 2, 3, 4, 5] (BG.getAsWord64 40) 4328719365- ]--main = do- print $ length $ filter id tests- putStrLn "PASS"