{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Haskoin.Util (
bsToInteger,
integerToBS,
hexBuilder,
encodeHex,
encodeHexLazy,
decodeHex,
decodeHexLazy,
getBits,
eitherToMaybe,
maybeToEither,
liftEither,
liftMaybe,
updateIndex,
matchTemplate,
convertBits,
fst3,
snd3,
lst3,
dropFieldLabel,
dropSumLabels,
putList,
getList,
putMaybe,
getMaybe,
putLengthBytes,
getLengthBytes,
putInteger,
getInteger,
putInt32be,
getInt32be,
putInt64be,
getInt64be,
getIntMap,
putIntMap,
getTwo,
putTwo,
) where
import Control.Monad
import Control.Monad.Except (ExceptT (..), liftEither)
import Data.Aeson.Types (
Options (..),
SumEncoding (..),
defaultOptions,
defaultTaggedObject,
)
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Base16 as BL16
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Char (toLower)
import Data.Int
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.List
import Data.Text (Text)
import qualified Data.Text.Encoding as E
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as EL
import Data.Word
bsToInteger :: ByteString -> Integer
bsToInteger :: ByteString -> Integer
bsToInteger = (Word8 -> Integer -> Integer) -> Integer -> ByteString -> Integer
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr Word8 -> Integer -> Integer
forall a. Integral a => a -> Integer -> Integer
f Integer
0 (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse
where
f :: a -> Integer -> Integer
f a
w Integer
n = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
w Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL Integer
n Int
8
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)
hexBuilder :: BL.ByteString -> Builder
hexBuilder :: ByteString -> Builder
hexBuilder = ByteString -> Builder
lazyByteStringHex
encodeHex :: ByteString -> Text
encodeHex :: ByteString -> Text
encodeHex = ByteString -> Text
B16.encodeBase16
encodeHexLazy :: BL.ByteString -> TL.Text
encodeHexLazy :: ByteString -> Text
encodeHexLazy = ByteString -> Text
BL16.encodeBase16
decodeHex :: Text -> Maybe ByteString
decodeHex :: Text -> Maybe ByteString
decodeHex = Either Text ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
eitherToMaybe (Either Text ByteString -> Maybe ByteString)
-> (Text -> Either Text ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
B16.decodeBase16 (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
E.encodeUtf8
decodeHexLazy :: TL.Text -> Maybe BL.ByteString
decodeHexLazy :: Text -> Maybe ByteString
decodeHexLazy = Either Text ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
eitherToMaybe (Either Text ByteString -> Maybe ByteString)
-> (Text -> Either Text ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
BL16.decodeBase16 (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
EL.encodeUtf8
getBits :: Int -> ByteString -> ByteString
getBits :: Int -> ByteString -> ByteString
getBits Int
b ByteString
bs
| Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> ByteString -> ByteString
BS.take Int
q ByteString
bs
| Bool
otherwise = ByteString
i ByteString -> Word8 -> ByteString
`BS.snoc` Word8
l
where
(Int
q, Int
r) = Int
b Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
s :: ByteString
s = Int -> ByteString -> ByteString
BS.take (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs
i :: ByteString
i = ByteString -> ByteString
BS.init ByteString
s
l :: Word8
l = ByteString -> Word8
BS.last ByteString
s Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. (Word8
0xff Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r))
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe (Right b
b) = b -> Maybe b
forall a. a -> Maybe a
Just b
b
eitherToMaybe Either a b
_ = Maybe b
forall a. Maybe a
Nothing
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither b
err = Either b a -> (a -> Either b a) -> Maybe a -> Either b a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> Either b a
forall a b. a -> Either a b
Left b
err) a -> Either b a
forall a b. b -> Either a b
Right
liftMaybe :: Monad m => b -> Maybe a -> ExceptT b m a
liftMaybe :: b -> Maybe a -> ExceptT b m a
liftMaybe b
err = Either b a -> ExceptT b m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either b a -> ExceptT b m a)
-> (Maybe a -> Either b a) -> Maybe a -> ExceptT b m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe a -> Either b a
forall b a. b -> Maybe a -> Either b a
maybeToEither b
err
updateIndex ::
Int ->
[a] ->
(a -> a) ->
[a]
updateIndex :: Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i [a]
xs a -> a
f
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs = [a]
xs
| Bool
otherwise = [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a -> a
f a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r)
where
([a]
l, a
h : [a]
r) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs
matchTemplate ::
[a] ->
[b] ->
(a -> b -> Bool) ->
[Maybe a]
matchTemplate :: [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [] [b]
bs a -> b -> Bool
_ = Int -> Maybe a -> [Maybe a]
forall a. Int -> a -> [a]
replicate ([b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
bs) Maybe a
forall a. Maybe a
Nothing
matchTemplate [a]
_ [] a -> b -> Bool
_ = []
matchTemplate [a]
as (b
b : [b]
bs) a -> b -> Bool
f = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> b -> Bool
`f` b
b) [a]
as of
([a]
l, a
r : [a]
rs) -> a -> Maybe a
forall a. a -> Maybe a
Just a
r Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate ([a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rs) [b]
bs a -> b -> Bool
f
([a], [a])
_ -> Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [a]
as [b]
bs a -> b -> Bool
f
fst3 :: (a, b, c) -> a
fst3 :: (a, b, c) -> a
fst3 (a
a, b
_, c
_) = a
a
snd3 :: (a, b, c) -> b
snd3 :: (a, b, c) -> b
snd3 (a
_, b
b, c
_) = b
b
lst3 :: (a, b, c) -> c
lst3 :: (a, b, c) -> c
lst3 (a
_, b
_, c
c) = c
c
dropFieldLabel :: Int -> Options
dropFieldLabel :: Int -> Options
dropFieldLabel Int
n =
Options
defaultOptions
{ fieldLabelModifier :: [Char] -> [Char]
fieldLabelModifier = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
n
}
dropSumLabels :: Int -> Int -> String -> Options
dropSumLabels :: Int -> Int -> [Char] -> Options
dropSumLabels Int
c Int
f [Char]
tag =
(Int -> Options
dropFieldLabel Int
f)
{ constructorTagModifier :: [Char] -> [Char]
constructorTagModifier = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
c
, sumEncoding :: SumEncoding
sumEncoding = SumEncoding
defaultTaggedObject{tagFieldName :: [Char]
tagFieldName = [Char]
tag}
}
convertBits :: Bool -> Int -> Int -> [Word] -> ([Word], Bool)
convertBits :: Bool -> Int -> Int -> [Word] -> ([Word], Bool)
convertBits Bool
pad Int
frombits Int
tobits [Word]
i = ([Word] -> [Word]
forall a. [a] -> [a]
reverse [Word]
yout, Bool
rem')
where
(Word
xacc, Int
xbits, [Word]
xout) = ((Word, Int, [Word]) -> Word -> (Word, Int, [Word]))
-> (Word, Int, [Word]) -> [Word] -> (Word, Int, [Word])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word, Int, [Word]) -> Word -> (Word, Int, [Word])
outer (Word
0, Int
0, []) [Word]
i
([Word]
yout, Bool
rem')
| Bool
pad Bool -> Bool -> Bool
&& Int
xbits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 =
let xout' :: [Word]
xout' = (Word
xacc Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
tobits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xbits)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
maxv Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
xout
in ([Word]
xout', Bool
False)
| Bool
pad = ([Word]
xout, Bool
False)
| Int
xbits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = ([Word]
xout, Bool
True)
| Bool
otherwise = ([Word]
xout, Bool
False)
maxv :: Word
maxv = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
tobits Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
max_acc :: Word
max_acc = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
frombits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tobits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
outer :: (Word, Int, [Word]) -> Word -> (Word, Int, [Word])
outer (Word
acc, Int
bits, [Word]
out) Word
it =
let acc' :: Word
acc' = ((Word
acc Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
frombits) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
it) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
max_acc
bits' :: Int
bits' = Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
frombits
([Word]
out', Int
bits'') = Word -> [Word] -> Int -> ([Word], Int)
inner Word
acc' [Word]
out Int
bits'
in (Word
acc', Int
bits'', [Word]
out')
inner :: Word -> [Word] -> Int -> ([Word], Int)
inner Word
acc [Word]
out Int
bits
| Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tobits =
let bits' :: Int
bits' = Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tobits
out' :: [Word]
out' = ((Word
acc Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
bits') Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
maxv) Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
out
in Word -> [Word] -> Int -> ([Word], Int)
inner Word
acc [Word]
out' Int
bits'
| Bool
otherwise = ([Word]
out, Int
bits)
putInt32be :: MonadPut m => Int32 -> m ()
putInt32be :: Int32 -> m ()
putInt32be Int32
n
| Int32
n Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0 = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be (Word32 -> Word32
forall a. Bits a => a -> a
complement (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
n)) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
| Bool
otherwise = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
n))
getInt32be :: MonadGet m => m Int32
getInt32be :: m Int32
getInt32be = do
Word32
n <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
if Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
n Int
31
then Int32 -> m Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Int32
forall a. Num a => a -> a
negate (Int32 -> Int32
forall a. Bits a => a -> a
complement (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1))
else Int32 -> m Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
putInt64be :: MonadPut m => Int64 -> m ()
putInt64be :: Int64 -> m ()
putInt64be Int64
n
| Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Word64 -> Word64
forall a. Bits a => a -> a
complement (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
n)) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
| Bool
otherwise = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
n))
getInt64be :: MonadGet m => m Int64
getInt64be :: m Int64
getInt64be = do
Word64
n <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
n Int
63
then Int64 -> m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Int64
forall a. Num a => a -> a
negate (Int64 -> Int64
forall a. Bits a => a -> a
complement (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1))
else Int64 -> m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
putInteger :: MonadPut m => Integer -> m ()
putInteger :: Integer -> m ()
putInteger Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
lo Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
hi = do
Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00
Int32 -> m ()
forall (m :: * -> *). MonadPut m => Int32 -> m ()
putInt32be (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
| Bool
otherwise = do
Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x01
Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Integer
forall a. Num a => a -> a
signum Integer
n))
let len :: Int
len = (Integer -> Int
forall a. (Ord a, Integral a) => a -> Int
nrBits (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
(Word8 -> m ()) -> [Word8] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Integer -> [Word8]
forall a. (Integral a, Bits a) => a -> [Word8]
unroll (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n))
where
lo :: Integer
lo = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
minBound :: Int32)
hi :: Integer
hi = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
maxBound :: Int32)
getInteger :: MonadGet m => m Integer
getInteger :: m Integer
getInteger =
m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m Integer) -> m Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
0 -> Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Integer) -> m Int32 -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int32
forall (m :: * -> *). MonadGet m => m Int32
getInt32be
Word8
_ -> do
Word8
sign <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
[Word8]
bytes <- m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
let v :: Integer
v = [Word8] -> Integer
forall a. (Integral a, Bits a) => [Word8] -> a
roll [Word8]
bytes
Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$! if Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x01 then Integer
v else - Integer
v
putMaybe :: MonadPut m => (a -> m ()) -> Maybe a -> m ()
putMaybe :: (a -> m ()) -> Maybe a -> m ()
putMaybe a -> m ()
f Maybe a
Nothing = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00
putMaybe a -> m ()
f (Just a
x) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x01 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
x
getMaybe :: MonadGet m => m a -> m (Maybe a)
getMaybe :: m a -> m (Maybe a)
getMaybe m a
f =
m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
0x00 -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Word8
0x01 -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
f
Word8
_ -> [Char] -> m (Maybe a)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Not a Maybe"
putLengthBytes :: MonadPut m => ByteString -> m ()
putLengthBytes :: ByteString -> m ()
putLengthBytes ByteString
bs = do
Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs))
ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
bs
getLengthBytes :: MonadGet m => m ByteString
getLengthBytes :: m ByteString
getLengthBytes = do
Int
len <- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> m Word64 -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
len
unroll :: (Integral a, Bits a) => a -> [Word8]
unroll :: a -> [Word8]
unroll = (a -> Maybe (Word8, a)) -> a -> [Word8]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr a -> Maybe (Word8, a)
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 :: (Integral a, Bits a) => [Word8] -> a
roll :: [Word8] -> a
roll = (Word8 -> a -> a) -> a -> [Word8] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word8 -> a -> a
forall a a. (Bits a, Integral a, Num a) => a -> a -> a
unstep a
0
where
unstep :: a -> a -> a
unstep a
b a
a = 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
nrBits :: (Ord a, Integral a) => a -> Int
nrBits :: a -> Int
nrBits a
k =
let expMax :: Int
expMax = (Int -> Bool) -> (Int -> Int) -> Int -> Int
forall a. (a -> Bool) -> (a -> a) -> a -> a
until (\Int
e -> a
2 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
k) (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int
1
findNr :: Int -> Int -> Int
findNr :: Int -> Int -> Int
findNr Int
lo Int
hi
| Int
mid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lo = Int
hi
| a
2 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
mid a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k = Int -> Int -> Int
findNr Int
mid Int
hi
| a
2 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
mid a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
k = Int -> Int -> Int
findNr Int
lo Int
mid
where
mid :: Int
mid = (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hi) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in Int -> Int -> Int
findNr (Int
expMax Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int
expMax
getIntMap :: MonadGet m => m Int -> m a -> m (IntMap a)
getIntMap :: m Int -> m a -> m (IntMap a)
getIntMap m Int
i m a
m = [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, a)] -> IntMap a) -> m [(Int, a)] -> m (IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Int, a) -> m [(Int, a)]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (m Int -> m a -> m (Int, a)
forall (m :: * -> *) a b. MonadGet m => m a -> m b -> m (a, b)
getTwo m Int
i m a
m)
putIntMap :: MonadPut m => (Int -> m ()) -> (a -> m ()) -> IntMap a -> m ()
putIntMap :: (Int -> m ()) -> (a -> m ()) -> IntMap a -> m ()
putIntMap Int -> m ()
f a -> m ()
g = ((Int, a) -> m ()) -> [(Int, a)] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList ((Int -> m ()) -> (a -> m ()) -> (Int, a) -> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> (a, b) -> m ()
putTwo Int -> m ()
f a -> m ()
g) ([(Int, a)] -> m ())
-> (IntMap a -> [(Int, a)]) -> IntMap a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList
putTwo :: MonadPut m => (a -> m ()) -> (b -> m ()) -> (a, b) -> m ()
putTwo :: (a -> m ()) -> (b -> m ()) -> (a, b) -> m ()
putTwo a -> m ()
f b -> m ()
g (a
x, b
y) = a -> m ()
f a
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
g b
y
getTwo :: MonadGet m => m a -> m b -> m (a, b)
getTwo :: m a -> m b -> m (a, b)
getTwo m a
f m b
g = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
f m (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m b
g
putList :: MonadPut m => (a -> m ()) -> [a] -> m ()
putList :: (a -> m ()) -> [a] -> m ()
putList a -> m ()
f [a]
ls = do
Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls))
(a -> m ()) -> [a] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m ()
f [a]
ls
getList :: MonadGet m => m a -> m [a]
getList :: m a -> m [a]
getList m a
f = do
Int
l <- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> m Word64 -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
l m a
f