{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module Formatting.Formatters
(
text,
stext,
string,
shown,
char,
builder,
fconst,
int,
float,
fixed,
sci,
scifmt,
shortest,
groupInt,
commas,
ords,
plural,
asInt,
left,
right,
center,
fitLeft,
fitRight,
base,
bin,
oct,
hex,
prefixBin,
prefixOct,
prefixHex,
bytes,
build,
Buildable,
) where
import Formatting.Internal
import Data.Char (chr, ord)
import Data.Scientific
import qualified Data.Text as S
import qualified Data.Text as T
import Formatting.Buildable (Buildable)
import qualified Formatting.Buildable as B (build)
import qualified Data.Text.Format as T
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as T
import Data.Text.Lazy.Builder.Scientific
import Numeric (showIntAtBase)
text :: Format r (Text -> r)
text :: forall r. Format r (Text -> r)
text = forall a r. (a -> Builder) -> Format r (a -> r)
later Text -> Builder
T.fromLazyText
{-# INLINE text #-}
stext :: Format r (S.Text -> r)
stext :: forall r. Format r (Text -> r)
stext = forall a r. (a -> Builder) -> Format r (a -> r)
later Text -> Builder
T.fromText
{-# INLINE stext #-}
string :: Format r (String -> r)
string :: forall r. Format r ([Char] -> r)
string = forall a r. (a -> Builder) -> Format r (a -> r)
later (Text -> Builder
T.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack)
{-# INLINE string #-}
shown :: Show a => Format r (a -> r)
shown :: forall a r. Show a => Format r (a -> r)
shown = forall a r. (a -> Builder) -> Format r (a -> r)
later (Text -> Builder
T.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show)
{-# INLINE shown #-}
char :: Format r (Char -> r)
char :: forall r. Format r (Char -> r)
char = forall a r. (a -> Builder) -> Format r (a -> r)
later forall p. Buildable p => p -> Builder
B.build
{-# INLINE char #-}
builder :: Format r (Builder -> r)
builder :: forall r. Format r (Builder -> r)
builder = forall a r. (a -> Builder) -> Format r (a -> r)
later forall a. a -> a
id
{-# INLINE builder #-}
fconst :: Builder -> Format r (a -> r)
fconst :: forall r a. Builder -> Format r (a -> r)
fconst Builder
m = forall a r. (a -> Builder) -> Format r (a -> r)
later (forall a b. a -> b -> a
const Builder
m)
{-# INLINE fconst #-}
build :: Buildable a => Format r (a -> r)
build :: forall a r. Buildable a => Format r (a -> r)
build = forall a r. (a -> Builder) -> Format r (a -> r)
later forall p. Buildable p => p -> Builder
B.build
{-# INLINE build #-}
int :: Integral a => Format r (a -> r)
int :: forall a r. Integral a => Format r (a -> r)
int = forall a r. Integral a => Int -> Format r (a -> r)
base Int
10
{-# INLINE int #-}
float :: Real a => Format r (a -> r)
float :: forall a r. Real a => Format r (a -> r)
float = forall a r. (a -> Builder) -> Format r (a -> r)
later forall a. Real a => a -> Builder
T.shortest
{-# INLINE float #-}
fixed :: Real a => Int -> Format r (a -> r)
fixed :: forall a r. Real a => Int -> Format r (a -> r)
fixed Int
i = forall a r. (a -> Builder) -> Format r (a -> r)
later (forall a. Real a => Int -> a -> Builder
T.fixed Int
i)
{-# INLINE fixed #-}
shortest :: Real a => Format r (a -> r)
shortest :: forall a r. Real a => Format r (a -> r)
shortest = forall a r. (a -> Builder) -> Format r (a -> r)
later forall a. Real a => a -> Builder
T.shortest
{-# INLINE shortest #-}
sci :: Format r (Scientific -> r)
sci :: forall r. Format r (Scientific -> r)
sci = forall a r. (a -> Builder) -> Format r (a -> r)
later Scientific -> Builder
scientificBuilder
{-# INLINE sci #-}
scifmt :: FPFormat -> Maybe Int -> Format r (Scientific -> r)
scifmt :: forall r. FPFormat -> Maybe Int -> Format r (Scientific -> r)
scifmt FPFormat
f Maybe Int
i = forall a r. (a -> Builder) -> Format r (a -> r)
later (FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
f Maybe Int
i)
{-# INLINE scifmt #-}
asInt :: Enum a => Format r (a -> r)
asInt :: forall a r. Enum a => Format r (a -> r)
asInt = forall a r. (a -> Builder) -> Format r (a -> r)
later (forall a. Real a => a -> Builder
T.shortest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum)
{-# INLINE asInt #-}
left :: Buildable a => Int -> Char -> Format r (a -> r)
left :: forall a r. Buildable a => Int -> Char -> Format r (a -> r)
left Int
i Char
c = forall a r. (a -> Builder) -> Format r (a -> r)
later (forall a. Buildable a => Int -> Char -> a -> Builder
T.left Int
i Char
c)
{-# INLINE left #-}
right :: Buildable a => Int -> Char -> Format r (a -> r)
right :: forall a r. Buildable a => Int -> Char -> Format r (a -> r)
right Int
i Char
c = forall a r. (a -> Builder) -> Format r (a -> r)
later (forall a. Buildable a => Int -> Char -> a -> Builder
T.right Int
i Char
c)
{-# INLINE right #-}
center :: Buildable a => Int -> Char -> Format r (a -> r)
center :: forall a r. Buildable a => Int -> Char -> Format r (a -> r)
center Int
i Char
c = forall a r. (a -> Builder) -> Format r (a -> r)
later a -> Builder
centerT where
centerT :: a -> Builder
centerT = Text -> Builder
T.fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Char -> Text -> Text
LT.center (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Char
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
T.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
B.build
groupInt :: (Buildable n,Integral n) => Int -> Char -> Format r (n -> r)
groupInt :: forall n r.
(Buildable n, Integral n) =>
Int -> Char -> Format r (n -> r)
groupInt Int
0 Char
_ = forall a r. (a -> Builder) -> Format r (a -> r)
later forall p. Buildable p => p -> Builder
B.build
groupInt Int
i Char
c =
forall a r. (a -> Builder) -> Format r (a -> r)
later
(\n
n ->
if n
n forall a. Ord a => a -> a -> Bool
< n
0
then Builder
"-" forall a. Semigroup a => a -> a -> a
<> n -> Builder
commaize (forall a. Num a => a -> a
negate n
n)
else n -> Builder
commaize n
n)
where
commaize :: n -> Builder
commaize =
Text -> Builder
T.fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text
LT.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)]
LT.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
LT.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
T.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
B.build
zeros :: Text
zeros = Int64 -> Text -> Text
LT.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) (Char -> Text
LT.singleton Char
'0')
zeros' :: Text
zeros' = Char -> Text
LT.singleton Char
c forall a. Semigroup a => a -> a -> a
<> Text -> Text
LT.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
LT.singleton Char
c forall a. Semigroup a => a -> a -> a
<> Char -> Text
LT.singleton Char
c' forall a. Semigroup a => a -> a -> a
<> Text
rest
| Bool
otherwise = Char -> Text
LT.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
fitLeft :: Buildable a => Int -> Format r (a -> r)
fitLeft :: forall a r. Buildable a => Int -> Format r (a -> r)
fitLeft Int
size = forall a r. (a -> Builder) -> Format r (a -> r)
later (forall {a}. Buildable a => Int64 -> a -> Builder
fit (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)) where
fit :: Int64 -> a -> Builder
fit Int64
i = Text -> Builder
T.fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Text -> Text
LT.take Int64
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
T.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
B.build
fitRight :: Buildable a => Int -> Format r (a -> r)
fitRight :: forall a r. Buildable a => Int -> Format r (a -> r)
fitRight Int
size = forall a r. (a -> Builder) -> Format r (a -> r)
later (forall {a}. Buildable a => Int64 -> a -> Builder
fit (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)) where
fit :: Int64 -> a -> Builder
fit Int64
i = Text -> Builder
T.fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\Text
t -> Int64 -> Text -> Text
LT.drop (Text -> Int64
LT.length Text
t forall a. Num a => a -> a -> a
- Int64
i) Text
t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
T.toLazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
B.build
commas :: (Buildable n,Integral n) => Format r (n -> r)
commas :: forall n r. (Buildable n, Integral n) => Format r (n -> r)
commas = forall n r.
(Buildable n, Integral n) =>
Int -> Char -> Format r (n -> r)
groupInt Int
3 Char
','
{-# INLINE commas #-}
ords :: Integral n => Format r (n -> r)
ords :: forall a r. Integral a => Format r (a -> r)
ords = forall a r. (a -> Builder) -> Format r (a -> r)
later forall {a}. Integral a => a -> Builder
go
where go :: a -> Builder
go 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 a. Real a => Int -> a -> Builder
T.fixed Int
0 a
n forall a. Semigroup a => a -> a -> a
<> Builder
"th"
| Bool
otherwise =
forall a. Real a => Int -> a -> Builder
T.fixed Int
0 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
plural :: (Num a, Eq a) => Text -> Text -> Format r (a -> r)
plural :: forall a r. (Num a, Eq a) => Text -> Text -> Format r (a -> r)
plural Text
s Text
p = forall a r. (a -> Builder) -> Format r (a -> r)
later (\a
i -> if a
i forall a. Eq a => a -> a -> Bool
== a
1 then forall p. Buildable p => p -> Builder
B.build Text
s else forall p. Buildable p => p -> Builder
B.build Text
p)
base :: Integral a => Int -> Format r (a -> r)
base :: forall a r. Integral a => Int -> Format r (a -> r)
base Int
numBase = forall a r. (a -> Builder) -> Format r (a -> r)
later (forall p. Buildable p => p -> Builder
B.build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Int -> a -> [Char]
atBase Int
numBase)
{-# INLINE base #-}
bin :: Integral a => Format r (a -> r)
bin :: forall a r. Integral a => Format r (a -> r)
bin = forall a r. Integral a => Int -> Format r (a -> r)
base Int
2
{-# INLINE bin #-}
oct :: Integral a => Format r (a -> r)
oct :: forall a r. Integral a => Format r (a -> r)
oct = forall a r. Integral a => Int -> Format r (a -> r)
base Int
8
{-# INLINE oct #-}
hex :: Integral a => Format r (a -> r)
hex :: forall a r. Integral a => Format r (a -> r)
hex = forall a r. (a -> Builder) -> Format r (a -> r)
later forall {a}. Integral a => a -> Builder
T.hex
{-# INLINE hex #-}
prefixBin :: Integral a => Format r (a -> r)
prefixBin :: forall a r. Integral a => Format r (a -> r)
prefixBin = Format (a -> r) (a -> r)
"0b" forall r a r'. Format r a -> Format r' r -> Format r' a
% forall a r. Integral a => Format r (a -> r)
bin
{-# INLINE prefixBin #-}
prefixOct :: Integral a => Format r (a -> r)
prefixOct :: forall a r. Integral a => Format r (a -> r)
prefixOct = Format (a -> r) (a -> r)
"0o" forall r a r'. Format r a -> Format r' r -> Format r' a
% forall a r. Integral a => Format r (a -> r)
oct
{-# INLINE prefixOct #-}
prefixHex :: Integral a => Format r (a -> r)
prefixHex :: forall a r. Integral a => Format r (a -> r)
prefixHex = Format (a -> r) (a -> r)
"0x" forall r a r'. Format r a -> Format r' r -> Format r' a
% forall a r. Integral a => Format r (a -> r)
hex
{-# INLINE prefixHex #-}
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]
"base: 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)
bytes :: (Ord f,Integral a,Fractional f)
=> Format Builder (f -> Builder)
-> Format r (a -> r)
bytes :: forall f a r.
(Ord f, Integral a, Fractional f) =>
Format Builder (f -> Builder) -> Format r (a -> r)
bytes Format Builder (f -> Builder)
d = forall a r. (a -> Builder) -> Format r (a -> r)
later forall {a}. Integral a => a -> Builder
go
where go :: a -> Builder
go a
bs =
forall a. Format Builder a -> a
bprint Format Builder (f -> Builder)
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
signum a
bs) forall a. Num a => a -> a -> a
* f
dec) forall a. Semigroup a => a -> a -> a
<> [Builder]
bytesSuffixes forall a. [a] -> Int -> a
!!
Int
i
where (f
dec,Int
i) = forall {a} {a}. (Fractional a, Integral a, Ord a) => a -> (a, Int)
getSuffix (forall a. Num a => a -> a
abs a
bs)
getSuffix :: a -> (a, Int)
getSuffix a
n =
forall a. (a -> Bool) -> (a -> a) -> a -> a
until forall {a}. (Ord a, Num a) => (a, Int) -> Bool
p
(\(a
x,Int
y) -> (a
x forall a. Fractional a => a -> a -> a
/ a
1024,Int
y forall a. Num a => a -> a -> a
+ Int
1))
(forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n,Int
0)
where p :: (a, Int) -> Bool
p (a
n',Int
numDivs) =
a
n' forall a. Ord a => a -> a -> Bool
< a
1024 Bool -> Bool -> Bool
|| Int
numDivs forall a. Eq a => a -> a -> Bool
== (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
bytesSuffixes forall a. Num a => a -> a -> a
- Int
1)
bytesSuffixes :: [Builder]
bytesSuffixes =
[Builder
"B",Builder
"KB",Builder
"MB",Builder
"GB",Builder
"TB",Builder
"PB",Builder
"EB",Builder
"ZB",Builder
"YB"]