module Util.Bytes(
Byte,
Bytes,
putByteToBytes,
getByteFromBytes,
putBytesToBytes,
hPutByte,
hGetByte,
hPutBytes,
hGetBytes,
bytesMalloc,
bytesReAlloc,
bytesAlloca,
bytesFree,
withBytesAsCChars,
mkBytes,
unMkBytes,
compareBytes,
) where
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Data.Bits(Bits)
import Data.Char
import System.IO
import System.IO.Error
import Control.Exception(Exception(IOException),throw)
newtype Byte = Byte CUChar deriving (Eq,Ord,Num,Bits,Show,Real,Enum,Integral)
newtype Bytes = Bytes (Ptr CChar)
putByteToBytes :: Byte -> Bytes -> Int -> IO ()
putByteToBytes (Byte u) (Bytes ptr) i
= pokeArray (advancePtr ptr i) [fromIntegral u]
getByteFromBytes :: Bytes -> Int -> IO Byte
getByteFromBytes (Bytes ptr) i =
do
[c] <- peekArray 1 (advancePtr ptr i)
return (Byte (fromIntegral c))
putBytesToBytes :: Bytes -> Int -> Bytes -> Int -> Int -> IO ()
putBytesToBytes (Bytes sourcePtr) sourceIndex (Bytes destPtr) destIndex len
= copyArray (advancePtr destPtr destIndex)
(advancePtr sourcePtr sourceIndex) len
hPutByte :: Handle -> Byte -> IO ()
hPutByte handle (Byte u) = hPutChar handle (chr (fromIntegral u))
hGetByte :: Handle -> IO Byte
hGetByte handle =
do
char <- hGetChar handle
return (Byte (fromIntegral (ord char)))
hPutBytes :: Handle -> Bytes -> Int -> IO ()
hPutBytes handle (Bytes ptr) len =
hPutBuf handle ptr len
hGetBytes :: Handle -> Int -> IO Bytes
hGetBytes handle len =
do
(bytes@(Bytes ptr)) <- bytesMalloc len
lenRead <- hGetBuf handle ptr len
if lenRead < len
then
do
bytesFree bytes
throwEOF handle
else
return bytes
bytesMalloc :: Int -> IO Bytes
bytesMalloc i =
do
ptr <- mallocBytes i
return (Bytes ptr)
bytesReAlloc :: Bytes -> Int -> IO Bytes
bytesReAlloc (Bytes ptr1) newLen =
do
ptr2 <- reallocBytes ptr1 newLen
return (Bytes ptr2)
bytesAlloca :: Int -> (Bytes -> IO a) -> IO a
bytesAlloca len fn = allocaBytes len (\ ptr -> fn (Bytes ptr))
bytesFree :: Bytes -> IO ()
bytesFree (Bytes ptr) = free ptr
withBytesAsCChars :: Bytes -> (Ptr CChar -> IO a) -> IO a
withBytesAsCChars (Bytes ptr) fn = fn ptr
mkBytes :: Ptr CChar -> Bytes
mkBytes = Bytes
unMkBytes :: Bytes -> Ptr CChar
unMkBytes (Bytes ptr) = ptr
throwEOF :: Handle -> IO a
throwEOF handle =
do
let
eofError = IOException (
mkIOError eofErrorType
"BinaryIO" (Just handle)
Nothing
)
throw eofError
compareBytes :: Bytes -> Bytes -> Int -> IO Ordering
compareBytes (Bytes p1) (Bytes p2) len =
do
res <- compareBytesPrim p1 p2 (fromIntegral len)
return (compare res 0)
foreign import ccall unsafe "string.h memcmp"
compareBytesPrim :: Ptr CChar -> Ptr CChar -> CSize -> IO CInt