    -- |
    -- Module      : Data.ByteString.Builder.RealFloat
    -- Copyright   : (c) Lawrence Wu 2021
    -- License     : BSD-style
    -- Maintainer  : lawrencejwu@gmail.com
    --
    -- Floating point formatting for @Bytestring.Builder@
    --
    -- This module primarily exposes `floatDec` and `doubleDec` which do the
    -- equivalent of converting through @'Data.ByteString.Builder.string7' . 'show'@.
    --
    -- It also exposes `formatFloat` and `formatDouble` with a similar API as
    -- `GHC.Float.formatRealFloat`.
    --
    -- NB: The float-to-string conversions exposed by this module match `show`'s
    -- output (specifically with respect to default rounding and length). In
    -- particular, there are boundary cases where the closest and \'shortest\'
    -- string representations are not used.  Mentions of \'shortest\' in the docs
    -- below are with this caveat.
    --
    -- For example, for fidelity, we match `show` on the output below.
    --
    -- >>> show (1.0e23 :: Float)
    -- "1.0e23"
    -- >>> show (1.0e23 :: Double)
    -- "9.999999999999999e22"
    -- >>> floatDec 1.0e23
    -- "1.0e23"
    -- >>> doubleDec 1.0e23
    -- "9.999999999999999e22"
    --
    -- Simplifying, we can build a shorter, lossless representation by just using
    -- @"1.0e23"@ since the floating point values that are 1 ULP away are
    --
    -- >>> showHex (castDoubleToWord64 1.0e23) []
    -- "44b52d02c7e14af6"
    -- >>> castWord64ToDouble 0x44b52d02c7e14af5
    -- 9.999999999999997e22
    -- >>> castWord64ToDouble 0x44b52d02c7e14af6
    -- 9.999999999999999e22
    -- >>> castWord64ToDouble 0x44b52d02c7e14af7
    -- 1.0000000000000001e23
    --
    -- In particular, we could use the exact boundary if it is the shortest
    -- representation and the original floating number is even. To experiment with
    -- the shorter rounding, refer to
    -- `Data.ByteString.Builder.RealFloat.Internal.acceptBounds`. This will give us
    --
    -- >>> floatDec 1.0e23
    -- "1.0e23"
    -- >>> doubleDec 1.0e23
    -- "1.0e23"
    --
    -- For more details, please refer to the
    -- <https://dl.acm.org/doi/10.1145/3192366.3192369 Ryu paper>.
    --
    -- @since 0.11.2.0

    module Data.ByteString.Builder.RealFloat
      ( floatDec
      , doubleDec

      -- * Custom formatting
      , formatFloat
      , formatDouble
      , FloatFormat
      , standard
      , standardDefaultPrecision
      , scientific
      , generic
      ) where

    import Data.ByteString.Builder.Internal (Builder)
    import qualified Data.ByteString.Builder.RealFloat.Internal as R
    import qualified Data.ByteString.Builder.RealFloat.F2S as RF
    import qualified Data.ByteString.Builder.RealFloat.D2S as RD
    import qualified Data.ByteString.Builder.Prim as BP
    import GHC.Float (roundTo)
    import GHC.Word (Word64)
    import GHC.Show (intToDigit)

    -- | Returns a rendered Float. Matches `show` in displaying in standard or
    -- scientific notation
    --
    -- @
    -- floatDec = 'formatFloat' 'generic'
    -- @
    {-# INLINABLE floatDec #-}
    floatDec :: Float -> Builder
    floatDec :: Float -> Builder
    floatDec = FloatFormat -> Float -> Builder
    formatFloat FloatFormat
    generic

    -- | Returns a rendered Double. Matches `show` in displaying in standard or
    -- scientific notation
    --
    -- @
    -- doubleDec = 'formatDouble' 'generic'
    -- @
    {-# INLINABLE doubleDec #-}
    doubleDec :: Double -> Builder
    doubleDec :: Double -> Builder
    doubleDec = FloatFormat -> Double -> Builder
    formatDouble FloatFormat
    generic

    -- | Format type for use with `formatFloat` and `formatDouble`.
    --
    -- @since 0.11.2.0
    data FloatFormat = MkFloatFormat FormatMode (Maybe Int)

    -- | Standard notation with `n` decimal places
    --
    -- @since 0.11.2.0
    standard :: Int -> FloatFormat
    standard :: Int -> FloatFormat
    standard Int
    n = FormatMode -> Maybe Int -> FloatFormat
    MkFloatFormat FormatMode
    FStandard (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n)

    -- | Standard notation with the \'default precision\' (decimal places matching `show`)
    --
    -- @since 0.11.2.0
    standardDefaultPrecision :: FloatFormat
    standardDefaultPrecision :: FloatFormat
    standardDefaultPrecision = FormatMode -> Maybe Int -> FloatFormat
    MkFloatFormat FormatMode
    FStandard Maybe Int
    forall a. Maybe a
    Nothing

    -- | Scientific notation with \'default precision\' (decimal places matching `show`)
    --
    -- @since 0.11.2.0
    scientific :: FloatFormat
    scientific :: FloatFormat
    scientific = FormatMode -> Maybe Int -> FloatFormat
    MkFloatFormat FormatMode
    FScientific Maybe Int
    forall a. Maybe a
    Nothing

    -- | Standard or scientific notation depending on the exponent. Matches `show`
    --
    -- @since 0.11.2.0
    generic :: FloatFormat
    generic :: FloatFormat
    generic = FormatMode -> Maybe Int -> FloatFormat
    MkFloatFormat FormatMode
    FGeneric Maybe Int
    forall a. Maybe a
    Nothing

    -- | ByteString float-to-string format
    data FormatMode
      = FScientific     -- ^ scientific notation
      | FStandard       -- ^ standard notation with `Maybe Int` digits after the decimal
      | FGeneric        -- ^ dispatches to scientific or standard notation based on the exponent
      deriving Int -> FormatMode -> ShowS
    [FormatMode] -> ShowS
    FormatMode -> String
    (Int -> FormatMode -> ShowS)
    -> (FormatMode -> String)
    -> ([FormatMode] -> ShowS)
    -> Show FormatMode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FormatMode -> ShowS
    showsPrec :: Int -> FormatMode -> ShowS
    $cshow :: FormatMode -> String
    show :: FormatMode -> String
    $cshowList :: [FormatMode] -> ShowS
    showList :: [FormatMode] -> ShowS
    Show

    -- TODO: support precision argument for FGeneric and FScientific
    -- | Returns a rendered Float. Returns the \'shortest\' representation in
    -- scientific notation and takes an optional precision argument in standard
    -- notation. Also see `floatDec`.
    --
    -- With standard notation, the precision argument is used to truncate (or
    -- extend with 0s) the \'shortest\' rendered Float. The \'default precision\' does
    -- no such modifications and will return as many decimal places as the
    -- representation demands.
    --
    -- e.g
    --
    -- >>> formatFloat (standard 1) 1.2345e-2
    -- "0.0"
    -- >>> formatFloat (standard 10) 1.2345e-2
    -- "0.0123450000"
    -- >>> formatFloat standardDefaultPrecision 1.2345e-2
    -- "0.01234"
    -- >>> formatFloat scientific 12.345
    -- "1.2345e1"
    -- >>> formatFloat generic 12.345
    -- "12.345"
    --
    -- @since 0.11.2.0
    {-# INLINABLE formatFloat #-}
    formatFloat :: FloatFormat -> Float -> Builder
    formatFloat :: FloatFormat -> Float -> Builder
    formatFloat (MkFloatFormat FormatMode
    fmt Maybe Int
    prec) = \Float
    f ->
      let (RF.FloatingDecimal Word32
    m Int32
    e) = Float -> FloatingDecimal
    RF.f2Intermediate Float
    f
          e' :: Int
    e' = Int32 -> Int
    R.int32ToInt Int32
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word32 -> Int
    R.decimalLength9 Word32
    m in
      case FormatMode
    fmt of
        FormatMode
    FGeneric ->
          case Float -> Maybe Builder
    forall a. RealFloat a => a -> Maybe Builder
    specialStr Float
    f of
            Just Builder
    b -> Builder
    b
            Maybe Builder
    Nothing ->
              if Int
    e' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    e' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    7
                 then Float -> Builder
    forall a. RealFloat a => a -> Builder
    sign Float
    f Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Word64 -> Int -> Maybe Int -> Builder
    showStandard (Word32 -> Word64
    R.word32ToWord64 Word32
    m) Int
    e' Maybe Int
    prec
                 else BoundedPrim () -> () -> Builder
    forall a. BoundedPrim a -> a -> Builder
    BP.primBounded (Bool -> Word32 -> Int32 -> BoundedPrim ()
    forall a. Mantissa a => Bool -> a -> Int32 -> BoundedPrim ()
    R.toCharsScientific (Float
    f Float -> Float -> Bool
    forall a. Ord a => a -> a -> Bool
    < Float
    0) Word32
    m Int32
    e) ()
        FormatMode
    FScientific -> Float -> Builder
    RF.f2s Float
    f
        FormatMode
    FStandard ->
          case Float -> Maybe Builder
    forall a. RealFloat a => a -> Maybe Builder
    specialStr Float
    f of
            Just Builder
    b -> Builder
    b
            Maybe Builder
    Nothing -> Float -> Builder
    forall a. RealFloat a => a -> Builder
    sign Float
    f Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Word64 -> Int -> Maybe Int -> Builder
    showStandard (Word32 -> Word64
    R.word32ToWord64 Word32
    m) Int
    e' Maybe Int
    prec

    -- TODO: support precision argument for FGeneric and FScientific
    -- | Returns a rendered Double. Returns the \'shortest\' representation in
    -- scientific notation and takes an optional precision argument in standard
    -- notation. Also see `doubleDec`.
    --
    -- With standard notation, the precision argument is used to truncate (or
    -- extend with 0s) the \'shortest\' rendered Float. The \'default precision\'
    -- does no such modifications and will return as many decimal places as the
    -- representation demands.
    --
    -- e.g
    --
    -- >>> formatDouble (standard 1) 1.2345e-2
    -- "0.0"
    -- >>> formatDouble (standard 10) 1.2345e-2
    -- "0.0123450000"
    -- >>> formatDouble standardDefaultPrecision 1.2345e-2
    -- "0.01234"
    -- >>> formatDouble scientific 12.345
    -- "1.2345e1"
    -- >>> formatDouble generic 12.345
    -- "12.345"
    --
    -- @since 0.11.2.0
    {-# INLINABLE formatDouble #-}
    formatDouble :: FloatFormat -> Double -> Builder
    formatDouble :: FloatFormat -> Double -> Builder
    formatDouble (MkFloatFormat FormatMode
    fmt Maybe Int
    prec) = \Double
    f ->
      let (RD.FloatingDecimal Word64
    m Int32
    e) = Double -> FloatingDecimal
    RD.d2Intermediate Double
    f
          e' :: Int
    e' = Int32 -> Int
    R.int32ToInt Int32
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word64 -> Int
    R.decimalLength17 Word64
    m in
      case FormatMode
    fmt of
        FormatMode
    FGeneric ->
          case Double -> Maybe Builder
    forall a. RealFloat a => a -> Maybe Builder
    specialStr Double
    f of
            Just Builder
    b -> Builder
    b
            Maybe Builder
    Nothing ->
              if Int
    e' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    e' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    7
                 then Double -> Builder
    forall a. RealFloat a => a -> Builder
    sign Double
    f Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Word64 -> Int -> Maybe Int -> Builder
    showStandard Word64
    m Int
    e' Maybe Int
    prec
                 else BoundedPrim () -> () -> Builder
    forall a. BoundedPrim a -> a -> Builder
    BP.primBounded (Bool -> Word64 -> Int32 -> BoundedPrim ()
    forall a. Mantissa a => Bool -> a -> Int32 -> BoundedPrim ()
    R.toCharsScientific (Double
    f Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    0) Word64
    m Int32
    e) ()
        FormatMode
    FScientific -> Double -> Builder
    RD.d2s Double
    f
        FormatMode
    FStandard ->
          case Double -> Maybe Builder
    forall a. RealFloat a => a -> Maybe Builder
    specialStr Double
    f of
            Just Builder
    b -> Builder
    b
            Maybe Builder
    Nothing -> Double -> Builder
    forall a. RealFloat a => a -> Builder
    sign Double
    f Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Word64 -> Int -> Maybe Int -> Builder
    showStandard Word64
    m Int
    e' Maybe Int
    prec

    -- | Char7 encode a 'Char'.
    {-# INLINE char7 #-}
    char7 :: Char -> Builder
    char7 :: Char -> Builder
    char7 = FixedPrim Char -> Char -> Builder
    forall a. FixedPrim a -> a -> Builder
    BP.primFixed FixedPrim Char
    BP.char7

    -- | Char7 encode a 'String'.
    {-# INLINE string7 #-}
    string7 :: String -> Builder
    string7 :: String -> Builder
    string7 = FixedPrim Char -> String -> Builder
    forall a. FixedPrim a -> [a] -> Builder
    BP.primMapListFixed FixedPrim Char
    BP.char7

    -- | Encodes a `-` if input is negative
    sign :: RealFloat a => a -> Builder
    sign :: forall a. RealFloat a => a -> Builder
    sign a
    f = if a
    f a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0 then Char -> Builder
    char7 Char
    '-' else Builder
    forall a. Monoid a => a
    mempty

    -- | Special rendering for Nan, Infinity, and 0. See
    -- RealFloat.Internal.NonNumbersAndZero
    specialStr :: RealFloat a => a -> Maybe Builder
    specialStr :: forall a. RealFloat a => a -> Maybe Builder
    specialStr a
    f
      | a -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN a
    f          = Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
    forall a b. (a -> b) -> a -> b
    $ String -> Builder
    string7 String
    "NaN"
      | a -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite a
    f     = Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
    forall a b. (a -> b) -> a -> b
    $ a -> Builder
    forall a. RealFloat a => a -> Builder
    sign a
    f Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` String -> Builder
    string7 String
    "Infinity"
      | a -> Bool
    forall a. RealFloat a => a -> Bool
    isNegativeZero a
    f = Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
    forall a b. (a -> b) -> a -> b
    $ String -> Builder
    string7 String
    "-0.0"
      | a
    f a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0           = Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
    forall a b. (a -> b) -> a -> b
    $ String -> Builder
    string7 String
    "0.0"
      | Bool
    otherwise        = Maybe Builder
    forall a. Maybe a
    Nothing

    -- | Returns a list of decimal digits in a Word64
    digits :: Word64 -> [Int]
    digits :: Word64 -> [Int]
    digits Word64
    w = [Int] -> Word64 -> [Int]
    go [] Word64
    w
      where go :: [Int] -> Word64 -> [Int]
    go [Int]
    ds Word64
    0 = [Int]
    ds
            go [Int]
    ds Word64
    c = let (Word64
    q, Word64
    r) = Word64 -> (Word64, Word64)
    R.dquotRem10 Word64
    c
                       in [Int] -> Word64 -> [Int]
    go ((Word64 -> Int
    R.word64ToInt Word64
    r) Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [Int]
    ds) Word64
    q

    -- | Show a floating point value in standard notation. Based on GHC.Float.showFloat
    showStandard :: Word64 -> Int -> Maybe Int -> Builder
    showStandard :: Word64 -> Int -> Maybe Int -> Builder
    showStandard Word64
    m Int
    e Maybe Int
    prec =
      case Maybe Int
    prec of
        Maybe Int
    Nothing
          | Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 -> Char -> Builder
    char7 Char
    '0'
                   Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    char7 Char
    '.'
                   Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` String -> Builder
    string7 (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (-Int
    e) Char
    '0')
                   Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Int] -> [Builder]
    digitsToBuilder [Int]
    ds)
          | Bool
    otherwise ->
              let f :: t -> [Builder] -> [Builder] -> Builder
    f t
    0 [Builder]
    s     [Builder]
    rs = [Builder] -> Builder
    mk0 ([Builder] -> [Builder]
    forall a. [a] -> [a]
    reverse [Builder]
    s) Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    char7 Char
    '.' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Builder] -> Builder
    mk0 [Builder]
    rs
                  f t
    n [Builder]
    s     [] = t -> [Builder] -> [Builder] -> Builder
    f (t
    nt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) (Char -> Builder
    char7 Char
    '0'Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    :[Builder]
    s) []
                  f t
    n [Builder]
    s (Builder
    r:[Builder]
    rs) = t -> [Builder] -> [Builder] -> Builder
    f (t
    nt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) (Builder
    rBuilder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    :[Builder]
    s) [Builder]
    rs
               in Int -> [Builder] -> [Builder] -> Builder
    forall {t}. (Eq t, Num t) => t -> [Builder] -> [Builder] -> Builder
    f Int
    e [] ([Int] -> [Builder]
    digitsToBuilder [Int]
    ds)
        Just Int
    p
          | Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 ->
              let (Int
    ei, [Int]
    is') = Int -> Int -> [Int] -> (Int, [Int])
    roundTo Int
    10 (Int
    p' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    e) [Int]
    ds
                  ([Builder]
    ls, [Builder]
    rs) = Int -> [Builder] -> ([Builder], [Builder])
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Int
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    ei) ([Int] -> [Builder]
    digitsToBuilder [Int]
    is')
               in [Builder] -> Builder
    mk0 [Builder]
    ls Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Builder] -> Builder
    mkDot [Builder]
    rs
          | Bool
    otherwise ->
              let (Int
    ei, [Int]
    is') = Int -> Int -> [Int] -> (Int, [Int])
    roundTo Int
    10 Int
    p' (Int -> Int -> [Int]
    forall a. Int -> a -> [a]
    replicate (-Int
    e) Int
    0 [Int] -> [Int] -> [Int]
    forall a. [a] -> [a] -> [a]
    ++ [Int]
    ds)
                  -- ds' should always be non-empty but use redundant pattern
                  -- matching to silence warning
                  ds' :: [Int]
    ds' = if Int
    ei Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then [Int]
    is' else Int
    0Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    is'
                  ([Builder]
    ls, [Builder]
    rs) = Int -> [Builder] -> ([Builder], [Builder])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    1 ([Builder] -> ([Builder], [Builder]))
    -> [Builder] -> ([Builder], [Builder])
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Builder]
    digitsToBuilder [Int]
    ds'
               in [Builder] -> Builder
    mk0 [Builder]
    ls Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Builder] -> Builder
    mkDot [Builder]
    rs
              where p' :: Int
    p' = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    p Int
    0
      where
        mk0 :: [Builder] -> Builder
    mk0 [Builder]
    ls = case [Builder]
    ls of [] -> Char -> Builder
    char7 Char
    '0'; [Builder]
    _ -> [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [Builder]
    ls
        mkDot :: [Builder] -> Builder
    mkDot [Builder]
    rs = if [Builder] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Builder]
    rs then Builder
    forall a. Monoid a => a
    mempty else Char -> Builder
    char7 Char
    '.' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [Builder]
    rs
        ds :: [Int]
    ds = Word64 -> [Int]
    digits Word64
    m
        digitsToBuilder :: [Int] -> [Builder]
    digitsToBuilder = (Int -> Builder) -> [Int] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Char -> Builder
    char7 (Char -> Builder) -> (Int -> Char) -> Int -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Char
    intToDigit)