module VLQ
(encode
,decode)
where
import Data.Bits hiding (shift)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import Data.Int
import Data.List
import Data.Word
import Prelude hiding ((>>))
baseShift :: Int
baseShift = 5
base :: Int32
base = 1 << baseShift
baseMask :: Int32
baseMask = base 1
continuationBit :: Int32
continuationBit = base
toVlqSigned :: Int32 -> Int32
toVlqSigned value =
if value < 0
then ((value) << 1) + 1
else (value << 1) + 0
fromVlgSigned :: Int32 -> Int32
fromVlgSigned value =
let value' = value >> 1
in if (value & 1) == 1
then value'
else value'
encode :: Int32 -> ByteString
encode = B.map encodeBase64 . start where
start 0 = B.singleton (fst (continue 0))
start n = B.unfoldr go . toVlqSigned $ n
go value
| value <= 0 = Nothing
| otherwise = Just (continue value)
continue value =
let digit = value & baseMask
value' = value >> baseShift
digit' = if value' > 0
then digit .|. continuationBit
else digit
in (fromIntegral digit',value')
decode :: ByteString -> Int32
decode = fromVlgSigned . go (0,0) . B.map decodeBase64 where
go (result,shift) bytes =
case B.uncons bytes of
Nothing -> result
Just (c,next) ->
let digit = fromIntegral c
continuation = (digit & continuationBit) /= 0
digit' = digit & baseMask
result' = result + (digit' << shift)
shift' = shift + baseShift
in if continuation
then go (result',shift') next
else result'
base64Chars :: [Word8]
base64Chars = map (fromIntegral.fromEnum) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
encodeBase64 :: Word8 -> Word8
encodeBase64 i = maybe (error "Base 64 char must be between 0 and 63.")
id
(lookup i (zip [0..] base64Chars))
decodeBase64 :: Word8 -> Word8
decodeBase64 i = maybe (error "Not a valid base 65 digit.")
id
(lookup i (zip base64Chars [0..]))
(<<) :: Int32 -> Int -> Int32
(<<) = shiftL
(>>) :: Int32 -> Int -> Int32
(>>) = shiftR
(&) :: Int32 -> Int32 -> Int32
(&) = (.&.)