diff --git a/Data/Text/Lazy/Builder/Int.hs b/Data/Text/Lazy/Builder/Int.hs index 8d6913be9..f3315b15e 100644 --- a/Data/Text/Lazy/Builder/Int.hs +++ b/Data/Text/Lazy/Builder/Int.hs @@ -16,9 +16,12 @@ module Data.Text.Lazy.Builder.Int ( decimal + , paddedDecimal , hexadecimal ) where +import Control.Monad (unless) +import Data.Foldable (for_) import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (mempty) import qualified Data.ByteString.Unsafe as B @@ -124,6 +127,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 = + for_ [0..iters - 1] $ \i -> + unsafeWrite marr (off + i) zero + minus, zero :: Word16 {-# INLINE minus #-} {-# INLINE zero #-} diff --git a/changelog.md b/changelog.md index 4bbeaf4d7..7dc875aa7 100644 --- a/changelog.md +++ b/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 diff --git a/tests/Tests.hs b/tests/Tests.hs index fb97ff4ad..64f9944b9 100644 --- a/tests/Tests.hs +++ b/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] diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs index 7b9db610b..e437ed410 100644 --- a/tests/Tests/Properties.hs +++ b/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 = "-" <> expected (abs a) + | otherwise = + let + shown = TL.pack (show a) + in + TL.replicate (fromIntegral padLen - TL.length shown) "0" <> 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, diff --git a/tests/Tests/Unit.hs b/tests/Tests/Unit.hs new file mode 100644 index 000000000..e3b4ffe35 --- /dev/null +++ b/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 + ] diff --git a/text.cabal b/text.cabal index d3048da52..4fb909a1b 100644 --- a/text.cabal +++ b/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