{-# LANGUAGE OverloadedStrings, Safe #-}

module Data.ByteString.Builder.Scientific
    ( scientificBuilder
    , formatScientificBuilder
    , FPFormat(..)
    ) where

import           Data.Scientific   (Scientific)
import qualified Data.Scientific as Scientific

import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

import qualified Data.ByteString.Char8 as BC8
import           Data.ByteString.Builder (Builder, string8, char8, intDec)
import           Data.ByteString.Builder.Extra (byteStringCopy)

import Utils (roundTo, i2d)

import Data.Monoid                  ((<>))


-- | A @ByteString@ @Builder@ which renders a scientific number to full
-- precision, using standard decimal notation for arguments whose
-- absolute value lies between @0.1@ and @9,999,999@, and scientific
-- notation otherwise.
scientificBuilder :: Scientific -> Builder
scientificBuilder :: Scientific -> Builder
scientificBuilder = FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
Generic Maybe Int
forall a. Maybe a
Nothing

-- | Like 'scientificBuilder' but provides rendering options.
formatScientificBuilder :: FPFormat
                        -> Maybe Int  -- ^ Number of decimal places to render.
                        -> Scientific
                        -> Builder
formatScientificBuilder :: FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
fmt Maybe Int
decs Scientific
scntfc
   | Scientific
scntfc Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
0 = Char -> Builder
char8 Char
'-' Builder -> Builder -> Builder
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 = (Int -> Char) -> [Int] -> [Char]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
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' = Int -> Builder
intDec (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) in
        case [Char]
ds of
          [Char]
"0"     -> ByteString -> Builder
byteStringCopy ByteString
"0.0e0"
          [Char
d]     -> Char -> Builder
char8 Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteStringCopy ByteString
".0e" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
          (Char
d:[Char]
ds') -> Char -> Builder
char8 Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
string8 [Char]
ds' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
'e' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
          []      -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.ByteString.Builder.Scientific.formatScientificBuilder" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
"/doFmt/Exponent: []"
       Just Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec Int
1 in
        case [Int]
is of
         [Int
0] -> ByteString -> Builder
byteStringCopy ByteString
"0." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                ByteString -> Builder
byteStringCopy (Int -> Char -> ByteString
BC8.replicate Int
dec' Char
'0') Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                ByteString -> Builder
byteStringCopy ByteString
"e0"
         [Int]
_ ->
          let
           (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
is
           (Char
d:[Char]
ds') = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
init [Int]
is' else [Int]
is')
          in
          Char -> Builder
char8 Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
string8 [Char]
ds' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
'e' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
     FPFormat
Fixed ->
      let
       mk0 :: [Char] -> Builder
mk0 [Char]
ls = case [Char]
ls of { [Char]
"" -> Char -> Builder
char8 Char
'0' ; [Char]
_ -> [Char] -> Builder
string8 [Char]
ls}
      in
      case Maybe Int
decs of
       Maybe Int
Nothing
          | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    -> ByteString -> Builder
byteStringCopy ByteString
"0." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                         ByteString -> Builder
byteStringCopy (Int -> Char -> ByteString
BC8.replicate (-Int
e) Char
'0') Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                         [Char] -> Builder
string8 [Char]
ds
          | Bool
otherwise ->
             let
                f :: t -> [Char] -> [Char] -> Builder
f t
0 [Char]
s    [Char]
rs  = [Char] -> Builder
mk0 ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
mk0 [Char]
rs
                f t
n [Char]
s    [Char]
""  = t -> [Char] -> [Char] -> Builder
f (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (Char
'0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
s) [Char]
""
                f t
n [Char]
s (Char
r:[Char]
rs) = t -> [Char] -> [Char] -> Builder
f (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (Char
rChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
s) [Char]
rs
             in
                Int -> [Char] -> [Char] -> Builder
forall {t}. (Eq t, Num t) => t -> [Char] -> [Char] -> Builder
f Int
e [Char]
"" [Char]
ds
       Just Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec Int
0 in
        if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
         let
          (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
          ([Char]
ls,[Char]
rs)  = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei) ((Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is')
         in
         [Char] -> Builder
mk0 [Char]
ls Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rs then Builder
forall a. Monoid a => a
mempty else Char -> Builder
char8 Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
string8 [Char]
rs)
        else
         let
          (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo Int
dec' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (-Int
e) Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
is)
          Char
d:[Char]
ds' = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [Int]
is' else Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is')
         in
         Char -> Builder
char8 Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ds' then Builder
forall a. Monoid a => a
mempty else Char -> Builder
char8 Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
string8 [Char]
ds')