{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}


module Fmt.Internal.Numeric where


import           Data.CallStack
#if __GLASGOW_HASKELL__ < 804
import           Data.Monoid ((<>))
#endif
import           Numeric
import           Data.Char
import           Data.Text.Lazy.Builder hiding (fromString)
import           Formatting.Buildable (Buildable(..))
import qualified Formatting.Internal.Raw as F
import qualified Data.Text.Lazy as TL


-- $setup
-- >>> import Fmt

----------------------------------------------------------------------------
-- Integer
----------------------------------------------------------------------------

{- |
Format a number as octal:

>>> listF' octF [7,8,9,10]
"[7, 10, 11, 12]"
-}
octF :: Integral a => a -> Builder
octF :: a -> Builder
octF = Int -> a -> Builder
forall a. (HasCallStack, Integral a) => Int -> a -> Builder
baseF Int
8

{- |
Format a number as binary:

>>> listF' binF [7,8,9,10]
"[111, 1000, 1001, 1010]"
-}
binF :: Integral a => a -> Builder
binF :: a -> Builder
binF = Int -> a -> Builder
forall a. (HasCallStack, Integral a) => Int -> a -> Builder
baseF Int
2

{- |
Format a number in arbitrary base (up to 36):

>>> baseF 3 10000
"111201101"
>>> baseF 7 10000
"41104"
>>> baseF 36 10000
"7ps"
-}
baseF :: (HasCallStack, Integral a) => Int -> a -> Builder
baseF :: Int -> a -> Builder
baseF Int
numBase = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder) -> (a -> String) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> String
forall a. Integral a => Int -> a -> String
atBase Int
numBase

----------------------------------------------------------------------------
-- Floating-point
----------------------------------------------------------------------------

{- |
Format a floating-point number:

>>> floatF 3.1415
"3.1415"

Numbers smaller than 1e-6 or bigger-or-equal to 1e21 will be displayed using
scientific notation:

>>> listF' floatF [-1.2,-12.2]
"[-1.2, -12.2]"
>>> listF' floatF [1e-6,9e-7]
"[0.000001, 9.0e-7]"
>>> listF' floatF [9e20,1e21]
"[900000000000000000000.0, 1.0e21]"
-}
floatF :: Real a => a -> Builder
floatF :: a -> Builder
floatF a
a | Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0                 = Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
forall a. Real a => a -> Builder
floatF (-Double
d)
         | Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e-6 Bool -> Bool -> Bool
|| Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e21 = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat Maybe Int
forall a. Maybe a
Nothing Double
d String
""
         | Bool
otherwise             = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Double
d String
""
  where d :: Double
d = a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
a :: Double

{- | Format a floating-point number using scientific notation, with the given
amount of decimal places.

>>> listF' (exptF 5) [pi,0.1,10]
"[3.14159e0, 1.00000e-1, 1.00000e1]"
-}
exptF :: Real a => Int -> a -> Builder
exptF :: Int -> a -> Builder
exptF Int
decs a
a = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
decs) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
a :: Double) String
""

{- |
Format a floating-point number without scientific notation:

>>> listF' (fixedF 5) [pi,0.1,10]
"[3.14159, 0.10000, 10.00000]"
-}
fixedF :: Real a => Int -> a -> Builder
fixedF :: Int -> a -> Builder
fixedF = Int -> a -> Builder
forall a. Real a => Int -> a -> Builder
F.fixed

----------------------------------------------------------------------------
-- Other
----------------------------------------------------------------------------

{- |
Break digits in a number:

>>> commaizeF 15830000
"15,830,000"
-}
commaizeF :: (Buildable a, Integral a) => a -> Builder
commaizeF :: a -> Builder
commaizeF = Int -> Char -> a -> Builder
forall a. (Buildable a, Integral a) => Int -> Char -> a -> Builder
groupInt Int
3 Char
','

{- |
Add an ordinal suffix to a number:

>>> ordinalF 15
"15th"
>>> ordinalF 22
"22nd"
-}
ordinalF :: (Buildable a, Integral a) => a -> Builder
ordinalF :: a -> Builder
ordinalF a
n
  | a
tens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
3 Bool -> Bool -> Bool
&& a
tens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
21 = a -> Builder
forall p. Buildable p => p -> Builder
build a
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"th"
  | Bool
otherwise = a -> Builder
forall p. Buildable p => p -> Builder
build a
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
10 of
                             a
1 -> Builder
"st"
                             a
2 -> Builder
"nd"
                             a
3 -> Builder
"rd"
                             a
_ -> Builder
"th"
  where
    tens :: a
tens = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
100

----------------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------------

groupInt :: (Buildable a, Integral a) => Int -> Char -> a -> Builder
groupInt :: Int -> Char -> a -> Builder
groupInt Int
0 Char
_ a
n = a -> Builder
forall p. Buildable p => p -> Builder
build a
n
groupInt Int
i Char
c a
n =
    Text -> Builder
fromLazyText (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.reverse (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Char, Char) -> Text -> Text) -> Text -> [(Char, Char)] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char, Char) -> Text -> Text
merge Text
"" ([(Char, Char)] -> Text) -> (a -> [(Char, Char)]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> [(Char, Char)]
TL.zip (Text
zeros Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall t. Semigroup t => t -> t
cycle' Text
zeros') (Text -> [(Char, Char)]) -> (a -> Text) -> a -> [(Char, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text
TL.reverse (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Builder -> Text
toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
build
      (a -> Builder) -> a -> Builder
forall a b. (a -> b) -> a -> b
$ a
n
  where
    zeros :: Text
zeros = Int64 -> Text -> Text
TL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) (Char -> Text
TL.singleton Char
'0')
    zeros' :: Text
zeros' = Char -> Text
TL.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TL.tail Text
zeros
    merge :: (Char, Char) -> Text -> Text
merge (Char
f, Char
c') Text
rest
      | Char
f Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = Char -> Text
TL.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
TL.singleton Char
c' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest
      | Bool
otherwise = Char -> Text
TL.singleton Char
c' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest
    cycle' :: t -> t
cycle' t
xs = t
xs t -> t -> t
forall a. Semigroup a => a -> a -> a
<> t -> t
cycle' t
xs
    -- Suppress the warning about redundant Integral constraint
    Integer
_ = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n

atBase :: Integral a => Int -> a -> String
atBase :: Int -> a -> String
atBase Int
b a
_ | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
|| Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
36 = ShowS
forall a. HasCallStack => String -> a
error (String
"baseF: Invalid base " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b)
atBase Int
b a
n =
  (Integer -> ShowS) -> Integer -> ShowS
forall a. Real a => (a -> ShowS) -> a -> ShowS
showSigned' (Integer -> (Int -> Char) -> Integer -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
b) Int -> Char
intToDigit') (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n) String
""
{-# INLINE atBase #-}

showSigned' :: Real a => (a -> ShowS) -> a -> ShowS
showSigned' :: (a -> ShowS) -> a -> ShowS
showSigned' a -> ShowS
f a
n
  | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = Char -> ShowS
showChar Char
'-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f (a -> a
forall a. Num a => a -> a
negate a
n)
  | Bool
otherwise = a -> ShowS
f a
n

intToDigit' :: Int -> Char
intToDigit' :: Int -> Char
intToDigit' Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0  Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
chr (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
chr (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
  | Bool
otherwise = String -> Char
forall a. HasCallStack => String -> a
error (String
"intToDigit': Invalid int " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)