network-byte-order 0.1.2.0 → 0.1.2.1

raw patch · 2 files changed

+115/−50 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Network/ByteOrder.hs +114/−49
• network-byte-order.cabal +1/−1

@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} @@ -41,6 +40,7 @@   , Readable(..)     -- *Reading from buffer   , ReadBuffer+  , newReadBuffer   , withReadBuffer   , read16   , read24@@ -51,6 +51,7 @@   , WriteBuffer(..)   , newWriteBuffer   , withWriteBuffer+  , withWriteBuffer'   , write8   , write16   , write24@@ -329,12 +330,22 @@  -- | Copying the bytestring to the buffer. --   This function returns the point where the next copy should start.+--+-- >>> let buf = "abc" :: ByteString+-- >>> unsafeWithByteString buf $ \ptr _ -> Network.ByteOrder.copy ptr "ABC" >> return buf+-- "ABC" copy :: Buffer -> ByteString -> IO Buffer-copy !ptr (PS fp o l) = withForeignPtr fp $ \p -> do+copy ptr (PS fp o l) = withForeignPtr fp $ \p -> do     memcpy ptr (p `plusPtr` o) (fromIntegral l)-    return $! ptr `plusPtr` l+    return $ ptr `plusPtr` l {-# INLINE copy #-} +-- | Converting the part of buffer to 'ByteString' and executing the+--   action with it.+--+-- >>> let buf = "abcdef" :: ByteString+-- >>> unsafeWithByteString buf $ \ptr _-> bufferIO ptr 2 return+-- "ab" bufferIO :: Buffer -> Int -> (ByteString -> IO a) -> IO a bufferIO ptr siz io = do     fptr <- newForeignPtr_ ptr@@ -344,10 +355,10 @@  -- | Read and write buffer. data WriteBuffer = WriteBuffer {-    start :: !Buffer-  , limit :: !Buffer-  , offset :: !(IORef Buffer)-  , oldoffset :: !(IORef Buffer)+    start :: Buffer+  , limit :: Buffer+  , offset :: IORef Buffer+  , oldoffset :: IORef Buffer   }  -- | Creating a write buffer with the given buffer.@@ -358,6 +369,9 @@ {-# INLINE write8 #-} -- | Write one byte and ff one byte. --   If buffer overrun occurs, 'BufferOverrun' is thrown.+--+-- >>> withWriteBuffer 1 $ \wbuf -> write8 wbuf 65+-- "A" write8 :: WriteBuffer -> Word8 -> IO () write8 WriteBuffer{..} w = do     ptr <- readIORef offset@@ -365,12 +379,15 @@         throwIO BufferOverrun       else do         poke ptr w-        let !ptr' = ptr `plusPtr` 1+        let ptr' = ptr `plusPtr` 1         writeIORef offset ptr'  {-# INLINE write16 #-} -- | Write two bytes and ff one byte. --   If buffer overrun occurs, 'BufferOverrun' is thrown.+--+-- >>> withWriteBuffer 2 $ \wbuf -> write16 wbuf (65 * 256 + 66)+-- "AB" write16 :: WriteBuffer -> Word16 -> IO () write16 WriteBuffer{..} w = do     ptr <- readIORef offset@@ -378,12 +395,15 @@         throwIO BufferOverrun       else do         poke16 w ptr 0-        let !ptr' = ptr `plusPtr` 2+        let ptr' = ptr `plusPtr` 2         writeIORef offset ptr'  {-# INLINE write24 #-} -- | Write three bytes and ff one byte. --   If buffer overrun occurs, 'BufferOverrun' is thrown.+--+-- >>> withWriteBuffer 3 $ \wbuf -> write24 wbuf (65 * 256^2 + 66 * 256 + 67)+-- "ABC" write24 :: WriteBuffer -> Word32 -> IO () write24 WriteBuffer{..} w = do     ptr <- readIORef offset@@ -391,12 +411,15 @@         throwIO BufferOverrun       else do         poke24 w ptr 0-        let !ptr' = ptr `plusPtr` 3+        let ptr' = ptr `plusPtr` 3         writeIORef offset ptr'  {-# INLINE write32 #-} -- | Write four bytes and ff one byte. --   If buffer overrun occurs, 'BufferOverrun' is thrown.+--+-- >>> withWriteBuffer 4 $ \wbuf -> write32 wbuf (65 * 256^3 + 66 * 256^2 + 67 * 256 + 68)+-- "ABCD" write32 :: WriteBuffer -> Word32 -> IO () write32 WriteBuffer{..} w = do     ptr <- readIORef offset@@ -404,53 +427,63 @@         throwIO BufferOverrun       else do         poke32 w ptr 0-        let !ptr' = ptr `plusPtr` 4+        let ptr' = ptr `plusPtr` 4         writeIORef offset ptr'  {-# INLINE shiftLastN #-}--- | Shifting the N-bytes area just before the current pointer.---   'Offset' is the distance from the offset pointer.---   If 'Offset' is positive, shift it to right.---   If 'Offset' is negative, shift it to left.-shiftLastN :: WriteBuffer -> Offset -> Int -> IO ()+-- | Shifting the N-bytes area just before the current pointer (the 3rd argument).+--   If the second argument is positive, shift it to right.+--   If it is negative, shift it to left.+--   'offset' moves as if it is sticky to the area.+--+-- >>> withWriteBuffer 16 $ \wbuf -> copyByteString wbuf "ABCD" >> shiftLastN wbuf 1 3+-- "ABBCD"+-- >>> withWriteBuffer 16 $ \wbuf -> copyByteString wbuf "ABCD" >> shiftLastN wbuf 2 3+-- "ABCBCD"+-- >>> withWriteBuffer 16 $ \wbuf -> copyByteString wbuf "ABCDE" >> shiftLastN wbuf (-2) 3 >> ff wbuf 2+-- "CDEDE"+shiftLastN :: WriteBuffer -> Int -> Int -> IO () shiftLastN WriteBuffer{..} 0 _   = return () shiftLastN WriteBuffer{..} i len = do     ptr <- readIORef offset-    let !ptr' = ptr `plusPtr` i+    let ptr' = ptr `plusPtr` i     if ptr' >= limit then         throwIO BufferOverrun       else if i < 0 then do-        let !src = ptr `plusPtr` negate len-            !dst = src `plusPtr` i+        let src = ptr `plusPtr` negate len+            dst = src `plusPtr` i         shiftLeft dst src len         writeIORef offset ptr'       else do-        let !src = ptr `plusPtr` (-1)-            !dst = ptr' `plusPtr` (-1)+        let src = ptr `plusPtr` (-1)+            dst = ptr' `plusPtr` (-1)         shiftRight dst src len         writeIORef offset ptr'   where     -- memcpy cannot be used for overlapped areas.     shiftLeft :: Buffer -> Buffer -> Int -> IO ()     shiftLeft _    _    0   = return ()-    shiftLeft !dst !src n = do+    shiftLeft dst src n = do         peek src >>= poke dst         shiftLeft (dst `plusPtr` 1) (src `plusPtr` 1) (n - 1)     shiftRight :: Buffer -> Buffer -> Int -> IO ()     shiftRight _    _    0   = return ()-    shiftRight !dst !src n = do+    shiftRight dst src n = do         peek src >>= poke dst         shiftRight (dst `plusPtr` (-1)) (src `plusPtr` (-1)) (n - 1)  {-# INLINE copyByteString #-} -- | Copy the content of 'ByteString' and ff its length. --   If buffer overrun occurs, 'BufferOverrun' is thrown.+--+-- >>> withWriteBuffer 3 $ \wbuf -> copyByteString wbuf "ABC"+-- "ABC" copyByteString :: WriteBuffer -> ByteString -> IO () copyByteString WriteBuffer{..} (PS fptr off len) = withForeignPtr fptr $ \ptr -> do     let src = ptr `plusPtr` off     dst <- readIORef offset-    let !dst' = dst `plusPtr` len-    if dst' >= limit then+    let dst' = dst `plusPtr` len+    if dst' > limit then         throwIO BufferOverrun       else do         memcpy dst src len@@ -458,12 +491,15 @@  -- | Copy the content of 'ShortByteString' and ff its length. --   If buffer overrun occurs, 'BufferOverrun' is thrown.+--+-- >>> withWriteBuffer 5 $ \wbuf -> copyShortByteString wbuf "ABCEF"+-- "ABCEF" copyShortByteString :: WriteBuffer -> ShortByteString -> IO () copyShortByteString WriteBuffer{..} sbs = do     dst <- readIORef offset     let len = Short.length sbs-    let !dst' = dst `plusPtr` len-    if dst' >= limit then+    let dst' = dst `plusPtr` len+    if dst' > limit then         throwIO BufferOverrun       else do         Short.copyToPtr sbs 0 dst len@@ -473,14 +509,14 @@ toByteString :: WriteBuffer -> IO ByteString toByteString WriteBuffer{..} = do     ptr <- readIORef offset-    let !len = ptr `minusPtr` start+    let len = ptr `minusPtr` start     create len $ \p -> memcpy p start len  -- | Copy the area from 'start' to the current pointer to 'ShortByteString'. toShortByteString :: WriteBuffer -> IO ShortByteString toShortByteString WriteBuffer{..} = do     ptr <- readIORef offset-    let !len = ptr `minusPtr` start+    let len = ptr `minusPtr` start     Short.createFromPtr start len  -- | Allocate a temporary buffer and copy the result to 'ByteString'.@@ -490,6 +526,18 @@     action wbuf     toByteString wbuf +-- | Allocate a temporary buffer and copy the result to 'ByteString' with+--   an additional value.+--+-- >>> withWriteBuffer' 1 $ \wbuf -> write8 wbuf 65 >> return 'a'+-- ("A",'a')+withWriteBuffer' :: BufferSize -> (WriteBuffer -> IO a) -> IO (ByteString, a)+withWriteBuffer' siz action = bracket (mallocBytes siz) free $ \buf -> do+    wbuf <- newWriteBuffer buf siz+    x <- action wbuf+    bs <- toByteString wbuf+    return (bs,x)+ {-# INLINE currentOffset #-} -- | Getting the offset pointer. currentOffset :: WriteBuffer -> IO Buffer@@ -518,27 +566,27 @@     read8 WriteBuffer{..} = do         ptr <- readIORef offset         w <- peek ptr-        writeIORef offset $! ptr `plusPtr` 1+        writeIORef offset $ ptr `plusPtr` 1         return w     {-# INLINE readInt8 #-}     readInt8 WriteBuffer{..} = do         ptr <- readIORef offset         if ptr < limit then do             w <- peek ptr-            writeIORef offset $! ptr `plusPtr` 1-            let !i = fromIntegral w+            writeIORef offset $ ptr `plusPtr` 1+            let i = fromIntegral w             return i           else             return (-1)     {-# INLINE ff #-}     ff WriteBuffer{..} n = do         ptr <- readIORef offset-        let !ptr' = ptr `plusPtr` n+        let ptr' = ptr `plusPtr` n         writeIORef offset ptr'     {-# INLINE remainingSize #-}     remainingSize WriteBuffer{..} = do         ptr <- readIORef offset-        return $! (limit `minusPtr` ptr)+        return $ limit `minusPtr` ptr     {-# INLINE withCurrentOffSet #-}     withCurrentOffSet WriteBuffer{..} action = readIORef offset >>= action     {-# INLINE save #-}@@ -571,12 +619,16 @@ --   this is an abstract data type. newtype ReadBuffer = ReadBuffer WriteBuffer +-- | Creating a read buffer with the given buffer.+newReadBuffer :: Buffer -> BufferSize -> IO ReadBuffer+newReadBuffer buf siz = ReadBuffer <$> newWriteBuffer buf siz+ -- | Converting 'ByteString' to 'ReadBuffer' and run the action --   with it. withReadBuffer :: ByteString -> (ReadBuffer -> IO a) -> IO a withReadBuffer (PS fp off siz) action = withForeignPtr fp $ \ptr -> do-    let !buf = ptr `plusPtr` off-    nsrc <- ReadBuffer <$> newWriteBuffer buf siz+    let buf = ptr `plusPtr` off+    nsrc <- newReadBuffer buf siz     action nsrc  -- | Extracting 'ByteString' from the current offset.@@ -584,16 +636,18 @@ --   Its length is specified by the 2nd argument. --   If the length is positive, the area after the current pointer is extracted and FF the length finally. --   If the length is negative, the area before the current pointer is extracted and does not FF.+--+-- >>> withReadBuffer "abcdefg" $ \rbuf -> ff rbuf 1 >> extractByteString rbuf 2+-- "bc" extractByteString :: Readable a => a -> Int -> IO ByteString-extractByteString wbuf len+extractByteString rbuf len   | len == 0 = return mempty   | len >  0 = do-    bs <- withCurrentOffSet wbuf $ \src ->+    bs <- withCurrentOffSet rbuf $ \src ->         create len $ \dst -> memcpy dst src len-    ff wbuf len+    ff rbuf len     return bs-  | otherwise = do-    withCurrentOffSet wbuf $ \src0 -> do+  | otherwise = withCurrentOffSet rbuf $ \src0 -> do       let src = src0 `plusPtr` len       let len' = negate len       create len' $ \dst -> memcpy dst src len'@@ -603,37 +657,48 @@ --   Its length is specified by the 2nd argument. --   If the length is positive, the area after the current pointer is extracted and FF the length finally. --   If the length is negative, the area before the current pointer is extracted and does not FF.+--+-- >>> withReadBuffer "abcdefg" $ \rbuf -> ff rbuf 2 >> extractShortByteString rbuf 3+-- "cde" extractShortByteString :: Readable a => a -> Int -> IO ShortByteString-extractShortByteString wbuf len+extractShortByteString rbuf len   | len == 0 = return mempty   | len >  0 = do-    sbs <- withCurrentOffSet wbuf $ \src -> Short.createFromPtr src len-    ff wbuf len+    sbs <- withCurrentOffSet rbuf $ \src -> Short.createFromPtr src len+    ff rbuf len     return sbs-  | otherwise = do-    withCurrentOffSet wbuf $ \src0 -> do+  | otherwise = withCurrentOffSet rbuf $ \src0 -> do       let src = src0 `plusPtr` len       let len' = negate len       Short.createFromPtr src len'  -- | Reading two bytes as 'Word16' and ff two bytes.+--+-- >>> withReadBuffer "\x0\x1\x2\x3" $ read16+-- 1 read16 :: Readable a => a -> IO Word16 read16 rbuf = do-    w16 <- withCurrentOffSet rbuf (\buf -> peek16 buf 0)+    w16 <- withCurrentOffSet rbuf (`peek16` 0)     ff rbuf 2     return w16  -- | Reading three bytes as 'Word32' and ff three bytes.+--+-- >>> withReadBuffer "\x0\x1\x2\x3" $ read24+-- 258 read24 :: Readable a => a -> IO Word32 read24 rbuf = do-    w24 <- withCurrentOffSet rbuf (\buf -> peek24 buf 0)+    w24 <- withCurrentOffSet rbuf (`peek24` 0)     ff rbuf 3     return w24  -- | Reading four bytes as 'Word32' and ff four bytes.+--+-- >>> withReadBuffer "\x0\x1\x2\x3" $ read32+-- 66051 read32 :: Readable a => a -> IO Word32 read32 rbuf = do-    w32 <- withCurrentOffSet rbuf (\buf -> peek32 buf 0)+    w32 <- withCurrentOffSet rbuf (`peek32` 0)     ff rbuf 4     return w32 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                network-byte-order-version:             0.1.2.0+version:             0.1.2.1 synopsis:            Network byte order utilities description:         Peek and poke functions for network byte order. license:             BSD3