{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, MagicHash,
UnliftedFFITypes
#-}
module Data.JSString.RealFloat ( FPFormat(..)
, realFloat
, formatRealFloat
, formatDouble
, formatFloat
) where
import GHC.Exts (Int#, Float#, Double#, Int(..), Float(..), Double(..))
import Data.JSString
data FPFormat = Exponent
| Fixed
| Generic
deriving (Enum, Read, Show)
realFloat :: (RealFloat a) => a -> JSString
realFloat = error "Data.JSString.RealFloat.realFloat not yet implemented"
{-# RULES "realFloat/Double" realFloat = genericDouble #-}
{-# RULES "realFoat/Float" realFloat = genericFloat #-}
{-# SPECIALIZE realFloat :: Double -> JSString #-}
{-# SPECIALIZE realFloat :: Float -> JSString #-}
{-# NOINLINE realFloat #-}
formatRealFloat :: (RealFloat a)
=> FPFormat
-> Maybe Int
-> a
-> JSString
formatRealFloat = error "Data.JSString.RealFloat.formatRealFloat not yet implemented"
{-# RULES "formatRealFloat/Double" formatRealFloat = formatDouble #-}
{-# RULES "formatRealFloat/Float" formatRealFloat = formatFloat #-}
{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> JSString #-}
{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> JSString #-}
{-# NOINLINE formatRealFloat #-}
genericDouble :: Double -> JSString
genericDouble (D# d) = js_doubleGeneric -1# d
{-# INLINE genericDouble #-}
genericFloat :: Float -> JSString
genericFloat (F# f) = js_floatGeneric -1# f
{-# INLINE genericFloat #-}
formatDouble :: FPFormat -> Maybe Int -> Double -> JSString
formatDouble fmt Nothing (D# d)
= case fmt of
Fixed -> js_doubleToFixed -1# d
Exponent -> js_doubleToExponent -1# d
Generic -> js_doubleGeneric -1# d
formatDouble fmt (Just (I# decs)) (D# d)
= case fmt of
Fixed -> js_doubleToFixed decs d
Exponent -> js_doubleToExponent decs d
Generic -> js_doubleGeneric decs d
{-# INLINE formatDouble #-}
formatFloat :: FPFormat -> Maybe Int -> Float -> JSString
formatFloat fmt Nothing (F# f)
= case fmt of
Fixed -> js_floatToFixed -1# f
Exponent -> js_floatToExponent -1# f
Generic -> js_floatGeneric -1# f
formatFloat fmt (Just (I# decs)) (F# f)
= case fmt of
Fixed -> js_floatToFixed decs f
Exponent -> js_floatToExponent decs f
Generic -> js_floatGeneric decs f
{-# INLINE formatFloat #-}
foreign import javascript unsafe
"h$jsstringDoubleToFixed"
js_doubleToFixed :: Int# -> Double# -> JSString
foreign import javascript unsafe
"h$jsstringDoubleToFixed"
js_floatToFixed :: Int# -> Float# -> JSString
foreign import javascript unsafe
"h$jsstringDoubleToExponent($1,$2)"
js_doubleToExponent :: Int# -> Double# -> JSString
foreign import javascript unsafe
"h$jsstringDoubleToExponent($1,$2)"
js_floatToExponent :: Int# -> Float# -> JSString
foreign import javascript unsafe
"h$jsstringDoubleGeneric($1,$2)"
js_doubleGeneric :: Int# -> Double# -> JSString
foreign import javascript unsafe
"h$jsstringDoubleGeneric($1,$2)"
js_floatGeneric :: Int# -> Float# -> JSString