packages feed

packer 0.1.1 → 0.1.3

raw patch · 7 files changed

+158/−43 lines, 7 files

Files

Data/Packer.hs view
@@ -18,11 +18,13 @@     , Unpacking     , OutOfBoundUnpacking(..)     , OutOfBoundPacking(..)+    , IsolationNotFullyConsumed(..)     , Hole     -- * Main methods     , runUnpacking     , tryUnpacking     , runPacking+    , runPackingRes     -- * Unpacking functions     , unpackSkip     , unpackSetPosition@@ -43,6 +45,7 @@     , getRemaining     , getRemainingCopy     , getStorable+    , isolate     -- * Packing functions     , packGetPosition     , putWord8@@ -194,11 +197,25 @@                                           else return $ Just i  -- | Get an arbitrary type with the Storable class constraint.+--+-- The Storage method for sizeOf need to be constant size related+-- to the type. It cannot use any fields to define its size.+--+-- The sizeOf method is always going to be called with undefined,+-- so make sure sizeOf doesn't need the value of the type. getStorable :: Storable a => Unpacking a getStorable = get_ undefined     where get_ :: Storable a => a -> Unpacking a           get_ undefA = unpackCheckAct (sizeOf undefA) (peek . castPtr) +-- | Isolate N bytes from the unpacking, and create an isolated+-- context where only those N bytes are available.+--+-- If the sub unpacker doesn't consume all the bytes available,+-- this function will raises an exception+isolate :: Int -> Unpacking a -> Unpacking a+isolate n subUnpacker = unpackIsolate n subUnpacker+ -- | Put a Word8 putWord8 :: Word8 -> Packing () putWord8 w = packCheckAct 1 (\ptr -> poke (castPtr ptr) w)@@ -285,7 +302,7 @@ putBytes bs =     packCheckAct len $ \ptr ->     withForeignPtr fptr $ \ptr2 ->-    B.memcpy ptr (ptr2 `plusPtr` o) len+    B.memcpy ptr (ptr2 `plusPtr` o) (fromIntegral len)   where (fptr,o,len) = B.toForeignPtr bs  -- | Put an arbitrary type with the Storable class constraint.@@ -301,5 +318,9 @@ tryUnpacking action bs = unsafeDoIO $ tryUnpackingIO bs action  -- | Run packing with a buffer created internally with a monadic action and return the bytestring-runPacking :: Int -> Packing () -> ByteString-runPacking sz action = unsafeDoIO $ runPackingIO sz action+runPackingRes :: Int -> Packing a -> (a, ByteString)+runPackingRes sz action = unsafeDoIO $ runPackingIO sz action++-- | Run packing with a buffer created internally with a monadic action and return the bytestring+runPacking :: Int -> Packing a -> ByteString+runPacking sz action = snd $ runPackingRes sz action
Data/Packer/Endian.hs view
@@ -22,6 +22,20 @@ import Data.Bits import Data.Word +#if MIN_VERSION_base(4,7,0)+-- | swap endianness on a Word16+swap16 :: Word16 -> Word16+swap16 = byteSwap16++-- | Transform a 32 bit value bytes from a.b.c.d to d.c.b.a+swap32 :: Word32 -> Word32+swap32 = byteSwap32++-- | Transform a 64 bit value bytes from a.b.c.d.e.f.g.h to h.g.f.e.d.c.b.a+swap64 :: Word64 -> Word64+swap64 = byteSwap64++#else #if BITS_IS_OLD shr :: Bits a => a -> Int -> a shr = shiftR@@ -44,11 +58,6 @@     .|. ((w `shr` 40) .&. 0xff00)     .|. ((w .&. 0xff00) `shl` 40)     .|. ((w `shr` 24) .&. 0xff0000)   .|. ((w .&. 0xff0000) `shl` 24)     .|. ((w `shr` 8)  .&. 0xff000000) .|. ((w .&. 0xff000000) `shl` 8)-{--    .|. ((w `shr` 48) .&. 0xff00)     .|. ((w .&. 0xff00) `shl` 48)-    .|. ((w `shr` 40) .&. 0xff0000)   .|. ((w .&. 0xff0000) `shl` 40)-    .|. ((w `shr` 32) .&. 0xff000000) .|. ((w .&. 0xff000000) `shl` 32)--}  -- | swap endianness on a Word32 swap32 :: Word32 -> Word32@@ -59,37 +68,50 @@ -- | swap endianness on a Word16 swap16 :: Word16 -> Word16 swap16 w = (w `shr` 8) .|. (w `shl` 8)+#endif  #ifdef CPU_BIG_ENDIAN+-- | 16 bit big endian to host endian {-# INLINE be16Host #-} be16Host :: Word16 -> Word16 be16Host = id+-- | 32 bit big endian to host endian {-# INLINE be32Host #-} be32Host :: Word32 -> Word32 be32Host = id+-- | 64 bit big endian to host endian {-# INLINE be64Host #-} be64Host :: Word64 -> Word64 be64Host = id+-- | 16 bit little endian to host endian le16Host :: Word16 -> Word16 le16Host w = swap16 w+-- | 32 bit little endian to host endian le32Host :: Word32 -> Word32 le32Host w = swap32 w+-- | 64 bit little endian to host endian le64Host :: Word64 -> Word64 le64Host w = swap64 w #else+-- | 16 bit little endian to host endian {-# INLINE le16Host #-} le16Host :: Word16 -> Word16 le16Host = id+-- | 32 bit little endian to host endian {-# INLINE le32Host #-} le32Host :: Word32 -> Word32 le32Host = id+-- | 64 bit little endian to host endian {-# INLINE le64Host #-} le64Host :: Word64 -> Word64 le64Host = id+-- | 16 bit big endian to host endian be16Host :: Word16 -> Word16 be16Host w = swap16 w+-- | 32 bit big endian to host endian be32Host :: Word32 -> Word32 be32Host w = swap32 w+-- | 64 bit big endian to host endian be64Host :: Word64 -> Word64 be64Host w = swap64 w #endif
Data/Packer/IO.hs view
@@ -28,10 +28,10 @@ tryUnpackingIO bs action = E.try $ runUnpackingIO bs action  -- | Run packing with a buffer created internally with a monadic action and return the bytestring-runPackingIO :: Int -> Packing () -> IO ByteString+runPackingIO :: Int -> Packing a -> IO (a, ByteString) runPackingIO sz action = createUptoN sz $ \ptr -> runPackingAt ptr sz action     where -- copy of bytestring createUptoN as it's only been added 2012-09           createUptoN l f = do fp <- B.mallocByteString l-                               l' <- withForeignPtr fp $ \p -> f p-                               return $! B.PS fp 0 l'+                               (a, l') <- withForeignPtr fp $ \p -> f p+                               return $! (,) a $! B.PS fp 0 l'
Data/Packer/Internal.hs view
@@ -15,18 +15,22 @@     , Hole     , Unpacking(..)     , Memory(..)-    , PackSt(..)+    -- * exceptions     , OutOfBoundUnpacking(..)     , OutOfBoundPacking(..)     , HoleInPacking(..)+    , IsolationNotFullyConsumed(..)+    -- * unpack methods     , unpackUnsafeActRef     , unpackCheckActRef     , unpackUnsafeAct     , unpackCheckAct+    , unpackIsolate     , unpackLookahead     , unpackSetPosition     , unpackGetPosition     , unpackGetNbRemaining+    -- * pack methods     , packCheckAct     , packHole     , packGetPosition@@ -37,21 +41,50 @@ import Foreign.ForeignPtr import Data.Data import Data.Word-import Control.Exception (Exception, throw, throwIO)-import Control.Monad.State+import Control.Exception (Exception, throwIO)+import Control.Monad.Trans import Control.Applicative (Applicative(..), (<$>), (<*>))+import Control.Concurrent.MVar+import Control.Monad (when)  -- | Represent a memory block with a ptr as beginning data Memory = Memory {-# UNPACK #-} !(Ptr Word8)                      {-# UNPACK #-} !Int --- | Packing state-data PackSt = PackSt (Ptr Word8) !Int !Memory- -- | Packing monad-newtype Packing a = Packing { runPacking_ :: StateT PackSt IO a }-                  deriving (Functor,Applicative,Monad,MonadIO)+newtype Packing a = Packing { runPacking_ :: (Ptr Word8, MVar Int) -> Memory -> IO (a, Memory) } +instance Monad Packing where+    return = returnPacking+    (>>=)  = bindPacking++instance MonadIO Packing where+    liftIO f = Packing $ \_ st -> f >>= \a -> return (a,st)++instance Functor Packing where+    fmap = fmapPacking++instance Applicative Packing where+    pure  = returnPacking+    (<*>) = apPacking++bindPacking m1 m2 = Packing $ \cst st -> do+    (a, st2) <- runPacking_ m1 cst st+    runPacking_ (m2 a) cst st2+{-# INLINE bindPacking #-}++fmapPacking :: (a -> b) -> Packing a -> Packing b+fmapPacking f m = Packing $ \cst st -> runPacking_ m cst st >>= \(a, st2) -> return (f a, st2)+{-# INLINE fmapPacking #-}++returnPacking :: a -> Packing a+returnPacking a = Packing $ \_ st -> return (a,st)+{-# INLINE [0] returnPacking #-}++apPacking :: Packing (a -> b) -> Packing a -> Packing b+apPacking fm m = fm >>= \p -> m >>= \r2 -> return (p r2)+{-# INLINE [0] apPacking #-}+ -- | Unpacking monad newtype Unpacking a = Unpacking { runUnpacking_ :: (ForeignPtr Word8, Memory) -> Memory -> IO (a, Memory) } @@ -59,6 +92,9 @@     return = returnUnpacking     (>>=)  = bindUnpacking +instance MonadIO Unpacking where+    liftIO f = Unpacking $ \_ st -> f >>= \a -> return (a,st)+ instance Functor Unpacking where     fmap = fmapUnpacking @@ -97,25 +133,52 @@                                                Int -- number of bytes requested     deriving (Show,Eq,Data,Typeable) +-- | Exception when isolate doesn't consume all the bytes passed in the sub unpacker+data IsolationNotFullyConsumed = IsolationNotFullyConsumed Int -- number of bytes isolated+                                                           Int -- number of bytes not consumed+    deriving (Show,Eq,Data,Typeable)+ instance Exception OutOfBoundPacking instance Exception HoleInPacking instance Exception OutOfBoundUnpacking+instance Exception IsolationNotFullyConsumed -unpackUnsafeActRef :: Int -> (ForeignPtr Word8 -> Ptr Word8 -> IO a) -> Unpacking a+-- | run an action to transform a number of bytes into a 'a'+-- and increment the pointer by number of bytes.+unpackUnsafeActRef :: Int -- ^ number of bytes+                   -> (ForeignPtr Word8 -> Ptr Word8 -> IO a)+                   -> Unpacking a unpackUnsafeActRef n act = Unpacking $ \(fptr, iniBlock) st@(Memory ptr sz) -> do     r <- act fptr ptr     return (r, Memory (ptr `plusPtr` n) (sz - n)) -unpackCheckActRef :: Int -> (ForeignPtr Word8 -> Ptr Word8 -> IO a) -> Unpacking a+-- | similar 'unpackUnsafeActRef' but does boundary checking.+unpackCheckActRef :: Int+                  -> (ForeignPtr Word8 -> Ptr Word8 -> IO a)+                  -> Unpacking a unpackCheckActRef n act = Unpacking $ \(fptr, iniBlock@(Memory iniPtr _)) (Memory ptr sz) -> do     when (sz < n) (throwIO $ OutOfBoundUnpacking (ptr `minusPtr` iniPtr) n)     r <- act fptr ptr     return (r, Memory (ptr `plusPtr` n) (sz - n)) {-# INLINE [0] unpackCheckActRef #-} +-- | Isolate a number of bytes to run an unpacking operation.+--+-- If the unpacking doesn't consume all the bytes, an exception is raised.+unpackIsolate :: Int+              -> Unpacking a+              -> Unpacking a+unpackIsolate n sub = Unpacking $ \(fptr, iniBlock@(Memory iniPtr _)) (Memory ptr sz) -> do+    when (sz < n) (throwIO $ OutOfBoundUnpacking (ptr `minusPtr` iniPtr) n)+    (r, Memory newPtr subLeft) <- (runUnpacking_ sub) (fptr,iniBlock) (Memory ptr n)+    when (subLeft > 0) $ (throwIO $ IsolationNotFullyConsumed n subLeft)+    return (r, Memory newPtr (sz - n))++-- | Similar to unpackUnsafeActRef except that it throw the foreign ptr. unpackUnsafeAct :: Int -> (Ptr Word8 -> IO a) -> Unpacking a unpackUnsafeAct n act = unpackUnsafeActRef n (\_ -> act) +-- | Similar to unpackCheckActRef except that it throw the foreign ptr. unpackCheckAct :: Int -> (Ptr Word8 -> IO a) -> Unpacking a unpackCheckAct n act = unpackCheckActRef n (\_ -> act) {-# INLINE [0] unpackCheckAct #-}@@ -132,9 +195,9 @@ unpackGetPosition = Unpacking $     \(_, (Memory iniPtr _)) st@(Memory ptr _) -> return (ptr `minusPtr` iniPtr, st) +-- | Return the number of remaining bytes unpackGetNbRemaining :: Unpacking Int-unpackGetNbRemaining = Unpacking $-    \_ st@(Memory _ sz) -> return (sz,st)+unpackGetNbRemaining = Unpacking $ \_ st@(Memory _ sz) -> return (sz,st)  -- | Allow to look into the memory. -- This is inherently unsafe@@ -143,23 +206,21 @@ unpackLookahead f = Unpacking $     \_ st@(Memory ptr sz) -> f ptr sz >>= \a -> return (a, st) -withPackMemory :: Int -> (Ptr Word8 -> IO a) -> StateT PackSt IO a-withPackMemory n act = do-    (PackSt iPos holes (Memory ptr sz)) <- get-    when (sz < n) (lift $ throw $ OutOfBoundPacking sz n)-    r <- lift (act ptr)-    put $ PackSt iPos holes (Memory (ptr `plusPtr` n) (sz - n))-    return r+-- | run a pack action on the internal packed buffer.+packCheckAct :: Int -> (Ptr Word8 -> IO a) -> Packing a+packCheckAct n act = Packing $ \_ (Memory ptr sz) -> do+    when (sz < n) (throwIO $ OutOfBoundPacking sz n)+    r <- act ptr+    return (r, Memory (ptr `plusPtr` n) (sz - n))+{-# INLINE [0] packCheckAct #-} +-- | modify holes modifyHoles :: (Int -> Int) -> Packing ()-modifyHoles f = Packing $ modify (\(PackSt iPos holes mem) -> PackSt iPos (f holes) mem)--packCheckAct :: Int -> (Ptr Word8 -> IO a) -> Packing a-packCheckAct n act = Packing (withPackMemory n act)+modifyHoles f = Packing $ \(_, holesMVar) mem -> modifyMVar_ holesMVar (\v -> return $! f v) >> return ((), mem)  -- | Get the position in the memory block. packGetPosition :: Packing Int-packGetPosition = Packing $ gets (\(PackSt iniPtr _ (Memory ptr _)) -> ptr `minusPtr` iniPtr)+packGetPosition = Packing $ \(iniPtr, _) mem@(Memory ptr _) -> return (ptr `minusPtr` iniPtr, mem)  -- | A Hole represent something that need to be filled -- later, for example a CRC, a prefixed size, etc.@@ -179,4 +240,4 @@ -- -- TODO: user can use one hole many times leading to wrong counting. fillHole :: Hole a -> a -> Packing ()-fillHole (Hole closure) a = modifyHoles (\i -> i - 1) >> Packing (lift $ closure a)+fillHole (Hole closure) a = modifyHoles (\i -> i - 1) >> liftIO (closure a)
Data/Packer/Unsafe.hs view
@@ -20,19 +20,23 @@ import Foreign.ForeignPtr import Control.Monad.State import Control.Exception+import Control.Concurrent.MVar (takeMVar, newMVar)  -- | Run packing on an arbitrary buffer with a size. -- -- This is available, for example to run on mmap typed memory, and this is highly unsafe, -- as the user need to make sure the pointer and size passed to this function are correct.-runPackingAt :: Ptr Word8  -- ^ Pointer to the beginning of the memory-             -> Int        -- ^ Size of the memory-             -> Packing () -- ^ Packing action-             -> IO Int     -- ^ Number of bytes filled+runPackingAt :: Ptr Word8   -- ^ Pointer to the beginning of the memory+             -> Int         -- ^ Size of the memory+             -> Packing a   -- ^ Packing action+             -> IO (a, Int) -- ^ Number of bytes filled runPackingAt ptr sz action = do-    (PackSt _ holes (Memory _ leftSz)) <- execStateT (runPacking_ action) (PackSt ptr 0 $ Memory ptr sz)+    mvar <- newMVar 0+    (a, (Memory _ leftSz)) <- (runPacking_ action) (ptr,mvar) (Memory ptr sz)+    --(PackSt _ holes (Memory _ leftSz)) <- execStateT (runPacking_ action) (PackSt ptr 0 $ Memory ptr sz)+    holes <- takeMVar mvar     when (holes > 0) (throwIO $ HoleInPacking holes)-    return $ sz - leftSz+    return (a, sz - leftSz)  -- | Run unpacking on an arbitrary buffer with a size. --
Tests/Tests.hs view
@@ -131,6 +131,13 @@                                                     (runUnpacking (unpackSetPosition 2) (B.singleton 1)))             , testCase "unpacking set pos after" (assertException "unpacking position" (\(OutOfBoundUnpacking _ _) -> Just ())                                                     (runUnpacking (unpackSetPosition (-1)) (B.singleton 1)))+            , testCase "unpacking isolate" (runUnpacking (isolate 2 (getBytes 2) >>= \i -> getWord8 >>= \r -> return (i,r)) (B.pack [1,2,3]) @=? (B.pack [1,2], 3))+            , testCase "unpacking isolate out of bounds" $+                assertException "unpacking isolate" (\(OutOfBoundUnpacking _ _) -> Just ())+                    (runUnpacking (isolate 2 (getBytes 3)) (B.pack [1,2,3]))+            , testCase "unpacking isolate not consumed" $+                assertException "unpacking isolate" (\(IsolationNotFullyConsumed _ _) -> Just ())+                    (runUnpacking (isolate 3 (getBytes 2)) (B.pack [1,2,3]))             ]         , testGroup "endianness cases" $ concatMap toEndianCase endiannessCases         , testProperty "unpacking.packing=id" (\ds -> unpackDataStream ds (packDataStream ds) == ds)
packer.cabal view
@@ -1,5 +1,5 @@ Name:                packer-Version:             0.1.1+Version:             0.1.3 Description:         Fast byte serializer and unserializer License:             BSD3 License-file:        LICENSE