{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RebindableSyntax #-}
{-# 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.Generics.Labels ()
import Data.List (nub)
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.0Double -> 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 = Text
"0"
  | 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 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 t a a.
(Ord t, FromInteger t, Additive t, Eq a) =>
(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. Eq a => [a] -> [a]
nub [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