{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -ddump-simpl -ddump-to-file #-}

#include <MachDeps.h>

-- | __Signed LEB128 codec__. This codec encodes the two's complement
-- of a signed number
-- [as described here](https://en.wikipedia.org/wiki/LEB128#Signed_LEB128).
--
-- Any /getXXX/ decoder can decode bytes generated using any of the /putXXX/
-- encoders, provided the encoded number fits in the target type.
--
-- __WARNING__: This is not compatible with the /Unsigned LEB128/ codec at
-- "Data.Binary.ULEB128" nor with the /ZigZag LEB128/ codec at
-- "Data.Binary.ZLEB128".
module Data.Binary.SLEB128
 ( SLEB128(..)
   -- * Put
 , putInteger
 , putInt64
 , putInt32
 , putInt16
 , putInt8
 , putInt
 , putNatural
 , putWord64
 , putWord32
 , putWord16
 , putWord8
 , putWord
   -- * Get
 , getInteger
 , getInt64
 , getInt32
 , getInt16
 , getInt8
 , getInt
 , getNatural
 , getWord64
 , getWord32
 , getWord16
 , getWord8
 , getWord
   -- * Extras
   -- ** Scientific
 , putScientific
 , getScientific
   -- ** Rational
 , putRational
 , getRational
   -- ** Fixed
 , putFixed
 , getFixed
 ) where

import Data.Binary qualified as Bin
import Data.Binary.Get qualified as Bin
import Data.Binary.Put qualified as Bin
import Data.ByteString.Builder.Prim qualified as BB
import Data.ByteString.Builder.Prim.Internal qualified as BB
import Data.Scientific qualified as S
import Data.Bits
import Data.Coerce
import Data.Fixed
import Data.Proxy
import GHC.Real
import GHC.Exts
import GHC.Int
import GHC.Word
import GHC.Num.BigNat
import GHC.Num.Natural
import GHC.Num.Integer
import Foreign.Ptr
import Foreign.Storable
import Math.NumberTheory.Logarithms (integerLog10)

import Data.Binary.ULEB128 qualified as U

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

-- | Newtype wrapper for 'Bin.Binary' encoding and decoding @x@ using the
-- /Signed LEB128/ codec. Useful in conjunction with @DerivingVia@.
newtype SLEB128 x = SLEB128 x

-- | Note: Maximum allowed number of input bytes is restricted to 1000.
-- Use 'putNatural' if you want a greater limit.
instance Bin.Binary (SLEB128 Integer) where
  put :: SLEB128 Integer -> Put
put = (Integer -> Put) -> SLEB128 Integer -> Put
forall a b. Coercible a b => a -> b
coerce Integer -> Put
putInteger
  {-# INLINE put #-}
  get :: Get (SLEB128 Integer)
get = Get Integer -> Get (SLEB128 Integer)
forall a b. Coercible a b => a -> b
coerce (Int -> Get Integer
getInteger Int
1000)
  {-# INLINE get #-}

-- | Note: Maximum allowed number of input bytes is restricted to 1000.
-- Use 'putNatural' if you want a greater limit.
instance Bin.Binary (SLEB128 Natural) where
  put :: SLEB128 Natural -> Put
put = (Natural -> Put) -> SLEB128 Natural -> Put
forall a b. Coercible a b => a -> b
coerce Natural -> Put
putNatural
  {-# INLINE put #-}
  get :: Get (SLEB128 Natural)
get = Get Natural -> Get (SLEB128 Natural)
forall a b. Coercible a b => a -> b
coerce (Int -> Get Natural
getNatural Int
1000)
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int) where
  put :: SLEB128 Int -> Put
put = (Int -> Put) -> SLEB128 Int -> Put
forall a b. Coercible a b => a -> b
coerce Int -> Put
putInt
  {-# INLINE put #-}
  get :: Get (SLEB128 Int)
get = Get Int -> Get (SLEB128 Int)
forall a b. Coercible a b => a -> b
coerce Get Int
getInt
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word) where
  put :: SLEB128 Word -> Put
put = (Word -> Put) -> SLEB128 Word -> Put
forall a b. Coercible a b => a -> b
coerce Word -> Put
putWord
  {-# INLINE put #-}
  get :: Get (SLEB128 Word)
get = Get Word -> Get (SLEB128 Word)
forall a b. Coercible a b => a -> b
coerce Get Word
getWord
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int8) where
  put :: SLEB128 Int8 -> Put
put = (Int8 -> Put) -> SLEB128 Int8 -> Put
forall a b. Coercible a b => a -> b
coerce Int8 -> Put
putInt8
  {-# INLINE put #-}
  get :: Get (SLEB128 Int8)
get = Get Int8 -> Get (SLEB128 Int8)
forall a b. Coercible a b => a -> b
coerce Get Int8
getInt8
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word8) where
  put :: SLEB128 Word8 -> Put
put = (Word8 -> Put) -> SLEB128 Word8 -> Put
forall a b. Coercible a b => a -> b
coerce Word8 -> Put
putWord8
  {-# INLINE put #-}
  get :: Get (SLEB128 Word8)
get = Get Word8 -> Get (SLEB128 Word8)
forall a b. Coercible a b => a -> b
coerce Get Word8
getWord8
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int16) where
  put :: SLEB128 Int16 -> Put
put = (Int16 -> Put) -> SLEB128 Int16 -> Put
forall a b. Coercible a b => a -> b
coerce Int16 -> Put
putInt16
  {-# INLINE put #-}
  get :: Get (SLEB128 Int16)
get = Get Int16 -> Get (SLEB128 Int16)
forall a b. Coercible a b => a -> b
coerce Get Int16
getInt16
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word16) where
  put :: SLEB128 Word16 -> Put
put = (Word16 -> Put) -> SLEB128 Word16 -> Put
forall a b. Coercible a b => a -> b
coerce Word16 -> Put
putWord16
  {-# INLINE put #-}
  get :: Get (SLEB128 Word16)
get = Get Word16 -> Get (SLEB128 Word16)
forall a b. Coercible a b => a -> b
coerce Get Word16
getWord16
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int32) where
  put :: SLEB128 Int32 -> Put
put = (Int32 -> Put) -> SLEB128 Int32 -> Put
forall a b. Coercible a b => a -> b
coerce Int32 -> Put
putInt32
  {-# INLINE put #-}
  get :: Get (SLEB128 Int32)
get = Get Int32 -> Get (SLEB128 Int32)
forall a b. Coercible a b => a -> b
coerce Get Int32
getInt32
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word32) where
  put :: SLEB128 Word32 -> Put
put = (Word32 -> Put) -> SLEB128 Word32 -> Put
forall a b. Coercible a b => a -> b
coerce Word32 -> Put
putWord32
  {-# INLINE put #-}
  get :: Get (SLEB128 Word32)
get = Get Word32 -> Get (SLEB128 Word32)
forall a b. Coercible a b => a -> b
coerce Get Word32
getWord32
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int64) where
  put :: SLEB128 Int64 -> Put
put = (Int64 -> Put) -> SLEB128 Int64 -> Put
forall a b. Coercible a b => a -> b
coerce Int64 -> Put
putInt64
  {-# INLINE put #-}
  get :: Get (SLEB128 Int64)
get = Get Int64 -> Get (SLEB128 Int64)
forall a b. Coercible a b => a -> b
coerce Get Int64
getInt64
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word64) where
  put :: SLEB128 Word64 -> Put
put = (Word64 -> Put) -> SLEB128 Word64 -> Put
forall a b. Coercible a b => a -> b
coerce Word64 -> Put
putWord64
  {-# INLINE put #-}
  get :: Get (SLEB128 Word64)
get = Get Word64 -> Get (SLEB128 Word64)
forall a b. Coercible a b => a -> b
coerce Get Word64
getWord64
  {-# INLINE get #-}

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

{-# INLINE putInteger #-}
putInteger :: Integer -> Bin.Put
putInteger :: Integer -> Put
putInteger = \case
    IS Int#
x -> Int -> Put
putInt (Int# -> Int
I# Int#
x)
    IP ByteArray#
x -> ByteArray# -> Int -> Put
putIP ByteArray#
x (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> ByteArray# -> Word
bigNatSizeInBase Word
2 ByteArray#
x)
    IN ByteArray#
x -> ByteArray# -> Put
putIN ByteArray#
x
  where
    {-# INLINE putIP #-}
    putIP :: BigNat# -> Int -> Bin.Put
    putIP :: ByteArray# -> Int -> Put
putIP !ByteArray#
a !Int
m = do
      Word8 -> Put
Bin.putWord8 (Word8# -> Word8
W8# (Word# -> Word8#
wordToWord8# (Word# -> Word# -> Word#
or# (ByteArray# -> Int# -> Word#
bigNatIndex# ByteArray#
a Int#
0#) Word#
0x80##)))
      let b :: ByteArray#
b = ByteArray# -> Word# -> ByteArray#
bigNatShiftR# ByteArray#
a Word#
7## :: BigNat#
          n :: Int
n = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WORD_SIZE_IN_BITS - 1
         then ByteArray# -> Int -> Put
putIP ByteArray#
b Int
n
         else Int -> Put
putInt (Int# -> Int
I# (Word# -> Int#
word2Int# (ByteArray# -> Int# -> Word#
bigNatIndex# ByteArray#
b Int#
0#)))
    -- TODO: Faster 'putIN' implementation, similar to 'putIP'
    {-# INLINE putIN #-}
    putIN :: BigNat# -> Bin.Put
    putIN :: ByteArray# -> Put
putIN !ByteArray#
a = do
      let b :: Integer
b = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
unsafeShiftR (ByteArray# -> Integer
IN ByteArray#
a) Int
7        :: Integer
          c :: Word8
c = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteArray# -> Integer
IN ByteArray#
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0x7f) :: Word8
          d :: Word8
d = Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40
      if Word8
d 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
c
         else do Word8 -> Put
Bin.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$! Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80
                 Integer -> Put
putInteger Integer
b

putNatural :: Natural -> Bin.Put
putNatural :: Natural -> Put
putNatural = Integer -> Put
putInteger (Integer -> Put) -> (Natural -> Integer) -> Natural -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE putNatural #-}

putInt8 :: Int8 -> Bin.Put
putInt8 :: Int8 -> Put
putInt8 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int8 -> Builder) -> Int8 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int8 -> Int8 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int8 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int8
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
2 Int8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putInt8 #-}

putInt16 :: Int16 -> Bin.Put
putInt16 :: Int16 -> Put
putInt16 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int16 -> Builder) -> Int16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int16 -> Int16 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int16 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int16
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
3 Int16 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putInt16 #-}

putInt32 :: Int32 -> Bin.Put
putInt32 :: Int32 -> Put
putInt32 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int32 -> Builder) -> Int32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int32 -> Int32 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int32 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int32
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
5 Int32 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putInt32 #-}

putInt64 :: Int64 -> Bin.Put
putInt64 :: Int64 -> Put
putInt64 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int64 -> Builder) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int64 -> Int64 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int64 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int64
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Int64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putInt64 #-}

putInt :: Int -> Bin.Put
putInt :: Int -> Put
putInt =
#if WORD_SIZE_IN_BITS == 64
  Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int -> Builder) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int -> Int -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Int -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
#elif WORD_SIZE_IN_BITS == 32
  Bin.putBuilder . BB.primBounded (BB.boundedPrim 5 unsafePoke)
#endif
{-# INLINE putInt #-}

putWord8 :: Word8 -> Bin.Put
putWord8 :: Word8 -> Put
putWord8 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word8 -> Builder) -> Word8 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word8 -> Word8 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Word8 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word8
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
2 Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putWord8 #-}

putWord16 :: Word16 -> Bin.Put
putWord16 :: Word16 -> Put
putWord16 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word16 -> Builder) -> Word16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word16 -> Word16 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word16 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word16
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
3 Word16 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putWord16 #-}

putWord32 :: Word32 -> Bin.Put
putWord32 :: Word32 -> Put
putWord32 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word32 -> Builder) -> Word32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word32 -> Word32 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word32 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word32
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
5 Word32 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putWord32 #-}

putWord64 :: Word64 -> Bin.Put
putWord64 :: Word64 -> Put
putWord64 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word64 -> Builder) -> Word64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word64 -> Word64 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word64 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word64
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Word64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putWord64 #-}

putWord :: Word -> Bin.Put
putWord :: Word -> Put
putWord =
#if WORD_SIZE_IN_BITS == 64
  Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word -> Builder) -> Word -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Word -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Word -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
#elif WORD_SIZE_IN_BITS == 32
  Bin.putBuilder . BB.primBounded (BB.boundedPrim 5 unsafePoke)
#endif
{-# INLINE putWord #-}

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

getInteger
  :: Int
  -- ^ /Maximum/ number of bytes to consume. If the 'Integer' number can be
  -- determined before consuming this number of bytes, it will be. If @0@,
  -- parsing fails.
  --
  -- Each SLEB128 byte encodes at most 7 bits of data. That is,
  -- \(length(encoded) == \lceil\frac{length(data)}{7}\rceil\).
  -> Bin.Get Integer
getInteger :: Int -> Get Integer
getInteger = (Word8 -> Integer) -> Int -> Get Integer
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger
{-# INLINE getInteger #-}

-- | Like 'getInteger', except it's offered here so that other parsers can use
-- this specilized to types other than 'Integer'. This is unsafe because it
-- only works for signed numbers whose SLEB128 representation is at most as
-- long as the specified 'Int', but none of that is checked by this parser.
{-# INLINE unsafeGetSigned #-}
unsafeGetSigned
  :: forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Bin.Get a
unsafeGetSigned :: forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> a
fromWord8 = \Int
m -> String -> Get a -> Get a
forall a. String -> Get a -> Get a
Bin.label String
"SLEB128" (Int -> Int -> a -> Get a
go Int
m Int
0 a
0)
  where
    {-# INLINE go #-}
    go :: Int -> Int -> a -> Bin.Get a
    go :: Int -> Int -> a -> Get a
go Int
m Int
i a
o | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m = do
      Word8
w <- Get Word8
Bin.getWord8
      let !a :: a
a = a
o a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> a
fromWord8 (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f)) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7)
      if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80 then Int -> Int -> a -> Get a
go Int
m (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
a
      else a -> Get a
forall a. 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
$! a
a a -> a -> a
forall a. Num a => a -> a -> a
- Int -> a
forall a. Bits a => Int -> a
bit ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7)
                     a -> a -> a
forall a. Num a => a -> a -> a
* Word8 -> a
fromWord8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40) Int
6)
    go Int
_ Int
_ a
_ = String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"input exceeds maximum allowed bytes"

getNatural
  :: Int
  -- ^ /Maximum/ number of bytes to consume. If the 'Natural' number can be
  -- determined before consuming this number of bytes, it will be. If @0@,
  -- parsing fails.
  --
  -- Each SLEB128 byte encodes at most 7 bits of data. That is,
  -- \(length(encoded) == \lceil\frac{length(data)}{7}\rceil\).
  -> Bin.Get Natural
getNatural :: Int -> Get Natural
getNatural = \Int
m -> do
  Integer
i <- Int -> Get Integer
getInteger Int
m
  String -> Get Natural -> Get Natural
forall a. String -> Get a -> Get a
Bin.label String
"SLEB128" (Integer -> Get Natural
forall (m :: * -> *). MonadFail m => Integer -> m Natural
naturalFromInteger Integer
i)
{-# INLINE getNatural #-}

getBoundedIntegral
  :: forall a b
  .  (Bits a, Integral a, Bits b, Integral b)
  => Bin.Get a
  -> Bin.Get b
getBoundedIntegral :: forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral = \Get a
ga -> do
  a
a <- Get a
ga
  Get b -> (b -> Get b) -> Maybe b -> Get b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get b
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"underflow or overflow") b -> Get b
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe b
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
a)
{-# INLINE getBoundedIntegral #-}

getInt8 :: Bin.Get Int8
getInt8 :: Get Int8
getInt8 = (Word8 -> Int8) -> Int -> Get Int8
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
2
{-# INLINE getInt8 #-}

getInt16 :: Bin.Get Int16
getInt16 :: Get Int16
getInt16 = (Word8 -> Int16) -> Int -> Get Int16
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
3
{-# INLINE getInt16 #-}

getInt32 :: Bin.Get Int32
getInt32 :: Get Int32
getInt32 = (Word8 -> Int32) -> Int -> Get Int32
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
5
{-# INLINE getInt32 #-}

getInt64 :: Bin.Get Int64
getInt64 :: Get Int64
getInt64 = (Word8 -> Int64) -> Int -> Get Int64
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
10
{-# INLINE getInt64 #-}

getInt :: Bin.Get Int
getInt :: Get Int
getInt =
#if WORD_SIZE_IN_BITS == 64
  (Word8 -> Int) -> Int -> Get Int
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
10
#elif WORD_SIZE_IN_BITS == 32
  unsafeGetSigned fromIntegral 5
#endif
{-# INLINE getInt #-}

getWord8 :: Bin.Get Word8
getWord8 :: Get Word8
getWord8 = Get Int16 -> Get Word8
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned @Int16 Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
2)
{-# INLINE getWord8 #-}

getWord16 :: Bin.Get Word16
getWord16 :: Get Word16
getWord16 = Get Int32 -> Get Word16
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned @Int32 Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
3)
{-# INLINE getWord16 #-}

getWord32 :: Bin.Get Word32
getWord32 :: Get Word32
getWord32 = Get Int64 -> Get Word32
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned @Int64 Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
5)
{-# INLINE getWord32 #-}

getWord64 :: Bin.Get Word64
getWord64 :: Get Word64
getWord64 = Get Integer -> Get Word64
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (Int -> Get Integer
getInteger Int
10)
{-# INLINE getWord64 #-}

getWord :: Bin.Get Word
getWord :: Get Word
getWord =
#if WORD_SIZE_IN_BITS == 64
  Get Integer -> Get Word
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (Int -> Get Integer
getInteger Int
10)
#elif WORD_SIZE_IN_BITS == 32
  getBoundedIntegral (unsafeGetSigned @Int64 fromIntegral 5)
#endif
{-# INLINE getWord #-}

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

-- | SLEB128-encodes @a@ and writes it into 'Ptr'. Returns one past the last
-- written address. None of this is not checked.
{-# INLINE unsafePoke #-}
unsafePoke
  :: forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke :: forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke = \a
a Ptr Word8
p ->
    -- We split neg and pos so that their internal 'if' checks for less things.
    if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then a -> Ptr Word8 -> IO (Ptr Word8)
neg a
a Ptr Word8
p else a -> Ptr Word8 -> IO (Ptr Word8)
pos a
a Ptr Word8
p
  where
    {-# INLINE neg #-}
    neg :: a -> Ptr Word8 -> IO (Ptr Word8)
    neg :: a -> Ptr Word8 -> IO (Ptr Word8)
neg = \ !a
a !Ptr Word8
p -> do
      let b :: a
b = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
a Int
7          :: a
          c :: Word8
c = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7f) :: Word8
          d :: Word8
d = Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40                :: Word8
      if Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
|| a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= -a
1 then do
         Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80
         a -> Ptr Word8 -> IO (Ptr Word8)
neg a
b (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1
      else do
         Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x40
         Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1
    {-# INLINE pos #-}
    pos :: a -> Ptr Word8 -> IO (Ptr Word8)
    pos :: a -> Ptr Word8 -> IO (Ptr Word8)
pos = \ !a
a !Ptr Word8
p -> do
      let b :: a
b = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
a Int
7 :: a
          c :: Word8
c = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a   :: Word8
          d :: Word8
d = Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40       :: Word8
      if Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 Bool -> Bool -> Bool
|| a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 then do
         Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80
         a -> Ptr Word8 -> IO (Ptr Word8)
pos a
b (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1
      else do
         Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
c
         Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1

{-# INLINE naturalFromInteger #-}
naturalFromInteger :: MonadFail m => Integer -> m Natural
naturalFromInteger :: forall (m :: * -> *). MonadFail m => Integer -> m Natural
naturalFromInteger = \case
  IS Int#
x | Int# -> Bool
isTrue# (Int#
0# Int# -> Int# -> Int#
<=# Int#
x) -> Natural -> m Natural
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> m Natural) -> Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ Word# -> Natural
naturalFromWord# (Int# -> Word#
int2Word# Int#
x)
  IP ByteArray#
x -> Natural -> m Natural
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> m Natural) -> Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ ByteArray# -> Natural
naturalFromBigNat# ByteArray#
x
  Integer
_ -> String -> m Natural
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"underflow"

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

-- | Compact 'S.Scientific' encoding. Internally, it uses both ULEB128 and
-- SLEB128. 0 is encoded as @\\x00@, other numbers take at least two bytes.
--
-- Compatible decoders are 'getFixed' and 'getScientific'.
putScientific :: S.Scientific -> Bin.Put
putScientific :: Scientific -> Put
putScientific = \Scientific
a -> case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Scientific -> Integer
S.coefficient Scientific
a) Integer
0 of
   Ordering
LT -> do
      -- We store the coefficient sign alongside the base10Exponent so as to
      -- increase the chances that the coefficient fits in one less byte. The
      -- base10Exponent is usually much smaller than the coefficient in bit
      -- size, so this is likely to happen.
      let b :: Scientific
b = Scientific -> Scientific
S.normalize Scientific
a
      Natural -> Put
U.putNatural (Natural -> Put) -> Natural -> Put
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
S.coefficient Scientific
b
      Integer -> Put
putInteger (Integer -> Put) -> Integer -> Put
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
setBit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Scientific -> Int
S.base10Exponent Scientific
b) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1) Int
0
   Ordering
GT -> do
      let b :: Scientific
b = Scientific -> Scientific
S.normalize Scientific
a
      Natural -> Put
U.putNatural (Natural -> Put) -> Natural -> Put
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
S.coefficient Scientific
b
      Integer -> Put
putInteger (Integer -> Put) -> Integer -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Scientific -> Int
S.base10Exponent Scientific
b) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1
   Ordering
EQ -> Word8 -> Put
Bin.putWord8 Word8
0

-- | Decode a 'S.Scientific' encoded with 'putScientific' or 'putFixed'.
getScientific
  :: Int
  -- ^ /Maximum/ number of ULEB128 bytes to consume for the 'S.coefficient'
  -- part. See 'U.getNatural'.
  -> Bin.Get S.Scientific
getScientific :: Int -> Get Scientific
getScientific Int
n = String -> Get Scientific -> Get Scientific
forall a. String -> Get a -> Get a
Bin.label String
"getScientific" (Get Scientific -> Get Scientific)
-> Get Scientific -> Get Scientific
forall a b. (a -> b) -> a -> b
$ do
   Integer
c <- Int -> Get Integer
U.getInteger Int
n
   if Integer
c Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
      then do
         Integer
e1 <- Int -> Get Integer
getInteger Int
10 -- Valid e1 can't be longer than 10.
         case Integer -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized (Integer
e1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1) of
            Just (Int
e0 :: Int)
               | Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
e1 Int
0 -> Scientific -> Get Scientific
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Get Scientific) -> Scientific -> Get Scientific
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
S.scientific (Integer -> Integer
forall a. Num a => a -> a
negate Integer
c) Int
e0
               | Bool
otherwise -> Scientific -> Get Scientific
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Get Scientific) -> Scientific -> Get Scientific
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
S.scientific Integer
c Int
e0
            Maybe Int
Nothing -> String -> Get Scientific
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Exponent too large"
      else Scientific -> Get Scientific
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
0

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

-- | Compact 'Rational' encoding. Internally, it uses both ULEB128 and SLEB128.
-- Decode with 'getRational'. 0 is encoded as @\\x00@, other numbers take at
-- least four bytes.
putRational :: Rational -> Bin.Put
putRational :: Rational -> Put
putRational = \(Rational -> Rational
unsafeReduceRational -> Integer
n :% Integer
d) ->
   if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
      then do
         -- ns: The coefficient is often larger than the non-negative exponent,
         -- so we store the coefficient sign with the exponent in order to
         -- improve the chances that the coefficient fit in one less byte.
         let ns :: Scientific
ns = Scientific -> Scientific
S.normalize (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
n) :: S.Scientific
         Natural -> Put
U.putNatural (Natural -> Put) -> Natural -> Put
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
S.coefficient Scientific
ns
         Int -> Put
putInt (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Int -> Int
forall a. Bits a => a -> a
complement (Scientific -> Int
S.base10Exponent Scientific
ns)
                           else Scientific -> Int
S.base10Exponent Scientific
ns
         -- ds: The coefficient is more than 0, the exponent is at least 0.
         -- We decrease the coefficient by one to improve the chances it fits
         -- in one less byte.
         let ds :: Scientific
ds = Scientific -> Scientific
S.normalize (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
d) :: S.Scientific
         Natural -> Put
U.putNatural (Natural -> Put) -> Natural -> Put
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
S.coefficient Scientific
ds Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
         Word -> Put
U.putWord (Word -> Put) -> Word -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
S.base10Exponent Scientific
ds
      else Word8 -> Put
Bin.putWord8 Word8
0
 where
   unsafeReduceRational :: Rational -> Rational
   unsafeReduceRational :: Rational -> Rational
unsafeReduceRational = \(Integer
n :% Integer
d) -> Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d
      -- Fails with 'error' if the denominator is 0. That's OK, that kind of
      -- 'Rational' is not supposed to exist, anyway.

-- | Decode a 'Rational' encoded with 'putRational'.
getRational
  :: Int
  -- ^ /Maximum/ number of bytes to consume for each of the numerator and
  -- denominator parts. See 'U.getNatural'.
  -> Bin.Get Rational
getRational :: Int -> Get Rational
getRational Int
m = String -> Get Rational -> Get Rational
forall a. String -> Get a -> Get a
Bin.label String
"getRational" (Get Rational -> Get Rational) -> Get Rational -> Get Rational
forall a b. (a -> b) -> a -> b
$ do
   Integer
ncs0 <- Int -> Get Integer
U.getInteger Int
m
   if Integer
ncs0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
      then do
         Int
nes0 <- Get Int
getInt
         let ns :: Scientific
ns = if Int
nes0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                     then Integer -> Int -> Scientific
S.scientific Integer
ncs0 Int
nes0
                     else Integer -> Int -> Scientific
S.scientific (Integer -> Integer
forall a. Num a => a -> a
negate Integer
ncs0) (Int -> Int
forall a. Bits a => a -> a
complement Int
nes0)
         case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
S.floatingOrInteger Scientific
ns of
            Right Integer
n -> do
               Integer
dcs <- (Integer
1 +) (Integer -> Integer) -> Get Integer -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Integer
U.getInteger Int
m
               Int
des <- Get Int
U.getInt
               case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
S.floatingOrInteger (Integer -> Int -> Scientific
S.scientific Integer
dcs Int
des) of
                  Right Integer
d -> Rational -> Get Rational
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d)
                  Left (Double
_ :: Double) -> String -> Get Rational
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Non-integer denominator"
            Left (Double
_ :: Double) -> String -> Get Rational
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Non-integer numerator"
      else Rational -> Get Rational
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
0

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

-- | Same encoding as 'putScientific'.
--
-- Compatible decoders are 'getFixed' and 'getScientific'.
putFixed :: HasResolution r => Fixed r -> Bin.Put
putFixed :: forall {k} (r :: k). HasResolution r => Fixed r -> Put
putFixed = Scientific -> Put
putScientific (Scientific -> Put) -> (Fixed r -> Scientific) -> Fixed r -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed r -> Scientific
forall {k} (r :: k). HasResolution r => Fixed r -> Scientific
fixedToScientific
{-# INLINE putFixed #-}

-- | Decode a 'Fixed' encoded with 'putFixed' or 'putScientific'.
getFixed
  :: (HasResolution r)
  => Int
  -- ^ /Maximum/ number of ULEB128 bytes to consume for the 'S.coefficient'
  -- part. See 'U.getNatural'.
  -> Bin.Get (Fixed r)
getFixed :: forall {k} (r :: k). HasResolution r => Int -> Get (Fixed r)
getFixed Int
n = String -> Get (Fixed r) -> Get (Fixed r)
forall a. String -> Get a -> Get a
Bin.label String
"getFixed" (Get (Fixed r) -> Get (Fixed r)) -> Get (Fixed r) -> Get (Fixed r)
forall a b. (a -> b) -> a -> b
$ do
  Scientific
s <- Int -> Get Scientific
getScientific Int
n
  (String -> Get (Fixed r))
-> (Fixed r -> Get (Fixed r))
-> Either String (Fixed r)
-> Get (Fixed r)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (Fixed r)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Fixed r -> Get (Fixed r)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Fixed r) -> Get (Fixed r))
-> Either String (Fixed r) -> Get (Fixed r)
forall a b. (a -> b) -> a -> b
$ Scientific -> Either String (Fixed r)
forall {k} (r :: k).
HasResolution r =>
Scientific -> Either String (Fixed r)
fixedFromScientific Scientific
s


fixedToScientific :: forall r. (HasResolution r) => Fixed r -> S.Scientific
fixedToScientific :: forall {k} (r :: k). HasResolution r => Fixed r -> Scientific
fixedToScientific = \(MkFixed Integer
i) -> Integer -> Int -> Scientific
S.scientific Integer
i Int
e
  where
   e :: Int
   e :: Int
e = Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
integerLog10 (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy r -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
forall (p :: k -> *). p r -> Integer
resolution (Proxy r -> Integer) -> Proxy r -> Integer
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r

fixedFromScientific
   :: forall r
    . (HasResolution r)
   => S.Scientific
   -> Either String (Fixed r)
fixedFromScientific :: forall {k} (r :: k).
HasResolution r =>
Scientific -> Either String (Fixed r)
fixedFromScientific = \Scientific
s0 ->
   if | Int
s0e <- Scientific -> Int
S.base10Exponent Scientific
s0, Int
s0e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
e ->
         Fixed r -> Either String (Fixed r)
forall a b. b -> Either a b
Right (Integer -> Fixed r
forall k (a :: k). Integer -> Fixed a
MkFixed (Scientific -> Integer
S.coefficient Scientific
s0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
s0e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e)))
      | Scientific
s1 <- Scientific -> Scientific
S.normalize Scientific
s0, Int
s1e <- Scientific -> Int
S.base10Exponent Scientific
s1, Int
s1e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
e ->
         Fixed r -> Either String (Fixed r)
forall a b. b -> Either a b
Right (Integer -> Fixed r
forall k (a :: k). Integer -> Fixed a
MkFixed (Scientific -> Integer
S.coefficient Scientific
s1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
s1e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e)))
      | Bool
otherwise -> String -> Either String (Fixed r)
forall a b. a -> Either a b
Left String
"Too small"
  where
   e :: Int
   e :: Int
e = Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
integerLog10 (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy r -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
forall (p :: k -> *). p r -> Integer
resolution (Proxy r -> Integer) -> Proxy r -> Integer
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r