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