1{-# LANGUAGE CPP, OverloadedStrings #-}
2
3module Data.ByteString.Builder.Scientific
4    ( scientificBuilder
5    , formatScientificBuilder
6    , FPFormat(..)
7    ) where
8
9import           Data.Scientific   (Scientific)
10import qualified Data.Scientific as Scientific
11
12import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
13
14import qualified Data.ByteString.Char8 as BC8
15import           Data.ByteString.Builder (Builder, string8, char8, intDec)
16import           Data.ByteString.Builder.Extra (byteStringCopy)
17
18import Utils (roundTo, i2d)
19
20#if !MIN_VERSION_base(4,8,0)
21import Data.Monoid                  (mempty)
22#endif
23
24#if MIN_VERSION_base(4,5,0)
25import Data.Monoid                  ((<>))
26#else
27import Data.Monoid                  (Monoid, mappend)
28(<>) :: Monoid a => a -> a -> a
29(<>) = mappend
30infixr 6 <>
31#endif
32
33
34-- | A @ByteString@ @Builder@ which renders a scientific number to full
35-- precision, using standard decimal notation for arguments whose
36-- absolute value lies between @0.1@ and @9,999,999@, and scientific
37-- notation otherwise.
38scientificBuilder :: Scientific -> Builder
39scientificBuilder = formatScientificBuilder Generic Nothing
40
41-- | Like 'scientificBuilder' but provides rendering options.
42formatScientificBuilder :: FPFormat
43                        -> Maybe Int  -- ^ Number of decimal places to render.
44                        -> Scientific
45                        -> Builder
46formatScientificBuilder fmt decs scntfc
47   | scntfc < 0 = char8 '-' <> doFmt fmt (Scientific.toDecimalDigits (-scntfc))
48   | otherwise  =              doFmt fmt (Scientific.toDecimalDigits   scntfc)
49 where
50  doFmt format (is, e) =
51    let ds = map i2d is in
52    case format of
53     Generic ->
54      doFmt (if e < 0 || e > 7 then Exponent else Fixed)
55            (is,e)
56     Exponent ->
57      case decs of
58       Nothing ->
59        let show_e' = intDec (e-1) in
60        case ds of
61          "0"     -> byteStringCopy "0.0e0"
62          [d]     -> char8 d <> byteStringCopy ".0e" <> show_e'
63          (d:ds') -> char8 d <> char8 '.' <> string8 ds' <> char8 'e' <> show_e'
64          []      -> error $ "Data.ByteString.Builder.Scientific.formatScientificBuilder" ++
65                             "/doFmt/Exponent: []"
66       Just dec ->
67        let dec' = max dec 1 in
68        case is of
69         [0] -> byteStringCopy "0." <>
70                byteStringCopy (BC8.replicate dec' '0') <>
71                byteStringCopy "e0"
72         _ ->
73          let
74           (ei,is') = roundTo (dec'+1) is
75           (d:ds') = map i2d (if ei > 0 then init is' else is')
76          in
77          char8 d <> char8 '.' <> string8 ds' <> char8 'e' <> intDec (e-1+ei)
78     Fixed ->
79      let
80       mk0 ls = case ls of { "" -> char8 '0' ; _ -> string8 ls}
81      in
82      case decs of
83       Nothing
84          | e <= 0    -> byteStringCopy "0." <>
85                         byteStringCopy (BC8.replicate (-e) '0') <>
86                         string8 ds
87          | otherwise ->
88             let
89                f 0 s    rs  = mk0 (reverse s) <> char8 '.' <> mk0 rs
90                f n s    ""  = f (n-1) ('0':s) ""
91                f n s (r:rs) = f (n-1) (r:s) rs
92             in
93                f e "" ds
94       Just dec ->
95        let dec' = max dec 0 in
96        if e >= 0 then
97         let
98          (ei,is') = roundTo (dec' + e) is
99          (ls,rs)  = splitAt (e+ei) (map i2d is')
100         in
101         mk0 ls <> (if null rs then mempty else char8 '.' <> string8 rs)
102        else
103         let
104          (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)
105          d:ds' = map i2d (if ei > 0 then is' else 0:is')
106         in
107         char8 d <> (if null ds' then mempty else char8 '.' <> string8 ds')
108