{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall #-}

-- | Text formatting of 'Double's.
--
-- In particular, the library provides functionality to calculate and display a fixed number of <https://en.wikipedia.org/wiki/Significant_figures significant figures> for a variety of different number formatting styles.
--
--
-- Some similar libraries that may be better suited for different use cases include:
--
-- Flexible formatters. These libraries provide more flexibility around formatting options, but do not have a concept of significance:
--
-- - <https://hackage.haskell.org/package/base-4.16.0.0/docs/Text-Printf.html Text.Printf> and <https://hackage.haskell.org/package/base-4.16.0.0/docs/Numeric.html#v:showFFloat Numeric> in base.
-- - <https://hackage.haskell.org/package/formatting Formatting>
-- - <https://hackage.haskell.org/package/vformat-0.9.0.0 vformat: A Python str.format() like formatter>
--
-- <https://hackage.haskell.org/package/text-format text-format> has similar functionality but is not native haskell and I wanted to do some tweaking to defaults. It's probably safer and faster.
--
-- <https://hackage.haskell.org/package/rounded rounded> seems to be much more about doing computation taking rounding into account, compared with the much simpler task of pretty printing a number.
--
-- This library could have just provided an ability to compute a significant figure version of a number and then use these other libraries, but the round trip (from Double to SigFig to Double) introduces errors (eg the least significant figure goes from being a '4' to a '3999999' via float maths).
module Data.FormatN
  ( -- * Usage
    -- $usage

    -- * FormatN
    FormatN (..),
    defaultFormatN,
    formatN,
    formatNs,
    precision,

    -- * SigFig
    SigFig (..),
    SigFigSign (..),
    toSigFig,
    fromSigFig,

    -- * formatters
    fixed,
    expt,
    decimal,
    prec,
    comma,
    dollar,
    percent,
    showOr,
  )
where

import Data.Bifunctor
import Data.Bool
import Data.Containers.ListUtils (nubOrd)
import Data.Foldable
import Data.Maybe
import Data.Text (Text, pack)
import qualified Data.Text as Text
import GHC.Generics hiding (prec)
import Numeric
import Prelude

-- $setup
-- >>> import Data.FormatN
-- >>> xs = [(-1),0,1,1.01,1.02,1.1,1.2]
--
-- >>> fixed (Just 2) <$> xs
-- ["-1.00","0.00","1.00","1.01","1.02","1.10","1.20"]
--
-- >>> decimal (Just 2) <$> xs
-- ["-1.0","0.0","1.0","1.0","1.0","1.1","1.2"]
--
-- >>> comma (Just 3) <$> xs
-- ["-1.00","0.00","1.00","1.01","1.02","1.10","1.20"]
--
-- comma (Just 3) . (1e3*) <$> xs
-- ["-1,000","0.00","1,000","1,010","1,020","1,100","1,200"]
--
-- comma (Just 3) . (1e-3*) <$> xs
-- ["-0.00100","0.00","0.00100","0.00101","0.00102","0.00110","0.00120"]
--
-- >>> comma (Just 3) . (1e-6*) <$> xs
-- ["-1.00e-6","0.00","1.00e-6","1.01e-6","1.02e-6","1.10e-6","1.20e-6"]
--
-- >>> comma (Just 2) . (1e3*) <$> xs
-- ["-1,000","0.0","1,000","1,000","1,000","1,100","1,200"]
--
-- >>> precision comma (Just 2) $ (1e3*) <$> [0,1,1.01,1.02,1.1,1.2]
-- ["0.00","1,000","1,010","1,020","1,100","1,200"]

-- $usage
-- >>> import Data.FormatN
-- >>> xs = [(-1),0,1,1.01,1.02,1.1,1.2]
-- >>> fixed (Just 2) <$> xs
-- ["-1.00","0.00","1.00","1.01","1.02","1.10","1.20"]
--
-- >>> decimal (Just 2) <$> xs
-- ["-1.0","0.0","1.0","1.0","1.0","1.1","1.2"]
--
-- formatn is used in the <https://hackage.haskell.org/package/chart-svg chart-svg> library to automate consistent number formatting across different scales.
--
-- >>> comma (Just 3) <$> xs
-- ["-1.00","0.00","1.00","1.01","1.02","1.10","1.20"]
--
-- >>> comma (Just 3) . (1e3*) <$> xs
-- ["-1,000","0.00","1,000","1,010","1,020","1,100","1,200"]
--
-- >>> comma (Just 3) . (1e-3*) <$> xs
-- ["-0.00100","0.00","0.00100","0.00101","0.00102","0.00110","0.00120"]
--
-- >>> comma (Just 3) . (1e-6*) <$> xs
-- ["-1.00e-6","0.00","1.00e-6","1.01e-6","1.02e-6","1.10e-6","1.20e-6"]
--
-- Using significant figures actually changes numbers - numbers that were slightly different end up being (and looking like) the same. 'precision' increases the number of significant figures to get around this.
--
-- >>> comma (Just 2) . (1e3*) <$> xs
-- ["-1,000","0.0","1,000","1,000","1,000","1,100","1,200"]
--
-- >>> precision comma (Just 2) $ (1e3*) <$> [0,1,1.01,1.02,1.1,1.2]
-- ["0.00","1,000","1,010","1,020","1,100","1,200"]
--
-- Also note the clunkiness of the treatment of zero. It is problematic to default format zero consistently.

-- | Wrapper for the various formatting options.
--
-- Nothing in the context of these constructors means do not perform and significant figure adjustments to the numbers (or decimal figures with respect to FormatFixed).
data FormatN
  = FormatFixed (Maybe Int)
  | FormatDecimal (Maybe Int)
  | FormatComma (Maybe Int)
  | FormatExpt (Maybe Int)
  | FormatPrec (Maybe Int)
  | FormatDollar (Maybe Int)
  | FormatPercent (Maybe Int)
  | FormatNone
  deriving (FormatN -> FormatN -> Bool
(FormatN -> FormatN -> Bool)
-> (FormatN -> FormatN -> Bool) -> Eq FormatN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatN -> FormatN -> Bool
$c/= :: FormatN -> FormatN -> Bool
== :: FormatN -> FormatN -> Bool
$c== :: FormatN -> FormatN -> Bool
Eq, Int -> FormatN -> ShowS
[FormatN] -> ShowS
FormatN -> String
(Int -> FormatN -> ShowS)
-> (FormatN -> String) -> ([FormatN] -> ShowS) -> Show FormatN
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatN] -> ShowS
$cshowList :: [FormatN] -> ShowS
show :: FormatN -> String
$cshow :: FormatN -> String
showsPrec :: Int -> FormatN -> ShowS
$cshowsPrec :: Int -> FormatN -> ShowS
Show, (forall x. FormatN -> Rep FormatN x)
-> (forall x. Rep FormatN x -> FormatN) -> Generic FormatN
forall x. Rep FormatN x -> FormatN
forall x. FormatN -> Rep FormatN x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormatN x -> FormatN
$cfrom :: forall x. FormatN -> Rep FormatN x
Generic)

-- | The official format
--
-- >>> defaultFormatN
-- FormatComma (Just 2)
defaultFormatN :: FormatN
defaultFormatN :: FormatN
defaultFormatN = Maybe Int -> FormatN
FormatComma (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

-- | run a 'FormatN'
--
-- >>> formatN defaultFormatN 1234
-- "1,200"
formatN :: FormatN -> Double -> Text
formatN :: FormatN -> Double -> Text
formatN (FormatFixed Maybe Int
n) Double
x = Maybe Int -> Double -> Text
fixed Maybe Int
n Double
x
formatN (FormatDecimal Maybe Int
n) Double
x = Maybe Int -> Double -> Text
decimal Maybe Int
n Double
x
formatN (FormatPrec Maybe Int
n) Double
x = Maybe Int -> Double -> Text
prec Maybe Int
n Double
x
formatN (FormatComma Maybe Int
n) Double
x = Maybe Int -> Double -> Text
comma Maybe Int
n Double
x
formatN (FormatExpt Maybe Int
n) Double
x = Maybe Int -> Double -> Text
expt Maybe Int
n Double
x
formatN (FormatDollar Maybe Int
n) Double
x = Maybe Int -> Double -> Text
dollar Maybe Int
n Double
x
formatN (FormatPercent Maybe Int
n) Double
x = Maybe Int -> Double -> Text
percent Maybe Int
n Double
x
formatN FormatN
FormatNone Double
x = String -> Text
pack (Double -> String
forall a. Show a => a -> String
show Double
x)

-- | Format to x decimal places with no significant figure rounding.
--
-- >>> fixed (Just 2) 100
-- "100.00"
--
-- >>> fixed (Just 2) 0.001
-- "0.00"
fixed :: Maybe Int -> Double -> Text
fixed :: Maybe Int -> Double -> Text
fixed Maybe Int
n Double
x = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
n Double
x String
""

-- | Decomposition of a Double into the components that are needed to determine significant figure formatting.
--
-- eliding type changes, the relationship between a Double and a SigFig is:
--
-- \[
--   x == sign * figures * 10^{exponent}
-- \]
data SigFig = SigFig
  { -- | sign
    SigFig -> SigFigSign
sign :: SigFigSign,
    -- | significant figures expressed as an Integer
    SigFig -> Integer
figures :: Integer,
    -- | the power of 10 exponent given figures.
    SigFig -> Int
exponent :: Int
  }
  deriving (SigFig -> SigFig -> Bool
(SigFig -> SigFig -> Bool)
-> (SigFig -> SigFig -> Bool) -> Eq SigFig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigFig -> SigFig -> Bool
$c/= :: SigFig -> SigFig -> Bool
== :: SigFig -> SigFig -> Bool
$c== :: SigFig -> SigFig -> Bool
Eq, Int -> SigFig -> ShowS
[SigFig] -> ShowS
SigFig -> String
(Int -> SigFig -> ShowS)
-> (SigFig -> String) -> ([SigFig] -> ShowS) -> Show SigFig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigFig] -> ShowS
$cshowList :: [SigFig] -> ShowS
show :: SigFig -> String
$cshow :: SigFig -> String
showsPrec :: Int -> SigFig -> ShowS
$cshowsPrec :: Int -> SigFig -> ShowS
Show)

-- | Sign component
data SigFigSign = SigFigNeg | SigFigPos deriving (SigFigSign -> SigFigSign -> Bool
(SigFigSign -> SigFigSign -> Bool)
-> (SigFigSign -> SigFigSign -> Bool) -> Eq SigFigSign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigFigSign -> SigFigSign -> Bool
$c/= :: SigFigSign -> SigFigSign -> Bool
== :: SigFigSign -> SigFigSign -> Bool
$c== :: SigFigSign -> SigFigSign -> Bool
Eq, Int -> SigFigSign -> ShowS
[SigFigSign] -> ShowS
SigFigSign -> String
(Int -> SigFigSign -> ShowS)
-> (SigFigSign -> String)
-> ([SigFigSign] -> ShowS)
-> Show SigFigSign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigFigSign] -> ShowS
$cshowList :: [SigFigSign] -> ShowS
show :: SigFigSign -> String
$cshow :: SigFigSign -> String
showsPrec :: Int -> SigFigSign -> ShowS
$cshowsPrec :: Int -> SigFigSign -> ShowS
Show)

sfsign :: SigFigSign -> String
sfsign :: SigFigSign -> String
sfsign SigFigSign
s = String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"" String
"-" (SigFigSign
s SigFigSign -> SigFigSign -> Bool
forall a. Eq a => a -> a -> Bool
== SigFigSign
SigFigNeg)

-- | convert from a Double to a 'SigFig'
--
-- >>> toSigFig (Just 2) 1234
-- SigFig {sign = SigFigPos, figures = 12, exponent = 2}
--
-- prop> \x -> let (SigFig s fs e) = toSigFig Nothing x in let x' = ((if (s==SigFigNeg) then (-1.0) else 1.0) * fromIntegral fs * 10.0**fromIntegral e) in (x==0 || abs (x/x'-1) < 1e-6)
toSigFig :: Maybe Int -> Double -> SigFig
toSigFig :: Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x = SigFigSign -> Integer -> Int -> SigFig
SigFig SigFigSign
s Integer
fs' Int
expo
  where
    (SigFigSign
s, ([Int]
floatfs, Int
floate)) = (SigFigSign, ([Int], Int))
-> (SigFigSign, ([Int], Int)) -> Bool -> (SigFigSign, ([Int], Int))
forall a. a -> a -> Bool -> a
bool (SigFigSign
SigFigPos, Integer -> Double -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
10 Double
x) (SigFigSign
SigFigNeg, Integer -> Double -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
10 (-Double
x)) (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0)
    -- floatToDigits 10 0 == ([0],0) floatToDigits 10 1 == ([1],1)
    floate' :: Int
floate' = Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
floate (Int
floate Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0)
    nsig :: Int
nsig = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
floatfs) Maybe Int
n
    -- pad with extra zeros if less figures than requested
    ([Int]
floatfs', Int
e) =
      ([Int], Int) -> ([Int], Int) -> Bool -> ([Int], Int)
forall a. a -> a -> Bool -> a
bool
      ([Int]
floatfs, Int
floate' Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
floatfs)
      ([Int]
floatfs [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
nsig Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
floatfs) Int
0, Int
floate' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nsig)
      ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
floatfs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nsig)
    ([Int]
fs0, [Int]
fs1) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
nsig [Int]
floatfs'
    -- reconstitute number to get rounding right at the least significance point
    fs :: Integer
fs =
      Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$
        (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
x' Int
a -> Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a) Int
0 [Int]
fs0 :: Double)
          Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
x' Int
a -> Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a) Int
0 [Int]
fs1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10.0 Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
fs1 :: Int))
    -- rounding can bump significant figures by 1 eg 99(.9999) ==> 100
    (Integer
fs', Int
expo) =
      (Integer, Int) -> (Integer, Int) -> Bool -> (Integer, Int)
forall a. a -> a -> Bool -> a
bool
      (Integer
fs, Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
floatfs' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nsig)
      (Integer
fs Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
10, Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
floatfs' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nsig Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Integer -> String
forall a. Show a => a -> String
show Integer
fs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
nsig)

-- | convert from a 'SigFig' to a Double
--
-- >>> fromSigFig (SigFig SigFigPos 12 2)
-- 1200.0
--
-- @fromSigFig . toSigFig Nothing@ may not be isomorphic
fromSigFig :: SigFig -> Double
fromSigFig :: SigFig -> Double
fromSigFig (SigFig SigFigSign
s Integer
fs Int
e) = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
1 (-Double
1) (SigFigSign
s SigFigSign -> SigFigSign -> Bool
forall a. Eq a => a -> a -> Bool
== SigFigSign
SigFigNeg) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e

exptR :: SigFig -> Text
exptR :: SigFig -> Text
exptR (SigFig SigFigSign
s Integer
i Int
e) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SigFigSign -> String
sfsign SigFigSign
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
i'' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"e" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e'
  where
    i'' :: String
i''
      | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String
i'
      | Bool
otherwise = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
i' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
i'
    i' :: String
i' = Integer -> String
forall a. Show a => a -> String
show Integer
i
    e' :: Int
e' = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Format in exponential style, maybe with significant figure rounding.
--
-- >>> expt Nothing 1245
-- "1.245e3"
--
-- >>> expt (Just 3) 1245
-- "1.24e3"
--
-- >>> expt (Just 3) 0.1245
-- "1.24e-1"
expt :: Maybe Int -> Double -> Text
expt :: Maybe Int -> Double -> Text
expt Maybe Int
n Double
x = SigFig -> Text
exptR (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x)

decimalR :: SigFig -> Text
decimalR :: SigFig -> Text
decimalR (SigFig SigFigSign
s Integer
xs Int
e) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SigFigSign -> String
sfsign SigFigSign
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
  where
    xs' :: String
xs' = Integer -> String
forall a. Show a => a -> String
show Integer
xs
    nsf :: Int
nsf = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs'
    extrasf :: Int
extrasf = Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool (-(Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nsf)) (-(Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nsf)) (Integer
xs Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)
    oversf :: Int
oversf = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e
    t :: String
t
      | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = String
xs' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
e Char
'0'
      | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int
nsf = String
"0." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
extrasf Char
'0' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs'
      | Bool
otherwise = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
oversf String
xs' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
oversf String
xs'

-- | Format in decimal style, and maybe round to n significant figures.
--
-- >>> decimal Nothing 1.2345e-2
-- "0.012345"
--
-- >>> decimal (Just 2) 0.012345
-- "0.012"
--
-- >>> decimal (Just 2) 12345
-- "12000"
decimal :: Maybe Int -> Double -> Text
decimal :: Maybe Int -> Double -> Text
decimal Maybe Int
n Double
x = SigFig -> Text
decimalR (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x)

-- | Format between 0.001 and 1,000,000 using decimal style and exponential style outside this range.
--
-- >>> prec (Just 2) 0.00234
-- "0.0023"
--
-- >>> prec (Just 2) 0.000023
-- "2.3e-5"
--
-- >>> prec (Just 2) 123
-- "120"
--
-- >>> prec (Just 2) 123456
-- "120000"
--
-- >>> prec (Just 2) 1234567
-- "1.2e6"
prec :: Maybe Int -> Double -> Text
prec :: Maybe Int -> Double -> Text
prec Maybe Int
n Double
x = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool (Double -> Text
go Double
x) (Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
go (-Double
x)) (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0)
  where
    go :: Double -> Text
go Double
x' =
      Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool
        ( Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool
            (Maybe Int -> Double -> Text
decimal Maybe Int
n Double
x')
            (Maybe Int -> Double -> Text
expt Maybe Int
n Double
x')
            (Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e6)
        )
        (Maybe Int -> Double -> Text
expt Maybe Int
n Double
x')
        (Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.001 Bool -> Bool -> Bool
&& (Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0))

-- | Format using comma separators for numbers above 1,000 but below 1 million, otherwise use prec style.
--
-- >>> comma (Just 3) 1234
-- "1,230"
comma :: Maybe Int -> Double -> Text
comma :: Maybe Int -> Double -> Text
comma Maybe Int
n Double
x
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Double -> Text
comma Maybe Int
n (-Double
x)
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1000 Bool -> Bool -> Bool
|| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e6 = Maybe Int -> Double -> Text
prec Maybe Int
n Double
x
  | Bool
otherwise = Text -> Text
addcomma (Maybe Int -> Double -> Text
prec Maybe Int
n Double
x)
  where
    addcomma :: Text -> Text
addcomma =
      (Text -> Text -> Text) -> (Text, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)
        ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> (Text, Text) -> (Text, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text
Text.reverse (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
Text.chunksOf Int
3 (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.reverse)
        ((Text, Text) -> (Text, Text))
-> (Text -> (Text, Text)) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
Text.breakOn Text
"."

-- | Format as dollars, always using comma notation
--
-- >>> dollar (Just 3) 1234
-- "$1,230"
--
-- >>> dollar (Just 2) 0.01234
-- "$0.012"
dollar :: Maybe Int -> Double -> Text
dollar :: Maybe Int -> Double -> Text
dollar Maybe Int
n Double
x
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Double -> Text
dollar Maybe Int
n (-Double
x)
  | Bool
otherwise = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Double -> Text
comma Maybe Int
n Double
x

-- | Format as a percentage using decimal style.
--
-- >>> percent (Just 2) 0.001234
-- "0.12%"
percent :: Maybe Int -> Double -> Text
percent :: Maybe Int -> Double -> Text
percent Maybe Int
n Double
x = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> Text
decimal Maybe Int
n (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)

precision_ :: (Maybe Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision_ :: (Maybe Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision_ Maybe Int -> Double -> Text
f Int
n0 [Double]
xs =
  Int -> [Double] -> [Text]
precLoop Int
n0 [Double]
xs
  where
    precLoop :: Int -> [Double] -> [Text]
precLoop Int
n [Double]
xs' =
      let s :: [Text]
s = Maybe Int -> Double -> Text
f (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) (Double -> Text) -> [Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs'
       in [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool (Int -> [Double] -> [Text]
precLoop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) [Double]
xs') [Text]
s ([Text]
s [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd [Text]
s Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4)

-- | Provide formatted text for a list of numbers so that they are just distinguished.
--
-- For example, __@precision comma (Just 2)@__ means use as much significant figures as is needed for the numbers to be distinguished on rendering, but with at least 2 significant figures.
--
-- The difference between this and __@fmap (comma (Just 2))@__ can be seen in these examples:
--
-- >>> precision comma (Just 2) [0,1,1.01,1.02,1.1,1.2]
-- ["0.00","1.00","1.01","1.02","1.10","1.20"]
--
-- >>> fmap (comma (Just 2)) [0,1,1.01,1.02,1.1,1.2]
-- ["0.0","1.0","1.0","1.0","1.1","1.2"]
precision :: (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision :: (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
f Maybe Int
n [Double]
xs =
  case Maybe Int
n of
    Maybe Int
Nothing -> Maybe Int -> Double -> Text
f Maybe Int
forall a. Maybe a
Nothing (Double -> Text) -> [Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs
    Just Int
n' -> (Maybe Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision_ Maybe Int -> Double -> Text
f Int
n' [Double]
xs

-- | Consistently format a list of numbers via using 'precision'.
--
-- >>> formatNs defaultFormatN [0,1,1.01,1.02,1.1,1.2]
-- ["0.00","1.00","1.01","1.02","1.10","1.20"]
formatNs :: FormatN -> [Double] -> [Text]
formatNs :: FormatN -> [Double] -> [Text]
formatNs (FormatFixed Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
fixed Maybe Int
n [Double]
xs
formatNs (FormatDecimal Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
decimal Maybe Int
n [Double]
xs
formatNs (FormatPrec Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
prec Maybe Int
n [Double]
xs
formatNs (FormatComma Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
comma Maybe Int
n [Double]
xs
formatNs (FormatExpt Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
expt Maybe Int
n [Double]
xs
formatNs (FormatDollar Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
dollar Maybe Int
n [Double]
xs
formatNs (FormatPercent Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
percent Maybe Int
n [Double]
xs
formatNs FormatN
FormatNone [Double]
xs = String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> Text) -> [Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs

-- | Format with the shorter of show and formatN.
showOr :: FormatN -> Double -> Text
showOr :: FormatN -> Double -> Text
showOr FormatN
f Double
x = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
f' (String -> Text
pack String
s') (Text -> Int
Text.length (String -> Text
pack String
s') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
Text.length Text
f')) Text
"0" (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e-6 Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> -Double
1e-6)
  where
    f' :: Text
f' = FormatN -> Double -> Text
formatN FormatN
f Double
x
    s' :: String
s' = Double -> String
forall a. Show a => a -> String
show Double
x