diff --git a/CHANGELOG.md b/CHANGELOG.md index 1bff3cb..f57b3f0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for small-bytearray-builder +## 0.3.4.0 -- 2020-??-?? + +* Add `wordPaddedDec4`. + ## 0.3.3.0 -- 2020-02-10 * Add `word64PaddedLowerHex` and `word32PaddedLowerHex` diff --git a/small-bytearray-builder.cabal b/small-bytearray-builder.cabal index 9227879..d20a4d8 100644 --- a/small-bytearray-builder.cabal +++ b/small-bytearray-builder.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: small-bytearray-builder -version: 0.3.3.0 +version: 0.3.4.0 synopsis: Serialize to a small byte arrays description: This is similar to the builder facilities provided by diff --git a/src/Data/ByteArray/Builder/Bounded.hs b/src/Data/ByteArray/Builder/Bounded.hs index 8ecc771..1b52be3 100644 --- a/src/Data/ByteArray/Builder/Bounded.hs +++ b/src/Data/ByteArray/Builder/Bounded.hs @@ -61,6 +61,7 @@ module Data.ByteArray.Builder.Bounded , char -- ** Native , wordPaddedDec2 + , wordPaddedDec4 , wordPaddedDec9 -- ** Machine-Readable -- *** One @@ -648,6 +649,22 @@ wordPaddedDec2 !w = Unsafe.construct $ \arr off -> do writeByteArray arr (off + 1) (unsafeWordToWord8 (d2 + 48)) pure (off + 2) +-- | Encode a number less than 10000 as a decimal number, zero-padding it to +-- two digits. For example: 0 is encoded as @0000@, 5 is encoded as @0005@, +-- and 73 is encoded as @0073@. +-- +-- Precondition: Argument must be less than 10000. Failure to satisfy this +-- precondition will not result in a segfault, but the resulting bytes are +-- undefined. The implemention uses a heuristic for division that is inaccurate +-- for large numbers. +wordPaddedDec4 :: Word -> Builder 4 +wordPaddedDec4 !w = Unsafe.construct $ \arr off -> do + putRem10 + (putRem10 $ putRem10 $ putRem10 + (\_ _ _ -> pure ()) + ) arr (off + 3) w + pure (off + 4) + -- | Encode a number less than 1e9 as a decimal number, zero-padding it to -- nine digits. For example: 0 is encoded as @000000000@ and 5 is encoded as -- @000000005@. diff --git a/test/Main.hs b/test/Main.hs index 637165b..0d8ccef 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -77,6 +77,10 @@ tests = testGroup "Tests" Bounded.run Nat.two (Bounded.wordPaddedDec2 w) === pack (zeroPadL 2 (show w)) + , TQC.testProperty "wordPaddedDec4" $ TQC.forAll (TQC.choose (0,9999)) $ \w -> + Bounded.run Nat.constant (Bounded.wordPaddedDec4 w) + === + pack (zeroPadL 4 (show w)) , TQC.testProperty "wordPaddedDec9" $ TQC.forAll (TQC.choose (0,999999999)) $ \w -> Bounded.run Nat.constant (Bounded.wordPaddedDec9 w) ===