diff --git a/compiler/src/Generate/VLQ.hs b/compiler/src/Generate/VLQ.hs index ba880137..7b220926 100644 --- a/compiler/src/Generate/VLQ.hs +++ b/compiler/src/Generate/VLQ.hs @@ -2,6 +2,55 @@ module Generate.VLQ ( encode ) where +import Data.Bits ((.|.), (.&.)) +import Data.Bits qualified as Bit +import Data.List qualified as List +import Data.Map (Map, (!)) +import Data.Map qualified as Map +import Data.Function ((&)) +import Data.Foldable.WithIndex (ifoldr) + + +{- Ported from the Elm package Janiczek/elm-vlq +-} + encode :: Int -> String -encode _num = - "" \ No newline at end of file +encode num = + let + numWithSign = + if num < 0 + then (negate num `Bit.shiftL` 1) .|. 1 + else num `Bit.shiftL` 1 + in + encodeHelp numWithSign "" + +encodeHelp :: Int -> String -> String +encodeHelp num acc = + let + clamped = + num .&. 31 + + newNum = + num `Bit.shiftR` 5 + + newClamped = + if newNum > 0 then + clamped .|. 32 + + else + clamped + + newAcc = + base64Table ! newClamped : acc + in + if newNum > 0 then + encodeHelp newNum newAcc + + else + List.reverse newAcc + + +base64Table :: Map Int Char +base64Table = + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/='" + & ifoldr Map.insert Map.empty diff --git a/gren.cabal b/gren.cabal index 1ac18f7f..54149d70 100644 --- a/gren.cabal +++ b/gren.cabal @@ -225,7 +225,8 @@ Common gren-common utf8-string, vector, text >= 2 && < 3, - base64-bytestring >= 1.2 && < 2 + base64-bytestring >= 1.2 && < 2, + indexed-traversable Executable gren Import: diff --git a/tests/Generate/VLQSpec.hs b/tests/Generate/VLQSpec.hs index 74519300..c6dbe7be 100644 --- a/tests/Generate/VLQSpec.hs +++ b/tests/Generate/VLQSpec.hs @@ -16,4 +16,4 @@ spec = do encode 123456789 `shouldBe` "qxmvrH" -- limits: encode (-2147483648) `shouldBe` "B" - encode 2147483647 `shouldBe` "+/////D" \ No newline at end of file + encode 2147483647 `shouldBe` "+/////D"