Binary.hs

-- |Iteratees for parsing binary data.
module Data.MutableIter.Binary (
  -- * Types
  Endian (..),
  -- * Endian multi-byte iteratees
  endianRead2,
  endianRead3,
  endianRead4
)
where

import Data.MutableIter as I
import qualified Data.MutableIter.IOBuffer as IB
import Data.MutableIter.IOBuffer (IOBuffer)
import Data.Iteratee.Binary (Endian (..))

import Data.Word
import Data.Bits
import Data.Int
import Control.Monad.CatchIO


-- ------------------------------------------------------------------------
-- Binary Random IO Iteratees

-- Iteratees to read unsigned integers written in Big- or Little-endian ways

endianRead2
  :: (MonadCatchIO m) =>
     Endian
     -> MIteratee (IOBuffer r Word8) m Word16
endianRead2 e = do
  c1 <- I.head
  c2 <- I.head
  case e of
    MSB -> return $ (fromIntegral c1 `shiftL` 8) .|. fromIntegral c2
    LSB -> return $ (fromIntegral c2 `shiftL` 8) .|. fromIntegral c1

-- |read 3 bytes in an endian manner.  If the first bit is set (negative),
-- set the entire first byte so the Word32 can be properly set negative as
-- well.
endianRead3
  :: (MonadCatchIO m) =>
     Endian
     -> MIteratee (IOBuffer r Word8) m Word32
endianRead3 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
  :: (MonadCatchIO m) =>
     Endian
     -> MIteratee (IOBuffer r Word8) m Word32
endianRead4 e = do
  c1 <- I.head
  c2 <- I.head
  c3 <- I.head
  c4 <- I.head
  case e of
    MSB -> return $
               (((((fromIntegral c1
                `shiftL` 8) .|. fromIntegral c2)
                `shiftL` 8) .|. fromIntegral c3)
                `shiftL` 8) .|. fromIntegral c4
    LSB -> return $
               (((((fromIntegral c4
                `shiftL` 8) .|. fromIntegral c3)
                `shiftL` 8) .|. fromIntegral c2)
                `shiftL` 8) .|. fromIntegral c1