{-# LANGUAGE CPP, OverloadedStrings #-}

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)

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid                  (mempty)
#endif

#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


-- | 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 fmt :: FPFormat
fmt decs :: Maybe Int
decs scntfc :: Scientific
scntfc
   | Scientific
scntfc Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Char -> Builder
char8 '-' 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 format :: FPFormat
format (is :: [Int]
is, e :: 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
     Generic ->
      FPFormat -> ([Int], Int) -> Builder
doFmt (if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 7 then FPFormat
Exponent else FPFormat
Fixed)
            ([Int]
is,Int
e)
     Exponent ->
      case Maybe Int
decs of
       Nothing ->
        let show_e' :: Builder
show_e' = Int -> Builder
intDec (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) in
        case [Char]
ds of
          "0"     -> ByteString -> Builder
byteStringCopy "0.0e0"
          [d :: Char
d]     -> Char -> Builder
char8 Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteStringCopy ".0e" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
          (d :: Char
d:ds' :: [Char]
ds') -> Char -> Builder
char8 Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 '.' 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 '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
$ "Data.ByteString.Builder.Scientific.formatScientificBuilder" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             "/doFmt/Exponent: []"
       Just dec :: Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec 1 in
        case [Int]
is of
         [0] -> ByteString -> Builder
byteStringCopy "0." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                ByteString -> Builder
byteStringCopy (Int -> Char -> ByteString
BC8.replicate Int
dec' '0') Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                ByteString -> Builder
byteStringCopy "e0"
         _ ->
          let
           (ei :: Int
ei,is' :: [Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec'Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Int]
is
           (d :: Char
d:ds' :: [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
> 0 then [Int] -> [Int]
forall a. [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 '.' 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 '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
-1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
     Fixed ->
      let
       mk0 :: [Char] -> Builder
mk0 ls :: [Char]
ls = case [Char]
ls of { "" -> Char -> Builder
char8 '0' ; _ -> [Char] -> Builder
string8 [Char]
ls}
      in
      case Maybe Int
decs of
       Nothing
          | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0    -> ByteString -> Builder
byteStringCopy "0." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                         ByteString -> Builder
byteStringCopy (Int -> Char -> ByteString
BC8.replicate (-Int
e) '0') Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                         [Char] -> Builder
string8 [Char]
ds
          | Bool
otherwise ->
             let
                f :: a -> [Char] -> [Char] -> Builder
f 0 s :: [Char]
s    rs :: [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 '.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
mk0 [Char]
rs
                f n :: a
n s :: [Char]
s    ""  = a -> [Char] -> [Char] -> Builder
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) ('0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
s) ""
                f n :: a
n s :: [Char]
s (r :: Char
r:rs :: [Char]
rs) = a -> [Char] -> [Char] -> Builder
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) (Char
rChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
s) [Char]
rs
             in
                Int -> [Char] -> [Char] -> Builder
forall a. (Eq a, Num a) => a -> [Char] -> [Char] -> Builder
f Int
e "" [Char]
ds
       Just dec :: Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec 0 in
        if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
         let
          (ei :: Int
ei,is' :: [Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
          (ls :: [Char]
ls,rs :: [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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rs then Builder
forall a. Monoid a => a
mempty else Char -> Builder
char8 '.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
string8 [Char]
rs)
        else
         let
          (ei :: Int
ei,is' :: [Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo Int
dec' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (-Int
e) 0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
is)
          d :: Char
d:ds' :: [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
> 0 then [Int]
is' else 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ds' then Builder
forall a. Monoid a => a
mempty else Char -> Builder
char8 '.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
string8 [Char]
ds')