{-# 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-type-defaults #-}

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

import Data.Generics.Labels ()
import Data.List (nub)
import Data.Scientific
import qualified Data.Text as Text
import NumHask.Prelude

-- | Wrapper for the various formatting options.
--
-- >>> defaultFormatN
-- FormatComma 2
data FormatN
  = FormatFixed Int
  | FormatDecimal Int
  | FormatComma Int
  | FormatExpt Int
  | FormatPrec Int
  | FormatDollar Int
  | FormatPercent 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 = Int -> FormatN
FormatComma Int
2

-- | make text
formatN :: FormatN -> Double -> Text
formatN :: FormatN -> Double -> Text
formatN (FormatFixed Int
n) Double
x = Int -> Double -> Text
fixed Int
n Double
x
formatN (FormatDecimal Int
n) Double
x = Int -> Double -> Text
decimal Int
n Double
x
formatN (FormatPrec Int
n) Double
x = Int -> Double -> Text
prec Int
n Double
x
formatN (FormatComma Int
n) Double
x = Int -> Double -> Text
comma Int
n Double
x
formatN (FormatExpt Int
n) Double
x = Int -> Double -> Text
expt Int
n Double
x
formatN (FormatDollar Int
n) Double
x = Int -> Double -> Text
dollar Int
n Double
x
formatN (FormatPercent Int
n) Double
x = Int -> Double -> Text
percent 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)

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

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

-- | to x decimal places
--
-- >>> fixed 2 1
-- "1.00"
--
-- >>> fixed 2 0.001
-- "0.00"
fixed :: Int -> Double -> Text
fixed :: Int -> Double -> Text
fixed 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 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x) (Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
n)

-- | scientific exponential
--
-- >>> expt 2 1234
-- "1.23e3"
expt :: Int -> Double -> Text
expt :: Int -> Double -> Text
expt 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 (Int -> Maybe Int
forall a. a -> Maybe a
Just 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 :: Int))
    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 1 0.00234
-- "0.0023"
--
-- >>> prec 1 0.000023
-- "2.3e-5"
--
-- >>> prec 1 123
-- "120"
--
-- >>> prec 1 123456
-- "120000"
--
-- >>> prec 1 1234567
-- "1.2e6"
prec :: Int -> Double -> Text
prec :: Int -> Double -> Text
prec 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
<> Int -> Double -> Text
prec 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 = Int -> Double -> Text
expt Int
n Double
x
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e6 = Int -> Double -> Text
expt Int
n Double
x
  | Bool
otherwise = Int -> Double -> Text
decimal 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 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Double
x

-- | round to n significant figures and always use decimal notation
--
-- >>> decimal 2 0.000001234
-- "0.00000123"
--
-- >>> decimal 2 1234567
-- "1230000"
decimal :: Int -> Double -> Text
decimal :: Int -> Double -> Text
decimal 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 (Int -> Maybe Int
forall a. a -> Maybe a
Just 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 2 1234
-- "1,230"
comma :: Int -> Double -> Text
comma :: Int -> Double -> Text
comma 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
<> Int -> Double -> Text
comma 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 = Int -> Double -> Text
prec Int
n Double
x
  | Bool
otherwise = Text -> Text
addcomma (Int -> Double -> Text
prec Int
n Double
x)
  where
    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 2 1234
-- "$1,230"
--
-- >>> dollar 2 0.01234
-- "$0.0123"
dollar :: Int -> Double -> Text
dollar :: Int -> Double -> Text
dollar 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
<> Int -> Double -> Text
dollar Int
n (- Double
x)
  | Bool
otherwise = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Double -> Text
comma Int
n Double
x

-- | fixed percent, always decimal notation
--
-- >>> percent 2 0.001234
-- "0.123%"
percent :: Int -> Double -> Text
percent :: Int -> Double -> Text
percent 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
$ Int -> Double -> Text
decimal Int
n (Double
100 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* 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 :: (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision :: (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision Int -> Double -> Text
f Int
n0 [Double]
xs =
  (Int -> Double -> Text) -> Int -> [Double] -> [Text]
forall t a a.
(Ord t, FromInteger t, Additive t, Eq a) =>
(t -> a -> a) -> t -> [a] -> [a]
precLoop Int -> Double -> Text
f Int
n0 [Double]
xs
  where
    precLoop :: (t -> a -> a) -> t -> [a] -> [a]
precLoop t -> a -> a
f' t
n [a]
xs' =
      let s :: [a]
s = t -> a -> a
f' 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 (t -> a -> a) -> t -> [a] -> [a]
precLoop 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 Int
n) [Double]
xs = (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision Int -> Double -> Text
fixed Int
n [Double]
xs
formatNs (FormatDecimal Int
n) [Double]
xs = (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision Int -> Double -> Text
decimal Int
n [Double]
xs
formatNs (FormatPrec Int
n) [Double]
xs = (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision Int -> Double -> Text
prec Int
n [Double]
xs
formatNs (FormatComma Int
n) [Double]
xs = (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision Int -> Double -> Text
comma Int
n [Double]
xs
formatNs (FormatExpt Int
n) [Double]
xs = (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision Int -> Double -> Text
expt Int
n [Double]
xs
formatNs (FormatDollar Int
n) [Double]
xs = (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision Int -> Double -> Text
dollar Int
n [Double]
xs
formatNs (FormatPercent Int
n) [Double]
xs = (Int -> Double -> Text) -> Int -> [Double] -> [Text]
precision Int -> Double -> Text
percent 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