-- |
-- 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
showList :: [FormatMode] -> ShowS
$cshowList :: [FormatMode] -> ShowS
show :: FormatMode -> String
$cshow :: FormatMode -> String
showsPrec :: Int -> FormatMode -> ShowS
$cshowsPrec :: Int -> 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 :: 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 :: 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 :: a -> [Builder] -> [Builder] -> Builder
f a
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 a
n [Builder]
s     [] = a -> [Builder] -> [Builder] -> Builder
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) (Char -> Builder
char7 Char
'0'Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:[Builder]
s) []
              f a
n [Builder]
s (Builder
r:[Builder]
rs) = a -> [Builder] -> [Builder] -> Builder
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) (Builder
rBuilder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:[Builder]
s) [Builder]
rs
           in Int -> [Builder] -> [Builder] -> Builder
forall a. (Eq a, Num a) => a -> [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 (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 (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)