module Data.Avro.Internal.DecodeRaw
  ( DecodeRaw(..)
  ) where

import Data.Avro.Internal.Zag
import Data.Binary.Get
import Data.Bits
import Data.Int
import Data.List
import Data.Word

getNonNegative :: (Bits i, Integral i) => Get i
getNonNegative :: Get i
getNonNegative = do
  [Word8]
orig <- Get [Word8]
getWord8s
  i -> Get i
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Get i) -> i -> Get i
forall a b. (a -> b) -> a -> b
$! (i -> Word8 -> i) -> i -> [Word8] -> i
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\i
a Word8
x -> (i
a i -> Int -> i
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) i -> i -> i
forall a. Num a => a -> a -> a
+ Word8 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) i
0 ([Word8] -> [Word8]
forall a. [a] -> [a]
reverse [Word8]
orig)

getWord8s :: Get [Word8]
getWord8s :: Get [Word8]
getWord8s = do
  Word8
w <- Get Word8
getWord8
  let msb :: Bool
msb = Word8
w Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7 in (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:) ([Word8] -> [Word8]) -> Get [Word8] -> Get [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
msb
    then Get [Word8]
getWord8s
    else [Word8] -> Get [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return []

class DecodeRaw a where
  decodeRaw :: Get a

instance DecodeRaw Word where
  decodeRaw :: Get Word
decodeRaw = Get Word
forall i. (Bits i, Integral i) => Get i
getNonNegative
  {-# INLINE decodeRaw #-}

instance DecodeRaw Word8 where
  decodeRaw :: Get Word8
decodeRaw = Get Word8
forall i. (Bits i, Integral i) => Get i
getNonNegative
  {-# INLINE decodeRaw #-}

instance DecodeRaw Word16 where
  decodeRaw :: Get Word16
decodeRaw = Get Word16
forall i. (Bits i, Integral i) => Get i
getNonNegative
  {-# INLINE decodeRaw #-}

instance DecodeRaw Word32 where
  decodeRaw :: Get Word32
decodeRaw = Get Word32
forall i. (Bits i, Integral i) => Get i
getNonNegative
  {-# INLINE decodeRaw #-}

instance DecodeRaw Word64 where
  decodeRaw :: Get Word64
decodeRaw = Get Word64
forall i. (Bits i, Integral i) => Get i
getNonNegative
  {-# INLINE decodeRaw #-}

instance DecodeRaw Int where
  decodeRaw :: Get Int
decodeRaw = Word -> Int
forall a. Zag a => a -> Zagged a
zag (Word -> Int) -> Get Word -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word
forall a. DecodeRaw a => Get a
decodeRaw :: Get Word)
  {-# INLINE decodeRaw #-}

instance DecodeRaw Int8 where
  decodeRaw :: Get Int8
decodeRaw = Word8 -> Int8
forall a. Zag a => a -> Zagged a
zag (Word8 -> Int8) -> Get Word8 -> Get Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word8
forall a. DecodeRaw a => Get a
decodeRaw :: Get Word8)
  {-# INLINE decodeRaw #-}

instance DecodeRaw Int16 where
  decodeRaw :: Get Int16
decodeRaw = Word16 -> Int16
forall a. Zag a => a -> Zagged a
zag (Word16 -> Int16) -> Get Word16 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word16
forall a. DecodeRaw a => Get a
decodeRaw :: Get Word16)
  {-# INLINE decodeRaw #-}

instance DecodeRaw Int32 where
  decodeRaw :: Get Int32
decodeRaw = Word32 -> Int32
forall a. Zag a => a -> Zagged a
zag (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word32
forall a. DecodeRaw a => Get a
decodeRaw :: Get Word32)
  {-# INLINE decodeRaw #-}

instance DecodeRaw Int64 where
  decodeRaw :: Get Int64
decodeRaw = Word64 -> Int64
forall a. Zag a => a -> Zagged a
zag (Word64 -> Int64) -> Get Word64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word64
forall a. DecodeRaw a => Get a
decodeRaw :: Get Word64)
  {-# INLINE decodeRaw #-}