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