module TextBuilder.Domains.Digits where import qualified Data.Text.Array as TextArray import qualified TextBuilder.Domains.Digits.Codepoints as Codepoints import TextBuilder.Prelude import TextBuilderCore -- | Decimal digit. {-# INLINE decimalDigit #-} decimalDigit :: (Integral a) => a -> TextBuilder decimalDigit (fromIntegral -> n) = unicodeCodepoint (n + 48) -- | Hexadecimal digit. {-# INLINE hexadecimalDigit #-} hexadecimalDigit :: (Integral a) => a -> TextBuilder hexadecimalDigit (fromIntegral -> n) = if n <= 9 then unicodeCodepoint (n + 48) else unicodeCodepoint (n + 87) {-# INLINE customFixedNumeralSystem #-} customFixedNumeralSystem :: (FiniteBits a, Integral a) => -- | Number of bits per digit. Int -> -- | Projection to codepoint with handling of overflow. (a -> a) -> -- | Value. a -> TextBuilder customFixedNumeralSystem bitsPerDigit digitCodepoint val = let size = div (finiteBitSize val + bitsPerDigit - 1) bitsPerDigit in TextBuilder size \array arrayStartIndex -> let go val arrayIndex = if arrayIndex >= arrayStartIndex then do TextArray.unsafeWrite array arrayIndex (fromIntegral (digitCodepoint val)) go (unsafeShiftR val bitsPerDigit) (pred arrayIndex) else return indexAfter indexAfter = arrayStartIndex + size in go val (pred indexAfter) -- | -- [Two's complement](https://en.wikipedia.org/wiki/Two%27s_complement) binary representation of a value. -- -- Bits of a statically sized value padded from the left according to the size. -- If it's a negatable integer, the sign is reflected in the bits. -- -- >>> binary @Int8 0 -- "00000000" -- -- >>> binary @Int8 4 -- "00000100" -- -- >>> binary @Int8 (-1) -- "11111111" -- -- >>> binary @Word8 255 -- "11111111" -- -- >>> binary @Int16 4 -- "0000000000000100" -- -- >>> binary @Int16 (-4) -- "1111111111111100" {-# INLINE binary #-} binary :: (FiniteBits a) => a -> TextBuilder binary val = let size = finiteBitSize val in TextBuilder size \array arrayStartIndex -> let go val arrayIndex = if arrayIndex >= arrayStartIndex then do TextArray.unsafeWrite array arrayIndex if testBit val 0 then 49 else 48 go (unsafeShiftR val 1) (pred arrayIndex) else return indexAfter indexAfter = arrayStartIndex + size in go val (pred indexAfter) -- | -- Same as 'binary', but with the \"0b\" prefix. -- -- >>> prefixedBinary @Int8 0 -- "0b00000000" {-# INLINE prefixedBinary #-} prefixedBinary :: (FiniteBits a) => a -> TextBuilder prefixedBinary = mappend "0b" . binary -- | Octal representation of an integer. -- -- >>> octal @Int32 123456 -- "00000361100" -- -- >>> octal @Int32 (-123456) -- "77777416700" {-# INLINE octal #-} octal :: (FiniteBits a, Integral a) => a -> TextBuilder octal = customFixedNumeralSystem 3 (Codepoints.octalDigit . fromIntegral) -- | -- Same as 'octal', but with the \"0o\" prefix. -- -- >>> prefixedOctal @Int8 0 -- "0o000" {-# INLINE prefixedOctal #-} prefixedOctal :: (FiniteBits a, Integral a) => a -> TextBuilder prefixedOctal = mappend "0o" . octal -- | Integer in hexadecimal notation with a fixed number of digits determined by the size of the type. -- -- >>> hexadecimal @Int8 0 -- "00" -- -- >>> hexadecimal @Int8 4 -- "04" -- -- >>> hexadecimal @Int8 (-128) -- "80" -- -- >>> hexadecimal @Int8 (-1) -- "ff" -- -- >>> hexadecimal @Word8 255 -- "ff" -- -- >>> hexadecimal @Int32 123456 -- "0001e240" -- -- >>> hexadecimal @Int32 (-123456) -- "fffe1dc0" {-# INLINE hexadecimal #-} hexadecimal :: (FiniteBits a, Integral a) => a -> TextBuilder hexadecimal = customFixedNumeralSystem 4 (Codepoints.hexDigit . fromIntegral) -- | -- Same as 'hexadecimal', but with the \"0x\" prefix. -- -- >>> prefixedHexadecimal @Int8 0 -- "0x00" {-# INLINE prefixedHexadecimal #-} prefixedHexadecimal :: (FiniteBits a, Integral a) => a -> TextBuilder prefixedHexadecimal = mappend "0x" . hexadecimal -- * Signed Numbers {-# INLINE signed #-} signed :: (Ord a, Num a) => (a -> TextBuilder) -> a -> TextBuilder signed onUnsigned i = if i >= 0 then onUnsigned i else unicodeCodepoint 45 <> onUnsigned (negate i) -- | Signed decimal representation of an integer. -- -- >>> decimal 123456 -- "123456" -- -- >>> decimal (-123456) -- "-123456" -- -- >>> decimal 0 -- "0" {-# INLINEABLE decimal #-} decimal :: (Integral a) => a -> TextBuilder decimal = signed unsignedDecimal -- * Unsigned Numbers -- | Render a number in the given radix. {-# INLINE digitsByRadix #-} digitsByRadix :: (Integral a) => a -> (a -> a) -> a -> TextBuilder digitsByRadix radix digitCodepoint = go 0 [] where go !offset !digits x = case divMod x radix of (next, digit) -> if next <= 0 then finish (succ offset) (digit : digits) else go (succ offset) (digit : digits) next finish size digits = TextBuilder size action where action :: TextArray.MArray s -> Int -> ST s Int action array = go digits where go digits offset = case digits of [] -> return offset (digit : digits) -> do TextArray.unsafeWrite array offset (fromIntegral (digitCodepoint digit)) go digits (succ offset) -- | Unsigned octal representation of a non-negative integral value. -- -- __Warning:__ It is your responsibility to ensure that the value is non-negative. -- -- -- >>> unsignedOctal 7 -- "7" -- -- >>> unsignedOctal 9 -- "11" -- -- >>> unsignedOctal 16 -- "20" {-# INLINE unsignedOctal #-} unsignedOctal :: (Integral a) => a -> TextBuilder unsignedOctal = digitsByRadix 8 (+ 48) -- | Unsigned decimal representation of a non-negative integral value. -- -- __Warning:__ It is your responsibility to ensure that the value is non-negative. -- -- >>> unsignedDecimal 123456 -- "123456" -- -- >>> unsignedDecimal 0 -- "0" {-# INLINE unsignedDecimal #-} unsignedDecimal :: (Integral a) => a -> TextBuilder unsignedDecimal = digitsByRadix 10 (+ 48) -- | Unsigned hexadecimal representation of a non-negative integral value. -- -- __Warning:__ It is your responsibility to ensure that the value is non-negative. -- -- >>> unsignedHexadecimal 123456 -- "1e240" -- -- >>> unsignedHexadecimal 0 -- "0" {-# INLINE unsignedHexadecimal #-} unsignedHexadecimal :: (Integral a) => a -> TextBuilder unsignedHexadecimal = digitsByRadix 16 (\digit -> if digit <= 9 then digit + 48 else digit + 87) -- * Other -- | Fixed-length decimal without sign. -- Padded with zeros or trimmed depending on whether it's shorter or longer -- than specified. -- -- >>> fixedLengthDecimal 5 123 -- "00123" -- -- >>> fixedLengthDecimal 5 123456 -- "23456" -- -- >>> fixedLengthDecimal 5 (-123456) -- "23456" -- -- >>> fixedLengthDecimal 7 (-123456) -- "0123456" -- -- >>> fixedLengthDecimal 0 123 -- "" -- -- >>> fixedLengthDecimal (-2) 123 -- "" {-# INLINEABLE fixedLengthDecimal #-} fixedLengthDecimal :: (Integral a) => Int -> a -> TextBuilder fixedLengthDecimal (max 0 -> size) (abs -> val) = TextBuilder size $ \array startOffset -> let offsetAfter = startOffset + size writeValue val offset = if offset >= startOffset then if val /= 0 then case divMod val 10 of (val, digit) -> do TextArray.unsafeWrite array offset $ 48 + fromIntegral digit writeValue val (pred offset) else writePadding offset else return offsetAfter writePadding offset = if offset >= startOffset then do TextArray.unsafeWrite array offset 48 writePadding (pred offset) else return offsetAfter in writeValue val (pred offsetAfter) -- | Decimal representation of an integral value with thousands separated by the specified character. -- -- >>> thousandSeparatedDecimal ',' 1234567890 -- "1,234,567,890" -- -- >>> thousandSeparatedDecimal ' ' (-1234567890) -- "-1 234 567 890" {-# INLINEABLE thousandSeparatedDecimal #-} thousandSeparatedDecimal :: (Integral a) => Char -> a -> TextBuilder thousandSeparatedDecimal separatorChar = signed (unsignedThousandSeparatedDecimal separatorChar) -- | Decimal representation of an unsigned integral value with thousands separated by the specified character. -- -- __Warning:__ It is your responsibility to ensure that the value is non-negative. -- -- >>> unsignedThousandSeparatedDecimal ',' 1234567890 -- "1,234,567,890" -- -- >>> unsignedThousandSeparatedDecimal ' ' 1234567890 -- "1 234 567 890" -- -- >>> unsignedThousandSeparatedDecimal ',' 0 -- "0" {-# INLINEABLE unsignedThousandSeparatedDecimal #-} unsignedThousandSeparatedDecimal :: (Integral a) => Char -> a -> TextBuilder unsignedThousandSeparatedDecimal separatorChar = processRightmostDigit where processRightmostDigit value = case divMod value 10 of (value, digit) -> processAnotherDigit [decimalDigit digit] (1 :: Int) value processAnotherDigit builders index value = if value == 0 then mconcat builders else case divMod value 10 of (value, digit) -> if mod index 3 == 0 then processAnotherDigit (decimalDigit digit : char separatorChar : builders) (succ index) value else processAnotherDigit (decimalDigit digit : builders) (succ index) value