{-|
Module      : Z.Data.Builder.Numeric
Description : Textual numeric builders.
Copyright   : (c) Dong Han, 2017-2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

Textual numeric builders.

-}

module Z.Data.Builder.Numeric (
  -- * Integral type formatting

    IFormat(..)
  , defaultIFormat
  , Padding(..)
  , int
  , intWith
  , integer
  -- * Fixded size hexidecimal formatting
  , hex, hexUpper
  -- * IEEE float formating
  , FFormat(..)
  , double
  , doubleWith
  , float
  , floatWith
  , scientific
  , scientificWith
  -- * Patterns
  , pattern PLUS
  , pattern MINUS
  , pattern ZERO
  , pattern SPACE
  , pattern DOT
  , pattern LITTLE_E
  , pattern BIG_E
  -- * Misc
  , grisu3
  , grisu3_sp
  , i2wDec, i2wHex, i2wHexUpper
  , countDigits
  , c_intWith, hs_intWith
) where

import           Control.Monad
import           Data.Bits
import           Data.Int
import qualified Data.List                           as List
import           Data.Primitive.ByteArray
import           Data.Primitive.PrimArray
import qualified Data.Scientific                     as Sci
import           Data.Word
import           GHC.Exts
import           GHC.Float
import           GHC.Integer
import           Z.Data.Builder.Base
import           Z.Data.Builder.Numeric.DigitTable
import           Z.Foreign
import           System.IO.Unsafe
#ifdef INTEGER_GMP
import           GHC.Integer.GMP.Internals
#endif
import           Test.QuickCheck.Arbitrary           (Arbitrary(..), CoArbitrary(..))

--------------------------------------------------------------------------------

foreign import ccall unsafe "dtoa.h" c_int_dec :: Word64 -> Int -> Int -> Word8 -> MBA# Word8 -> Int -> IO Int

-- | Integral formatting options.
--
data IFormat = IFormat
    { width       :: Int            -- ^ total width, only effective with padding options
    , padding     :: Padding        -- ^ padding options
    , posSign     :: Bool           -- ^ show @+@ when the number is positive
    } deriving (Show, Eq, Ord)

instance Arbitrary IFormat where
    arbitrary = IFormat <$> arbitrary <*> arbitrary <*> arbitrary

instance CoArbitrary IFormat where
    coarbitrary (IFormat w pad p) = coarbitrary (w, pad, p)


-- | @defaultIFormat = IFormat 0 NoPadding False@
defaultIFormat :: IFormat
defaultIFormat = IFormat 0 NoPadding False

data Padding = NoPadding | RightSpacePadding | LeftSpacePadding | ZeroPadding deriving (Show, Eq, Ord, Enum)

instance Arbitrary Padding where
    arbitrary = toEnum . (`mod` 4) <$> arbitrary

instance CoArbitrary Padding where
    coarbitrary = coarbitrary . fromEnum

-- | @int = intWith defaultIFormat@
int :: (Integral a, Bounded a) => a -> Builder ()
{-# INLINE int #-}
int = intWith defaultIFormat

-- | Format a 'Bounded' 'Integral' type like @Int@ or @Word16@ into decimal ASCII digits.
--
-- @
-- import Z.Data.Builder as B
-- import Z.Data.Text    as T
--
-- > T.validate . B.buildBytes $ B.intWith defaultIFormat  (12345 :: Int)
-- "12345"
-- > T.validate . B.buildBytes $ B.intWith defaultIFormat{width=10, padding=RightSpacePadding} (12345 :: Int)
-- "12345     "
-- > T.validate . B.buildBytes $ B.intWith defaultIFormat{width=10, padding=ZeroPadding} (12345 :: Int)
-- "0000012345"
-- @
--
intWith :: (Integral a, Bounded a) => IFormat -> a -> Builder ()
intWith = hs_intWith
{-# INLINE[0] intWith #-}
{-# RULES "intWith'/Int8"    intWith = c_intWith  :: IFormat -> Int8    -> Builder () #-}
{-# RULES "intWith'/Int"     intWith = c_intWith  :: IFormat -> Int     -> Builder () #-}
{-# RULES "intWith'/Int16"   intWith = c_intWith  :: IFormat -> Int16   -> Builder () #-}
{-# RULES "intWith'/Int32"   intWith = c_intWith  :: IFormat -> Int32   -> Builder () #-}
{-# RULES "intWith'/Int64"   intWith = c_intWith  :: IFormat -> Int64   -> Builder () #-}
{-# RULES "intWith'/Word"    intWith = c_intWith  :: IFormat -> Word    -> Builder () #-}
{-# RULES "intWith'/Word8"   intWith = c_intWith  :: IFormat -> Word8   -> Builder () #-}
{-# RULES "intWith'/Word16"  intWith = c_intWith  :: IFormat -> Word16  -> Builder () #-}
{-# RULES "intWith'/Word32"  intWith = c_intWith  :: IFormat -> Word32  -> Builder () #-}
{-# RULES "intWith'/Word64"  intWith = c_intWith  :: IFormat -> Word64  -> Builder () #-}

-- | Internal formatting backed by C FFI, it must be used with type smaller than 'Word64'.
--
-- We use rewrite rules to rewrite most of the integral types formatting to this function.
c_intWith :: (Integral a, Bits a) => IFormat -> a -> Builder ()
{-# INLINE c_intWith #-}
c_intWith (IFormat{..}) x
    | x < 0 =
        let !x' = (fromIntegral (complement x) :: Word64) + 1
        in ensureN width' (\ (MutablePrimArray mba#) i ->
            (c_int_dec x' (-1) width pad (unsafeCoerce# mba#) i))
    | posSign =
        ensureN width' (\ (MutablePrimArray mba#) i ->
            (c_int_dec (fromIntegral x) 1 width pad (unsafeCoerce# mba#) i))
    | otherwise =
        ensureN width' (\ (MutablePrimArray mba#) i ->
            (c_int_dec (fromIntegral x) 0 width pad (unsafeCoerce# mba#) i))
  where
    width' = max 21 width
    pad = case padding of NoPadding          -> 0
                          RightSpacePadding  -> 1
                          LeftSpacePadding   -> 2
                          ZeroPadding        -> 3

-- | Internal formatting in haskell, it can be used with any bounded integral type.
--
-- Other than provide fallback for the c version, this function is also used to check
-- the c version's formatting result.
hs_intWith :: (Integral a, Bounded a) => IFormat -> a -> Builder ()
{-# INLINABLE hs_intWith #-}
hs_intWith format@IFormat{..} i
    | i < 0 =
        if i == minBound            -- can't directly negate in this case
        then do
            let (q, r) = i `quotRem` 10
                !qq = -q            -- all digits except last one
                !rr = i2wDec (-r)      -- last digits
                !n = countDigits qq
                !n' = n + 2         -- extra two bytes: MINUS and last digit
            if width > n'
            then case padding of
                NoPadding ->
                    writeN n' $ \marr off -> do
                        writePrimArray marr off MINUS                       -- leading MINUS
                        let off' = off + 1
                        writePositiveDec marr off' n qq                      -- digits
                        let off'' = off' + n
                        writePrimArray marr off'' rr                        -- last digit
                ZeroPadding ->
                    writeN width $ \marr off -> do
                        let !leadingN = width-n'
                        writePrimArray marr off MINUS                   -- leading MINUS
                        let off' = off + 1
                        setPrimArray marr off' leadingN ZERO            -- leading zeros
                        let off'' = off' + leadingN
                        writePositiveDec marr off'' n qq                 -- digits
                        let off''' = off'' + n
                        writePrimArray marr off''' rr                   -- last digit
                LeftSpacePadding ->
                    writeN width $ \marr off -> do
                        let !leadingN = width-n'
                        setPrimArray marr off leadingN SPACE            -- leading spaces
                        let off' = off + leadingN
                        writePrimArray marr off' MINUS                  -- leading MINUS
                        let off'' = off' + 1
                        writePositiveDec marr off'' n qq                 -- digits
                        let off''' = off'' + n
                        writePrimArray marr off''' rr                   -- last digit
                RightSpacePadding ->
                    writeN width $ \marr off -> do
                        let !trailingN = width-n'
                        writePrimArray marr off MINUS                   -- leading MINUS
                        let off' = off + 1
                        writePositiveDec marr off' n qq                  -- digits
                        let off'' = off' + n
                        writePrimArray marr off'' rr                    -- last digit
                        let off''' = off'' + 1
                        setPrimArray marr off''' trailingN SPACE        -- trailing spaces
            else
                writeN n' $ \marr off -> do
                    writePrimArray marr off MINUS                       -- leading MINUS
                    let off' = off + 1
                    writePositiveDec marr off' n qq                      -- digits
                    let off'' = off' + n
                    writePrimArray marr off'' rr                        -- last digit
        else do
            let !qq = -i
                !n = countDigits qq
                !n' = n + 1  -- extra byte: MINUS
            if width > n'
            then case padding of
                NoPadding ->
                    writeN n' $ \marr off -> do
                        writePrimArray marr off MINUS                       -- leading MINUS
                        let off' = off + 1
                        writePositiveDec marr off' n qq                      -- digits
                ZeroPadding ->
                    writeN width $ \marr off -> do
                        let !leadingN = width-n'
                        writePrimArray marr off MINUS                   -- leading MINUS
                        let off' = off + 1
                        setPrimArray marr off' leadingN ZERO            -- leading zeros
                        let off'' = off' + leadingN
                        writePositiveDec marr off'' n qq                 -- digits
                LeftSpacePadding ->
                    writeN width $ \marr off -> do
                        let !leadingN = width-n'
                        setPrimArray marr off leadingN SPACE            -- leading spaces
                        let off' = off + leadingN
                        writePrimArray marr off' MINUS                  -- leading MINUS
                        let off'' = off' + 1
                        writePositiveDec marr off'' n qq                 -- digits
                RightSpacePadding ->
                    writeN width $ \marr off -> do
                        let !trailingN = width-n'
                        writePrimArray marr off MINUS                   -- leading MINUS
                        let off' = off + 1
                        writePositiveDec marr off' n qq                  -- digits
                        let off'' = off' + n
                        setPrimArray marr off'' trailingN SPACE         -- trailing spaces
            else
                writeN n' $ \marr off -> do
                    writePrimArray marr off MINUS                       -- leading MINUS
                    let off' = off + 1
                    writePositiveDec marr off' n qq                      -- digits
    | otherwise = positiveInt format i

positiveInt :: (Integral a) => IFormat -> a -> Builder ()
{-# INLINABLE positiveInt #-}
positiveInt (IFormat width padding ps) i =
    let !n = countDigits i
    in if ps
        then
            let n' = n+1
            in if width > n'
            then case padding of
                NoPadding ->
                    writeN n' $ \marr off -> do
                        writePrimArray marr off PLUS                    -- leading PLUS
                        let off' = off + 1
                        writePositiveDec marr off' n i                   -- digits
                ZeroPadding ->
                    writeN width $ \marr off -> do
                        let !leadingN = width-n'
                        writePrimArray marr off PLUS                    -- leading PLUS
                        let off' = off + 1
                        setPrimArray marr off' leadingN ZERO            -- leading zeros
                        let off'' = off' + leadingN
                        writePositiveDec marr off'' n i                  -- digits
                LeftSpacePadding ->
                    writeN width $ \marr off -> do
                        let !leadingN = width-n'
                        setPrimArray marr off leadingN SPACE            -- leading spaces
                        let off' = off + leadingN
                        writePrimArray marr off' PLUS                   -- leading PLUS
                        let off'' = off' + 1
                        writePositiveDec marr off'' n i                  -- digits
                RightSpacePadding ->
                    writeN width $ \marr off -> do
                        let !trailingN = width-n'
                        writePrimArray marr off PLUS                    -- leading PLUS
                        let off' = off + 1
                        writePositiveDec marr off' n i                   -- digits
                        let off'' = off' + n
                        setPrimArray marr off'' trailingN SPACE         -- trailing spaces
            else
                writeN n' $ \marr off -> do
                    writePrimArray marr off PLUS                        -- leading PLUS
                    let off' = off + 1
                    writePositiveDec marr off' n i                       -- digits

        else if width > n
            then case padding of
                NoPadding ->
                    writeN n $ \marr off -> do
                        writePositiveDec marr off n i                    -- digits
                ZeroPadding ->
                    writeN width $ \marr off -> do
                        let !leadingN = width-n
                        setPrimArray marr off leadingN ZERO             -- leading zeros
                        let off' = off + leadingN
                        writePositiveDec marr off' n i                   -- digits
                LeftSpacePadding ->
                    writeN width $ \marr off -> do
                        let !leadingN = width-n
                        setPrimArray marr off leadingN SPACE            -- leading spaces
                        let off' = off + leadingN
                        writePositiveDec marr off' n i                   -- digits
                RightSpacePadding ->
                    writeN width $ \marr off -> do
                        let !trailingN = width-n
                        writePositiveDec marr off n i                    -- digits
                        let off' = off + n
                        setPrimArray marr off' trailingN SPACE          -- trailing spaces
            else
                writeN n $ \marr off -> do
                    writePositiveDec marr off n i                        -- digits

writePositiveDec :: (Integral a)
                => MutablePrimArray RealWorld Word8       -- ^ The buffer
                -> Int                                      -- ^ writing offset
                -> Int                                      -- ^ total digits
                -> a                                        -- ^ the value
                -> IO ()
{-# INLINE writePositiveDec #-}
writePositiveDec marr off0 ds = go (off0 + ds - 1)
  where
    go off v
        | v >= 100 = do
            let (q, r) = v `quotRem` 100
            write2 off r
            go (off - 2) q
        | v < 10    = writePrimArray marr off (i2wDec v)
        | otherwise = write2 off v
    write2 off i0 = do
        let i = fromIntegral i0; j = i + i
        writePrimArray marr off $ indexOffPtr decDigitTable (j + 1)
        writePrimArray marr (off - 1) $ indexOffPtr decDigitTable j


--------------------------------------------------------------------------------
-- Below is an implementation of formatting integer, the main
-- idea is borrowed from base (GHC.Show).

#include "MachDeps.h"
#if SIZEOF_HSWORD == 4
#define DIGITS       9
#define BASE         1000000000
#elif SIZEOF_HSWORD == 8
#define DIGITS       18
#define BASE         1000000000000000000
#else
#error Please define DIGITS and BASE
-- DIGITS should be the largest integer such that
--     10^DIGITS < 2^(SIZEOF_HSWORD * 8 - 1)
-- BASE should be 10^DIGITS.
#endif

-- | Format a 'Integer' into decimal ASCII digits.
integer :: Integer -> Builder ()
#ifdef INTEGER_GMP
integer (S# i#) = int (I# i#)
#endif
-- Divide and conquer implementation of string conversion
integer n0
    | n0 < 0    = encodePrim MINUS >> integer' (-n0)
    | otherwise = integer' n0
  where
    integer' :: Integer -> Builder ()
    integer' n
        | n < BASE  = jhead (fromInteger n)
        | otherwise = jprinth (jsplitf (BASE*BASE) n)

    -- Convert a number that has been split into digits in base BASE^2
    -- this includes a last splitting step and then conversion of digits
    -- that all fit into a machine word.
    jprinth :: [Integer] -> Builder ()
    jprinth (n:ns) =
        case n `quotRemInteger` BASE of
        (# q', r' #) ->
            let q = fromInteger q'
                r = fromInteger r'
            in if q > 0 then jhead q >> jblock r >> jprintb ns
                        else jhead r >> jprintb ns
    jprinth [] = errorWithoutStackTrace "jprinth []"

    jprintb :: [Integer] -> Builder ()
    jprintb []     = pure ()
    jprintb (n:ns) = case n `quotRemInteger` BASE of
                        (# q', r' #) ->
                            let q = fromInteger q'
                                r = fromInteger r'
                            in jblock q >> jblock r >> jprintb ns

    -- Convert an integer that fits into a machine word. Again, we have two
    -- functions, one that drops leading zeros (jhead) and one that doesn't
    -- (jblock)
    jhead :: Int -> Builder ()
    jhead = int
    jblock :: Int -> Builder ()
    jblock = intWith defaultIFormat{padding = ZeroPadding, width=DIGITS}

    -- Split n into digits in base p. We first split n into digits
    -- in base p*p and then split each of these digits into two.
    -- Note that the first 'digit' modulo p*p may have a leading ZERO
    -- in base p that we need to drop - this is what jsplith takes care of.
    -- jsplitb the handles the remaining digits.
    jsplitf :: Integer -> Integer -> [Integer]
    jsplitf p n
        | p > n     = [n]
        | otherwise = jsplith p (jsplitf (p*p) n)

    jsplith :: Integer -> [Integer] -> [Integer]
    jsplith p (n:ns) =
        case n `quotRemInteger` p of
        (# q, r #) ->
            if q > 0 then q : r : jsplitb p ns
                     else     r : jsplitb p ns
    jsplith _ [] = errorWithoutStackTrace "jsplith: []"

    jsplitb :: Integer -> [Integer] -> [Integer]
    jsplitb _ []     = []
    jsplitb p (n:ns) = case n `quotRemInteger` p of
                       (# q, r #) ->
                           q : r : jsplitb p ns

--------------------------------------------------------------------------------

-- | Count how many decimal digits an integer has.
countDigits :: (Integral a) => a -> Int
{-# INLINE countDigits #-}
countDigits v0
  | fromIntegral v64 == v0 = go 1 v64
  | otherwise              = goBig 1 (fromIntegral v0)
  where v64 = fromIntegral v0
        goBig !k (v :: Integer)
           | v > big   = goBig (k + 19) (v `quot` big)
           | otherwise = go k (fromIntegral v)
        big = 10000000000000000000
        go !k (v :: Word64)
           | v < 10    = k
           | v < 100   = k + 1
           | v < 1000  = k + 2
           | v < 1000000000000 =
               k + if v < 100000000
                   then if v < 1000000
                        then if v < 10000
                             then 3
                             else 4 + fin v 100000
                        else 6 + fin v 10000000
                   else if v < 10000000000
                        then 8 + fin v 1000000000
                        else 10 + fin v 100000000000
           | otherwise = go (k + 12) (v `quot` 1000000000000)
        fin v n = if v >= n then 1 else 0

pattern MINUS, PLUS, ZERO, SPACE, DOT, LITTLE_E, BIG_E :: Word8
pattern PLUS     = 43
pattern MINUS    = 45
pattern ZERO     = 48
pattern SPACE    = 32
pattern DOT      = 46
pattern LITTLE_E = 101
pattern BIG_E    = 69

-- | Decimal digit to ASCII digit.
i2wDec :: (Integral a) => a -> Word8
{-# INLINE i2wDec #-}
{-# SPECIALIZE INLINE i2wDec :: Int -> Word8 #-}
i2wDec v = ZERO + fromIntegral v

-- | Hexadecimal digit to ASCII char.
i2wHex :: (Integral a) => a -> Word8
{-# INLINE i2wHex #-}
{-# SPECIALIZE INLINE i2wHex :: Int -> Word8 #-}
i2wHex v
    | v <= 9    = ZERO + fromIntegral v
    | otherwise = 87 + fromIntegral v       -- fromEnum 'a' - 10

-- | Hexadecimal digit to UPPERCASED ASCII char.
i2wHexUpper :: (Integral a) => a -> Word8
{-# INLINE i2wHexUpper #-}
{-# SPECIALIZE INLINE i2wHexUpper :: Int -> Word8 #-}
i2wHexUpper v
    | v <= 9    = ZERO + fromIntegral v
    | otherwise = 55 + fromIntegral v       -- fromEnum 'A' - 10

--------------------------------------------------------------------------------

-- | Format a 'FiniteBits' 'Integral' type into hex nibbles.
--
-- @
-- import Z.Data.Builder as B
-- import Z.Data.Text    as T
-- import Data.Word
-- import Data.Int
--
-- > T.validate . B.buildBytes $ B.hex (125 :: Int8)
-- "7d"
-- > T.validate . B.buildBytes $ B.hex (-1 :: Int8)
-- "ff"
-- > T.validate . B.buildBytes $ B.hex (125 :: Word16)
-- "007d"
-- @
--
hex :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
{-# INLINE hex #-}
hex w = writeN hexSiz (go w (hexSiz-2))
  where
    bitSiz = finiteBitSize (undefined :: a)
    hexSiz = (bitSiz+3) `unsafeShiftR` 2
    go !v !d marr off
        | d > 0 = do
            let !i = fromIntegral v .&. 0xFF; !j = i + i
            writePrimArray marr (off + d) $ indexOffPtr hexDigitTable j
            writePrimArray marr (off + d + 1) $ indexOffPtr hexDigitTable (j+1)
            go (v `unsafeShiftR` 8) (d-2) marr off
        | d == 0 = do
            let !i = fromIntegral v .&. 0xFF; !j = i + i
            writePrimArray marr off $ indexOffPtr hexDigitTable j
            writePrimArray marr (off + 1) $ indexOffPtr hexDigitTable (j+1)
        | d < 0  = do         -- for FiniteBits instances which has extra bits
            let !i = fromIntegral v .&. 0x0F :: Int
            writePrimArray marr off $ i2wHex i


-- | The UPPERCASED version of 'hex'.
hexUpper :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
{-# INLINE hexUpper #-}
hexUpper w = writeN hexSiz (go w (hexSiz-2))
  where
    bitSiz = finiteBitSize (undefined :: a)
    hexSiz = (bitSiz+3) `unsafeShiftR` 2
    go !v !d marr off
        | d > 0 = do
            let !i = fromIntegral v .&. 0xFF; !j = i + i
            writePrimArray marr (off + d) $ indexOffPtr hexDigitTableUpper j
            writePrimArray marr (off + d + 1) $ indexOffPtr hexDigitTableUpper (j+1)
            go (v `unsafeShiftR` 8) (d-2) marr off
        | d == 0 = do
            let !i = fromIntegral v .&. 0xFF; !j = i + i
            writePrimArray marr off $ indexOffPtr hexDigitTableUpper j
            writePrimArray marr (off + 1) $ indexOffPtr hexDigitTableUpper (j+1)
        | d < 0  = do         -- for FiniteBits instances which has extra bits
            let !i = fromIntegral v .&. 0x0F :: Int
            writePrimArray marr off $ i2wHexUpper i

--------------------------------------------------------------------------------

-- Floating point numbers
-------------------------

-- | Control the rendering of floating point numbers.
data FFormat = Exponent -- ^ Scientific notation (e.g. @2.3e123@).
             | Fixed    -- ^ Standard decimal notation.
             | Generic  -- ^ Use decimal notation for values between @0.1@ and
                        -- @9,999,999@, and scientific notation otherwise.
           deriving (Enum, Read, Show)


-- | Decimal encoding of an IEEE 'Float'.
--
-- Using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
float :: Float -> Builder ()
{-# INLINE float #-}
float = floatWith Generic Nothing

-- | Decimal encoding of an IEEE 'Double'.
--
-- Using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
double :: Double -> Builder ()
{-# INLINE double #-}
double = doubleWith Generic Nothing

-- | Format single-precision float using drisu3 with dragon4 fallback.
floatWith :: FFormat
          -> Maybe Int  -- ^ Number of decimal places to render.
          -> Float
          -> Builder ()
{-# INLINE floatWith #-}
floatWith fmt decs x
    | isNaN x                   = "NaN"
    | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"
    | x < 0                     = char8 '-' >> doFmt fmt decs (grisu3_sp (-x))
    | isNegativeZero x          = char8 '-' >> doFmt fmt decs ([0], 0)
    | x == 0                    = doFmt fmt decs ([0], 0)
    | otherwise                 = doFmt fmt decs (grisu3_sp x) -- Grisu only handles strictly positive finite numbers.

-- | Format double-precision float using drisu3 with dragon4 fallback.
doubleWith :: FFormat
           -> Maybe Int  -- ^ Number of decimal places to render.
           -> Double
           -> Builder ()
{-# INLINE doubleWith #-}
doubleWith fmt decs x
    | isNaN x                   = "NaN"
    | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"
    | x < 0                     = char8 '-' >> doFmt fmt decs (grisu3 (-x))
    | isNegativeZero x          = char8 '-' >> doFmt fmt decs ([0], 0)
    | x == 0                    = doFmt fmt decs ([0], 0)
    | otherwise                 = doFmt fmt decs (grisu3 x) -- Grisu only handles strictly positive finite numbers.

-- | A faster version of 'Sci.toDecimalDigits' in case of small coefficient.
positiveSciToDigits :: Sci.Scientific -> ([Int], Int)
positiveSciToDigits sci =
    if c == 0
        then ([0], 0)
        else case c of
#ifdef INTEGER_GMP
            (S# i#) -> goI (I# i#) 0 []
#endif
            _ -> go c 0 []
  where
    sci' = Sci.normalize sci
    !c = Sci.coefficient sci'
    !e = Sci.base10Exponent sci'

    go :: Integer -> Int -> [Int] -> ([Int], Int)
    go 0 !n ds = let !ne = n + e in (ds, ne)
    go i !n ds = case i `quotRemInteger` 10 of
                     (# q, r #) -> go q (n+1) (d:ds)
                       where
                         !d = fromIntegral r
#ifdef INTEGER_GMP
    goI :: Int -> Int -> [Int] -> ([Int], Int)
    goI 0 !n ds = let !ne = n + e in (ds, ne)
    goI i !n ds = case i `quotRem` 10 of (q, !r) -> goI q (n+1) (r:ds)
#endif

-- | Worker function to do formatting.
doFmt :: FFormat
      -> Maybe Int -- ^ Number of decimal places to render.
      -> ([Int], Int) -- ^ List of digits and exponent
      -> Builder ()
{-# INLINABLE doFmt #-}
doFmt format decs (is, e) = case format of
    Generic -> doFmt (if e < 0 || e > 7 then Exponent else Fixed) decs (is,e)
    Exponent -> case decs of
        Nothing -> case is of
            [0]     -> "0.0e0"
            [i]     -> encodeDigit i >> ".0e" >> int (e-1)
            (i:is') -> do
                encodeDigit i
                encodePrim DOT
                encodeDigits is'
                encodePrim LITTLE_E
                int (e-1)
            []      -> error "doFmt/Exponent: []"
        Just dec
            | dec <= 0 ->
            -- decimal point as well (ghc trac #15115).
            -- Note that this handles negative precisions as well for consistency
            -- (see ghc trac #15509).
                case is of
                    [0] -> "0e0"
                    _ -> do
                        let (ei,is') = roundTo 10 1 is
                            n:_ = if ei > 0 then List.init is' else is'
                        encodeDigit n
                        encodePrim LITTLE_E
                        int (e-1+ei)
        Just dec ->
            let !dec' = max dec 1 in
            case is of
                [0] -> do
                    "0." >> encodeZeros dec' >> "e0"
                _ -> do
                    let (ei,is') = roundTo 10 (dec'+1) is
                        (d:ds') = if ei > 0 then List.init is' else is'
                    encodeDigit d
                    encodePrim DOT
                    encodeDigits ds'
                    encodePrim LITTLE_E
                    int (e-1+ei)
    Fixed -> case decs of
        Nothing
            | e <= 0    -> do
                "0."
                encodeZeros (-e)
                encodeDigits is
            | otherwise -> insertDot e is
        Just dec ->
            let !dec' = max dec 0
            in if e >= 0
                then do
                    let (ei,is') = roundTo 10 (dec' + e) is
                        (ls,rs)  = splitAt (e+ei) is'
                    mk0 ls
                    (unless (List.null rs) $ encodePrim DOT >> encodeDigits rs)
                else do
                    let (ei,is') = roundTo 10 dec' (List.replicate (-e) 0 ++ is)
                        d:ds' = if ei > 0 then is' else 0:is'
                    encodeDigit d
                    (unless (List.null ds') $ encodePrim DOT >> encodeDigits ds')
  where
    encodeDigit = encodePrim . i2wDec

    encodeDigits = mapM_ encodeDigit

    encodeZeros n = replicateM_ n (encodePrim ZERO)

    mk0 [] = encodePrim ZERO
    mk0 ls = encodeDigits ls

    insertDot 0     rs = encodePrim DOT >> mk0 rs
    insertDot n     [] = encodePrim ZERO >> insertDot (n-1) []
    insertDot n (r:rs) = encodeDigit r >> insertDot (n-1) rs

 ------------------------------------------------------------------------------
-- Conversion of 'Float's and 'Double's to ASCII in decimal using Grisu3
------------------------------------------------------------------------

#define GRISU3_SINGLE_BUF_LEN 10
#define GRISU3_DOUBLE_BUF_LEN 18

foreign import ccall unsafe "static grisu3" c_grisu3
    :: Double
    -> MBA# Word8   -- ^ char*
    -> MBA# Int     -- ^ Int
    -> MBA# Int     -- ^ Int
    -> IO Int

-- | Decimal encoding of a 'Double', note grisu only handles strictly positive finite numbers.
grisu3 :: Double -> ([Int], Int)
{-# INLINE grisu3 #-}
grisu3 d = unsafePerformIO $ do
    (MutableByteArray pBuf) <- newByteArray GRISU3_DOUBLE_BUF_LEN
    (len, (e, success)) <- allocPrimUnsafe $ \ pLen ->
        allocPrimUnsafe $ \ pE ->
            c_grisu3 (realToFrac d) pBuf pLen pE
    if success == 0 -- grisu3 fail
    then pure (floatToDigits 10 d)
    else do
        buf <- forM [0..len-1] $ \ i -> do
            w8 <- readByteArray (MutableByteArray pBuf) i :: IO Word8
            pure $! fromIntegral w8
        let !e' = e + len
        pure (buf, e')

foreign import ccall unsafe "static grisu3_sp" c_grisu3_sp
    :: Float
    -> MBA# Word8   -- ^ char*
    -> MBA# Int     -- ^ Int
    -> MBA# Int     -- ^ Int
    -> IO Int

-- | Decimal encoding of a 'Float', note grisu3_sp only handles strictly positive finite numbers.
grisu3_sp :: Float -> ([Int], Int)
{-# INLINE grisu3_sp #-}
grisu3_sp d = unsafePerformIO $ do
    (MutableByteArray pBuf) <- newByteArray GRISU3_SINGLE_BUF_LEN
    (len, (e, success)) <- allocPrimUnsafe $ \ pLen ->
        allocPrimUnsafe $ \ pE ->
            c_grisu3_sp (realToFrac d) pBuf pLen pE
    if success == 0 -- grisu3 fail
    then pure (floatToDigits 10 d)
    else do
        buf <- forM [0..len-1] $ \ i -> do
            w8 <- readByteArray (MutableByteArray pBuf) i :: IO Word8
            pure $! fromIntegral w8
        let !e' = e + len
        pure (buf, e')

--------------------------------------------------------------------------------

-- | A @Builder@ which renders a scientific number to full
-- precision, using standard decimal notation for arguments whose
-- absolute value lies between @0.1@ and @9,999,999@, and scientific
-- notation otherwise.
scientific :: Sci.Scientific -> Builder ()
{-# INLINE scientific #-}
scientific = scientificWith Generic Nothing

-- | Like 'scientific' but provides rendering options.
scientificWith :: FFormat
               -> Maybe Int  -- ^ Number of decimal places to render.
               -> Sci.Scientific
               -> Builder ()
{-# INLINE scientificWith #-}
scientificWith fmt decs scntfc
   | scntfc < 0 = char8 '-' <> doFmt fmt decs (positiveSciToDigits (-scntfc))
   | otherwise  =              doFmt fmt decs (positiveSciToDigits   scntfc)