module Data.Packer
(
Packing
, Unpacking
, OutOfBoundUnpacking(..)
, OutOfBoundPacking(..)
, Hole
, runUnpacking
, tryUnpacking
, runPacking
, unpackSkip
, unpackSetPosition
, unpackGetPosition
, getWord8
, getWord16
, getWord16LE
, getWord16BE
, getWord32
, getWord32LE
, getWord32BE
, getWord64
, getWord64LE
, getWord64BE
, getBytes
, getBytesCopy
, getBytesWhile
, getRemaining
, getRemainingCopy
, getStorable
, packGetPosition
, putWord8
, putWord16
, putWord16LE
, putWord16BE
, putWord32
, putWord32LE
, putWord32BE
, putHoleWord32
, putHoleWord32LE
, putHoleWord32BE
, putWord64
, putWord64LE
, putWord64BE
, putHoleWord64
, putHoleWord64LE
, putHoleWord64BE
, putBytes
, putStorable
, fillHole
) where
import Control.Applicative
import Data.Packer.Internal
import Data.Packer.Unsafe
import Data.Packer.IO
import Data.Packer.Endian
import Foreign.Ptr
import Foreign.ForeignPtr
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B (memcpy, unsafeCreate, toForeignPtr, fromForeignPtr)
import Data.Word
import Foreign.Storable
import System.IO.Unsafe
import qualified Control.Exception as E
#if __GLASGOW_HASKELL__ > 704
unsafeDoIO = unsafeDupablePerformIO
#else
unsafeDoIO = unsafePerformIO
#endif
peekAnd :: Storable a => (a -> b) -> Ptr a -> IO b
peekAnd f p = f <$> peek p
unpackSkip :: Int -> Unpacking ()
unpackSkip n = unpackCheckAct n (\_ -> return ())
getWord8 :: Unpacking Word8
getWord8 = unpackCheckAct 1 peek
getWord16 :: Unpacking Word16
getWord16 = unpackCheckAct 2 (peek . castPtr)
getWord16LE :: Unpacking Word16
getWord16LE = unpackCheckAct 2 (peekAnd le16Host . castPtr)
getWord16BE :: Unpacking Word16
getWord16BE = unpackCheckAct 2 (peekAnd be16Host . castPtr)
getWord32 :: Unpacking Word32
getWord32 = unpackCheckAct 4 (peek . castPtr)
getWord32LE :: Unpacking Word32
getWord32LE = unpackCheckAct 4 (peekAnd le32Host . castPtr)
getWord32BE :: Unpacking Word32
getWord32BE = unpackCheckAct 4 (peekAnd be32Host . castPtr)
getWord64 :: Unpacking Word64
getWord64 = unpackCheckAct 8 (peek . castPtr)
getWord64LE :: Unpacking Word64
getWord64LE = unpackCheckAct 8 (peekAnd le64Host . castPtr)
getWord64BE :: Unpacking Word64
getWord64BE = unpackCheckAct 8 (peekAnd be64Host . castPtr)
getBytes :: Int -> Unpacking ByteString
getBytes n = unpackCheckActRef n $ \fptr ptr -> do
o <- withForeignPtr fptr $ \origPtr -> return (ptr `minusPtr` origPtr)
return $ B.fromForeignPtr fptr o n
getBytesCopy :: Int -> Unpacking ByteString
getBytesCopy n = B.copy <$> getBytes n
getRemaining :: Unpacking ByteString
getRemaining = unpackGetNbRemaining >>= getBytes
getRemainingCopy :: Unpacking ByteString
getRemainingCopy = B.copy <$> getRemaining
getBytesWhile :: (Word8 -> Bool) -> Unpacking (Maybe ByteString)
getBytesWhile predicate = unpackLookahead searchEnd >>= \mn -> maybe (return Nothing) (\n -> Just <$> getBytes n) mn
where searchEnd :: Ptr Word8 -> Int -> IO (Maybe Int)
searchEnd ptr sz = loop 0
where loop :: Int -> IO (Maybe Int)
loop i
| i >= sz = return $ Nothing
| otherwise = do w <- peek (ptr `plusPtr` i)
if predicate w
then loop (i+1)
else return $ Just i
getStorable :: Storable a => Unpacking a
getStorable = get_ undefined
where get_ :: Storable a => a -> Unpacking a
get_ undefA = unpackCheckAct (sizeOf undefA) (peek . castPtr)
putWord8 :: Word8 -> Packing ()
putWord8 w = packCheckAct 1 (\ptr -> poke (castPtr ptr) w)
putWord16 :: Word16 -> Packing ()
putWord16 w = packCheckAct 2 (\ptr -> poke (castPtr ptr) w)
putWord16LE :: Word16 -> Packing ()
putWord16LE w = putWord16 (le16Host w)
putWord16BE :: Word16 -> Packing ()
putWord16BE w = putWord16 (be16Host w)
putWord32 :: Word32 -> Packing ()
putWord32 w = packCheckAct 4 (\ptr -> poke (castPtr ptr) w)
putWord32LE :: Word32 -> Packing ()
putWord32LE w = putWord32 (le32Host w)
putWord32BE :: Word32 -> Packing ()
putWord32BE w = putWord32 (be32Host w)
putHoleWord32_ :: (Word32 -> Word32) -> Packing (Hole Word32)
putHoleWord32_ f = packHole 4 (\ptr w -> poke (castPtr ptr) (f w))
putHoleWord32, putHoleWord32BE, putHoleWord32LE :: Packing (Hole Word32)
putHoleWord32 = putHoleWord32_ id
putHoleWord32BE = putHoleWord32_ be32Host
putHoleWord32LE = putHoleWord32_ le32Host
putWord64 :: Word64 -> Packing ()
putWord64 w = packCheckAct 8 (\ptr -> poke (castPtr ptr) w)
putWord64LE :: Word64 -> Packing ()
putWord64LE w = putWord64 (le64Host w)
putWord64BE :: Word64 -> Packing ()
putWord64BE w = putWord64 (be64Host w)
putHoleWord64_ :: (Word64 -> Word64) -> Packing (Hole Word64)
putHoleWord64_ f = packHole 8 (\ptr w -> poke (castPtr ptr) (f w))
putHoleWord64, putHoleWord64BE, putHoleWord64LE :: Packing (Hole Word64)
putHoleWord64 = putHoleWord64_ id
putHoleWord64BE = putHoleWord64_ be64Host
putHoleWord64LE = putHoleWord64_ le64Host
putBytes :: ByteString -> Packing ()
putBytes bs =
packCheckAct len $ \ptr ->
withForeignPtr fptr $ \ptr2 ->
B.memcpy ptr (ptr2 `plusPtr` o) len
where (fptr,o,len) = B.toForeignPtr bs
putStorable :: Storable a => a -> Packing ()
putStorable a = packCheckAct (sizeOf a) (\ptr -> poke (castPtr ptr) a)
runUnpacking :: Unpacking a -> ByteString -> a
runUnpacking action bs = unsafeDoIO $ runUnpackingIO bs action
tryUnpacking :: Unpacking a -> ByteString -> Either E.SomeException a
tryUnpacking action bs = unsafeDoIO $ tryUnpackingIO bs action
runPacking :: Int -> Packing () -> ByteString
runPacking sz action = unsafeDoIO $ runPackingIO sz action