Add paddedDecimal, for zero-padding.

This doesn't currently specialise as well as `decimal`, but it should
be easy to give it an analogous structure if that would help. In the
absence of benchmarks, I've left it in the simpler form.

Author: quasicomputational

Data/Text/Lazy/Builder/Int.hs

@@ -16,9 +16,11 @@
 module Data.Text.Lazy.Builder.Int
     (
       decimal
+    , paddedDecimal
     , hexadecimal
     ) where
 
+import Control.Monad (forM_, unless)
 import Data.Int (Int8, Int16, Int32, Int64)
 import Data.Monoid (mempty)
 import qualified Data.ByteString.Unsafe as B
@@ -124,6 +126,49 @@ posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0
           unsafeWrite marr (off - 1) $ get j
         get = fromIntegral . B.unsafeIndex digits
 
+-- | Prefix the output digits with the given with zeroes to the given
+-- length. If the padding length is zero or negative, this is
+-- identical to 'decimal'.
+--
+-- Note that, with fixed padding length /N/, the output is only
+-- constant-width if the input is always both positive or always
+-- negative and with absolute value less than /10^N/.
+--
+-- >>>  paddedDecimal 3 12
+-- "012"
+-- >>>  paddedDecimal 3 1234
+-- "1234"
+-- >>>  paddedDecimal 3 (-123)
+-- "-123"
+-- >>>  paddedDecimal 5 (-12)
+-- "-00012"
+--
+-- @since 1.2.4
+paddedDecimal :: Integral a => Int -> a -> Builder
+paddedDecimal padLen i
+    | i < 0 = let (q, r) = i `quotRem` 10
+                  qq = -q
+                  !n = if q == 0
+                       then 0
+                       else countDigits qq
+                  padding = max 0 $ padLen - n - 1
+              in writeN (n + padding + 2) $ \marr off -> do
+                   unsafeWrite marr off minus
+                   zeroPad marr (off + 1) padding
+                   unless (q == 0) $
+                     posDecimal marr (off + 1 + padding) n qq
+                   unsafeWrite marr (off + 1 + padding + n) (i2w (-r))
+    | otherwise = let !n = countDigits i
+                      padding = max 0 $ padLen - n
+                  in writeN (n + padding) $ \marr off -> do
+                       zeroPad marr off padding
+                       posDecimal marr (off + padding) n i
+
+zeroPad :: forall s. MArray s -> Int -> Int -> ST s ()
+zeroPad marr off iters =
+  forM_ [0..iters - 1] $ \i ->
+    unsafeWrite marr (off + i) zero
+
 minus, zero :: Word16
 {-# INLINE minus #-}
 {-# INLINE zero #-}

changelog.md

@@ -1,3 +1,7 @@
+### Next
+
+* Added `Data.Text.Lazy.Builder.paddedDecimal`.
+
 ### 1.2.3.1
 
 * Make `decodeUtf8With` fail explicitly for unsupported non-BMP

tests/Tests.hs

@@ -8,6 +8,7 @@ import Test.Framework (defaultMain)
 
 import qualified Tests.Properties as Properties
 import qualified Tests.Regressions as Regressions
+import qualified Tests.Unit as Unit
 
 main :: IO ()
-main = defaultMain [Properties.tests, Regressions.tests]
+main = defaultMain [Properties.tests, Regressions.tests, Unit.tests]

tests/Tests/Properties.hs

@@ -29,7 +29,7 @@ import Numeric (showEFloat, showFFloat, showGFloat, showHex)
 import Prelude hiding (replicate)
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.QuickCheck hiding ((.&.))
+import Test.QuickCheck hiding ((.&.), Small(..))
 import Test.QuickCheck.Monadic
 import Test.QuickCheck.Property (Property(..))
 import Test.QuickCheck.Unicode (char)
@@ -849,6 +849,38 @@ tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
 tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
 tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
 
+tb_paddedDecimal :: (Integral a, Show a) => Small -> a -> Bool
+tb_paddedDecimal padLenSmall = (TB.toLazyText . TB.paddedDecimal padLen) `eq` (expected . fromIntegral)
+  where
+  padLen = fromIntegral padLenSmall
+  expected :: Integer -> TL.Text
+  expected a
+    | abs a >= 10 ^ padLen = TL.pack (show a)
+    | a < 0 = "-" `TL.append` expected (abs a)
+    | otherwise =
+        let
+          shown = TL.pack (show a)
+        in
+          TL.replicate (fromIntegral padLen - TL.length shown) "0" `TL.append` shown
+
+tb_paddedDecimal_integer len (a::Integer) = tb_paddedDecimal len a
+tb_paddedDecimal_integer_big len (Big a) = tb_paddedDecimal len a
+tb_paddedDecimal_int len (a::Int) = tb_paddedDecimal len a
+tb_paddedDecimal_int8 len (a::Int8) = tb_paddedDecimal len a
+tb_paddedDecimal_int16 len (a::Int16) = tb_paddedDecimal len a
+tb_paddedDecimal_int32 len (a::Int32) = tb_paddedDecimal len a
+tb_paddedDecimal_int64 len (a::Int64) = tb_paddedDecimal len a
+tb_paddedDecimal_word len (a::Word) = tb_paddedDecimal len a
+tb_paddedDecimal_word8 len (a::Word8) = tb_paddedDecimal len a
+tb_paddedDecimal_word16 len (a::Word16) = tb_paddedDecimal len a
+tb_paddedDecimal_word32 len (a::Word32) = tb_paddedDecimal len a
+tb_paddedDecimal_word64 len (a::Word64) = tb_paddedDecimal len a
+
+tb_paddedDecimal_big_int len (BigBounded (a::Int)) = tb_paddedDecimal len a
+tb_paddedDecimal_big_int64 len (BigBounded (a::Int64)) = tb_paddedDecimal len a
+tb_paddedDecimal_big_word len (BigBounded (a::Word)) = tb_paddedDecimal len a
+tb_paddedDecimal_big_word64 len (BigBounded (a::Word64)) = tb_paddedDecimal len a
+
 tb_hex :: (Integral a, Show a) => a -> Bool
 tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
 
@@ -1401,6 +1433,24 @@ tests =
         testProperty "tb_decimal_big_int64" tb_decimal_big_int64,
         testProperty "tb_decimal_big_word64" tb_decimal_big_word64
       ],
+      testGroup "paddedDecimal" [
+        testProperty "tb_paddedDecimal_int" tb_paddedDecimal_int,
+        testProperty "tb_paddedDecimal_int8" tb_paddedDecimal_int8,
+        testProperty "tb_paddedDecimal_int16" tb_paddedDecimal_int16,
+        testProperty "tb_paddedDecimal_int32" tb_paddedDecimal_int32,
+        testProperty "tb_paddedDecimal_int64" tb_paddedDecimal_int64,
+        testProperty "tb_paddedDecimal_integer" tb_paddedDecimal_integer,
+        testProperty "tb_paddedDecimal_integer_big" tb_paddedDecimal_integer_big,
+        testProperty "tb_paddedDecimal_word" tb_paddedDecimal_word,
+        testProperty "tb_paddedDecimal_word8" tb_paddedDecimal_word8,
+        testProperty "tb_paddedDecimal_word16" tb_paddedDecimal_word16,
+        testProperty "tb_paddedDecimal_word32" tb_paddedDecimal_word32,
+        testProperty "tb_paddedDecimal_word64" tb_paddedDecimal_word64,
+        testProperty "tb_paddedDecimal_big_int" tb_paddedDecimal_big_int,
+        testProperty "tb_paddedDecimal_big_word" tb_paddedDecimal_big_word,
+        testProperty "tb_paddedDecimal_big_int64" tb_paddedDecimal_big_int64,
+        testProperty "tb_paddedDecimal_big_word64" tb_paddedDecimal_big_word64
+      ],
       testGroup "hexadecimal" [
         testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
         testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8,

tests/Tests/Unit.hs

@@ -0,0 +1,47 @@
+-- | Tests for specific cases.
+--
+{-# LANGUAGE OverloadedStrings #-}
+module Tests.Unit
+    (
+      tests
+    ) where
+
+import Data.Int (Int8)
+import Test.HUnit ((@?=))
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
+import qualified Data.Text.Lazy.Builder.Int as Int
+import qualified Test.Framework as F
+import qualified Test.Framework.Providers.HUnit as F
+
+paddedDecimalTests :: F.Test
+paddedDecimalTests = F.testGroup "paddedDecimal"
+  [ tI 3 12 "012"
+  , tI 3 1234 "1234"
+  , tI 3 (-123) "-123"
+  , tI 3 (-12) "-012"
+  , tI 3 0 "000"
+  , tI 0 0 "0"
+  , tI 3 10 "010"
+  , tI 3 (-10) "-010"
+  , tI 3 (-1) "-001"
+  , tI 7 1234 "0001234"
+  , tI (-3) 12 "12"
+  , tI 1 (-3) "-3"
+  , tI8 5 (-128) "-00128"
+  , tI8 3 (-128) "-128"
+  , tI8 2 (-128) "-128"
+  ]
+  where
+  tI :: Int -> Int -> TL.Text -> F.Test
+  tI padLen input expected = F.testCase ("Int " ++ show (padLen, input)) $
+    TB.toLazyText (Int.paddedDecimal padLen input) @?= expected
+
+  tI8 :: Int -> Int8 -> TL.Text -> F.Test
+  tI8 padLen input expected = F.testCase ("Int8 " ++ show (padLen, input)) $
+    TB.toLazyText (Int.paddedDecimal padLen input) @?= expected
+
+tests :: F.Test
+tests = F.testGroup "unit tests"
+  [ paddedDecimalTests
+  ]

text.cabal

@@ -188,6 +188,7 @@ test-suite tests
     Tests.QuickCheckUtils
     Tests.Regressions
     Tests.SlowFunctions
+    Tests.Unit
     Tests.Utils
 
   -- Same as in `library` stanza; this is needed by cabal for accurate