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