-- | Implements Base 64-encoded VLQ for 32-bit
-- integers. Implementation copied from
-- https://code.google.com/p/closure-compiler/source/browse/trunk/src/com/google/debugging/sourcemap/Base64VLQ.java
--

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.Maybe
import           Data.Word
import           Prelude hiding ((>>))

-- | A Base64 VLQ digit can represent 5 bits, so it is base-32.
baseShift :: Int
baseShift :: Int
baseShift = Int
5

-- | Base point.
base :: Int32
base :: Int32
base = Int32
1 Int32 -> Int -> Int32
<< Int
baseShift

-- | A mask of bits for a VLQ digit (11111), 31 decimal.
baseMask :: Int32
baseMask :: Int32
baseMask = Int32
base Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1

-- | The continuation bit is the 6th bit.
continuationBit :: Int32
continuationBit :: Int32
continuationBit = Int32
base

-- | Converts from a two-complement value to a value where the sign
-- bit is is placed in the least significant bit.  For example, as
-- decimals:
--   1 becomes 2 (10 binary), -1 becomes 3 (11 binary)
--   2 becomes 4 (100 binary), -2 becomes 5 (101 binary)
toVlqSigned :: Int32 -> Int32
toVlqSigned :: Int32 -> Int32
toVlqSigned Int32
value =
  if Int32
value Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0
     then ((-Int32
value) Int32 -> Int -> Int32
<< Int
1) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1
     else (Int32
value Int32 -> Int -> Int32
<< Int
1) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
0

-- | Converts to a two-complement value from a value where the sign
-- bit is is placed in the least significant bit.  For example, as
-- decimals:
--   2 (10 binary) becomes 1, 3 (11 binary) becomes -1
--   4 (100 binary) becomes 2, 5 (101 binary) becomes -2
fromVlgSigned :: Int32 -> Int32
fromVlgSigned :: Int32 -> Int32
fromVlgSigned Int32
value =
  let value' :: Int32
value' = Int32
value Int32 -> Int -> Int32
>> Int
1
  in if (Int32
value Int32 -> Int32 -> Int32
& Int32
1) Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
1
        then -Int32
value'
        else Int32
value'

-- | Produces a ByteString containing a VLQ-encoded value of the given 32-bit integer.
encode :: Int32 -> ByteString
encode :: Int32 -> ByteString
encode = (Word8 -> Word8) -> ByteString -> ByteString
B.map Word8 -> Word8
encodeBase64 (ByteString -> ByteString)
-> (Int32 -> ByteString) -> Int32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> ByteString
start where
  start :: Int32 -> ByteString
start Int32
0 = Word8 -> ByteString
B.singleton ((Word8, Int32) -> Word8
forall a b. (a, b) -> a
fst (Int32 -> (Word8, Int32)
forall a. Num a => Int32 -> (a, Int32)
continue Int32
0))
  start Int32
n = (Int32 -> Maybe (Word8, Int32)) -> Int32 -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
B.unfoldr Int32 -> Maybe (Word8, Int32)
forall a. Num a => Int32 -> Maybe (a, Int32)
go (Int32 -> ByteString) -> (Int32 -> Int32) -> Int32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
toVlqSigned (Int32 -> ByteString) -> Int32 -> ByteString
forall a b. (a -> b) -> a -> b
$ Int32
n

  go :: Int32 -> Maybe (a, Int32)
go Int32
value
    | Int32
value Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0 = Maybe (a, Int32)
forall a. Maybe a
Nothing
    | Bool
otherwise  = (a, Int32) -> Maybe (a, Int32)
forall a. a -> Maybe a
Just (Int32 -> (a, Int32)
forall a. Num a => Int32 -> (a, Int32)
continue Int32
value)

  continue :: Int32 -> (a, Int32)
continue Int32
value =
    let digit :: Int32
digit = Int32
value Int32 -> Int32 -> Int32
& Int32
baseMask
        value' :: Int32
value' = Int32
value Int32 -> Int -> Int32
>> Int
baseShift
        digit' :: Int32
digit' = if Int32
value' Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0
                    then Int32
digit Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|. Int32
continuationBit
                    else Int32
digit
    in (Int32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
digit',Int32
value')


-- | Decodes the given VLQ-encoded value into a 32-bit integer.
decode :: ByteString -> Int32
decode :: ByteString -> Int32
decode = Int32 -> Int32
fromVlgSigned (Int32 -> Int32) -> (ByteString -> Int32) -> ByteString -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32, Int) -> ByteString -> Int32
go (Int32
0,Int
0) (ByteString -> Int32)
-> (ByteString -> ByteString) -> ByteString -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> ByteString -> ByteString
B.map Word8 -> Word8
decodeBase64 where
  go :: (Int32, Int) -> ByteString -> Int32
go (Int32
result,Int
shift) ByteString
bytes =
    case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bytes of
      Maybe (Word8, ByteString)
Nothing -> Int32
result
      Just (Word8
c,ByteString
next) ->
        let digit :: Int32
digit = Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c
            continuation :: Bool
continuation = (Int32
digit Int32 -> Int32 -> Int32
& Int32
continuationBit) Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
0
            digit' :: Int32
digit' = Int32
digit Int32 -> Int32 -> Int32
& Int32
baseMask
            result' :: Int32
result' = Int32
result Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32
digit' Int32 -> Int -> Int32
<< Int
shift)
            shift' :: Int
shift' = Int
shift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
baseShift
        in if Bool
continuation
              then (Int32, Int) -> ByteString -> Int32
go (Int32
result',Int
shift') ByteString
next
              else Int32
result'

-- | Base 64 characters.
base64Chars :: [Word8]
base64Chars :: [Word8]
base64Chars = (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
forall a. Enum a => a -> Int
fromEnum) [Char]
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

-- | Encode the given number to a base 64 character.
encodeBase64 :: Word8 -> Word8
encodeBase64 :: Word8 -> Word8
encodeBase64 Word8
i = Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Word8
forall a. HasCallStack => [Char] -> a
error [Char]
"Base 64 char must be between 0 and 63.")
                 (Word8 -> [(Word8, Word8)] -> Maybe Word8
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
i ([Word8] -> [Word8] -> [(Word8, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
0..] [Word8]
base64Chars))

-- | Encode the given base 64 character to a number.
decodeBase64 :: Word8 -> Word8
decodeBase64 :: Word8 -> Word8
decodeBase64 Word8
i = Word8 -> (Int -> Word8) -> Maybe Int -> Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Word8
forall a. HasCallStack => [Char] -> a
error [Char]
"Not a valid base 65 digit.") Int -> Word8
forall a. Enum a => Int -> a
toEnum
                 (Word8 -> [Word8] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Word8
i [Word8]
base64Chars)

-- | Makes the code more familiar to read. Shift-left.
(<<) :: Int32 -> Int -> Int32
<< :: Int32 -> Int -> Int32
(<<) = Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
shiftL

-- | Makes the code more familiar to read. Shift-right.
(>>) :: Int32 -> Int -> Int32
>> :: Int32 -> Int -> Int32
(>>) = Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
shiftR

-- | Makes the code more familiar to read. And.
(&) :: Int32 -> Int32 -> Int32
& :: Int32 -> Int32 -> Int32
(&) = Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
(.&.)