{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Signed LEB128 codec.
--
-- Any /getXXX/ decoder can decode bytes generated using any of the /putXXX/ 
-- encoders, provided the encoded number fits in the target type.
module Data.Binary.SLEB128
 ( -- * Put
   putInteger
 , putInt64
 , putInt32
 , putInt16
 , putInt8
 , putInt
   -- * Get
 , getInteger
 , getInt64
 , getInt32
 , getInt16
 , getInt8
 , getInt
 ) where

import Control.Monad
import qualified Data.Binary.Get as Bin
import qualified Data.Binary.Put as Bin
import Data.Bits
import Data.Int
import Data.Word

--------------------------------------------------------------------------------

putInteger :: Integer -> Bin.Put
putInteger :: Integer -> Put
putInteger = \Integer
a ->  do
  let w8 :: Word8
w8 = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0x7f) :: Word8
      b :: Integer
b = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
unsafeShiftR Integer
a Int
7
      w8s :: Word8
w8s = Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40 
  if (Word8
w8s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
&& Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) Bool -> Bool -> Bool
|| (Word8
w8s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 Bool -> Bool -> Bool
&& Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -Integer
1)
     then Word8 -> Put
Bin.putWord8 Word8
w8
     else do Word8 -> Put
Bin.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$! Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80
             Integer -> Put
putInteger Integer
b

-- TODO: The following dispatch to 'putInteger'. Make faster.

putInt8 :: Int8 -> Bin.Put
putInt8 :: Int8 -> Put
putInt8 = Integer -> Put
putInteger (Integer -> Put) -> (Int8 -> Integer) -> Int8 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt16 :: Int16 -> Bin.Put
putInt16 :: Int16 -> Put
putInt16 = Integer -> Put
putInteger (Integer -> Put) -> (Int16 -> Integer) -> Int16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt32 :: Int32 -> Bin.Put
putInt32 :: Int32 -> Put
putInt32 = Integer -> Put
putInteger (Integer -> Put) -> (Int32 -> Integer) -> Int32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt64 :: Int64 -> Bin.Put
putInt64 :: Int64 -> Put
putInt64 = Integer -> Put
putInteger (Integer -> Put) -> (Int64 -> Integer) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt :: Int -> Bin.Put
putInt :: Int -> Put
putInt = Integer -> Put
putInteger (Integer -> Put) -> (Int -> Integer) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

--------------------------------------------------------------------------------

getInteger :: Bin.Get Integer
getInteger :: Get Integer
getInteger = Int -> Integer -> Get Integer
f Int
0 Integer
0
  where
    f :: Int -> Integer -> Bin.Get Integer
    f :: Int -> Integer -> Get Integer
f !Int
p !Integer
a = do
        Word8
w8 <- Get Word8
Bin.getWord8 
        let Integer
b :: Integer = Integer
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f)) Int
p
        case Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 of
          Word8
0 -> Integer -> Get Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Get Integer) -> Integer -> Get Integer
forall a b. (a -> b) -> a -> b
$! case Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40 of 
                         Word8
0 -> Integer
b 
                         Word8
_ -> Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a. Bits a => Int -> a
bit (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
          Word8
_ -> Int -> Integer -> Get Integer
f (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Integer
b

-- TODO: The following dispatch to 'getInteger'. Make faster.

getBoundedIntegral :: forall a. (Integral a, Bounded a) => String -> Bin.Get a
getBoundedIntegral :: String -> Get a
getBoundedIntegral String
label = do
    Integer
i <- Get Integer
getInteger
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
minA) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
erru)
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxA) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
erro)
    a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i
  where
    String
erru :: String  = String
label String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": underflow"
    String
erro :: String  = String
label String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": overflow" 
    Integer
minA :: Integer = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a) 
    Integer
maxA :: Integer = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a) 

getInt8 :: Bin.Get Int8
getInt8 :: Get Int8
getInt8 = String -> Get Int8
forall a. (Integral a, Bounded a) => String -> Get a
getBoundedIntegral String
"Data.Binary.SLEB128.getInt8"

getInt16 :: Bin.Get Int16
getInt16 :: Get Int16
getInt16 = String -> Get Int16
forall a. (Integral a, Bounded a) => String -> Get a
getBoundedIntegral String
"Data.Binary.SLEB128.getInt16"

getInt32 :: Bin.Get Int32
getInt32 :: Get Int32
getInt32 = String -> Get Int32
forall a. (Integral a, Bounded a) => String -> Get a
getBoundedIntegral String
"Data.Binary.SLEB128.getInt32"

getInt64 :: Bin.Get Int64
getInt64 :: Get Int64
getInt64 = String -> Get Int64
forall a. (Integral a, Bounded a) => String -> Get a
getBoundedIntegral String
"Data.Binary.SLEB128.getInt64"

getInt :: Bin.Get Int
getInt :: Get Int
getInt = String -> Get Int
forall a. (Integral a, Bounded a) => String -> Get a
getBoundedIntegral String
"Data.Binary.SLEB128.getInt"