module Data.Binary.Roll where

import Data.Binary
import Data.Bits
import Data.List (foldl', unfoldr)


-- | Unroll and produce an exact number of bytes (left-pad with 0 bytes)
unroll :: Int -> Integer -> [Word8]
unroll :: Int -> Integer -> [Word8]
unroll Int
bytes Integer
val = Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate (Int
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
xs) Word8
0 [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
xs
    where xs :: [Word8]
xs = Integer -> [Word8]
unroll' (Integer -> Integer
forall a. Num a => a -> a
abs Integer
val)


-- | Source:
-- https://hackage.haskell.org/package/binary-0.8.5.1/docs/src/Data-Binary-Class.html#line-311
--
-- Fold and unfold an Integer to and from a list of its bytes
--
-- MOST SIGNIFICANT BYTE FIRST please
-- (this is a change from the default `Data.Binary` impl)
unroll' :: Integer -> [Word8]
unroll' :: Integer -> [Word8]
unroll' = [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> (Integer -> [Word8]) -> Integer -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Maybe (Word8, Integer)) -> Integer -> [Word8]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Integer -> Maybe (Word8, Integer)
forall b a. (Integral b, Num a, Bits b) => b -> Maybe (a, b)
step
  where
    step :: b -> Maybe (a, b)
step b
0 = Maybe (a, b)
forall a. Maybe a
Nothing
    step b
i = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
i, b
i b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)


roll :: [Word8] -> Integer
roll :: [Word8] -> Integer
roll = (Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> Word8 -> Integer
forall a a. (Bits a, Integral a, Num a) => a -> a -> a
unstep Integer
0
  where
    unstep :: a -> a -> a
unstep a
a a
b = a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b