module Data.Iteratee.ZoomCache.Utils (
readInt8
, readInt16be
, readInt32be
, readInt64be
, readWord8
, readWord16be
, readWord32be
, readWord64be
, readIntegerVLC
, readFloat32be
, readDouble64be
, readRational64be
, readCodec
) where
import Control.Applicative ((<$>))
import Control.Monad (msum)
import Data.Bits
import Data.ByteString (ByteString)
import Data.Int
import Data.Iteratee (Iteratee)
import qualified Data.Iteratee as I
import qualified Data.Iteratee.Offset as OffI
import qualified Data.ListLike as LL
import Data.Offset
import Data.Ratio
import Data.Word
import Unsafe.Coerce (unsafeCoerce)
import Data.ZoomCache.Types
readInt8 :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)
=> Iteratee s m a
readInt8 = fromIntegral . u8_to_s8 <$> I.head
where
u8_to_s8 :: Word8 -> Int8
u8_to_s8 = fromIntegral
readInt16be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)
=> Iteratee s m a
readInt16be = fromIntegral . u16_to_s16 <$> I.endianRead2 I.MSB
where
u16_to_s16 :: Word16 -> Int16
u16_to_s16 = fromIntegral
readInt32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)
=> Iteratee s m a
readInt32be = fromIntegral . u32_to_s32 <$> I.endianRead4 I.MSB
where
u32_to_s32 :: Word32 -> Int32
u32_to_s32 = fromIntegral
readInt64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)
=> Iteratee s m a
readInt64be = fromIntegral . u64_to_s64 <$> I.endianRead8 I.MSB
where
u64_to_s64 :: Word64 -> Int64
u64_to_s64 = fromIntegral
readWord8 :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)
=> Iteratee s m a
readWord8 = fromIntegral <$> I.head
readWord16be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)
=> Iteratee s m a
readWord16be = fromIntegral <$> I.endianRead2 I.MSB
readWord32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)
=> Iteratee s m a
readWord32be = fromIntegral <$> I.endianRead4 I.MSB
readWord64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m, Integral a)
=> Iteratee s m a
readWord64be = fromIntegral <$> I.endianRead8 I.MSB
readIntegerVLC :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)
=> Iteratee s m Integer
readIntegerVLC = do
x0 <- I.head
let sign = if (x0 .&. 1) == 1 then negate else id
contBit = x0 .&. 128
x1 = fromIntegral $ (x0 .&. 126) `shiftR` 1
if contBit == 0
then return . sign $ x1
else sign <$> readVLC 6 x1
where
readVLC :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)
=> Int -> Integer -> Iteratee s m Integer
readVLC n x0 = do
x <- I.head
let contBit = x .&. 128
x1 = (fromIntegral (x .&. 127) `shiftL` n) .|. x0
if contBit == 0
then return x1
else readVLC (n+7) x1
readFloat32be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)
=> Iteratee s m Float
readFloat32be = do
n <- I.endianRead4 I.MSB
return (unsafeCoerce n :: Float)
readDouble64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)
=> Iteratee s m Double
readDouble64be = do
n <- I.endianRead8 I.MSB
return (unsafeCoerce n :: Double)
readRational64be :: (I.Nullable s, LL.ListLike s Word8, Functor m, Monad m)
=> Iteratee s m Rational
readRational64be = do
(num :: Integer) <- readInt64be
(den :: Integer) <- readInt64be
if (den == 0)
then return 0
else return (num % den)
readCodec :: (Functor m, Monad m)
=> [IdentifyCodec]
-> Int
-> Iteratee (Offset ByteString) m (Maybe Codec)
readCodec identifiers n = do
tt <- OffI.takeBS n
return (parseCodec identifiers tt)
parseCodec :: [IdentifyCodec] -> IdentifyCodec
parseCodec identifiers h = msum . map ($ h) $ identifiers