{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | This defines primitive byte operations, to be used with binary conversion.
-- For the present we use the FFI.  There are probably lots of better ways.

module Util.Bytes(
   Byte,
      -- this type is expected to be an instance of Eq, Ord, Num, Bits,
      -- Integral, Show and contain (at least) the values 0..255.
   Bytes,
      -- an array of values of type Byte.
      -- NB.  The caller is responsible for making sure writes to and from
      -- this array are within bounds.


   putByteToBytes,
      -- :: Byte -> Bytes -> Int -> IO ()
      -- write byte to index.
   getByteFromBytes,
      -- :: Bytes -> Int -> IO Byte

   putBytesToBytes,
      -- :: Bytes -> Int -> Byte -> Int -> Int -> IO ()
      -- putBytesToBytes source sourceIndex dest destIndex length
      --    copies length bytes starting at source[sourceIndex] to
      --    dest[destIndex]
      -- It assumes that the source and destination areas don't overlap.
   hPutByte,
      -- :: Handle -> Byte -> IO ()
   hGetByte,
      -- :: Handle -> IO Byte

   hPutBytes,
      -- :: Handle -> Bytes -> Int -> IO ()
   hGetBytes,
      -- :: Handle -> Int -> IO Bytes
      -- hGetBytes allocates an area, which needs to be
      -- freed using freeBytes.

   -- the following are similar to C's malloc/alloc/realloc/free.
   bytesMalloc,
      -- :: Int -> IO Bytes
   bytesReAlloc,
      -- :: Bytes -> Int -> IO Bytes.
   bytesAlloca,
      -- :: Int -> (Bytes -> IO a) -> IO a
   bytesFree,
      -- :: Bytes -> IO ()

   withBytesAsCChars,
      -- :: Bytes -> (Ptr CChar -> IO a) -> IO a
      -- This gives you access to the contents of Bytes as a Ptr CChar.
      -- The length will be the number of Bytes in the array.
      -- NB.  The Ptr CChar may become invalid (or garbage) after the
      -- function supplied by the caller returns.

   mkBytes,
      -- :: Ptr CChar -> Bytes
   unMkBytes,
      -- :: Bytes -> Ptr CChar
      -- low-level interface (and therefore likely to change)


   compareBytes, -- :: Bytes -> Bytes -> Int -> IO Ordering
      -- Compare two Bytes items up to the given length, in a consistent
      -- way.
   ) where

-- FFI imports
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Ptr

-- Other GHC imports.
import Data.Bits(Bits)
import Data.Char

import System.IO

import System.IO.Error
import Control.Exception (throw)

-- ----------------------------------------------------------------------
-- The datatypes
-- ----------------------------------------------------------------------

newtype Byte = Byte CUChar deriving (Byte -> Byte -> Bool
(Byte -> Byte -> Bool) -> (Byte -> Byte -> Bool) -> Eq Byte
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Byte -> Byte -> Bool
$c/= :: Byte -> Byte -> Bool
== :: Byte -> Byte -> Bool
$c== :: Byte -> Byte -> Bool
Eq,Eq Byte
Eq Byte
-> (Byte -> Byte -> Ordering)
-> (Byte -> Byte -> Bool)
-> (Byte -> Byte -> Bool)
-> (Byte -> Byte -> Bool)
-> (Byte -> Byte -> Bool)
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte -> Byte)
-> Ord Byte
Byte -> Byte -> Bool
Byte -> Byte -> Ordering
Byte -> Byte -> Byte
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Byte -> Byte -> Byte
$cmin :: Byte -> Byte -> Byte
max :: Byte -> Byte -> Byte
$cmax :: Byte -> Byte -> Byte
>= :: Byte -> Byte -> Bool
$c>= :: Byte -> Byte -> Bool
> :: Byte -> Byte -> Bool
$c> :: Byte -> Byte -> Bool
<= :: Byte -> Byte -> Bool
$c<= :: Byte -> Byte -> Bool
< :: Byte -> Byte -> Bool
$c< :: Byte -> Byte -> Bool
compare :: Byte -> Byte -> Ordering
$ccompare :: Byte -> Byte -> Ordering
$cp1Ord :: Eq Byte
Ord,Integer -> Byte
Byte -> Byte
Byte -> Byte -> Byte
(Byte -> Byte -> Byte)
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte)
-> (Byte -> Byte)
-> (Byte -> Byte)
-> (Integer -> Byte)
-> Num Byte
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Byte
$cfromInteger :: Integer -> Byte
signum :: Byte -> Byte
$csignum :: Byte -> Byte
abs :: Byte -> Byte
$cabs :: Byte -> Byte
negate :: Byte -> Byte
$cnegate :: Byte -> Byte
* :: Byte -> Byte -> Byte
$c* :: Byte -> Byte -> Byte
- :: Byte -> Byte -> Byte
$c- :: Byte -> Byte -> Byte
+ :: Byte -> Byte -> Byte
$c+ :: Byte -> Byte -> Byte
Num,Eq Byte
Byte
Eq Byte
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Byte)
-> Byte
-> (Int -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Bool)
-> (Byte -> Maybe Int)
-> (Byte -> Int)
-> (Byte -> Bool)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int -> Byte)
-> (Byte -> Int)
-> Bits Byte
Int -> Byte
Byte -> Bool
Byte -> Int
Byte -> Maybe Int
Byte -> Byte
Byte -> Int -> Bool
Byte -> Int -> Byte
Byte -> Byte -> Byte
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Byte -> Int
$cpopCount :: Byte -> Int
rotateR :: Byte -> Int -> Byte
$crotateR :: Byte -> Int -> Byte
rotateL :: Byte -> Int -> Byte
$crotateL :: Byte -> Int -> Byte
unsafeShiftR :: Byte -> Int -> Byte
$cunsafeShiftR :: Byte -> Int -> Byte
shiftR :: Byte -> Int -> Byte
$cshiftR :: Byte -> Int -> Byte
unsafeShiftL :: Byte -> Int -> Byte
$cunsafeShiftL :: Byte -> Int -> Byte
shiftL :: Byte -> Int -> Byte
$cshiftL :: Byte -> Int -> Byte
isSigned :: Byte -> Bool
$cisSigned :: Byte -> Bool
bitSize :: Byte -> Int
$cbitSize :: Byte -> Int
bitSizeMaybe :: Byte -> Maybe Int
$cbitSizeMaybe :: Byte -> Maybe Int
testBit :: Byte -> Int -> Bool
$ctestBit :: Byte -> Int -> Bool
complementBit :: Byte -> Int -> Byte
$ccomplementBit :: Byte -> Int -> Byte
clearBit :: Byte -> Int -> Byte
$cclearBit :: Byte -> Int -> Byte
setBit :: Byte -> Int -> Byte
$csetBit :: Byte -> Int -> Byte
bit :: Int -> Byte
$cbit :: Int -> Byte
zeroBits :: Byte
$czeroBits :: Byte
rotate :: Byte -> Int -> Byte
$crotate :: Byte -> Int -> Byte
shift :: Byte -> Int -> Byte
$cshift :: Byte -> Int -> Byte
complement :: Byte -> Byte
$ccomplement :: Byte -> Byte
xor :: Byte -> Byte -> Byte
$cxor :: Byte -> Byte -> Byte
.|. :: Byte -> Byte -> Byte
$c.|. :: Byte -> Byte -> Byte
.&. :: Byte -> Byte -> Byte
$c.&. :: Byte -> Byte -> Byte
$cp1Bits :: Eq Byte
Bits,Int -> Byte -> ShowS
[Byte] -> ShowS
Byte -> String
(Int -> Byte -> ShowS)
-> (Byte -> String) -> ([Byte] -> ShowS) -> Show Byte
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Byte] -> ShowS
$cshowList :: [Byte] -> ShowS
show :: Byte -> String
$cshow :: Byte -> String
showsPrec :: Int -> Byte -> ShowS
$cshowsPrec :: Int -> Byte -> ShowS
Show,Num Byte
Ord Byte
Num Byte -> Ord Byte -> (Byte -> Rational) -> Real Byte
Byte -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Byte -> Rational
$ctoRational :: Byte -> Rational
$cp2Real :: Ord Byte
$cp1Real :: Num Byte
Real,Int -> Byte
Byte -> Int
Byte -> [Byte]
Byte -> Byte
Byte -> Byte -> [Byte]
Byte -> Byte -> Byte -> [Byte]
(Byte -> Byte)
-> (Byte -> Byte)
-> (Int -> Byte)
-> (Byte -> Int)
-> (Byte -> [Byte])
-> (Byte -> Byte -> [Byte])
-> (Byte -> Byte -> [Byte])
-> (Byte -> Byte -> Byte -> [Byte])
-> Enum Byte
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Byte -> Byte -> Byte -> [Byte]
$cenumFromThenTo :: Byte -> Byte -> Byte -> [Byte]
enumFromTo :: Byte -> Byte -> [Byte]
$cenumFromTo :: Byte -> Byte -> [Byte]
enumFromThen :: Byte -> Byte -> [Byte]
$cenumFromThen :: Byte -> Byte -> [Byte]
enumFrom :: Byte -> [Byte]
$cenumFrom :: Byte -> [Byte]
fromEnum :: Byte -> Int
$cfromEnum :: Byte -> Int
toEnum :: Int -> Byte
$ctoEnum :: Int -> Byte
pred :: Byte -> Byte
$cpred :: Byte -> Byte
succ :: Byte -> Byte
$csucc :: Byte -> Byte
Enum,Enum Byte
Real Byte
Real Byte
-> Enum Byte
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte -> Byte)
-> (Byte -> Byte -> (Byte, Byte))
-> (Byte -> Byte -> (Byte, Byte))
-> (Byte -> Integer)
-> Integral Byte
Byte -> Integer
Byte -> Byte -> (Byte, Byte)
Byte -> Byte -> Byte
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Byte -> Integer
$ctoInteger :: Byte -> Integer
divMod :: Byte -> Byte -> (Byte, Byte)
$cdivMod :: Byte -> Byte -> (Byte, Byte)
quotRem :: Byte -> Byte -> (Byte, Byte)
$cquotRem :: Byte -> Byte -> (Byte, Byte)
mod :: Byte -> Byte -> Byte
$cmod :: Byte -> Byte -> Byte
div :: Byte -> Byte -> Byte
$cdiv :: Byte -> Byte -> Byte
rem :: Byte -> Byte -> Byte
$crem :: Byte -> Byte -> Byte
quot :: Byte -> Byte -> Byte
$cquot :: Byte -> Byte -> Byte
$cp2Integral :: Enum Byte
$cp1Integral :: Real Byte
Integral)

newtype Bytes = Bytes (Ptr CChar)

-- ----------------------------------------------------------------------
-- The exported functions
--  ----------------------------------------------------------------------

putByteToBytes :: Byte -> Bytes -> Int -> IO ()
putByteToBytes :: Byte -> Bytes -> Int -> IO ()
putByteToBytes (Byte CUChar
u) (Bytes Ptr CChar
ptr) Int
i
   = Ptr CChar -> [CChar] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (Ptr CChar -> Int -> Ptr CChar
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr CChar
ptr Int
i) [CUChar -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUChar
u]

getByteFromBytes :: Bytes -> Int -> IO Byte
getByteFromBytes :: Bytes -> Int -> IO Byte
getByteFromBytes (Bytes Ptr CChar
ptr) Int
i =
   do
      [CChar
c] <- Int -> Ptr CChar -> IO [CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
1 (Ptr CChar -> Int -> Ptr CChar
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr CChar
ptr Int
i)
      Byte -> IO Byte
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> Byte
Byte (CChar -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral CChar
c))

putBytesToBytes :: Bytes -> Int -> Bytes -> Int -> Int -> IO ()
putBytesToBytes :: Bytes -> Int -> Bytes -> Int -> Int -> IO ()
putBytesToBytes (Bytes Ptr CChar
sourcePtr) Int
sourceIndex (Bytes Ptr CChar
destPtr) Int
destIndex Int
len
   = Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray (Ptr CChar -> Int -> Ptr CChar
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr CChar
destPtr Int
destIndex)
      (Ptr CChar -> Int -> Ptr CChar
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr CChar
sourcePtr Int
sourceIndex) Int
len

hPutByte :: Handle -> Byte -> IO ()
hPutByte :: Handle -> Byte -> IO ()
hPutByte Handle
handle (Byte CUChar
u) = Handle -> Char -> IO ()
hPutChar Handle
handle (Int -> Char
chr (CUChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUChar
u))

hGetByte :: Handle -> IO Byte
hGetByte :: Handle -> IO Byte
hGetByte Handle
handle =
   do
      Char
char <- Handle -> IO Char
hGetChar Handle
handle
      Byte -> IO Byte
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> Byte
Byte (Int -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
char)))

hPutBytes :: Handle -> Bytes -> Int -> IO ()
hPutBytes :: Handle -> Bytes -> Int -> IO ()
hPutBytes Handle
handle (Bytes Ptr CChar
ptr) Int
len =
   Handle -> Ptr CChar -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
handle Ptr CChar
ptr Int
len

hGetBytes ::  Handle -> Int -> IO Bytes
hGetBytes :: Handle -> Int -> IO Bytes
hGetBytes Handle
handle Int
len =
   do
      (bytes :: Bytes
bytes@(Bytes Ptr CChar
ptr)) <- Int -> IO Bytes
bytesMalloc Int
len
      Int
lenRead <- Handle -> Ptr CChar -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
handle Ptr CChar
ptr Int
len
      if Int
lenRead Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
         then
            do
               Bytes -> IO ()
bytesFree Bytes
bytes
               Handle -> IO Bytes
forall a. Handle -> IO a
throwEOF Handle
handle
         else
            Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
bytes

bytesMalloc :: Int -> IO Bytes
bytesMalloc :: Int -> IO Bytes
bytesMalloc Int
i =
   do
      Ptr CChar
ptr <- Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
i
      Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CChar -> Bytes
Bytes Ptr CChar
ptr)

bytesReAlloc :: Bytes -> Int -> IO Bytes
bytesReAlloc :: Bytes -> Int -> IO Bytes
bytesReAlloc (Bytes Ptr CChar
ptr1) Int
newLen =
   do
      Ptr CChar
ptr2 <- Ptr CChar -> Int -> IO (Ptr CChar)
forall a. Ptr a -> Int -> IO (Ptr a)
reallocBytes Ptr CChar
ptr1 Int
newLen
      Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CChar -> Bytes
Bytes Ptr CChar
ptr2)

bytesAlloca :: Int -> (Bytes -> IO a) -> IO a
bytesAlloca :: Int -> (Bytes -> IO a) -> IO a
bytesAlloca Int
len Bytes -> IO a
fn = Int -> (Ptr CChar -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
len (\ Ptr CChar
ptr -> Bytes -> IO a
fn (Ptr CChar -> Bytes
Bytes Ptr CChar
ptr))

bytesFree :: Bytes -> IO ()
bytesFree :: Bytes -> IO ()
bytesFree (Bytes Ptr CChar
ptr) = Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
ptr


withBytesAsCChars :: Bytes -> (Ptr CChar -> IO a) -> IO a
withBytesAsCChars :: Bytes -> (Ptr CChar -> IO a) -> IO a
withBytesAsCChars (Bytes Ptr CChar
ptr) Ptr CChar -> IO a
fn = Ptr CChar -> IO a
fn Ptr CChar
ptr



mkBytes :: Ptr CChar -> Bytes
mkBytes :: Ptr CChar -> Bytes
mkBytes = Ptr CChar -> Bytes
Bytes

unMkBytes :: Bytes -> Ptr CChar
unMkBytes :: Bytes -> Ptr CChar
unMkBytes (Bytes Ptr CChar
ptr) = Ptr CChar
ptr

-- ----------------------------------------------------------------------
-- Throw an EOF error
-- ----------------------------------------------------------------------

throwEOF :: Handle -> IO a
throwEOF :: Handle -> IO a
throwEOF Handle
handle =
   do
      let
         eofError :: IOError
eofError =
            IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
eofErrorType
               String
"BinaryIO" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle)
               Maybe String
forall a. Maybe a
Nothing
      IOError -> IO a
forall a e. Exception e => e -> a
throw IOError
eofError

-- ----------------------------------------------------------------------
-- Compare two Bytes values in an unspecified but consistent way.
-- ----------------------------------------------------------------------

compareBytes :: Bytes -> Bytes -> Int -> IO Ordering
compareBytes :: Bytes -> Bytes -> Int -> IO Ordering
compareBytes (Bytes Ptr CChar
p1) (Bytes Ptr CChar
p2) Int
len =
   do
      CInt
res <- Ptr CChar -> Ptr CChar -> CSize -> IO CInt
compareBytesPrim Ptr CChar
p1 Ptr CChar
p2 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
      Ordering -> IO Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> CInt -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CInt
res CInt
0)

foreign import ccall unsafe "string.h memcmp"
   compareBytesPrim :: Ptr CChar -> Ptr CChar -> CSize -> IO CInt