{-# language BangPatterns #-}
{-# language TypeApplications #-}

module Data.Bytes.Parser.Base128
  ( -- * Unsigned
    word16
  , word32
  , word64
  ) where

import Control.Monad (when)
import Data.Bits (testBit,unsafeShiftL,(.|.),bit,clearBit)
import Data.Bytes.Parser (Parser)
import Data.Word (Word8,Word16,Word32,Word64)

import qualified Data.Bytes.Parser as P

word16 :: e -> Parser e s Word16
word16 :: e -> Parser e s Word16
word16 e
e = (Integral Word64, Num Word16) => Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word16 (Word64 -> Word16) -> Parser e s Word64 -> Parser e s Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> Int -> Word64 -> Parser e s Word64
forall e s. e -> Int -> Word64 -> Parser e s Word64
stepBoundedWord e
e Int
16 Word64
0

word32 :: e -> Parser e s Word32
word32 :: e -> Parser e s Word32
word32 e
e = (Integral Word64, Num Word32) => Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word32 (Word64 -> Word32) -> Parser e s Word64 -> Parser e s Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> Int -> Word64 -> Parser e s Word64
forall e s. e -> Int -> Word64 -> Parser e s Word64
stepBoundedWord e
e Int
32 Word64
0

word64 :: e -> Parser e s Word64
word64 :: e -> Parser e s Word64
word64 e
e = (Integral Word64, Num Word64) => Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word64 (Word64 -> Word64) -> Parser e s Word64 -> Parser e s Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> Int -> Word64 -> Parser e s Word64
forall e s. e -> Int -> Word64 -> Parser e s Word64
stepBoundedWord e
e Int
64 Word64
0

stepBoundedWord :: e -> Int -> Word64 -> Parser e s Word64
stepBoundedWord :: e -> Int -> Word64 -> Parser e s Word64
stepBoundedWord e
e !Int
bitLimit !Word64
acc = do
  Bool -> Parser e s () -> Parser e s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
acc Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Word64
forall a. Bits a => Int -> a
bit (Int
bitLimit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)) (Parser e s () -> Parser e s ()) -> Parser e s () -> Parser e s ()
forall a b. (a -> b) -> a -> b
$ e -> Parser e s ()
forall e s a. e -> Parser e s a
P.fail e
e
  Word8
raw <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
P.any e
e
  let content :: Word8
content = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
raw Int
7
      acc' :: Word64
acc' = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL Word64
acc Int
7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Word64 Word8
content
  if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
raw Int
7
    then e -> Int -> Word64 -> Parser e s Word64
forall e s. e -> Int -> Word64 -> Parser e s Word64
stepBoundedWord e
e Int
bitLimit Word64
acc'
    else Word64 -> Parser e s Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
acc'