{-# LANGUAGE FlexibleContexts #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0

module Data.Word7
    (
      -- * Types
      Word7

      -- * Conversions
    , toWord7
    , toWord8
    , toWord7s
    , toNatural

      -- * Encode / Decode
    , 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 )


-- | A 'Word7' algebraic data-type.
-- @since 2.0.0
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)


--
-- Conversions
--
-- > toWord7 1
-- > Word7 1
-- > toWord7 127
-- > Word7 127
-- > toWord7 128
-- > Word7 0
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 1
-- > [Word7 1]
-- > toWord7s 128
-- > [Word7 1,Word7 0]
-- > toWord7s 19099
-- > [Word7 1,Word7 21,Word7 27]
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

--
-- Decoding
--
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]