module Data.Iteratee.Binary (
Endian (..)
,endianRead2
,endianRead3
,endianRead3i
,endianRead4
,endianRead8
,readWord16be_bs
,readWord16le_bs
,readWord32be_bs
,readWord32le_bs
,readWord64be_bs
,readWord64le_bs
)
where
import Data.Iteratee.Base
import qualified Data.Iteratee.ListLike as I
import qualified Data.ListLike as LL
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.Word
import Data.Bits
import Data.Int
data Endian = MSB
| LSB
deriving (Eq, Ord, Show, Enum)
endianRead2
:: (Nullable s, LL.ListLike s Word8, Monad m)
=> Endian
-> Iteratee s m Word16
endianRead2 e = do
c1 <- I.head
c2 <- I.head
case e of
MSB -> return $ word16 c1 c2
LSB -> return $ word16 c2 c1
endianRead3
:: (Nullable s, LL.ListLike s Word8, Monad m)
=> Endian
-> Iteratee s m Word32
endianRead3 e = do
c1 <- I.head
c2 <- I.head
c3 <- I.head
case e of
MSB -> return $ word32 0 c1 c2 c3
LSB -> return $ word32 0 c3 c2 c1
endianRead3i
:: (Nullable s, LL.ListLike s Word8, Monad m)
=> Endian
-> Iteratee s m Int32
endianRead3i e = do
c1 <- I.head
c2 <- I.head
c3 <- I.head
case e of
MSB -> return $ (((fromIntegral c1
`shiftL` 8) .|. fromIntegral c2)
`shiftL` 8) .|. fromIntegral c3
LSB ->
let m :: Int32
m = shiftR (shiftL (fromIntegral c3) 24) 8
in return $ (((fromIntegral c3
`shiftL` 8) .|. fromIntegral c2)
`shiftL` 8) .|. fromIntegral m
endianRead4
:: (Nullable s, LL.ListLike s Word8, Monad m)
=> Endian
-> Iteratee s m Word32
endianRead4 e = do
ln' <- I.chunkLength
case ln' of
Just ln | ln >= 4 -> do
ck <- I.getChunk
let t = LL.drop 4 ck
res = case e of
MSB -> word32 (LL.index ck 0)
(LL.index ck 1)
(LL.index ck 2)
(LL.index ck 3)
LSB -> word32 (LL.index ck 3)
(LL.index ck 2)
(LL.index ck 1)
(LL.index ck 0)
res `seq` idone res (I.Chunk t)
_ -> do
c1 <- I.head
c2 <- I.head
c3 <- I.head
c4 <- I.head
return $ case e of
MSB -> word32 c1 c2 c3 c4
LSB -> word32 c4 c3 c2 c1
endianRead8
:: (Nullable s, LL.ListLike s Word8, Monad m)
=> Endian
-> Iteratee s m Word64
endianRead8 e = do
ln' <- I.chunkLength
case ln' of
Just ln | ln >= 8 -> do
ck <- I.getChunk
let t = LL.drop 8 ck
res = case e of
MSB -> word64 (LL.index ck 0)
(LL.index ck 1)
(LL.index ck 2)
(LL.index ck 3)
(LL.index ck 4)
(LL.index ck 5)
(LL.index ck 6)
(LL.index ck 7)
LSB -> word64 (LL.index ck 7)
(LL.index ck 6)
(LL.index ck 5)
(LL.index ck 4)
(LL.index ck 3)
(LL.index ck 2)
(LL.index ck 1)
(LL.index ck 0)
res `seq` idone res (I.Chunk t)
_ -> do
c1 <- I.head
c2 <- I.head
c3 <- I.head
c4 <- I.head
c5 <- I.head
c6 <- I.head
c7 <- I.head
c8 <- I.head
return $ case e of
MSB -> word64 c1 c2 c3 c4 c5 c6 c7 c8
LSB -> word64 c8 c7 c6 c5 c4 c3 c2 c1
endianRead4BS :: Monad m => Endian -> Iteratee B.ByteString m Word32
endianRead4BS MSB = readWord32be_bs
endianRead4BS LSB = readWord32le_bs
endianRead8BS :: Monad m => Endian -> Iteratee B.ByteString m Word64
endianRead8BS MSB = readWord64be_bs
endianRead8BS LSB = readWord64le_bs
readWord16be_bs :: Monad m => Iteratee B.ByteString m Word16
readWord16be_bs = endianRead2 MSB
readWord16le_bs :: Monad m => Iteratee B.ByteString m Word16
readWord16le_bs = endianRead2 LSB
readWord32be_bs :: Monad m => Iteratee B.ByteString m Word32
readWord32be_bs = do
ln' <- I.chunkLength
case ln' of
Just ln | ln >= 4 -> do
ck <- I.getChunk
let t = B.drop 4 ck
res = word32 (B.unsafeIndex ck 0)
(B.unsafeIndex ck 1)
(B.unsafeIndex ck 2)
(B.unsafeIndex ck 3)
res `seq` idone res (I.Chunk t)
_ -> do
c1 <- I.head
c2 <- I.head
c3 <- I.head
c4 <- I.head
return $! word32 c1 c2 c3 c4
readWord32le_bs :: Monad m => Iteratee B.ByteString m Word32
readWord32le_bs = do
ln' <- I.chunkLength
case ln' of
Just ln | ln >= 4 -> do
ck <- I.getChunk
let t = B.drop 4 ck
res = word32 (B.unsafeIndex ck 3)
(B.unsafeIndex ck 2)
(B.unsafeIndex ck 1)
(B.unsafeIndex ck 0)
res `seq` idone res (I.Chunk t)
_ -> do
c1 <- I.head
c2 <- I.head
c3 <- I.head
c4 <- I.head
return $! word32 c4 c3 c2 c1
readWord64be_bs :: Monad m => Iteratee B.ByteString m Word64
readWord64be_bs = do
ln' <- I.chunkLength
case ln' of
Just ln | ln >= 8 -> do
ck <- I.getChunk
let t = B.drop 8 ck
res = word64 (B.unsafeIndex ck 0)
(B.unsafeIndex ck 1)
(B.unsafeIndex ck 2)
(B.unsafeIndex ck 3)
(B.unsafeIndex ck 4)
(B.unsafeIndex ck 5)
(B.unsafeIndex ck 6)
(B.unsafeIndex ck 7)
res `seq` idone res (I.Chunk t)
_ -> do
cs <- I.joinI $ I.take 8 I.stream2stream
if B.length cs == 8
then return $ word64 (B.unsafeIndex cs 0)
(B.unsafeIndex cs 1)
(B.unsafeIndex cs 2)
(B.unsafeIndex cs 3)
(B.unsafeIndex cs 4)
(B.unsafeIndex cs 5)
(B.unsafeIndex cs 6)
(B.unsafeIndex cs 7)
else I.throwErr (toException EofException)
readWord64le_bs :: Monad m => Iteratee B.ByteString m Word64
readWord64le_bs = do
ln' <- I.chunkLength
case ln' of
Just ln | ln >= 8 -> do
ck <- I.getChunk
let t = B.drop 8 ck
res = word64 (B.unsafeIndex ck 7)
(B.unsafeIndex ck 6)
(B.unsafeIndex ck 5)
(B.unsafeIndex ck 4)
(B.unsafeIndex ck 3)
(B.unsafeIndex ck 2)
(B.unsafeIndex ck 1)
(B.unsafeIndex ck 0)
res `seq` idone res (I.Chunk t)
_ -> do
cs <- I.joinI $ I.take 8 I.stream2stream
if B.length cs == 8
then return $ word64 (B.unsafeIndex cs 7)
(B.unsafeIndex cs 6)
(B.unsafeIndex cs 5)
(B.unsafeIndex cs 4)
(B.unsafeIndex cs 3)
(B.unsafeIndex cs 2)
(B.unsafeIndex cs 1)
(B.unsafeIndex cs 0)
else I.throwErr (toException EofException)
word16 :: Word8 -> Word8 -> Word16
word16 c1 c2 = (fromIntegral c1 `shiftL` 8) .|. fromIntegral c2
word32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
word32 c1 c2 c3 c4 =
(fromIntegral c1 `shiftL` 24) .|.
(fromIntegral c2 `shiftL` 16) .|.
(fromIntegral c3 `shiftL` 8) .|.
fromIntegral c4
word64
:: Word8 -> Word8 -> Word8 -> Word8
-> Word8 -> Word8 -> Word8 -> Word8
-> Word64
word64 c1 c2 c3 c4 c5 c6 c7 c8 =
(fromIntegral c1 `shiftL` 56) .|.
(fromIntegral c2 `shiftL` 48) .|.
(fromIntegral c3 `shiftL` 40) .|.
(fromIntegral c4 `shiftL` 32) .|.
(fromIntegral c5 `shiftL` 24) .|.
(fromIntegral c6 `shiftL` 16) .|.
(fromIntegral c7 `shiftL` 8) .|.
fromIntegral c8