{-# 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 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 w :: a
w n :: 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 8
integerToBS :: Integer -> ByteString
integerToBS :: Integer -> ByteString
integerToBS 0 = [Word8] -> ByteString
BS.pack [0]
integerToBS i :: Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "integerToBS not defined for negative values"
where
f :: Integer -> Maybe (Word8, Integer)
f 0 = Maybe (Word8, Integer)
forall a. Maybe a
Nothing
f x :: 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` 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 b :: Int
b bs :: ByteString
bs
| Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Int -> ByteString -> ByteString
BS.take Int
q ByteString
bs
| Bool
otherwise = ByteString
i ByteString -> Word8 -> ByteString
`BS.snoc` Word8
l
where
(q :: Int
q, r :: Int
r) = Int
b Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 8
s :: ByteString
s = Int -> ByteString -> ByteString
BS.take (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
.&. (0xff Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` (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) = b -> Maybe b
forall a. a -> Maybe a
Just b
b
eitherToMaybe _ = Maybe b
forall a. Maybe a
Nothing
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither err :: 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 err :: 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 i :: Int
i xs :: [a]
xs f :: a -> a
f
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
(l :: [a]
l,h :: a
h:r :: [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 [] bs :: [b]
bs _ = 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 _ [] _ = []
matchTemplate as :: [a]
as (b :: b
b:bs :: [b]
bs) f :: 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
(l :: [a]
l,r :: a
r:rs :: [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
_ -> 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
a,_,_) = a
a
snd3 :: (a,b,c) -> b
snd3 :: (a, b, c) -> b
snd3 (_,b :: b
b,_) = b
b
lst3 :: (a,b,c) -> c
lst3 :: (a, b, c) -> c
lst3 (_,_,c :: c
c) = c
c
dropFieldLabel :: Int -> Options
dropFieldLabel :: Int -> Options
dropFieldLabel n :: 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 c :: Int
c f :: Int
f tag :: [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 pad :: Bool
pad frombits :: Int
frombits tobits :: Int
tobits i :: [Word]
i = ([Word] -> [Word]
forall a. [a] -> [a]
reverse [Word]
yout, Bool
rem')
where
(xacc :: Word
xacc, xbits :: Int
xbits, xout :: [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 (0, 0, []) [Word]
i
(yout :: [Word]
yout, rem' :: Bool
rem')
| Bool
pad Bool -> Bool -> Bool
&& Int
xbits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 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
/= 0 = ([Word]
xout, Bool
True)
| Bool
otherwise = ([Word]
xout, Bool
False)
maxv :: Word
maxv = 1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
tobits Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
max_acc :: Word
max_acc = 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
- 1) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
outer :: (Word, Int, [Word]) -> Word -> (Word, Int, [Word])
outer (acc :: Word
acc, bits :: Int
bits, out :: [Word]
out) it :: 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
(out' :: [Word]
out', bits'' :: 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 acc :: Word
acc out :: [Word]
out bits :: 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 n :: Int32
n
| Int32
n Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< 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
+ 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 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
+ 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 n :: Int64
n
| Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 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
+ 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 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
+ 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 n :: 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 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 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
+ 7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 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
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
_ -> 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
== 0x01 then Integer
v else - Integer
v
putMaybe :: MonadPut m => (a -> m ()) -> Maybe a -> m ()
putMaybe :: (a -> m ()) -> Maybe a -> m ()
putMaybe f :: a -> m ()
f Nothing = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x00
putMaybe f :: a -> m ()
f (Just x :: a
x) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 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 f :: 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
0x00 -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
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
_ -> [Char] -> m (Maybe a)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "Not a Maybe"
putLengthBytes :: MonadPut m => ByteString -> m ()
putLengthBytes :: ByteString -> m ()
putLengthBytes bs :: 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 0 = Maybe (a, b)
forall a. Maybe a
Nothing
step i :: 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` 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 0
where
unstep :: a -> a -> a
unstep b :: a
b a :: a
a = a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` 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 k :: a
k =
let expMax :: Int
expMax = (Int -> Bool) -> (Int -> Int) -> Int -> Int
forall a. (a -> Bool) -> (a -> a) -> a -> a
until (\e :: Int
e -> 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
* 2) 1
findNr :: Int -> Int -> Int
findNr :: Int -> Int -> Int
findNr lo :: Int
lo hi :: Int
hi
| Int
mid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lo = Int
hi
| 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
| 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` 2
in Int -> Int -> Int
findNr (Int
expMax Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) Int
expMax
getIntMap :: MonadGet m => m Int -> m a -> m (IntMap a)
getIntMap :: m Int -> m a -> m (IntMap a)
getIntMap i :: m Int
i m :: 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 f :: Int -> m ()
f g :: 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 f :: a -> m ()
f g :: b -> m ()
g (x :: a
x, y :: 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 f :: m a
f g :: 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 f :: a -> m ()
f ls :: [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 f :: 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