{-# LANGUAGE OverloadedStrings #-}

-- | 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).
--
-- formatn is used in the <https://hackage.haskell.org/package/chart-svg chart-svg> library to automate consistent number formatting across different scales.
module Data.FormatN
  ( -- * Usage
    -- $setup

    -- * SigFig
    SigFig (..),
    SigFigSign (..),
    toSigFig,
    fromSigFig,
    isZero,
    incSigFig,
    decSigFig,

    -- * Format Styles
    FormatStyle (..),
    precStyle,
    commaPrecStyle,
    FStyle (..),

    -- * SigFig formatters
    fixedSF,
    exptSF,
    exptSFWith,
    decimalSF,
    commaSF,
    dollarSF,
    percentSF,
    formatSF,

    -- * Double formatters
    format,
    formatOrShow,
    fixed,
    expt,
    exptWith,
    decimal,
    prec,
    comma,
    commaPrec,
    dollar,
    percent,

    -- * List Modifiers
    majorityStyle,
    formats,
    formatsSF,
    decSigFigs,
    lpads,
    distinguish,

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

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

-- $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"]
-- >>> decimal (Just 3) . (1e-3*) <$> xs
-- ["-0.00100","0.00","0.00100","0.00101","0.00102","0.00110","0.00120"]
-- >>> comma (Just 3) . (1e3*) <$> xs
-- ["-1,000","0.00","1,000","1,010","1,020","1,100","1,200"]
--
-- 'formats' is useful when you want a consistent textual style across a list of numbers:
--
-- >>> formats True False (const DecimalStyle) (Just 2) $ (1e-3*) <$> xs
-- ["-0.0010"," 0.0000"," 0.0010"," 0.0010"," 0.0010"," 0.0011"," 0.0012"]
--
-- Using significant figures actually changes numbers - numbers that were slightly different end up being (and looking like) the same. 'distinguish' increases the number of significant figures to compensate for this effect.
--
-- >>> distinguish 4 True False (const DecimalStyle) (Just 2) xs
-- ["-1.00"," 0.00"," 1.00"," 1.01"," 1.02"," 1.10"," 1.20"]

-- | 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
sfSign :: SigFigSign,
    -- | significant figures expressed as an Integer
    SigFig -> Integer
sfFigures :: Integer,
    -- | the power of 10 exponent given figures.
    SigFig -> Int
sfExponent :: Int
  }
  deriving (SigFig -> SigFig -> Bool
(SigFig -> SigFig -> Bool)
-> (SigFig -> SigFig -> Bool) -> Eq SigFig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigFig -> SigFig -> Bool
== :: SigFig -> SigFig -> Bool
$c/= :: SigFig -> SigFig -> Bool
/= :: 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
$cshowsPrec :: Int -> SigFig -> ShowS
showsPrec :: Int -> SigFig -> ShowS
$cshow :: SigFig -> String
show :: SigFig -> String
$cshowList :: [SigFig] -> ShowS
showList :: [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
$c== :: SigFigSign -> SigFigSign -> Bool
== :: SigFigSign -> SigFigSign -> Bool
$c/= :: SigFigSign -> SigFigSign -> Bool
/= :: 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
$cshowsPrec :: Int -> SigFigSign -> ShowS
showsPrec :: Int -> SigFigSign -> ShowS
$cshow :: SigFigSign -> String
show :: SigFigSign -> String
$cshowList :: [SigFigSign] -> ShowS
showList :: [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)

-- | Note that zero can still be represented in a SigFig way, so that we can distinguish between something that starts off as zero, and something that ends up as zero via rounding.
--
-- >>> isZero (SigFig SigFigPos 0 (-3))
-- True
isZero :: SigFig -> Bool
isZero :: SigFig -> Bool
isZero (SigFig SigFigSign
_ Integer
i Int
_) = Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0

-- | convert from a Double to a 'SigFig'
--
-- >>> toSigFig (Just 2) 1234
-- SigFig {sfSign = SigFigPos, sfFigures = 12, sfExponent = 2}
--
-- > toSigFig Nothing . fromSigFig <==> id
-- > toSigFig (Just x) . fromSigFig . toSigFig (Just x) <==> toSigFig (Just x)
--
-- 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)
--
-- Checks for a valid number of significant figures and turns it off on a silly number.
--
-- >>> toSigFig Nothing 1234
-- SigFig {sfSign = SigFigPos, sfFigures = 1234, sfExponent = 0}
--
-- >>> toSigFig (Just (-3)) 1234
-- SigFig {sfSign = SigFigPos, sfFigures = 1234, sfExponent = 0}
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
    n' :: Maybe Int
n' = Maybe Int -> (Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Int
forall a. Maybe a
Nothing (\Int
sf -> Maybe Int -> Maybe Int -> Bool -> Maybe Int
forall a. a -> a -> Bool -> a
bool (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
sf) Maybe Int
forall a. Maybe a
Nothing (Int
sf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1)) Maybe Int
n
    (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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 b. Integral b => Double -> b
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 b a. (b -> a -> b) -> b -> [a] -> b
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 b a. (b -> a -> b) -> b -> [a] -> b
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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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)
    -- zero fix
    expo' :: Int
expo' = Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
expo Int
0 (Integer
fs' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Int
expo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)

-- | convert from a 'SigFig' to a Double
--
-- >>> fromSigFig (SigFig SigFigPos 12 2)
-- 1200.0
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

-- | increase significant figures
--
-- >>> incSigFig 1 (SigFig SigFigPos 1 0)
-- SigFig {sfSign = SigFigPos, sfFigures = 10, sfExponent = -1}
incSigFig :: Int -> SigFig -> SigFig
incSigFig :: Int -> SigFig -> SigFig
incSigFig Int
n (SigFig SigFigSign
s Integer
fs Int
e) = SigFigSign -> Integer -> Int -> SigFig
SigFig SigFigSign
s (Integer
fs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n)) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)

-- | decrease significant figures, if possible.
--
-- >>> decSigFig 1 (SigFig SigFigPos 100 0)
-- Just (SigFig {sfSign = SigFigPos, sfFigures = 10, sfExponent = 1})
--
-- >>> decSigFig 1 (SigFig SigFigPos 123 0)
-- Nothing
decSigFig :: Int -> SigFig -> Maybe SigFig
decSigFig :: Int -> SigFig -> Maybe SigFig
decSigFig Int
n (SigFig SigFigSign
s Integer
fs Int
e) =
  Maybe SigFig -> Maybe SigFig -> Bool -> Maybe SigFig
forall a. a -> a -> Bool -> a
bool
    Maybe SigFig
forall a. Maybe a
Nothing
    (SigFig -> Maybe SigFig
forall a. a -> Maybe a
Just (SigFigSign -> Integer -> Int -> SigFig
SigFig SigFigSign
s (Integer
fs Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n)) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)))
    (Integer
fs Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)

-- The natural exponent to format with
eSF :: SigFig -> Int
eSF :: SigFig -> Int
eSF (SigFig SigFigSign
_ Integer
fs Int
e) = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Integer -> String
forall a. Show a => a -> String
show Integer
fs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | expt format for a SigFig
fixedSF :: Maybe Int -> SigFig -> Text
fixedSF :: Maybe Int -> SigFig -> Text
fixedSF Maybe Int
n SigFig
sf = Maybe Int -> Double -> Text
fixed Maybe Int
n (SigFig -> Double
fromSigFig SigFig
sf)

-- | expt format for a SigFig
exptSF :: SigFig -> Text
exptSF :: SigFig -> Text
exptSF (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
sfTextDot 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
eText
  where
    sfTextDot :: String
sfTextDot
      | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sfText Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String
sfText
      | Bool
otherwise = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
sfText 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
sfText
    sfText :: String
sfText = String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool (Integer -> String
forall a. Show a => a -> String
show Integer
i) (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e)) Char
'0') (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)
    eText :: Int
eText = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sfText Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | expt format for a SigFig, with an exponent override
--
-- >>> exptSFWith (Just 1) (toSigFig (Just 1) 1)
-- "0.1e1"
-- >>> exptSFWith (Just 0) (toSigFig (Just 1) 1)
-- "1e0"
-- >>> exptSFWith (Just (-1)) (toSigFig (Just 1) 1)
-- "10e-1"
exptSFWith :: Maybe Int -> SigFig -> Text
exptSFWith :: Maybe Int -> SigFig -> Text
exptSFWith Maybe Int
eover (SigFig SigFigSign
s Integer
i Int
e) = String -> Text
pack (SigFigSign -> String
sfsign SigFigSign
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Int -> Text
posDecimalSF Integer
i (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"e" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
e')
  where
    e' :: Int
e' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Integer -> String
forall a. Show a => a -> String
show Integer
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0 (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)) Maybe Int
eover

-- Formatting the positive component in decimal style
posDecimalSF :: Integer -> Int -> Text
posDecimalSF :: Integer -> Int -> Text
posDecimalSF Integer
xs Int
e = String -> Text
pack String
t
  where
    xs' :: String
xs' = Integer -> String
forall a. Show a => a -> String
show Integer
xs
    nsf :: Int
nsf = String -> Int
forall a. [a] -> 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 a. [a] -> 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 -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool (String
xs' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
e Char
'0') String
xs' (Integer
xs Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
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'

-- | comma format for a SigFig
maybeCommaSF :: Bool -> SigFig -> Text
maybeCommaSF :: Bool -> SigFig -> Text
maybeCommaSF Bool
doCommas (SigFig SigFigSign
s Integer
xs Int
e) = String -> Text
pack (SigFigSign -> String
sfsign SigFigSign
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> (Text -> Text) -> Bool -> Text -> Text
forall a. a -> a -> Bool -> a
bool Text -> Text
forall a. a -> a
id Text -> Text
addcommas Bool
doCommas (Integer -> Int -> Text
posDecimalSF Integer
xs Int
e)
  where
    addcommas :: Text -> Text
addcommas =
      (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 a b c. (a -> b) -> (a, c) -> (b, c)
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
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
Text.breakOn Text
"."

-- | comma format for a SigFig
commaSF :: SigFig -> Text
commaSF :: SigFig -> Text
commaSF = Bool -> SigFig -> Text
maybeCommaSF Bool
True

-- | decimal format for a SigFig
decimalSF :: SigFig -> Text
decimalSF :: SigFig -> Text
decimalSF = Bool -> SigFig -> Text
maybeCommaSF Bool
False

-- | percent format for a SigFig
percentSF :: (SigFig -> Text) -> SigFig -> Text
percentSF :: (SigFig -> Text) -> SigFig -> Text
percentSF SigFig -> Text
f (SigFig SigFigSign
s Integer
figs Int
e) = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SigFig -> Text
f (SigFigSign -> Integer -> Int -> SigFig
SigFig SigFigSign
s Integer
figs (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))

-- | dollar format for a SigFig
dollarSF :: (SigFig -> Text) -> SigFig -> Text
dollarSF :: (SigFig -> Text) -> SigFig -> Text
dollarSF SigFig -> Text
f SigFig
sf =
  case SigFig -> SigFigSign
sfSign SigFig
sf of
    SigFigSign
SigFigNeg -> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (SigFig -> Text) -> SigFig -> Text
dollarSF SigFig -> Text
f (SigFigSign -> Integer -> Int -> SigFig
SigFig SigFigSign
SigFigPos (SigFig -> Integer
sfFigures SigFig
sf) (SigFig -> Int
sfExponent SigFig
sf))
    SigFigSign
SigFigPos -> Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SigFig -> Text
f SigFig
sf

-- * specific number formats

-- | 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
""

-- | 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 (Just 2) 0
-- "0.0e0"
expt :: Maybe Int -> Double -> Text
expt :: Maybe Int -> Double -> Text
expt Maybe Int
n Double
x = SigFig -> Text
exptSF (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x)

-- | Format in exponential style, with the suggested exponent.
--
-- >>> exptWith (Just 2) Nothing 1245
-- "12.45e2"
-- >>> exptWith (Just 6) (Just 3) 1245
-- "0.00124e6"
exptWith :: Maybe Int -> Maybe Int -> Double -> Text
exptWith :: Maybe Int -> Maybe Int -> Double -> Text
exptWith Maybe Int
n' Maybe Int
n Double
x = Maybe Int -> SigFig -> Text
exptSFWith Maybe Int
n' (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x)

-- | 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
decimalSF (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x)

-- | Format with US-style commas
--
-- >>> comma (Just 3) 1234567
-- "1,230,000"
comma :: Maybe Int -> Double -> Text
comma :: Maybe Int -> Double -> Text
comma Maybe Int
n Double
x = SigFig -> Text
commaSF (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x)

-- | Adjust format to a percent.
--
-- >>> percent commaSF (Just 3) 0.1234
-- "12.3%"
-- >>> percent decimalSF (Just 1) 0.1234
-- "10%"
percent :: (SigFig -> Text) -> Maybe Int -> Double -> Text
percent :: (SigFig -> Text) -> Maybe Int -> Double -> Text
percent SigFig -> Text
f Maybe Int
n Double
x = (SigFig -> Text) -> SigFig -> Text
percentSF SigFig -> Text
f (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x)

-- | Adjust format to dollar style.
--
-- >>> dollar commaSF (Just 3) 1234
-- "$1,230"
-- >>> dollar (fixedSF (Just 2)) (Just 2) 0.01234
-- "$0.01"
dollar :: (SigFig -> Text) -> Maybe Int -> Double -> Text
dollar :: (SigFig -> Text) -> Maybe Int -> Double -> Text
dollar SigFig -> Text
f Maybe Int
n Double
x = (SigFig -> Text) -> SigFig -> Text
dollarSF SigFig -> Text
f (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n Double
x)

-- | Data type representing styles of formatting
data FormatStyle
  = -- | 1000 1 0.001
    DecimalStyle
  | -- | 1e3 1e0 1e-3
    ExponentStyle (Maybe Int)
  | -- | 1,000 1 0.001
    CommaStyle
  | -- | 1000.00 1.00 0.00
    FixedStyle Int
  | -- | 100,000% 100% 0.1%
    PercentStyle
  | -- | \$1,000 $1 $0.001
    DollarStyle
  deriving (Int -> FormatStyle -> ShowS
[FormatStyle] -> ShowS
FormatStyle -> String
(Int -> FormatStyle -> ShowS)
-> (FormatStyle -> String)
-> ([FormatStyle] -> ShowS)
-> Show FormatStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatStyle -> ShowS
showsPrec :: Int -> FormatStyle -> ShowS
$cshow :: FormatStyle -> String
show :: FormatStyle -> String
$cshowList :: [FormatStyle] -> ShowS
showList :: [FormatStyle] -> ShowS
Show, FormatStyle -> FormatStyle -> Bool
(FormatStyle -> FormatStyle -> Bool)
-> (FormatStyle -> FormatStyle -> Bool) -> Eq FormatStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatStyle -> FormatStyle -> Bool
== :: FormatStyle -> FormatStyle -> Bool
$c/= :: FormatStyle -> FormatStyle -> Bool
/= :: FormatStyle -> FormatStyle -> Bool
Eq, Eq FormatStyle
Eq FormatStyle =>
(FormatStyle -> FormatStyle -> Ordering)
-> (FormatStyle -> FormatStyle -> Bool)
-> (FormatStyle -> FormatStyle -> Bool)
-> (FormatStyle -> FormatStyle -> Bool)
-> (FormatStyle -> FormatStyle -> Bool)
-> (FormatStyle -> FormatStyle -> FormatStyle)
-> (FormatStyle -> FormatStyle -> FormatStyle)
-> Ord FormatStyle
FormatStyle -> FormatStyle -> Bool
FormatStyle -> FormatStyle -> Ordering
FormatStyle -> FormatStyle -> FormatStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FormatStyle -> FormatStyle -> Ordering
compare :: FormatStyle -> FormatStyle -> Ordering
$c< :: FormatStyle -> FormatStyle -> Bool
< :: FormatStyle -> FormatStyle -> Bool
$c<= :: FormatStyle -> FormatStyle -> Bool
<= :: FormatStyle -> FormatStyle -> Bool
$c> :: FormatStyle -> FormatStyle -> Bool
> :: FormatStyle -> FormatStyle -> Bool
$c>= :: FormatStyle -> FormatStyle -> Bool
>= :: FormatStyle -> FormatStyle -> Bool
$cmax :: FormatStyle -> FormatStyle -> FormatStyle
max :: FormatStyle -> FormatStyle -> FormatStyle
$cmin :: FormatStyle -> FormatStyle -> FormatStyle
min :: FormatStyle -> FormatStyle -> FormatStyle
Ord)

-- | DecimalStyle between 0.001 and a million and ExponentStyle outside this range.
precStyle :: Double -> FormatStyle
precStyle :: Double -> FormatStyle
precStyle Double
x
  | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = FormatStyle
DecimalStyle
  | Double -> Double
forall a. Num a => a -> a
abs Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.001 = Maybe Int -> FormatStyle
ExponentStyle (Int -> Maybe Int
forall a. a -> Maybe a
Just (SigFig -> Int
eSF (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
forall a. Maybe a
Nothing Double
x)))
  | Double -> Double
forall a. Num a => a -> a
abs Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e6 = Maybe Int -> FormatStyle
ExponentStyle (Int -> Maybe Int
forall a. a -> Maybe a
Just (SigFig -> Int
eSF (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
forall a. Maybe a
Nothing Double
x)))
  | Bool
otherwise = FormatStyle
DecimalStyle

-- | CommaStyle above a thousand but below a million, DecimalStyle between 0.001 and a thousand and ExponentStyle outside this range.
commaPrecStyle :: Double -> FormatStyle
commaPrecStyle :: Double -> FormatStyle
commaPrecStyle Double
x
  | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = FormatStyle
CommaStyle
  | Double -> Double
forall a. Num a => a -> a
abs Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.001 = Maybe Int -> FormatStyle
ExponentStyle (Int -> Maybe Int
forall a. a -> Maybe a
Just (SigFig -> Int
eSF (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
forall a. Maybe a
Nothing Double
x)))
  | Double -> Double
forall a. Num a => a -> a
abs Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e6 = Maybe Int -> FormatStyle
ExponentStyle (Int -> Maybe Int
forall a. a -> Maybe a
Just (SigFig -> Int
eSF (Maybe Int -> Double -> SigFig
toSigFig Maybe Int
forall a. Maybe a
Nothing Double
x)))
  | Bool
otherwise = FormatStyle
CommaStyle

-- | Data type representing styles of formatting dependent on the number
data FStyle
  = FSDecimal
  | FSExponent (Maybe Int)
  | FSComma
  | FSFixed Int
  | FSPercent
  | FSDollar
  | FSPrec
  | FSCommaPrec
  | FSNone
  deriving (Int -> FStyle -> ShowS
[FStyle] -> ShowS
FStyle -> String
(Int -> FStyle -> ShowS)
-> (FStyle -> String) -> ([FStyle] -> ShowS) -> Show FStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FStyle -> ShowS
showsPrec :: Int -> FStyle -> ShowS
$cshow :: FStyle -> String
show :: FStyle -> String
$cshowList :: [FStyle] -> ShowS
showList :: [FStyle] -> ShowS
Show, FStyle -> FStyle -> Bool
(FStyle -> FStyle -> Bool)
-> (FStyle -> FStyle -> Bool) -> Eq FStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FStyle -> FStyle -> Bool
== :: FStyle -> FStyle -> Bool
$c/= :: FStyle -> FStyle -> Bool
/= :: FStyle -> FStyle -> Bool
Eq, Eq FStyle
Eq FStyle =>
(FStyle -> FStyle -> Ordering)
-> (FStyle -> FStyle -> Bool)
-> (FStyle -> FStyle -> Bool)
-> (FStyle -> FStyle -> Bool)
-> (FStyle -> FStyle -> Bool)
-> (FStyle -> FStyle -> FStyle)
-> (FStyle -> FStyle -> FStyle)
-> Ord FStyle
FStyle -> FStyle -> Bool
FStyle -> FStyle -> Ordering
FStyle -> FStyle -> FStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FStyle -> FStyle -> Ordering
compare :: FStyle -> FStyle -> Ordering
$c< :: FStyle -> FStyle -> Bool
< :: FStyle -> FStyle -> Bool
$c<= :: FStyle -> FStyle -> Bool
<= :: FStyle -> FStyle -> Bool
$c> :: FStyle -> FStyle -> Bool
> :: FStyle -> FStyle -> Bool
$c>= :: FStyle -> FStyle -> Bool
>= :: FStyle -> FStyle -> Bool
$cmax :: FStyle -> FStyle -> FStyle
max :: FStyle -> FStyle -> FStyle
$cmin :: FStyle -> FStyle -> FStyle
min :: FStyle -> FStyle -> FStyle
Ord)

-- | Compute the majority (modal) FormatStyle so a list of numbers can all have the same formatting
--
-- Also equalises the exponent to the majority for exponent style.
--
-- >>> commaPrecStyle <$> [0,5e6,1e7,2e7]
-- [CommaStyle,ExponentStyle (Just 6),ExponentStyle (Just 7),ExponentStyle (Just 7)]
-- >>> majorityStyle commaPrecStyle [0,5e6,1e7,2e7]
-- ExponentStyle (Just 7)
majorityStyle :: (Double -> FormatStyle) -> [Double] -> FormatStyle
majorityStyle :: (Double -> FormatStyle) -> [Double] -> FormatStyle
majorityStyle Double -> FormatStyle
s [Double]
xs = FormatStyle
maj'
  where
    maj :: FormatStyle
maj = FormatStyle -> Maybe FormatStyle -> FormatStyle
forall a. a -> Maybe a -> a
fromMaybe FormatStyle
CommaStyle ([FormatStyle] -> Maybe FormatStyle
forall a. Ord a => [a] -> Maybe a
major (FormatStyle -> FormatStyle
neutralExpStyle (FormatStyle -> FormatStyle)
-> (Double -> FormatStyle) -> Double -> FormatStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FormatStyle
s (Double -> FormatStyle) -> [Double] -> [FormatStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs))
    maj' :: FormatStyle
maj' = FormatStyle -> FormatStyle -> Bool -> FormatStyle
forall a. a -> a -> Bool -> a
bool FormatStyle
maj (Maybe Int -> FormatStyle
ExponentStyle (Maybe Int -> Maybe (Maybe Int) -> Maybe Int
forall a. a -> Maybe a -> a
fromMaybe Maybe Int
forall a. Maybe a
Nothing Maybe (Maybe Int)
expXs)) (FormatStyle
maj FormatStyle -> FormatStyle -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int -> FormatStyle
ExponentStyle Maybe Int
forall a. Maybe a
Nothing)
    neutralExpStyle :: FormatStyle -> FormatStyle
neutralExpStyle (ExponentStyle Maybe Int
_) = Maybe Int -> FormatStyle
ExponentStyle Maybe Int
forall a. Maybe a
Nothing
    neutralExpStyle FormatStyle
x = FormatStyle
x

    expXs :: Maybe (Maybe Int)
expXs = [Maybe Int] -> Maybe (Maybe Int)
forall a. Ord a => [a] -> Maybe a
major [Maybe Int
x | (ExponentStyle Maybe Int
x) <- Double -> FormatStyle
s (Double -> FormatStyle) -> [Double] -> [FormatStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs]

major :: (Ord a) => [a] -> Maybe a
major :: forall a. Ord a => [a] -> Maybe a
major [a]
xs = (a, Integer) -> a
forall a b. (a, b) -> a
fst ((a, Integer) -> a) -> Maybe (a, Integer) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Integer)] -> Maybe (a, Integer)
forall a. [a] -> Maybe a
listToMaybe (((a, Integer) -> Down Integer) -> [(a, Integer)] -> [(a, Integer)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Integer -> Down Integer
forall a. a -> Down a
Down (Integer -> Down Integer)
-> ((a, Integer) -> Integer) -> (a, Integer) -> Down Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Integer) -> Integer
forall a b. (a, b) -> b
snd) ([(a, Integer)] -> [(a, Integer)])
-> [(a, Integer)] -> [(a, Integer)]
forall a b. (a -> b) -> a -> b
$ Map a Integer -> [(a, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map a Integer -> [(a, Integer)])
-> Map a Integer -> [(a, Integer)]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer) -> [(a, Integer)] -> Map a Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) ((,Integer
1 :: Integer) (a -> (a, Integer)) -> [a] -> [(a, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs))

-- | format a number according to a FormatStyle and significant figures
--
-- >>> format CommaStyle (Just 2) 1234
-- "1,200"
format :: FormatStyle -> Maybe Int -> Double -> Text
format :: FormatStyle -> Maybe Int -> Double -> Text
format FormatStyle
fs 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' = case FormatStyle
fs of
      FormatStyle
DecimalStyle -> Maybe Int -> Double -> Text
decimal Maybe Int
n Double
x'
      ExponentStyle Maybe Int
n' -> Maybe Int -> Maybe Int -> Double -> Text
exptWith Maybe Int
n' Maybe Int
n Double
x'
      FormatStyle
CommaStyle -> Maybe Int -> Double -> Text
comma Maybe Int
n Double
x'
      FixedStyle Int
n' -> Maybe Int -> Double -> Text
fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n') Double
x'
      FormatStyle
PercentStyle -> (SigFig -> Text) -> Maybe Int -> Double -> Text
percent SigFig -> Text
commaSF Maybe Int
n Double
x'
      FormatStyle
DollarStyle -> (SigFig -> Text) -> Maybe Int -> Double -> Text
dollar SigFig -> Text
commaSF Maybe Int
n Double
x'

-- | format a SigFig according to a style
--
-- >>> formatSF CommaStyle (toSigFig (Just 2) 1234)
-- "1,200"
-- >>> formatSF CommaStyle (SigFig SigFigPos 0 1)
-- "0"
-- >>> formatSF CommaStyle (SigFig SigFigPos 0 (-1))
-- "0.0"
formatSF :: FormatStyle -> SigFig -> Text
formatSF :: FormatStyle -> SigFig -> Text
formatSF FormatStyle
fs SigFig
x = case FormatStyle
fs of
  FormatStyle
DecimalStyle -> SigFig -> Text
decimalSF SigFig
x
  ExponentStyle Maybe Int
n' -> Maybe Int -> SigFig -> Text
exptSFWith Maybe Int
n' SigFig
x
  FormatStyle
CommaStyle -> SigFig -> Text
commaSF SigFig
x
  FixedStyle Int
n -> Maybe Int -> Double -> Text
fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) (SigFig -> Double
fromSigFig SigFig
x)
  FormatStyle
PercentStyle -> (SigFig -> Text) -> SigFig -> Text
percentSF SigFig -> Text
commaSF SigFig
x
  FormatStyle
DollarStyle -> (SigFig -> Text) -> SigFig -> Text
dollarSF SigFig -> Text
commaSF SigFig
x

-- | Format between 0.001 and 1000000 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 = FormatStyle -> Maybe Int -> Double -> Text
format (Double -> FormatStyle
precStyle Double
x) Maybe Int
n Double
x

-- | Format using comma separators for numbers above 1,000 but below 1 million, otherwise use prec style.
--
-- >>> commaPrec (Just 3) 1234
-- "1,230"
-- >>> commaPrec (Just 3) 1234567
-- "1.23e6"
commaPrec :: Maybe Int -> Double -> Text
commaPrec :: Maybe Int -> Double -> Text
commaPrec Maybe Int
n Double
x = FormatStyle -> Maybe Int -> Double -> Text
format (Double -> FormatStyle
commaPrecStyle Double
x) Maybe Int
n Double
x

-- | Consistently format a list of numbers,using the minimum number of decimal places or minimum exponent.
--
-- >>> formats True True precStyle (Just 1) [0,0.5,1,2]
-- ["0.0","0.5","1.0","2.0"]
--
-- Note how the presence of 0.5 in the example above changes the format of all numbers. Without it:
--
-- >>> formats True True precStyle (Just 1) [0,1,2]
-- ["0","1","2"]
--
-- >>> formats False True precStyle (Just 1) $ ((-1)*) <$> [0,0.5,1,2]
-- ["0.0","-0.5","-1.0","-2.0"]
-- >>> formats True True commaPrecStyle (Just 1) $ ((-1000)*) <$> [0,0.5,1,2]
-- ["     0","  -500","-1,000","-2,000"]
-- >>> formats True True commaPrecStyle (Just 1) $ ((1e6)*) <$> [0,0.5,1,2]
-- ["        0","  500,000","1,000,000","2,000,000"]
-- >>> formats True True commaPrecStyle (Just 1) $ ((1e6)*) <$> [0.9,2,3]
-- ["0.9e6","2.0e6","3.0e6"]
-- >>> formats True True commaPrecStyle (Just 1) $ ((1e-6)*) <$> [0,0.5,1,2]
-- ["0.0e-6","0.5e-6","1.0e-6","2.0e-6"]
-- >>> formats True True commaPrecStyle (Just 1) $ ((1e-3)*) <$> [0,0.5,1,2]
-- ["0.0000","0.0005","0.0010","0.0020"]
-- >>> formats True False (const (ExponentStyle Nothing)) (Just 2) [0..4]
-- ["0.0e0","1.0e0","2.0e0","3.0e0","4.0e0"]
-- >>> formats True True (const (ExponentStyle Nothing)) (Just 2) [0..4]
-- ["0e0","1e0","2e0","3e0","4e0"]
formats ::
  -- | left pad to the largest text length
  Bool ->
  -- | Try and reduce excess right-hand zeros
  Bool ->
  -- | style
  (Double -> FormatStyle) ->
  -- | significant figures requested
  Maybe Int ->
  -- | list of numbers
  [Double] ->
  [Text]
formats :: Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
formats Bool
lpad Bool
rcut Double -> FormatStyle
s Maybe Int
n0 [Double]
xs =
  Bool -> (Double -> FormatStyle) -> [SigFig] -> [Text]
formatsFromSF Bool
lpad Double -> FormatStyle
s ([SigFig] -> [Text]) -> [SigFig] -> [Text]
forall a b. (a -> b) -> a -> b
$
    ([SigFig] -> [SigFig])
-> ([SigFig] -> [SigFig]) -> Bool -> [SigFig] -> [SigFig]
forall a. a -> a -> Bool -> a
bool [SigFig] -> [SigFig]
forall a. a -> a
id [SigFig] -> [SigFig]
decSigFigs Bool
rcut (Maybe Int -> [Double] -> [SigFig]
formatsSF Maybe Int
n0 [Double]
xs)

-- | Consistently convert a list of numbers to 'SigFig's, using the minimum natural exponent of the list.
formatsSF ::
  -- | significant figures requested
  Maybe Int ->
  -- | list of numbers
  [Double] ->
  [SigFig]
formatsSF :: Maybe Int -> [Double] -> [SigFig]
formatsSF Maybe Int
n0 [Double]
xs = [SigFig]
sigs'
  where
    sigs :: [SigFig]
sigs = Maybe Int -> Double -> SigFig
toSigFig Maybe Int
n0 (Double -> SigFig) -> [Double] -> [SigFig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs
    minexp :: Int
minexp = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (SigFig -> Int
sfExponent (SigFig -> Int) -> [SigFig] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SigFig -> Bool) -> [SigFig] -> [SigFig]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (SigFig -> Bool) -> SigFig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigFig -> Bool
isZero) [SigFig]
sigs)
    sigs' :: [SigFig]
sigs' = (\SigFig
x -> SigFig -> SigFig -> Bool -> SigFig
forall a. a -> a -> Bool -> a
bool (Int -> SigFig -> SigFig
incSigFig (SigFig -> Int
sfExponent SigFig
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minexp) SigFig
x) (SigFigSign -> Integer -> Int -> SigFig
SigFig SigFigSign
SigFigPos Integer
0 Int
minexp) (SigFig -> Bool
isZero SigFig
x)) (SigFig -> SigFig) -> [SigFig] -> [SigFig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigFig]
sigs

formatsFromSF ::
  -- | left pad to the largest text length
  Bool ->
  -- | style
  (Double -> FormatStyle) ->
  -- | list of numbers
  [SigFig] ->
  [Text]
formatsFromSF :: Bool -> (Double -> FormatStyle) -> [SigFig] -> [Text]
formatsFromSF Bool
lpad Double -> FormatStyle
s [SigFig]
sigs = [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [Text]
fsigs ([Text] -> [Text]
lpads [Text]
fsigs) Bool
lpad
  where
    maj :: FormatStyle
maj = (Double -> FormatStyle) -> [Double] -> FormatStyle
majorityStyle Double -> FormatStyle
s (SigFig -> Double
fromSigFig (SigFig -> Double) -> [SigFig] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigFig]
sigs)
    fsigs :: [Text]
fsigs = FormatStyle -> SigFig -> Text
formatSF FormatStyle
maj (SigFig -> Text) -> [SigFig] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigFig]
sigs

-- | Decrease the SigFig figure of a list of SigFigs without loss of precision, if possible. This has the effect of removing right zeros in decimal representations.
decSigFigs :: [SigFig] -> [SigFig]
decSigFigs :: [SigFig] -> [SigFig]
decSigFigs [SigFig]
xs = [SigFig] -> [SigFig] -> Bool -> [SigFig]
forall a. a -> a -> Bool -> a
bool [SigFig]
xs ([SigFig] -> [SigFig]
decSigFigs [SigFig]
xs') ((Maybe SigFig -> Bool) -> [Maybe SigFig] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe SigFig -> Bool
forall a. Maybe a -> Bool
isJust [Maybe SigFig]
decXs)
  where
    decXs :: [Maybe SigFig]
decXs = Int -> SigFig -> Maybe SigFig
decSigFig Int
1 (SigFig -> Maybe SigFig) -> [SigFig] -> [Maybe SigFig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigFig]
xs
    xs' :: [SigFig]
xs' = [Maybe SigFig] -> [SigFig]
forall a. [Maybe a] -> [a]
catMaybes [Maybe SigFig]
decXs

-- | Add spaces to the left of a text representation so that all elements have the same length.
lpads :: [Text] -> [Text]
lpads :: [Text] -> [Text]
lpads [Text]
ts = (\Text
x -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate (Int
maxl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
x) Text
" ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ts
  where
    maxl :: Int
maxl = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length (Text -> Int) -> [Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ts

-- | Provide formatted text for a list of numbers so that they are just distinguished.
--
-- For example, __@distinguish 4 commaPrecStyle (Just 2)@__ means use as much significant figures as is needed for the numbers to be distinguished on rendering (up to 4+2=6), but with at least 2 significant figures.
--
-- The difference between this and 'formats' can be seen in these examples:
--
-- >>> formats True True commaPrecStyle (Just 2) [0,1,1.01,1.02,1.1,1.2]
-- ["0.0","1.0","1.0","1.0","1.1","1.2"]
-- >>> distinguish 4 True True commaPrecStyle (Just 2) [0,1,1.01,1.02,1.1,1.2]
-- ["0.00","1.00","1.01","1.02","1.10","1.20"]
--
-- A common occurence is that significant figures being increased to enable textual uniqueness results in excess right zeros (after a decimal place). Consider:
--
-- >>> formats True False commaPrecStyle (Just 1) [0, 0.5, 1, 1.5, 2]
-- ["0.0","0.5","1.0","2.0","2.0"]
--
-- Note that formats seeks With 1.5 rounding up to 2, the distinguish algorithm will increase the number of sigfigs to 2:
--
-- >>> distinguish 4 True False commaPrecStyle (Just 1) [0, 0.5, 1, 1.5, 2]
-- ["0.00","0.50","1.00","1.50","2.00"]
--
-- The format can be simplified further by removing the excess right zeros from each formatted number:
--
-- >>> distinguish 4 True True commaPrecStyle (Just 2) [0, 0.5, 1, 1.5, 2]
-- ["0.0","0.5","1.0","1.5","2.0"]
distinguish ::
  -- | maximum number of iterations
  Int ->
  -- | left pad to the largest text length
  Bool ->
  -- | try and reduce excess right zero pads
  Bool ->
  -- | style
  (Double -> FormatStyle) ->
  -- | significant figures requested
  Maybe Int ->
  -- | list of numbers
  [Double] ->
  [Text]
distinguish :: Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr Double -> FormatStyle
f Maybe Int
n [Double]
xs =
  case Maybe Int
n of
    Maybe Int
Nothing -> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
formats Bool
pad Bool
cutr Double -> FormatStyle
f Maybe Int
forall a. Maybe a
Nothing [Double]
xs
    Just Int
n0 -> Int -> [Text]
loopSF Int
n0
  where
    loopSF :: Int -> [Text]
loopSF Int
n' = [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool (Int -> [Text]
loopSF (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n')) [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
maxi)
      where
        s :: [Text]
s = Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
formats Bool
pad Bool
cutr Double -> FormatStyle
f (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n') [Double]
xs

-- | Wrapper for the various formatting options.
--
-- >>> defaultFormatN
-- FormatN {fstyle = FSCommaPrec, sigFigs = Just 2, maxDistinguishIterations = 4, addLPad = True, cutRightZeros = True}
data FormatN = FormatN {FormatN -> FStyle
fstyle :: FStyle, FormatN -> Maybe Int
sigFigs :: Maybe Int, FormatN -> Int
maxDistinguishIterations :: Int, FormatN -> Bool
addLPad :: Bool, FormatN -> Bool
cutRightZeros :: Bool} deriving (FormatN -> FormatN -> Bool
(FormatN -> FormatN -> Bool)
-> (FormatN -> FormatN -> Bool) -> Eq FormatN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatN -> FormatN -> Bool
== :: FormatN -> FormatN -> Bool
$c/= :: FormatN -> FormatN -> Bool
/= :: 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
$cshowsPrec :: Int -> FormatN -> ShowS
showsPrec :: Int -> FormatN -> ShowS
$cshow :: FormatN -> String
show :: FormatN -> String
$cshowList :: [FormatN] -> ShowS
showList :: [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
$cfrom :: forall x. FormatN -> Rep FormatN x
from :: forall x. FormatN -> Rep FormatN x
$cto :: forall x. Rep FormatN x -> FormatN
to :: forall x. Rep FormatN x -> FormatN
Generic)

-- | The official FormatN
defaultFormatN :: FormatN
defaultFormatN :: FormatN
defaultFormatN = FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSCommaPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Int
4 Bool
True Bool
True

-- | run a 'FormatN'
--
-- >>> formatN defaultFormatN 1234
-- "1,200"
formatN :: FormatN -> Double -> Text
formatN :: FormatN -> Double -> Text
formatN FormatN
fn Double
x = case FormatN -> FStyle
fstyle FormatN
fn of
  FStyle
FSDecimal -> FormatStyle -> Maybe Int -> Double -> Text
format FormatStyle
DecimalStyle (FormatN -> Maybe Int
sigFigs FormatN
fn) Double
x
  (FSExponent Maybe Int
n) -> FormatStyle -> Maybe Int -> Double -> Text
format (Maybe Int -> FormatStyle
ExponentStyle Maybe Int
n) (FormatN -> Maybe Int
sigFigs FormatN
fn) Double
x
  FStyle
FSComma -> FormatStyle -> Maybe Int -> Double -> Text
format FormatStyle
CommaStyle (FormatN -> Maybe Int
sigFigs FormatN
fn) Double
x
  (FSFixed Int
n) -> FormatStyle -> Maybe Int -> Double -> Text
format (Int -> FormatStyle
FixedStyle Int
n) (FormatN -> Maybe Int
sigFigs FormatN
fn) Double
x
  FStyle
FSPercent -> FormatStyle -> Maybe Int -> Double -> Text
format FormatStyle
PercentStyle (FormatN -> Maybe Int
sigFigs FormatN
fn) Double
x
  FStyle
FSDollar -> FormatStyle -> Maybe Int -> Double -> Text
format FormatStyle
DollarStyle (FormatN -> Maybe Int
sigFigs FormatN
fn) Double
x
  FStyle
FSPrec -> FormatStyle -> Maybe Int -> Double -> Text
format (Double -> FormatStyle
precStyle Double
x) (FormatN -> Maybe Int
sigFigs FormatN
fn) Double
x
  FStyle
FSCommaPrec -> FormatStyle -> Maybe Int -> Double -> Text
format (Double -> FormatStyle
commaPrecStyle Double
x) (FormatN -> Maybe Int
sigFigs FormatN
fn) Double
x
  FStyle
FSNone -> String -> Text
pack (Double -> String
forall a. Show a => a -> String
show Double
x)

-- | Consistently format a list of numbers via using 'distinguish'.
--
-- >>> 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 (FormatN FStyle
FSDecimal Maybe Int
sf Int
maxi Bool
pad Bool
cutr) [Double]
x = Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr (FormatStyle -> Double -> FormatStyle
forall a b. a -> b -> a
const FormatStyle
DecimalStyle) Maybe Int
sf [Double]
x
formatNs (FormatN (FSExponent Maybe Int
n) Maybe Int
sf Int
maxi Bool
pad Bool
cutr) [Double]
x = Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr (FormatStyle -> Double -> FormatStyle
forall a b. a -> b -> a
const (Maybe Int -> FormatStyle
ExponentStyle Maybe Int
n)) Maybe Int
sf [Double]
x
formatNs (FormatN FStyle
FSComma Maybe Int
sf Int
maxi Bool
pad Bool
cutr) [Double]
x = Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr (FormatStyle -> Double -> FormatStyle
forall a b. a -> b -> a
const FormatStyle
CommaStyle) Maybe Int
sf [Double]
x
formatNs (FormatN (FSFixed Int
n) Maybe Int
sf Int
maxi Bool
pad Bool
cutr) [Double]
x = Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr (FormatStyle -> Double -> FormatStyle
forall a b. a -> b -> a
const (Int -> FormatStyle
FixedStyle Int
n)) Maybe Int
sf [Double]
x
formatNs (FormatN FStyle
FSPercent Maybe Int
sf Int
maxi Bool
pad Bool
cutr) [Double]
x = Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr (FormatStyle -> Double -> FormatStyle
forall a b. a -> b -> a
const FormatStyle
PercentStyle) Maybe Int
sf [Double]
x
formatNs (FormatN FStyle
FSDollar Maybe Int
sf Int
maxi Bool
pad Bool
cutr) [Double]
x = Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr (FormatStyle -> Double -> FormatStyle
forall a b. a -> b -> a
const FormatStyle
DollarStyle) Maybe Int
sf [Double]
x
formatNs (FormatN FStyle
FSPrec Maybe Int
sf Int
maxi Bool
pad Bool
cutr) [Double]
x = Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr Double -> FormatStyle
precStyle Maybe Int
sf [Double]
x
formatNs (FormatN FStyle
FSCommaPrec Maybe Int
sf Int
maxi Bool
pad Bool
cutr) [Double]
x = Int
-> Bool
-> Bool
-> (Double -> FormatStyle)
-> Maybe Int
-> [Double]
-> [Text]
distinguish Int
maxi Bool
pad Bool
cutr Double -> FormatStyle
commaPrecStyle Maybe Int
sf [Double]
x
formatNs (FormatN FStyle
FSNone Maybe Int
_ Int
_ Bool
pad Bool
_) [Double]
x = ([Text] -> [Text])
-> ([Text] -> [Text]) -> Bool -> [Text] -> [Text]
forall a. a -> a -> Bool -> a
bool [Text] -> [Text]
forall a. a -> a
id [Text] -> [Text]
lpads Bool
pad ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ 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]
x

-- | Format with the shorter of show and a style.
--
-- >>> format (ExponentStyle Nothing) Nothing 0
-- "0e0"
-- >>> formatOrShow (ExponentStyle Nothing) Nothing 0
-- "0"
formatOrShow :: FormatStyle -> Maybe Int -> Double -> Text
formatOrShow :: FormatStyle -> Maybe Int -> Double -> Text
formatOrShow FormatStyle
f Maybe Int
n 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' = FormatStyle -> Maybe Int -> Double -> Text
format FormatStyle
f Maybe Int
n Double
x
    s' :: String
s' = Double -> String
forall a. Show a => a -> String
show Double
x