{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# 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 #-}
module Data.FormatN
( FormatN (..),
defaultFormatN,
fromFormatN,
toFormatN,
fixed,
decimal,
prec,
comma,
expt,
dollar,
percent,
formatN,
precision,
formatNs,
showOr,
roundSig,
)
where
import Data.Bifunctor
import Data.Bool
import Data.Containers.ListUtils (nubOrd)
import Data.Foldable
import Data.Generics.Labels ()
import Data.Scientific
import Data.String
import Data.Text (Text, pack)
import qualified Data.Text as Text
import GHC.Generics hiding (prec)
import Prelude
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)
defaultFormatN :: FormatN
defaultFormatN :: FormatN
defaultFormatN = Maybe Int -> FormatN
FormatComma (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)
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"
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
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)
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)
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. Num 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. Num a => a -> a -> a
+ Int
1) [Int]
ds
r :: Double
r =
(Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
x Int
a -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a) Int
0 [Int]
ds0 :: Double)
Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
x Int
a -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a) Int
0 [Int]
ds1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10.0 Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ds1)
r' :: Integer
r' = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Double
r :: Integer
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
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'
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 (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
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 b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> (Text, Text) -> (Text, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text
Text.reverse (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
Text.chunksOf Int
3 (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.reverse) ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
Text.breakOn Text
"." Text
x
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
percent :: Maybe Int -> Double -> Text
percent :: Maybe Int -> Double -> Text
percent Maybe Int
n Double
x = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> Text
decimal Maybe Int
n (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
formatN :: FormatN -> Double -> Text
formatN :: FormatN -> Double -> Text
formatN (FormatFixed Maybe Int
n) Double
x = Maybe Int -> Double -> Text
fixed Maybe Int
n Double
x
formatN (FormatDecimal Maybe Int
n) Double
x = Maybe Int -> Double -> Text
decimal Maybe Int
n Double
x
formatN (FormatPrec Maybe Int
n) Double
x = Maybe Int -> Double -> Text
prec Maybe Int
n Double
x
formatN (FormatComma Maybe Int
n) Double
x = Maybe Int -> Double -> Text
comma Maybe Int
n Double
x
formatN (FormatExpt Maybe Int
n) Double
x = Maybe Int -> Double -> Text
expt Maybe Int
n Double
x
formatN (FormatDollar Maybe Int
n) Double
x = Maybe Int -> Double -> Text
dollar Maybe Int
n Double
x
formatN (FormatPercent Maybe Int
n) Double
x = Maybe Int -> Double -> Text
percent Maybe Int
n Double
x
formatN FormatN
FormatNone Double
x = String -> Text
pack (Double -> String
forall a. Show a => a -> String
show Double
x)
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, Num 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. Num a => a -> a -> a
+ t
1) [a]
xs'
formatNs :: FormatN -> [Double] -> [Text]
formatNs :: FormatN -> [Double] -> [Text]
formatNs (FormatFixed Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
fixed Maybe Int
n [Double]
xs
formatNs (FormatDecimal Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
decimal Maybe Int
n [Double]
xs
formatNs (FormatPrec Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
prec Maybe Int
n [Double]
xs
formatNs (FormatComma Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
comma Maybe Int
n [Double]
xs
formatNs (FormatExpt Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
expt Maybe Int
n [Double]
xs
formatNs (FormatDollar Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
dollar Maybe Int
n [Double]
xs
formatNs (FormatPercent Maybe Int
n) [Double]
xs = (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text]
precision Maybe Int -> Double -> Text
percent Maybe Int
n [Double]
xs
formatNs FormatN
FormatNone [Double]
xs = String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> Text) -> [Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs
showOr :: FormatN -> Double -> Text
showOr :: FormatN -> Double -> Text
showOr FormatN
f Double
x = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
f' (String -> Text
pack String
s') (Text -> Int
Text.length (String -> Text
pack String
s') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
Text.length Text
f')) Text
"0" (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e-6 Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> -Double
1e-6)
where
f' :: Text
f' = FormatN -> Double -> Text
formatN FormatN
f Double
x
s' :: String
s' = Double -> String
forall a. Show a => a -> String
show Double
x