{-# 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
octF :: Integral a => a -> Builder
octF :: forall a. Integral a => a -> Builder
octF = forall a. (HasCallStack, Integral a) => Int -> a -> Builder
baseF Int
8
binF :: Integral a => a -> Builder
binF :: forall a. Integral a => a -> Builder
binF = forall a. (HasCallStack, Integral a) => Int -> a -> Builder
baseF Int
2
baseF :: (HasCallStack, Integral a) => Int -> a -> Builder
baseF :: forall a. (HasCallStack, Integral a) => Int -> a -> Builder
baseF Int
numBase = forall p. Buildable p => p -> Builder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Int -> a -> [Char]
atBase Int
numBase
floatF :: Real a => a -> Builder
floatF :: forall a. Real a => a -> Builder
floatF a
a | Double
d forall a. Ord a => a -> a -> Bool
< Double
0 = Builder
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Real a => a -> Builder
floatF (-Double
d)
| Double
d forall a. Ord a => a -> a -> Bool
< Double
1e-6 Bool -> Bool -> Bool
|| Double
d forall a. Ord a => a -> a -> Bool
>= Double
1e21 = forall p. Buildable p => p -> Builder
build forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat forall a. Maybe a
Nothing Double
d [Char]
""
| Bool
otherwise = forall p. Buildable p => p -> Builder
build forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat forall a. Maybe a
Nothing Double
d [Char]
""
where d :: Double
d = forall a b. (Real a, Fractional b) => a -> b
realToFrac a
a :: Double
exptF :: Real a => Int -> a -> Builder
exptF :: forall a. Real a => Int -> a -> Builder
exptF Int
decs a
a = forall p. Buildable p => p -> Builder
build forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (forall a. a -> Maybe a
Just Int
decs) (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
a :: Double) [Char]
""
fixedF :: Real a => Int -> a -> Builder
fixedF :: forall a. Real a => Int -> a -> Builder
fixedF = forall a. Real a => Int -> a -> Builder
F.fixed
commaizeF :: (Buildable a, Integral a) => a -> Builder
commaizeF :: forall a. (Buildable a, Integral a) => a -> Builder
commaizeF = forall a. (Buildable a, Integral a) => Int -> Char -> a -> Builder
groupInt Int
3 Char
','
ordinalF :: (Buildable a, Integral a) => a -> Builder
ordinalF :: forall a. (Buildable a, Integral a) => a -> Builder
ordinalF a
n
| a
tens forall a. Ord a => a -> a -> Bool
> a
3 Bool -> Bool -> Bool
&& a
tens forall a. Ord a => a -> a -> Bool
< a
21 = forall p. Buildable p => p -> Builder
build a
n forall a. Semigroup a => a -> a -> a
<> Builder
"th"
| Bool
otherwise = forall p. Buildable p => p -> Builder
build a
n forall a. Semigroup a => a -> a -> a
<> case a
n 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 forall a. Integral a => a -> a -> a
`mod` a
100
groupInt :: (Buildable a, Integral a) => Int -> Char -> a -> Builder
groupInt :: forall a. (Buildable a, Integral a) => Int -> Char -> a -> Builder
groupInt Int
0 Char
_ a
n = forall p. Buildable p => p -> Builder
build a
n
groupInt Int
i Char
c a
n =
Text -> Builder
fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char, Char) -> Text -> Text
merge Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text -> [(Char, Char)]
TL.zip (Text
zeros forall a. Semigroup a => a -> a -> a
<> forall {t}. Semigroup t => t -> t
cycle' Text
zeros') forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text
TL.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
build
forall a b. (a -> b) -> a -> b
$ a
n
where
zeros :: Text
zeros = Int64 -> Text -> Text
TL.replicate (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 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 forall a. Eq a => a -> a -> Bool
== Char
c = Char -> Text
TL.singleton Char
c forall a. Semigroup a => a -> a -> a
<> Char -> Text
TL.singleton Char
c' forall a. Semigroup a => a -> a -> a
<> Text
rest
| Bool
otherwise = Char -> Text
TL.singleton Char
c' forall a. Semigroup a => a -> a -> a
<> Text
rest
cycle' :: t -> t
cycle' t
xs = t
xs forall a. Semigroup a => a -> a -> a
<> t -> t
cycle' t
xs
Integer
_ = forall a. Integral a => a -> Integer
toInteger a
n
atBase :: Integral a => Int -> a -> String
atBase :: forall a. Integral a => Int -> a -> [Char]
atBase Int
b a
_ | Int
b forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
|| Int
b forall a. Ord a => a -> a -> Bool
> Int
36 = forall a. HasCallStack => [Char] -> a
error ([Char]
"baseF: Invalid base " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
b)
atBase Int
b a
n =
forall a. Real a => (a -> ShowS) -> a -> ShowS
showSigned' (forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase (forall a. Integral a => a -> Integer
toInteger Int
b) Int -> Char
intToDigit') (forall a. Integral a => a -> Integer
toInteger a
n) [Char]
""
{-# INLINE atBase #-}
showSigned' :: Real a => (a -> ShowS) -> a -> ShowS
showSigned' :: forall a. Real a => (a -> ShowS) -> a -> ShowS
showSigned' a -> ShowS
f a
n
| a
n forall a. Ord a => a -> a -> Bool
< a
0 = Char -> ShowS
showChar Char
'-' forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f (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 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
chr (Char -> Int
ord Char
'0' forall a. Num a => a -> a -> a
+ Int
i)
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
10 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
chr (Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ Int
i forall a. Num a => a -> a -> a
- Int
10)
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error ([Char]
"intToDigit': Invalid int " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i)