    -- ---------------------------------------------------------------------------
    -- |
    -- Module      : Text.Show.ByteString.Float
    -- Copyright   : (c) 2008 Dan Doel
    -- Maintainer  : Dan Doel
    -- Stability   : Experimental
    -- Portability : Non-portable (magic hash)
    --
    -- Putting floating point values.
    --
    -- The code in this module is heavily based on GHC.Float

    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

    -- | Show a signed RealFloat value using decimal notation when the
    -- absolute value lies between 0.1 and 9,999,999, and scientific
    -- notation otherwise. The optional integer can be used to specify
    -- precision.
    showpGFloat :: RealFloat a => Maybe Int -> a -> Put
    showpGFloat = putFormattedFloat FFGeneric

    -- | Show a signed RealFloat value using decimal notation. The optional
    -- integer can be used to specify precision.
    showpFFloat :: RealFloat a => Maybe Int -> a -> Put
    showpFFloat = putFormattedFloat FFFixed

    -- | Show a signed RealFloat value using scientific (exponential) notation.
    -- The optional integer can be used to specify precision.
    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 (e-1)
           (d:ds) -> unsafePutDigit d >> putAscii '.' >> mapM_ unsafePutDigit ds
                                      >> putAscii 'e' >> showpInt (e-1)
         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 (n-1) []
                            g n (r:rs) = unsafePutDigit r >> g (n-1) 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