module Data.Binary.Put.Integer
  ( putIntegerbe
  ) where

import Data.Binary.Put ( Put, putByteString )
import Data.Bits ( shiftR )
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import Data.Word ( Word8 )
import Prelude

-- | Encode an 'Integer' to a 'ByteString' as big endian.
--
-- Ripped from [haskoin-core-1.1.0](https://hackage.haskell.org/package/haskoin-core-1.1.0/docs/src/Haskoin.Util.Helpers.html#integerToBS).
integerToBS :: Integer -> ByteString
integerToBS :: Integer -> ByteString
integerToBS Integer
0 = [Word8] -> ByteString
BS.pack [Word8
0]
integerToBS Integer
i
  | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = ByteString -> ByteString
BS.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Integer -> Maybe (Word8, Integer)) -> Integer -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
BS.unfoldr Integer -> Maybe (Word8, Integer)
f Integer
i
  | Bool
otherwise = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"integerToBS not defined for negative values"
  where
    f :: Integer -> Maybe (Word8, Integer)
f Integer
0 = Maybe (Word8, Integer)
forall a. Maybe a
Nothing
    f Integer
x = (Word8, Integer) -> Maybe (Word8, Integer)
forall a. a -> Maybe a
Just (Integer -> Word8
forall a. Num a => Integer -> a
fromInteger Integer
x :: Word8, Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)

-- | Write an 'Integer' in big endian format
putIntegerbe :: Integer -> Put
putIntegerbe :: Integer -> Put
putIntegerbe = ByteString -> Put
putByteString (ByteString -> Put) -> (Integer -> ByteString) -> Integer -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ByteString
integerToBS
{-# INLINE putIntegerbe #-}