module Text.Show.ByteString.Float where
import GHC.Float
import Control.Monad
import Data.Binary
import Text.Show.ByteString.Util
import Text.Show.ByteString.Int
showpGFloat :: RealFloat a => Maybe Int -> a -> Put
showpGFloat = putFormattedFloat FFGeneric
showpFFloat :: RealFloat a => Maybe Int -> a -> Put
showpFFloat = putFormattedFloat FFFixed
showpEFloat :: RealFloat a => Maybe Int -> a -> Put
showpEFloat = putFormattedFloat FFExponent
putFormattedFloat :: RealFloat a => FFFormat -> Maybe Int -> a -> Put
putFormattedFloat fmt decs f
| isNaN f = putAscii 'N' >> putAscii 'a' >> putAscii 'N'
| isInfinite f = putAsciiStr (if f < 0 then "-Infinity" else "Infinity")
| f < 0 || isNegativeZero f = putAscii '-' >> go fmt (floatToDigits (toInteger base) (f))
| otherwise = go fmt (floatToDigits (toInteger base) f)
where
base = 10
go FFGeneric p@(_,e)
| e < 0 || e > 7 = go FFExponent p
| otherwise = go FFFixed p
go FFExponent (is, e) =
case decs of
Nothing -> case is of
[] -> error "putFormattedFloat"
[0] -> putAsciiStr "0.0e0"
[d] -> unsafePutDigit d >> putAsciiStr ".0e" >> showpInt (e1)
(d:ds) -> unsafePutDigit d >> putAscii '.' >> mapM_ unsafePutDigit ds
>> putAscii 'e' >> showpInt (e1)
Just dec ->
let dec' = max dec 1 in
case is of
[0] -> putAscii '0' >> putAscii '.' >> replicateM_ dec' (putAscii '0')
>> putAscii 'e' >> putAscii '0'
_ ->
let (ei, is') = roundTo base (dec'+1) is
(d:ds) = if ei > 0 then init is' else is'
in unsafePutDigit d >> putAscii '.' >> mapM_ unsafePutDigit ds
>> putAscii 'e' >> showpInt (e 1 + ei)
go FFFixed (is, e) = case decs of
Nothing
| e <= 0 -> putAscii '0' >> putAscii '.' >> replicateM_ (e) (putAscii '0')
>> mapM_ unsafePutDigit is
| otherwise -> let g 0 rs = putAscii '.' >> mk0 rs
g n [] = putAscii '0' >> g (n1) []
g n (r:rs) = unsafePutDigit r >> g (n1) rs
in g e is
Just dec ->
let dec' = max dec 0 in
if e >= 0 then
let (ei, is') = roundTo base (dec' + e) is
(ls,rs) = splitAt (e+ei) is'
in mk0 ls >> when (not $ null rs) (putAscii '.' >> mapM_ unsafePutDigit rs)
else
let (ei, is') = roundTo base dec' (replicate (e) 0 ++ is)
d:ds = if ei > 0 then is' else 0:is'
in unsafePutDigit d >> when (not $ null ds) (putAscii '.' >> mapM_ unsafePutDigit ds)
mk0 [] = putAscii '0'
mk0 rs = mapM_ unsafePutDigit rs