{-# LANGUAGE CPP, OverloadedStrings, Safe #-}
module Data.Text.Lazy.Builder.Scientific
( scientificBuilder
, formatScientificBuilder
, FPFormat(..)
) where
import Data.Scientific (Scientific)
import qualified Data.Scientific as Scientific
import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
import Data.Text.Lazy.Builder (Builder, fromString, singleton, fromText)
import Data.Text.Lazy.Builder.Int (decimal)
import qualified Data.Text as T (replicate)
import Utils (roundTo, i2d)
#if MIN_VERSION_base(4,5,0)
import Data.Monoid ((<>))
#else
import Data.Monoid (Monoid, mappend)
(<>) :: Monoid a => a -> a -> a
(<>) = mappend
infixr 6 <>
#endif
scientificBuilder :: Scientific -> Builder
scientificBuilder :: Scientific -> Builder
scientificBuilder = FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
Generic forall a. Maybe a
Nothing
formatScientificBuilder :: FPFormat
-> Maybe Int
-> Scientific
-> Builder
formatScientificBuilder :: FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
fmt Maybe Int
decs Scientific
scntfc
| Scientific
scntfc forall a. Ord a => a -> a -> Bool
< Scientific
0 = Char -> Builder
singleton Char
'-' forall a. Semigroup a => a -> a -> a
<> FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (Scientific -> ([Int], Int)
Scientific.toDecimalDigits (-Scientific
scntfc))
| Bool
otherwise = FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (Scientific -> ([Int], Int)
Scientific.toDecimalDigits Scientific
scntfc)
where
doFmt :: FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
format ([Int]
is, Int
e) =
let ds :: [Char]
ds = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is in
case FPFormat
format of
FPFormat
Generic ->
FPFormat -> ([Int], Int) -> Builder
doFmt (if Int
e forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
> Int
7 then FPFormat
Exponent else FPFormat
Fixed)
([Int]
is,Int
e)
FPFormat
Exponent ->
case Maybe Int
decs of
Maybe Int
Nothing ->
let show_e' :: Builder
show_e' = forall a. Integral a => a -> Builder
decimal (Int
eforall a. Num a => a -> a -> a
-Int
1) in
case [Char]
ds of
[Char]
"0" -> Builder
"0.0e0"
[Char
d] -> Char -> Builder
singleton Char
d forall a. Semigroup a => a -> a -> a
<> Builder
".0e" forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
(Char
d:[Char]
ds') -> Char -> Builder
singleton Char
d forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
ds' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'e' forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
[] -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Text.Lazy.Builder.Scientific.formatScientificBuilder" forall a. [a] -> [a] -> [a]
++
[Char]
"/doFmt/Exponent: []"
Just Int
dec ->
let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
1 in
case [Int]
is of
[Int
0] -> Builder
"0." forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate Int
dec' Text
"0") forall a. Semigroup a => a -> a -> a
<> Builder
"e0"
[Int]
_ ->
let
(Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec'forall a. Num a => a -> a -> a
+Int
1) [Int]
is
(Char
d:[Char]
ds') = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
in
Char -> Builder
singleton Char
d forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
ds' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'e' forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
decimal (Int
eforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
ei)
FPFormat
Fixed ->
let
mk0 :: [Char] -> Builder
mk0 [Char]
ls = case [Char]
ls of { [Char]
"" -> Builder
"0" ; [Char]
_ -> [Char] -> Builder
fromString [Char]
ls}
in
case Maybe Int
decs of
Maybe Int
Nothing
| Int
e forall a. Ord a => a -> a -> Bool
<= Int
0 -> Builder
"0." forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (-Int
e) Text
"0") forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
ds
| Bool
otherwise ->
let
f :: t -> [Char] -> [Char] -> Builder
f t
0 [Char]
s [Char]
rs = [Char] -> Builder
mk0 (forall a. [a] -> [a]
reverse [Char]
s) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
mk0 [Char]
rs
f t
n [Char]
s [Char]
"" = t -> [Char] -> [Char] -> Builder
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
'0'forall a. a -> [a] -> [a]
:[Char]
s) [Char]
""
f t
n [Char]
s (Char
r:[Char]
rs) = t -> [Char] -> [Char] -> Builder
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
rforall a. a -> [a] -> [a]
:[Char]
s) [Char]
rs
in
forall {t}. (Eq t, Num t) => t -> [Char] -> [Char] -> Builder
f Int
e [Char]
"" [Char]
ds
Just Int
dec ->
let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
0 in
if Int
e forall a. Ord a => a -> a -> Bool
>= Int
0 then
let
(Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec' forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
([Char]
ls,[Char]
rs) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eforall a. Num a => a -> a -> a
+Int
ei) (forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is')
in
[Char] -> Builder
mk0 [Char]
ls forall a. Semigroup a => a -> a -> a
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rs then Builder
"" else Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
rs)
else
let
(Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo Int
dec' (forall a. Int -> a -> [a]
replicate (-Int
e) Int
0 forall a. [a] -> [a] -> [a]
++ [Int]
is)
Char
d:[Char]
ds' = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then [Int]
is' else Int
0forall a. a -> [a] -> [a]
:[Int]
is')
in
Char -> Builder
singleton Char
d forall a. Semigroup a => a -> a -> a
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ds' then Builder
"" else Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
ds')