Skip to content
Browse files

Allow more control over floating point rendering.

  • Loading branch information...
1 parent ff580d1 commit 9d95011c5b39787595db28beaebdd48eef99da0c @bos committed May 22, 2011
View
15 Data/Text/Buildable.hs
@@ -20,9 +20,10 @@ import Data.Int (Int8, Int16, Int32, Int64)
import Data.Ratio (Ratio, denominator, numerator)
import Data.Text.Format.Functions ((<>))
import Data.Text.Format.Int (integral)
-import Data.Text.Format.RealFloat (showFloat)
-import Data.Text.Format.RealFloat.Fast (fshowFloat)
+import Data.Text.Format.RealFloat (formatRealFloat, showFloat)
+import Data.Text.Format.RealFloat.Fast (DispFloat, formatFloat, fshowFloat)
import Data.Text.Format.Types (Fast(..), Shown(..))
+import Data.Text.Format.Types.Internal (FPControl(..))
import Data.Text.Lazy.Builder
import Data.Time.Calendar (Day, showGregorian)
import Data.Time.Clock (DiffTime, NominalDiffTime, UTCTime, UniversalTime)
@@ -111,14 +112,18 @@ instance Buildable Double where
build = showFloat
{-# INLINE build #-}
-instance Buildable (Fast Float) where
- build = fshowFloat . fromFast
+instance (RealFloat a) => Buildable (FPControl a) where
+ build (FPControl fmt decs x) = formatRealFloat fmt decs x
{-# INLINE build #-}
-instance Buildable (Fast Double) where
+instance (RealFloat a, DispFloat a) => Buildable (Fast a) where
build = fshowFloat . fromFast
{-# INLINE build #-}
+instance (RealFloat a, DispFloat a) => Buildable (Fast (FPControl a)) where
+ build (Fast (FPControl fmt decs x)) = formatFloat fmt decs x
+ {-# INLINE build #-}
+
instance Buildable DiffTime where
build = build . Shown
{-# INLINE build #-}
View
44 Data/Text/Format.hs
@@ -19,23 +19,28 @@ module Data.Text.Format
-- ** Types for format control
, Fast(..)
, Shown(..)
- -- * Functions
- -- ** Rendering
+ -- * Rendering
, format
, print
, hprint
, build
- -- ** Functions for format control
+ -- * Format control
, left
, right
+ -- ** Floating point numbers
+ , expt
+ , expt_
+ , fixed
+ , fixed_
) where
import qualified Data.Text.Buildable as B
import Data.Text.Format.Params (Params(..))
import Data.Text.Format.Functions ((<>))
-import Data.Text.Format.Types.Internal (Fast(..), Format(..), Only(..), Shown(..))
+import Data.Text.Format.Types.Internal (FPControl(..), FPFormat(..), Fast(..))
+import Data.Text.Format.Types.Internal (Format(..), Only(..), Shown(..))
import Data.Text.Lazy.Builder
-import Prelude hiding (print)
+import Prelude hiding (exp, print)
import System.IO (Handle)
import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT
@@ -65,13 +70,38 @@ hprint :: Params ps => Handle -> Format -> ps -> IO ()
hprint h fmt ps = LT.hPutStr h . toLazyText $ build fmt ps
-- | Pad the left hand side of a string until it reaches @k@
--- characters wide, filling with character @c@.
+-- characters wide, if necessary filling with character @c@.
left :: B.Buildable a => Int -> Char -> a -> Builder
left k c =
fromLazyText . LT.justifyLeft (fromIntegral k) c . toLazyText . B.build
-- | Pad the right hand side of a string until it reaches @k@
--- characters wide, filling with character @c@.
+-- characters wide, if necessary filling with character @c@.
right :: B.Buildable a => Int -> Char -> a -> Builder
right k c =
fromLazyText . LT.justifyRight (fromIntegral k) c . toLazyText . B.build
+
+-- ^ Render a floating point number using normal notation, with the
+-- given number of decimal places.
+fixed :: (B.Buildable a, RealFloat a) =>
+ Int
+ -- ^ Number of digits of precision after the decimal.
+ -> a -> Builder
+fixed decs = B.build . FPControl Fixed (Just decs)
+
+-- ^ Render a floating point number using normal notation.
+fixed_ :: (B.Buildable a, RealFloat a) => -> a -> Builder
+fixed_ = B.build . FPControl Fixed Nothing
+
+-- ^ Render a floating point number using scientific/engineering
+-- notation (e.g. @2.3e123@), with the given number of decimal places.
+expt :: (B.Buildable a, RealFloat a) =>
+ Int
+ -- ^ Number of digits of precision after the decimal.
+ -> a -> Builder
+expt decs = B.build . FPControl Exponent (Just decs)
+
+-- ^ Render a floating point number using scientific/engineering
+-- notation (e.g. @2.3e123@).
+expt_ :: (B.Buildable a, RealFloat a) => -> a -> Builder
+expt_ decs = B.build . FPControl Exponent Nothing
View
5 Data/Text/Format/Int.hs
@@ -11,8 +11,7 @@
module Data.Text.Format.Int
(
- digit
- , integral
+ integral
, minus
) where
@@ -59,7 +58,7 @@ integral i
| otherwise = go (n `quot` 10) <> digit (n `rem` 10)
digit :: Integral a => a -> Builder
-digit n = singleton $! i2d (fromIntegral n + 48)
+digit n = singleton $! i2d (fromIntegral n)
{-# INLINE digit #-}
minus :: Builder
View
3 Data/Text/Format/RealFloat.hs
@@ -9,7 +9,8 @@
module Data.Text.Format.RealFloat
(
- showFloat
+ formatRealFloat
+ , showFloat
) where
import Data.Text.Format.Functions ((<>), i2d)
View
1 Data/Text/Format/RealFloat/Fast.hs
@@ -16,6 +16,7 @@ module Data.Text.Format.RealFloat.Fast
, fshowEFloat
, fshowFFloat
, fshowGFloat
+ , formatFloat
) where
import Data.Text.Format.Functions ((<>), i2d)
View
6 Data/Text/Format/Types.hs
@@ -14,9 +14,13 @@
module Data.Text.Format.Types
(
Format
- , Fast(..)
, Only(..)
, Shown(..)
+ -- * Floating point format control
+ , FPControl
+ , Fast(..)
+ , DispFloat
) where
import Data.Text.Format.Types.Internal
+import Data.Text.Format.RealFloat.Fast (DispFloat)
View
9 Data/Text/Format/Types/Internal.hs
@@ -14,10 +14,12 @@
module Data.Text.Format.Types.Internal
(
Format(..)
- , FPFormat(..)
- , Fast(..)
, Only(..)
, Shown(..)
+ -- * Floating point format control
+ , Fast(..)
+ , FPControl(..)
+ , FPFormat(..)
) where
import Data.Monoid (Monoid(..))
@@ -63,6 +65,9 @@ data FPFormat = Exponent
-- @9,999,999@, and scientific notation otherwise.
deriving (Enum, Read, Show)
+-- | A floating point number, complete with rendering instructions.
+data FPControl a = FPControl FPFormat (Maybe Int) a
+
-- | Render a floating point number using a much faster algorithm than
-- the default (up to 10x faster). This performance comes with a
-- potential cost in readability, as the faster algorithm can produce

0 comments on commit 9d95011

Please sign in to comment.
Something went wrong with that request. Please try again.