{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

-- | Formatting of numeric values.
module Data.FormatN
  ( FormatN (..),
    defaultFormatN,
    fromFormatN,
    toFormatN,
    fixed,
    decimal,
    prec,
    comma,
    expt,
    dollar,
    formatN,
    precision,
    formatNs,
    showOr,
  )
where

import Data.Containers.ListUtils (nubOrd)
import Data.Generics.Labels ()
import Data.Scientific
import qualified Data.Text as Text
import NumHask.Prelude

-- $setup
--
-- >>> :set -XNoImplicitPrelude
-- >>> -- import NumHask.Prelude

-- | Number formatting options.
--
-- >>> defaultFormatN
-- FormatComma (Just 2)
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 :: FormatN
defaultFormatN :: FormatN
defaultFormatN = Maybe Int -> FormatN
FormatComma (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

-- | textifier
fromFormatN :: (IsString s) => FormatN -> s
fromFormatN :: FormatN -> s
fromFormatN (FormatFixed Maybe Int
_) = s
"Fixed"
fromFormatN (FormatDecimal Maybe Int
_) = s
"Decimal"
fromFormatN (FormatComma Maybe Int
_) = s
"Comma"
fromFormatN (FormatExpt Maybe Int
_) = s
"Expt"
fromFormatN (FormatPrec Maybe Int
_) = s
"Prec"
fromFormatN (FormatDollar Maybe Int
_) = s
"Dollar"
fromFormatN (FormatPercent Maybe Int
_) = s
"Percent"
fromFormatN FormatN
FormatNone = s
"None"

-- | readifier
toFormatN :: (Eq s, IsString s) => s -> Maybe Int -> FormatN
toFormatN :: s -> Maybe Int -> FormatN
toFormatN s
"Fixed" Maybe Int
n = Maybe Int -> FormatN
FormatFixed Maybe Int
n
toFormatN s
"Decimal" Maybe Int
n = Maybe Int -> FormatN
FormatDecimal Maybe Int
n
toFormatN s
"Comma" Maybe Int
n = Maybe Int -> FormatN
FormatComma Maybe Int
n
toFormatN s
"Expt" Maybe Int
n = Maybe Int -> FormatN
FormatExpt Maybe Int
n
toFormatN s
"Prec" Maybe Int
n = Maybe Int -> FormatN
FormatPrec Maybe Int
n
toFormatN s
"Dollar" Maybe Int
n = Maybe Int -> FormatN
FormatDollar Maybe Int
n
toFormatN s
"Percent" Maybe Int
n = Maybe Int -> FormatN
FormatPercent Maybe Int
n
toFormatN s
"None" Maybe Int
_ = FormatN
FormatNone
toFormatN s
_ Maybe Int
_ = FormatN
FormatNone

-- | to x decimal places
--
-- >>> fixed (Just 2) 1
-- "1.00"
--
-- >>> fixed (Just 2) 0.001
-- "0.00"
fixed :: Maybe Int -> Double -> Text
fixed :: Maybe Int -> Double -> Text
fixed Maybe Int
x Double
n = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed Maybe Int
x (Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
n)

-- | scientific exponential
--
-- >>> expt (Just 2) 1234
-- "1.23e3"
expt :: Maybe Int -> Double -> Text
expt :: Maybe Int -> Double -> Text
expt Maybe Int
x Double
n = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Exponent Maybe Int
x (Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
n)

-- | round to n significant figures
--
-- >>> roundSig 2 1234
-- 1230.0
--
-- >>> roundSig 2 0.001234
-- 1.23e-3
roundSig :: Int -> Double -> Scientific
roundSig :: Int -> Double -> Scientific
roundSig Int
n Double
x = Integer -> Int -> Scientific
scientific Integer
r' (Int
e Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ds0)
  where
    ([Int]
ds, Int
e) = Scientific -> ([Int], Int)
toDecimalDigits (Scientific -> ([Int], Int)) -> Scientific -> ([Int], Int)
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
x
    ([Int]
ds0, [Int]
ds1) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
n Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
1) [Int]
ds
    r :: Double
r =
      (Int -> Double
forall a b. FromIntegral a b => b -> a
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. Multiplicative a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
a) Int
0 [Int]
ds0 :: Double)
        Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Int -> Double
forall a b. FromIntegral a b => b -> a
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. Multiplicative a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
a) Int
0 [Int]
ds1) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Double
10.0 Double -> Int -> Double
forall a. Divisive a => a -> Int -> a
^ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ds1)
    r' :: Integer
r' = Double -> Integer
forall a b. QuotientField a b => a -> b
round Double
r :: Integer

-- | format numbers between 0.001 and 1,000,000 using digit and comma notation and exponential outside this range, with x significant figures.
-- > prec (Just 1) 0.00234
-- "0.0023"
--
-- > prec (Just 1) 0.000023
-- "2.3e-5"
--
-- > prec (Just 1) 123
-- "120"
--
-- > prec (Just 1) 123456
-- "120,000"
--
-- >>> prec (Just 1) 1234567
-- "1.2e6"
prec :: Maybe Int -> Double -> Text
prec :: Maybe Int -> Double -> Text
prec 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
prec Maybe Int
n (- Double
x)
  | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Maybe Int -> Double -> Text
decimal Maybe Int
n (Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x')
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.001 = 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
  | Bool
otherwise = Maybe Int -> Double -> Text
decimal Maybe Int
n (Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x')
  where
    x' :: Scientific
x' = (Double -> Scientific)
-> (Int -> Double -> Scientific)
-> Maybe Int
-> Double
-> Scientific
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Int -> Double -> Scientific
roundSig Maybe Int
n Double
x

-- | round to n significant figures and always use decimal notation
-- >>> decimal (Just 2) 0.000001234
-- "0.00000123"
--
-- >>> decimal (Just 2) 1234567
-- "1230000"
decimal :: Maybe Int -> Double -> Text
decimal :: Maybe Int -> Double -> Text
decimal Maybe Int
n Double
x = Text
x''
  where
    x' :: Text
x' = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed Maybe Int
forall a. Maybe a
Nothing (Scientific -> String) -> Scientific -> String
forall a b. (a -> b) -> a -> b
$ (Double -> Scientific)
-> (Int -> Double -> Scientific)
-> Maybe Int
-> Double
-> Scientific
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Int -> Double -> Scientific
roundSig Maybe Int
n Double
x
    x'' :: Text
x'' = (\(Text, Text)
x -> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
x' ((Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
x) ((Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
".0")) ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
Text.breakOn Text
"." Text
x'

-- | add commas format for numbers above 1,000 but below 1 million, otherwise use prec.
--
-- >>> comma Nothing 1234.567
-- "1,234.567"
--
-- >>> comma (Just 2) 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 = case Maybe Int
n of
    Maybe Int
Nothing -> Text -> Text
addcomma (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x)
    Just Int
_ -> Text -> Text
addcomma (Maybe Int -> Double -> Text
prec Maybe Int
n Double
x)
  where
    addcomma :: Text -> Text
    addcomma :: Text -> Text
addcomma Text
x = (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, Text) -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Text -> [Text]
Text.chunksOf Int
3 (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
Text.reverse) ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
Text.breakOn Text
"." Text
x

-- | dollars and cents, always decimal notation
--
-- >>> dollar (Just 2) 1234
-- "$1,230"
--
-- >>> dollar (Just 2) 0.01234
-- "$0.0123"
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

-- | fixed percent, always decimal notation
--
-- >>> percent (Just 2) 0.001234
-- "0.123%"
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. Multiplicative a => a -> a -> a
* Double
x)

-- | make text
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 b. (Show a, ConvertText String b) => a -> b
show Double
x)

-- | Provide formatted text for a list of numbers so that they are just distinguished.  'precision commas (Just 2) ticks' means use as much precision as is needed for them to be distinguished, but with at least 2 significant figures.
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
Nothing [Double]
xs = 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
precision Maybe Int -> Double -> Text
f (Just Int
n0) [Double]
xs =
  (Maybe Int -> Double -> Text) -> Int -> [Double] -> [Text]
forall a t a.
(Ord a, Ord t, FromInteger t, Additive t) =>
(Maybe t -> a -> a) -> t -> [a] -> [a]
precLoop Maybe Int -> Double -> Text
f Int
n0 [Double]
xs
  where
    precLoop :: (Maybe t -> a -> a) -> t -> [a] -> [a]
precLoop Maybe t -> a -> a
f' t
n [a]
xs' =
      let s :: [a]
s = Maybe t -> a -> a
f' (t -> Maybe t
forall a. a -> Maybe a
Just t
n) (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs'
       in if [a]
s [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> [a]
forall a. Ord a => [a] -> [a]
nubOrd [a]
s Bool -> Bool -> Bool
|| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
4
            then [a]
s
            else (Maybe t -> a -> a) -> t -> [a] -> [a]
precLoop Maybe t -> a -> a
f' (t
n t -> t -> t
forall a. Additive a => a -> a -> a
+ t
1) [a]
xs'

-- | Consistently format a list of doubles.
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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> String
forall a b. (Show a, ConvertText String b) => a -> b
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' Text
s' (Text -> Int
Text.length Text
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' :: Text
s' = Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x