{-|
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, heX
  -- * IEEE float formating
  , FFormat(..)
  , double
  , doubleWith
  , float
  , floatWith
  , scientific
  , scientificWith
  -- * Misc
  , grisu3
  , grisu3_sp
  , i2wDec, i2wHex, i2wHeX
  , countDigits
  , c_intWith, hs_intWith
) where

import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.ST.Unsafe
import           Data.Bits
import           Data.Char
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 atMost width' (\ (MutablePrimArray mba#) i ->
            unsafeIOToST (c_int_dec x' (-1) width pad (unsafeCoerce# mba#) i))
    | posSign =
        atMost width' (\ (MutablePrimArray mba#) i ->
            unsafeIOToST (c_int_dec (fromIntegral x) 1 width pad (unsafeCoerce# mba#) i))
    | otherwise =
        atMost width' (\ (MutablePrimArray mba#) i ->
            unsafeIOToST (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)
                => forall s. MutablePrimArray s Word8       -- ^ The buffer
                -> Int                                      -- ^ writing offset
                -> Int                                      -- ^ total digits
                -> a                                        -- ^ the value
                -> ST s ()
{-# 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

minus, plus, zero, space :: Word8
{-# INLINE plus #-}
{-# INLINE minus #-}
{-# INLINE zero #-}
{-# INLINE space #-}
plus = 43
minus = 45
zero = 48
space = 32

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

-- | Decimal digit to ASCII char.
i2cDec :: (Integral a) => a -> Char
{-# INLINE i2cDec #-}
i2cDec v = chr . fromIntegral $ zero + fromIntegral v

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

-- | Hexadecimal digit to UPPERCASED ASCII char.
i2wHeX :: (Integral a) => a -> Word8
{-# INLINE i2wHeX #-}
i2wHeX 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'.
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 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 $ i2wHeX 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.

-- | 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) =
    let ds = map i2cDec is
    in case format of
        Generic ->
            doFmt (if e < 0 || e > 7 then Exponent else Fixed) decs (is,e)
        Exponent ->
            case decs of
                Nothing ->
                    let show_e' = int (e-1)
                    in case ds of
                        "0"     -> "0.0e0"
                        [d]     -> char8 d >> ".0e" >> show_e'
                        (d:ds') -> char8 d >> char8 '.' >>
                                        string8 ds' >> char8 'e' >> show_e'
                        []      -> 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:_ = map i2cDec (if ei > 0 then init is' else is')
                                char8 n
                                char8 'e'
                                int (e-1+ei)
                Just dec ->
                    let dec' = max dec 1 in
                    case is of
                        [0] -> do
                                char8 '0'
                                char8 '.'
                                replicateM_ dec' $ char8 '0'
                                char8 'e'
                                char8 '0'
                        _ -> do
                            let (ei,is') = roundTo 10 (dec'+1) is
                                (d:ds') = map i2cDec (if ei > 0 then init is' else is')
                            char8 d
                            char8 '.'
                            string8 ds'
                            char8 'e'
                            int (e-1+ei)
        Fixed ->
            let mk0 ls = case ls of { "" -> char8 '0' ; _ -> string8 ls}
            in case decs of
                Nothing
                    | e <= 0    -> do
                                char8 '0'
                                char8 '.'
                                replicateM_ (-e) $ char8 '0'
                                string8 ds
                    | otherwise ->
                        let f 0 s    rs  = mk0 (reverse s) >> char8 '.' >> mk0 rs
                            f n s    ""  = f (n-1) ('0':s) ""
                            f n s (r:rs) = f (n-1) (r:s) rs
                        in f e "" ds
                Just dec ->
                    let dec' = max dec 0
                    in if e >= 0
                        then
                            let (ei,is') = roundTo 10 (dec' + e) is
                                (ls,rs)  = splitAt (e+ei) (map i2cDec is')
                            in mk0 ls >>
                                (unless (List.null rs) $ char8 '.' >> string8 rs)
                        else
                            let (ei,is') = roundTo 10 dec' (List.replicate (-e) 0 ++ is)
                                d:ds' = map i2cDec (if ei > 0 then is' else 0:is')
                            in char8 d >>
                                (unless (List.null ds') $ char8 '.' >> string8 ds')

 ------------------------------------------------------------------------------
-- 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 (Sci.toDecimalDigits (-scntfc))
   | otherwise  =              doFmt fmt decs (Sci.toDecimalDigits   scntfc)