{-# LANGUAGE FlexibleContexts #-}
module Data.Word7
(
Word7
, toWord7
, toWord8
, toWord7s
, toNatural
, putVariableLengthNat
, getVariableLengthNat
) where
import Prelude
import Data.Binary.Get
( Get, getWord8 )
import Data.Binary.Put
( Put, putWord8 )
import Data.Bits
( shiftL, shiftR, (.&.), (.|.) )
import Data.List
( foldl' )
import Data.Word
( Word8 )
import Numeric.Natural
( Natural )
newtype Word7 = Word7 Word8
deriving (Word7 -> Word7 -> Bool
(Word7 -> Word7 -> Bool) -> (Word7 -> Word7 -> Bool) -> Eq Word7
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word7 -> Word7 -> Bool
$c/= :: Word7 -> Word7 -> Bool
== :: Word7 -> Word7 -> Bool
$c== :: Word7 -> Word7 -> Bool
Eq, Int -> Word7 -> ShowS
[Word7] -> ShowS
Word7 -> String
(Int -> Word7 -> ShowS)
-> (Word7 -> String) -> ([Word7] -> ShowS) -> Show Word7
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word7] -> ShowS
$cshowList :: [Word7] -> ShowS
show :: Word7 -> String
$cshow :: Word7 -> String
showsPrec :: Int -> Word7 -> ShowS
$cshowsPrec :: Int -> Word7 -> ShowS
Show)
toWord7 :: Word8 -> Word7
toWord7 :: Word8 -> Word7
toWord7 Word8
x = Word8 -> Word7
Word7 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F)
toWord8 :: Word7 -> Word8
toWord8 :: Word7 -> Word8
toWord8 (Word7 Word8
x) = Word8
x
toWord7s :: Natural -> [Word7]
toWord7s :: Natural -> [Word7]
toWord7s = [Word7] -> [Word7]
forall a. [a] -> [a]
reverse ([Word7] -> [Word7]) -> (Natural -> [Word7]) -> Natural -> [Word7]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> [Word7]
forall t. (Integral t, Bits t) => t -> [Word7]
go
where
go :: t -> [Word7]
go t
n
| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0x7F = [Word8 -> Word7
Word7 (Word8 -> Word7) -> (t -> Word8) -> t -> Word7
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t -> Word7) -> t -> Word7
forall a b. (a -> b) -> a -> b
$ t
n]
| Bool
otherwise = (Word8 -> Word7
toWord7 (Word8 -> Word7) -> (t -> Word8) -> t -> Word7
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral) t
n Word7 -> [Word7] -> [Word7]
forall a. a -> [a] -> [a]
: t -> [Word7]
go (t -> Int -> t
forall a. Bits a => a -> Int -> a
shiftR t
n Int
7)
word7sToNat :: [Word7] -> Natural
word7sToNat :: [Word7] -> Natural
word7sToNat = (Natural -> Word7 -> Natural) -> Natural -> [Word7] -> Natural
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Natural -> Word7 -> Natural
forall a. (Bits a, Num a) => a -> Word7 -> a
f Natural
0
where
f :: a -> Word7 -> a
f a
n (Word7 Word8
r) = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
n Int
7 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r)
toNatural :: [Word7] -> Natural
toNatural :: [Word7] -> Natural
toNatural =
(Natural, Int) -> Natural
forall a b. (a, b) -> a
fst ((Natural, Int) -> Natural)
-> ([Word7] -> (Natural, Int)) -> [Word7] -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Word7 -> (Natural, Int) -> (Natural, Int))
-> (Natural, Int) -> [Word7] -> (Natural, Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Word7 Word8
x) (Natural
res, Int
pow) ->
(Natural
res Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ (Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
*(Int -> Natural
limit Int
pow Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1), Int
pow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
)
(Natural
0,Int
0)
where
limit :: Int -> Natural
limit :: Int -> Natural
limit Int
pow = Natural
2 Natural -> Int -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
pow Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
putVariableLengthNat :: Natural -> Put
putVariableLengthNat :: Natural -> Put
putVariableLengthNat = [Word7] -> Put
putWord7s ([Word7] -> Put) -> (Natural -> [Word7]) -> Natural -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> [Word7]
toWord7s
where
putWord7s :: [Word7] -> Put
putWord7s :: [Word7] -> Put
putWord7s [] = () -> Put
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
putWord7s [Word7 Word8
x] = Word8 -> Put
putWord8 Word8
x
putWord7s (Word7 Word8
x : [Word7]
xs) = Word8 -> Put
putWord8 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Word7] -> Put
putWord7s [Word7]
xs
getVariableLengthNat :: Get Natural
getVariableLengthNat :: Get Natural
getVariableLengthNat = [Word7] -> Natural
word7sToNat ([Word7] -> Natural) -> Get [Word7] -> Get Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word7]
getWord7s
where
getWord7s :: Get [Word7]
getWord7s :: Get [Word7]
getWord7s = do
Word8
next <- Get Word8
getWord8
case Word8
next Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 of
Word8
0x80 -> (:) (Word8 -> Word7
toWord7 Word8
next) ([Word7] -> [Word7]) -> Get [Word7] -> Get [Word7]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word7]
getWord7s
Word8
_ -> [Word7] -> Get [Word7]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word8 -> Word7
Word7 Word8
next]