module Tahoe.Util where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Lazy as LBS

-- | The smallest multiple of `multiplier` which is >= `value`.
nextMultipleOf :: (Integral m, Integral v) => m -> v -> v
nextMultipleOf :: m -> v -> v
nextMultipleOf m
multiplier v
value = v
factor v -> v -> v
forall a. Num a => a -> a -> a
* m -> v
forall a b. (Integral a, Num b) => a -> b
fromIntegral m
multiplier
  where
    factor :: v
factor = v
factor' v -> v -> v
forall a. Num a => a -> a -> a
+ (if v
remainder v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
0 then v
0 else v
1)
    (v
factor', v
remainder) = v
value v -> v -> (v, v)
forall a. Integral a => a -> a -> (a, a)
`divMod` m -> v
forall a b. (Integral a, Num b) => a -> b
fromIntegral m
multiplier

{- | Return the smallest integer which is a power of k and greater than or
 equal to n
-}
nextPowerOf :: (Ord p, Num p) => p -> p -> p
nextPowerOf :: p -> p -> p
nextPowerOf p
k p
n =
    p -> p -> p -> p
forall p. (Ord p, Num p) => p -> p -> p -> p
nextPowerOf' p
k p
n p
1
  where
    nextPowerOf' :: p -> p -> p -> p
nextPowerOf' p
k' p
n' p
p' =
        if p
p' p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
n'
            then p -> p -> p -> p
nextPowerOf' p
k' p
n' (p
p' p -> p -> p
forall a. Num a => a -> a -> a
* p
k')
            else p
p'

{- | Construct a binary representation of the given integer.  The first
 argument represents a zero bit.  The second argument represents a one bit.
 The result is ordered from most to least significant bit.
-}
toBinary :: a -> a -> Int -> [a]
toBinary :: a -> a -> Int -> [a]
toBinary a
off a
on Int
i = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a]
toBinaryRev Int
i
  where
    toBinaryRev :: Int -> [a]
toBinaryRev Int
0 = []
    toBinaryRev Int
n
        | Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0 :: Int) = a
off a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
toBinaryRev (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
        | Bool
otherwise = a
on a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
toBinaryRev (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)

{- | Break up a byte string into equal sized pieces, except the last piece
 which might be short.  *BS.concat . chunkedBy n == id*
-}
chunkedBy ::
    -- | The number of bytes in each piece.
    Int ->
    -- | The byte string to break up.
    BS.ByteString ->
    [BS.ByteString]
chunkedBy :: Int -> ByteString -> [ByteString]
chunkedBy Int
_n ByteString
"" = []
chunkedBy Int
n ByteString
xs = ByteString
nextChunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
chunkedBy Int
n ByteString
theRest
  where
    (ByteString
nextChunk, ByteString
theRest) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
n ByteString
xs

toStrictByteString :: BS.Builder -> BS.ByteString
toStrictByteString :: Builder -> ByteString
toStrictByteString = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BS.toLazyByteString

-- | Integer division rounded towards positive infinity.
ceilDiv :: Integral i => i -> i -> i
ceilDiv :: i -> i -> i
ceilDiv i
a i
b = i
q i -> i -> i
forall a. Num a => a -> a -> a
+ i
adjustment
  where
    (i
q, i
r) = i
a i -> i -> (i, i)
forall a. Integral a => a -> a -> (a, a)
`divMod` i
b
    adjustment :: i
adjustment = case i
r of
        i
0 -> i
0
        i
_ -> i
1