binary-strict (empty) → 0.1
raw patch · 4 files changed
+376/−0 lines, 4 filesdep +arraydep +basedep +bytestringbuild-type:Customsetup-changed
Dependencies added: array, base, bytestring, containers
Files
- LICENSE +30/−0
- Setup.lhs +3/−0
- binary-strict.cabal +20/−0
- src/Data/Binary/Strict/Get.hs +323/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) Lennart Kolmodin++All rights reserved.++Redistribution and use in source and binary forms, with or without+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.++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.++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.++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.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ binary-strict.cabal view
@@ -0,0 +1,20 @@+name: binary-strict+version: 0.1+license: BSD3+license-file: LICENSE+author: Lennart Kolmodin <kolmodin@dtek.chalmers.se>+maintainer: Adam Langley <agl@imperialviolet.org>+description: This is a strict version of the Get monad from the binary+ package. Ti'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.+synopsis: Binary deserialisation using strict ByteStrings+category: Data, Parsing+build-depends: base, containers, array, bytestring>=0.9+stability: provisional+tested-with: GHC == 6.8.1+exposed-modules: Data.Binary.Strict.Get+extensions: CPP, FlexibleContexts+hs-source-dirs: src+ghc-options: -O2 -Wall
+ src/Data/Binary/Strict/Get.hs view
@@ -0,0 +1,323 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fglasgow-exts #-}+-- for unboxed shifts++-----------------------------------------------------------------------------+-- |+-- Module : Data.Binary.Get+-- Copyright : Lennart Kolmodin+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Adam Langley <agl@imperialviolet.org>+-- Stability : experimental+-- Portability : portable to Hugs and GHC.+--+-- 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 a stop gap measure.+--+-- To use, write a function in the Get monad:+--+-- > import Data.Binary.Strict.Get as BinStrict+-- > import Data.ByteString as BS+-- > parse :: BinStrict.Get+-- > parse = getWord16be+-- > main = print $ runGet parse $ BS.pack [1, 1]+--+-- This results in a tuple of (Right 257, \"\") (where the second element is+-- just the remaining data after the parser has run)+-----------------------------------------------------------------------------++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Data.Binary.Strict.Get (+ -- * The Get type+ Get+ , runGet++ -- * Parsing+ , lookAhead+ , lookAheadM+ , lookAheadE++ -- * Utility+ , skip+ , bytesRead+ , remaining+ , isEmpty++ -- * Parsing particular types+ , getWord8++ -- ** ByteStrings+ , getByteString++ -- ** Big-endian reads+ , getWord16be+ , getWord32be+ , getWord64be++ -- ** Little-endian reads+ , getWord16le+ , getWord32le+ , getWord64le++ -- ** Host-endian, unaligned reads+ , getWordhost+ , getWord16host+ , getWord32host+ , getWord64host+) where++import Control.Monad (when)+import Data.Maybe (isNothing)++import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B++import Foreign++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base+import GHC.Word+#endif++-- | The parse state+data S = S {-# UNPACK #-} !B.ByteString -- input+ {-# UNPACK #-} !Int -- bytes read++newtype Get a = Get { unGet :: S -> (Either String a, S) }++instance Functor Get where+ fmap f m = Get (\s -> case unGet m s of+ (Right a, s') -> (Right $ f a, s')+ (Left err, s') -> (Left err, s'))++instance Monad Get where+ return a = Get (\s -> (Right a, s))+ m >>= k = Get (\s -> case unGet m s of+ (Left err, s') -> (Left err, s')+ (Right a, s') -> unGet (k a) s')+ fail err = Get (\s -> (Left err, s))++get :: Get S+get = Get (\s -> (Right s, s))++put :: S -> Get ()+put s = Get (const (Right (), s))++initState :: B.ByteString -> S+initState input = S input 0+{-# INLINE initState #-}++-- | Run a parser on the given input and return the result (either an error+-- string from a call to @fail@, or the parsing result) and the remainder of+-- of the input.+runGet :: Get a -> B.ByteString -> (Either String a, B.ByteString)+runGet m input =+ case unGet m (initState input) of+ (a, ~(S _ offset)) -> (a, B.drop offset input)++-- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.+skip :: Int -> Get ()+skip n = readN (fromIntegral n) (const ())++-- | Run @ga@, but return without consuming its input.+-- Fails if @ga@ fails.+lookAhead :: Get a -> Get a+lookAhead ga = do+ s <- get+ a <- ga+ put s+ return a++-- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'.+-- Fails if @gma@ fails.+lookAheadM :: Get (Maybe a) -> Get (Maybe a)+lookAheadM gma = do+ s <- get+ ma <- gma+ when (isNothing ma) $+ put s+ return ma++-- | Like 'lookAhead', but consume the input if @gea@ returns 'Right _'.+-- Fails if @gea@ fails.+lookAheadE :: Get (Either a b) -> Get (Either a b)+lookAheadE gea = do+ s <- get+ ea <- gea+ case ea of+ Left _ -> put s+ _ -> return ()+ return ea++-- | Get the total number of bytes read to this point.+bytesRead :: Get Int+bytesRead = do+ S _ b <- get+ return b++-- | Get the number of remaining unparsed bytes.+-- Useful for checking whether all input has been consumed.+remaining :: Get Int+remaining = do+ S s _ <- get+ return (fromIntegral (B.length s))++-- | Test whether all input has been consumed,+-- i.e. there are no remaining unparsed bytes.+isEmpty :: Get Bool+isEmpty = do+ S s _ <- get+ return $ B.null s++------------------------------------------------------------------------+-- Utility with ByteStrings++-- | An efficient 'get' method for strict ByteStrings. Fails if fewer+-- than @n@ bytes are left in the input.+getByteString :: Int -> Get B.ByteString+getByteString n = readN n id+{-# INLINE getByteString #-}++-- | Pull @n@ bytes from the input, as a strict ByteString.+getBytes :: Int -> Get B.ByteString+getBytes n = do+ S s offset <- get+ if n <= B.length s+ then do let (consume, rest) = B.splitAt n s+ put $! S rest (offset + fromIntegral n)+ return $! consume+ else fail "too few bytes"+{-# INLINE getBytes #-}++-- Pull n bytes from the input, and apply a parser to those bytes,+-- yielding a value. If less than @n@ bytes are available, fail with an+-- error. This wraps @getBytes@.+readN :: Int -> (B.ByteString -> a) -> Get a+readN n f = fmap f $ getBytes n+{-# INLINE readN #-}++getPtr :: Storable a => Int -> Get a+getPtr n = do+ (fp, o, _) <- readN n B.toForeignPtr+ return . B.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)+{-# INLINE getPtr #-}++getWord8 :: Get Word8+getWord8 = getPtr (sizeOf (undefined :: Word8))+{-# INLINE getWord8 #-}++-- | Read a Word16 in big endian format+getWord16be :: Get Word16+getWord16be = do+ s <- readN 2 id+ return $! (fromIntegral (s `B.index` 0) `shiftl_w16` 8) .|.+ (fromIntegral (s `B.index` 1))++-- | Read a Word16 in little endian format+getWord16le :: Get Word16+getWord16le = do+ s <- readN 2 id+ return $! (fromIntegral (s `B.index` 1) `shiftl_w16` 8) .|.+ (fromIntegral (s `B.index` 0) )+{-# INLINE getWord16le #-}++-- | Read a Word32 in big endian format+getWord32be :: Get Word32+getWord32be = do+ s <- readN 4 id+ return $! (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) )+{-# INLINE getWord32be #-}++-- | Read a Word32 in little endian format+getWord32le :: Get Word32+getWord32le = do+ s <- readN 4 id+ return $! (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) )+{-# INLINE getWord32le #-}++-- | Read a Word64 in big endian format+getWord64be :: Get Word64+getWord64be = do+ s <- readN 8 id+ return $! (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) )+{-# INLINE getWord64be #-}++-- | Read a Word64 in little endian format+getWord64le :: Get Word64+getWord64le = do+ s <- readN 8 id+ return $! (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) )++------------------------------------------------------------------------+-- Host-endian reads++-- | /O(1)./ Read a single native machine word. The word is read in+-- host order, host endian form, for the machine you're on. On a 64 bit+-- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes.+getWordhost :: Get Word+getWordhost = getPtr (sizeOf (undefined :: Word))+{-# INLINE getWordhost #-}++-- | /O(1)./ Read a 2 byte Word16 in native host order and host endianness.+getWord16host :: Get Word16+getWord16host = getPtr (sizeOf (undefined :: Word16))+{-# INLINE getWord16host #-}++-- | /O(1)./ Read a Word32 in native host order and host endianness.+getWord32host :: Get Word32+getWord32host = getPtr (sizeOf (undefined :: Word32))+{-# INLINE getWord32host #-}++-- | /O(1)./ Read a Word64 in native host order and host endianess.+getWord64host :: Get Word64+getWord64host = getPtr (sizeOf (undefined :: Word64))+{-# INLINE getWord64host #-}++++{-# INLINE getWord64le #-}+shiftl_w16 :: Word16 -> Int -> Word16+shiftl_w32 :: Word32 -> Int -> Word32+shiftl_w64 :: Word64 -> Int -> Word64++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)+shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)++#if WORD_SIZE_IN_BITS < 64+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)+#else+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)+#endif++#else+shiftl_w16 = shiftL+shiftl_w32 = shiftL+shiftl_w64 = shiftL+#endif