diff --git a/Data/Text/Buildable.hs b/Data/Text/Buildable.hs --- a/Data/Text/Buildable.hs +++ b/Data/Text/Buildable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} -- | -- Module : Data.Text.Buildable @@ -19,16 +19,18 @@ 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.Types (Fast(..), Shown(..)) +import Data.Text.Format.Int (decimal, hexadecimal) +import Data.Text.Format.RealFloat (formatRealFloat, showFloat) +import Data.Text.Format.RealFloat.Fast (DispFloat, formatFloat, fshowFloat) +import Data.Text.Format.Types (Fast(..), Hex(..), 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) import Data.Time.Clock (getModJulianDate) import Data.Time.LocalTime (LocalTime, TimeOfDay, TimeZone, ZonedTime) import Data.Word (Word, Word8, Word16, Word32, Word64) +import Foreign.Ptr (IntPtr, WordPtr, Ptr, ptrToWordPtr) import qualified Data.Text as ST import qualified Data.Text.Lazy as LT @@ -55,48 +57,52 @@ build = fromString {-# INLINE build #-} +instance (Integral a) => Buildable (Hex a) where + build = hexadecimal + {-# INLINE build #-} + instance Buildable Int8 where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Int16 where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Int32 where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Int where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Int64 where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Integer where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Word8 where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Word16 where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Word32 where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Word where - build = integral + build = decimal {-# INLINE build #-} instance Buildable Word64 where - build = integral + build = decimal {-# INLINE build #-} instance (Integral a, Buildable a) => Buildable (Ratio a) where @@ -111,14 +117,18 @@ 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 #-} @@ -158,3 +168,12 @@ instance Buildable ZonedTime where build = build . Shown {-# INLINE build #-} + +instance Buildable IntPtr where + build p = fromText "0x" <> hexadecimal p + +instance Buildable WordPtr where + build p = fromText "0x" <> hexadecimal p + +instance Buildable (Ptr a) where + build = build . ptrToWordPtr diff --git a/Data/Text/Format.hs b/Data/Text/Format.hs --- a/Data/Text/Format.hs +++ b/Data/Text/Format.hs @@ -14,35 +14,43 @@ module Data.Text.Format ( -- * Types - Only(..) + Format + , Only(..) -- ** Types for format control , Fast(..) , Shown(..) - -- * Functions - -- ** Rendering + -- * Rendering , format , print , hprint , build - -- ** Functions for format control + -- * Format control , left , right + -- ** Integers + , hex + -- ** 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 (Fast(..), Only(..), Shown(..)) +import Data.Text.Format.Types.Internal (FPControl(..), FPFormat(..), Fast(..)) +import Data.Text.Format.Types.Internal (Format(..), Hex(..), 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 import qualified Data.Text.Lazy.IO as LT -- | Render a format string and arguments to a 'Builder'. -build :: Params ps => ST.Text -> ps -> Builder -build fmt ps = zipParams (map fromText . ST.splitOn "{}" $ fmt) xs +build :: Params ps => Format -> ps -> Builder +build (Format fmt) ps = zipParams (map fromText . ST.splitOn "{}" $ fmt) xs where zipParams (f:fs) (y:ys) = f <> y <> zipParams fs ys zipParams [f] [] = f zipParams _ _ = error . LT.unpack $ format @@ -51,26 +59,56 @@ xs = buildParams ps -- | Render a format string and arguments to a 'LT.Text'. -format :: Params ps => ST.Text -> ps -> LT.Text +format :: Params ps => Format -> ps -> LT.Text format fmt ps = toLazyText $ build fmt ps -- | Render a format string and arguments, then print the result. -print :: Params ps => ST.Text -> ps -> IO () +print :: Params ps => Format -> ps -> IO () print fmt ps = LT.putStr . toLazyText $ build fmt ps -- | Render a format string and arguments, then print the result to -- the given file handle. -hprint :: Params ps => Handle -> ST.Text -> ps -> IO () +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 + fromLazyText . LT.justifyRight (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 + fromLazyText . LT.justifyLeft (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_ = B.build . FPControl Exponent Nothing + +-- ^ Render an integer using hexadecimal notation. (No leading "0x" +-- is added.) +hex :: Integral a => a -> Builder +hex = B.build . Hex diff --git a/Data/Text/Format/Int.hs b/Data/Text/Format/Int.hs --- a/Data/Text/Format/Int.hs +++ b/Data/Text/Format/Int.hs @@ -11,8 +11,8 @@ module Data.Text.Format.Int ( - digit - , integral + decimal + , hexadecimal , minus ) where @@ -39,39 +39,67 @@ # define PAIR(a,b) (a,b) #endif -integral :: Integral a => a -> Builder -{-# SPECIALIZE integral :: Int -> Builder #-} -{-# SPECIALIZE integral :: Int8 -> Builder #-} -{-# SPECIALIZE integral :: Int16 -> Builder #-} -{-# SPECIALIZE integral :: Int32 -> Builder #-} -{-# SPECIALIZE integral :: Int64 -> Builder #-} -{-# SPECIALIZE integral :: Word -> Builder #-} -{-# SPECIALIZE integral :: Word8 -> Builder #-} -{-# SPECIALIZE integral :: Word16 -> Builder #-} -{-# SPECIALIZE integral :: Word32 -> Builder #-} -{-# SPECIALIZE integral :: Word64 -> Builder #-} -{-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-} -integral i +decimal :: Integral a => a -> Builder +{-# SPECIALIZE decimal :: Int -> Builder #-} +{-# SPECIALIZE decimal :: Int8 -> Builder #-} +{-# SPECIALIZE decimal :: Int16 -> Builder #-} +{-# SPECIALIZE decimal :: Int32 -> Builder #-} +{-# SPECIALIZE decimal :: Int64 -> Builder #-} +{-# SPECIALIZE decimal :: Word -> Builder #-} +{-# SPECIALIZE decimal :: Word8 -> Builder #-} +{-# SPECIALIZE decimal :: Word16 -> Builder #-} +{-# SPECIALIZE decimal :: Word32 -> Builder #-} +{-# SPECIALIZE decimal :: Word64 -> Builder #-} +{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-} +decimal i | i < 0 = minus <> go (-i) | otherwise = go i where go n | n < 10 = digit n | otherwise = go (n `quot` 10) <> digit (n `rem` 10) +hexadecimal :: Integral a => a -> Builder +{-# SPECIALIZE hexadecimal :: Int -> Builder #-} +{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-} +{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-} +{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-} +{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-} +{-# SPECIALIZE hexadecimal :: Word -> Builder #-} +{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-} +{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-} +{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-} +{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-} +{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-} +hexadecimal i + | i < 0 = minus <> go (-i) + | otherwise = go i + where + go n | n < 16 = hexDigit n + | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16) + digit :: Integral a => a -> Builder -digit n = singleton $! i2d (fromIntegral n + 48) +digit n = singleton $! i2d (fromIntegral n) {-# INLINE digit #-} +hexDigit :: Integral a => a -> Builder +hexDigit n + | n <= 9 = singleton $! i2d (fromIntegral n) + | otherwise = singleton $! toEnum (fromIntegral n + 87) +{-# INLINE hexDigit #-} + minus :: Builder minus = singleton '-' int :: Int -> Builder -int = integral +int = decimal {-# INLINE int #-} -integer :: Integer -> Builder -integer (S# i#) = int (I# i#) -integer i +data T = T !Integer !Int + +integer :: Int -> Integer -> Builder +integer 10 (S# i#) = decimal (I# i#) +integer 16 (S# i#) = hexadecimal (I# i#) +integer base i | i < 0 = minus <> go (-i) | otherwise = go i where @@ -91,38 +119,38 @@ PAIR(q,r) -> q : r : splitb p ns splitb _ _ = [] -data T = T !Integer !Int + T maxInt10 maxDigits10 = + until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1) + where mi = fromIntegral (maxBound :: Int) + T maxInt16 maxDigits16 = + until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1) + where mi = fromIntegral (maxBound :: Int) -fstT :: T -> Integer -fstT (T a _) = a + fstT (T a _) = a -maxInt :: Integer -maxDigits :: Int -T maxInt maxDigits = - until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1) - where mi = fromIntegral (maxBound :: Int) + maxInt | base == 10 = maxInt10 + | otherwise = maxInt16 + maxDigits | base == 10 = maxDigits10 + | otherwise = maxDigits16 -putH :: [Integer] -> Builder -putH (n:ns) = case n `quotRemInteger` maxInt of - PAIR(x,y) - | q > 0 -> int q <> pblock r <> putB ns - | otherwise -> int r <> putB ns - where q = fromInteger x - r = fromInteger y -putH _ = error "putH: the impossible happened" + putH (n:ns) = case n `quotRemInteger` maxInt of + PAIR(x,y) + | q > 0 -> int q <> pblock r <> putB ns + | otherwise -> int r <> putB ns + where q = fromInteger x + r = fromInteger y + putH _ = error "putH: the impossible happened" -putB :: [Integer] -> Builder -putB (n:ns) = case n `quotRemInteger` maxInt of - PAIR(x,y) -> pblock q <> pblock r <> putB ns - where q = fromInteger x - r = fromInteger y -putB _ = mempty + putB (n:ns) = case n `quotRemInteger` maxInt of + PAIR(x,y) -> pblock q <> pblock r <> putB ns + where q = fromInteger x + r = fromInteger y + putB _ = mempty -pblock :: Int -> Builder -pblock = go maxDigits - where - go !d !n - | d == 1 = digit n - | otherwise = go (d-1) q <> digit r - where q = n `quotInt` 10 - r = n `remInt` 10 + pblock = loop maxDigits + where + loop !d !n + | d == 1 = digit n + | otherwise = loop (d-1) q <> digit r + where q = n `quotInt` base + r = n `remInt` base diff --git a/Data/Text/Format/Params.hs b/Data/Text/Format/Params.hs --- a/Data/Text/Format/Params.hs +++ b/Data/Text/Format/Params.hs @@ -23,6 +23,9 @@ class Params ps where buildParams :: ps -> [Builder] +instance Params () where + buildParams _ = [] + instance (Buildable a) => Params (Only a) where buildParams (Only a) = [build a] diff --git a/Data/Text/Format/RealFloat.hs b/Data/Text/Format/RealFloat.hs --- a/Data/Text/Format/RealFloat.hs +++ b/Data/Text/Format/RealFloat.hs @@ -9,13 +9,14 @@ module Data.Text.Format.RealFloat ( - showFloat + formatRealFloat + , showFloat ) where import Data.Text.Format.Functions ((<>), i2d) import Data.Text.Format.RealFloat.Functions (roundTo) -import Data.Text.Format.Int (integral) -import Data.Text.Format.Types (Format(..)) +import Data.Text.Format.Int (decimal) +import Data.Text.Format.Types.Internal (FPFormat(..)) import qualified Data.Text as T import Data.Array.Base (unsafeAt) import Data.Text.Lazy.Builder @@ -29,9 +30,9 @@ {-# SPECIALIZE showFloat :: Double -> Builder #-} showFloat x = formatRealFloat Generic Nothing x -formatRealFloat :: (RealFloat a) => Format -> Maybe Int -> a -> Builder -{-# SPECIALIZE formatRealFloat :: Format -> Maybe Int -> Float -> Builder #-} -{-# SPECIALIZE formatRealFloat :: Format -> Maybe Int -> Double -> Builder #-} +formatRealFloat :: (RealFloat a) => FPFormat -> Maybe Int -> a -> Builder +{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-} +{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-} formatRealFloat fmt decs x | isNaN x = "NaN" | isInfinite x = if x < 0 then "-Infinity" else "Infinity" @@ -47,7 +48,7 @@ Exponent -> case decs of Nothing -> - let show_e' = integral (e-1) in + let show_e' = decimal (e-1) in case ds of "0" -> "0.0e0" [d] -> singleton d <> ".0e" <> show_e' @@ -62,7 +63,7 @@ (ei,is') = roundTo (dec'+1) is (d:ds') = map i2d (if ei > 0 then init is' else is') in - singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> integral (e-1+ei) + singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei) Fixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls} diff --git a/Data/Text/Format/RealFloat/Fast.hs b/Data/Text/Format/RealFloat/Fast.hs --- a/Data/Text/Format/RealFloat/Fast.hs +++ b/Data/Text/Format/RealFloat/Fast.hs @@ -16,13 +16,14 @@ , fshowEFloat , fshowFFloat , fshowGFloat + , formatFloat ) where import Data.Text.Format.Functions ((<>), i2d) -import Data.Text.Format.Int (integral) +import Data.Text.Format.Int (decimal) import Data.Text.Format.RealFloat.Fast.Internal (posToDigits) import Data.Text.Format.RealFloat.Functions (roundTo) -import Data.Text.Format.Types (Format(..)) +import Data.Text.Format.Types.Internal (FPFormat(..)) import Data.Text.Lazy.Builder import qualified Data.Text as T @@ -119,9 +120,9 @@ {-# SPECIALIZE fshowGFloat :: Maybe Int -> Double -> Builder #-} fshowGFloat d x = formatFloat Generic d x -formatFloat :: DispFloat a => Format -> Maybe Int -> a -> Builder -{-# SPECIALIZE formatFloat :: Format -> Maybe Int -> Float -> Builder #-} -{-# SPECIALIZE formatFloat :: Format -> Maybe Int -> Double -> Builder #-} +formatFloat :: DispFloat a => FPFormat -> Maybe Int -> a -> Builder +{-# SPECIALIZE formatFloat :: FPFormat -> Maybe Int -> Float -> Builder #-} +{-# SPECIALIZE formatFloat :: FPFormat -> Maybe Int -> Double -> Builder #-} formatFloat fmt decs x | isNaN x = "NaN" | isInfinite x = if x < 0 then "-Infinity" else "Infinity" @@ -141,7 +142,7 @@ Exponent -> case decs of Nothing -> - let show_e' = integral $ if ei == 0 then (e-1) else e + let show_e' = decimal $ if ei == 0 then (e-1) else e (ei,(d:ds)) = roundToS (decDigits x) is in case is of [0] -> "0.0e0" @@ -152,7 +153,7 @@ [0] -> fromText "0." <> fromText (T.replicate dec' "0") <> "e0" _ -> let (ei,is') = roundTo (dec'+1) is (d:ds') = map i2d (if ei > 0 then init is' else is') - in singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> integral (e-1+ei) + in singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei) Fixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls} in case decs of diff --git a/Data/Text/Format/Types.hs b/Data/Text/Format/Types.hs --- a/Data/Text/Format/Types.hs +++ b/Data/Text/Format/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} -- | -- Module : Data.Text.Format.Types @@ -13,41 +13,16 @@ module Data.Text.Format.Types ( - Format(..) - , Fast(..) + Format , Only(..) , Shown(..) + -- * Integer format control + , Hex(..) + -- * Floating point format control + , FPControl + , Fast(..) + , DispFloat ) where --- | Control the rendering of floating point numbers. -data Format = Exponent - -- ^ Scientific notation (e.g. @2.3e123@). - | Fixed - -- ^ Standard decimal notation. - | Generic - -- ^ Use decimal notation for values between @0.1@ and - -- @9,999,999@, and scientific notation otherwise. - deriving (Enum, Read, Show) - --- | 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 --- strings that are longer than the default algorithm --- (e.g. \"@1.3300000000000001@\" instead of \"@1.33@\"). -newtype Fast a = Fast { - fromFast :: a - } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac, - Floating, RealFloat) - --- | Use this @newtype@ wrapper for your single parameter if you are --- formatting a string containing exactly one substitution site. -newtype Only a = Only { - fromOnly :: a - } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac, - Floating, RealFloat, Enum, Integral, Bounded) - --- | Render a value using its 'Show' instance. -newtype Shown a = Shown { - shown :: a - } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac, - Floating, RealFloat, Enum, Integral, Bounded) +import Data.Text.Format.Types.Internal +import Data.Text.Format.RealFloat.Fast (DispFloat) diff --git a/Data/Text/Format/Types/Internal.hs b/Data/Text/Format/Types/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/Text/Format/Types/Internal.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Data.Text.Format.Types.Internal +-- Copyright : (c) 2011 MailRank, Inc. +-- +-- License : BSD-style +-- Maintainer : bos@mailrank.com +-- Stability : experimental +-- Portability : GHC +-- +-- Types for text mangling. + +module Data.Text.Format.Types.Internal + ( + Format(..) + , Only(..) + , Shown(..) + -- * Integer format control + , Hex(..) + -- * Floating point format control + , Fast(..) + , FPControl(..) + , FPFormat(..) + ) where + +import Data.Monoid (Monoid(..)) +import Data.String (IsString(..)) +import Data.Text (Text) +import Data.Typeable (Typeable) + +-- | A format string. This is intentionally incompatible with other +-- string types, to make it difficult to construct a format string by +-- concatenating string fragments (a very common way to accidentally +-- make code vulnerable to malicious data). +-- +-- This type is an instance of 'IsString', so the easiest way to +-- construct a query is to enable the @OverloadedStrings@ language +-- extension and then simply write the query in double quotes. +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Data.Text.Format +-- > +-- > f :: Format +-- > f = "hello {}" +-- +-- The underlying type is 'Text', so literal Haskell strings that +-- contain Unicode characters will be correctly handled. +newtype Format = Format Text + deriving (Eq, Ord, Typeable) + +instance Monoid Format where + Format a `mappend` Format b = Format (a `mappend` b) + mempty = Format mempty + +instance IsString Format where + fromString = Format . fromString + +-- | Render an integral type in hexadecimal. +newtype Hex a = Hex a + deriving (Eq, Ord, Read, Show, Num, Real, Enum, Integral) + +-- | Control the rendering of floating point numbers. +data FPFormat = Exponent + -- ^ Scientific notation (e.g. @2.3e123@). + | Fixed + -- ^ Standard decimal notation. + | Generic + -- ^ Use decimal notation for values between @0.1@ and + -- @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 +-- strings that are longer than the default algorithm +-- (e.g. \"@1.3300000000000001@\" instead of \"@1.33@\"). +newtype Fast a = Fast { + fromFast :: a + } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac, + Floating, RealFloat) + +-- | Use this @newtype@ wrapper for your single parameter if you are +-- formatting a string containing exactly one substitution site. +newtype Only a = Only { + fromOnly :: a + } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac, + Floating, RealFloat, Enum, Integral, Bounded) + +-- | Render a value using its 'Show' instance. +newtype Shown a = Shown { + shown :: a + } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac, + Floating, RealFloat, Enum, Integral, Bounded) diff --git a/tests/Benchmarks.hs b/tests/Benchmarks.hs new file mode 100644 --- /dev/null +++ b/tests/Benchmarks.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Criterion.Main +import Data.Text.Format +import qualified Data.Text as T +import qualified Data.Text.Lazy as L + +main = defaultMain [ + bgroup "arity" [ + bench "0" $ nf (format "hi") () + , bench "1" $ nf (format "hi {}") (Only $ T.pack "mom") + , bench "2" $ nf (format "hi {}, how are {}") + (T.pack "mom", T.pack "you") + , bench "3" $ nf (format "hi {}, how are {} keeping {}") + (T.pack "mom", T.pack "you", T.pack "now") + , bench "4" $ nf (format "hi {}, {} - how are {} keeping {}") + (T.pack "mom", T.pack "hey", T.pack "you", T.pack "now") + ] + , bgroup "types" [ + bench "unit" $ nf (format "hi") () + , bgroup "int" [ + bench "small" $ nf (format "hi {}") (Only (1::Int)) + , bench "medium" $ nf (format "hi {}") (Only (1234::Int)) + , bench "large" $ nf (format "hi {}") (Only (0x7fffffff::Int)) + ] + , bgroup "float" [ + bgroup "slow" [ + bench "small" $ nf (format "hi {}") (Only (1::Float)) + , bench "medium" $ nf (format "hi {}") (Only (pi::Float)) + , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Float)) + ] + , bgroup "fast" [ + bench "small" $ nf (format "hi {}") (Only (1::Fast Float)) + , bench "medium" $ nf (format "hi {}") (Only (pi::Fast Float)) + , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Fast Float)) + ] + ] + , bgroup "double" [ + bgroup "slow" [ + bench "small" $ nf (format "hi {}") (Only (1::Double)) + , bench "medium" $ nf (format "hi {}") (Only (pi::Double)) + , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Double)) + ] + , bgroup "fast" [ + bench "small" $ nf (format "hi {}") (Only (1::Fast Double)) + , bench "medium" $ nf (format "hi {}") (Only (pi::Fast Double)) + , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Fast Double)) + ] + ] + , bgroup "string" [ + bench "small" $ nf (format "hi {}") (Only ("mom" :: String)) + , bench "medium" $ nf (format "hi {}") + (Only . concat . replicate 64 $ ("mom" :: String)) + , bench "large" $ nf (format "hi {}") + (Only . concat . replicate 1024 $ ("mom" :: String)) + ] + , bgroup "text" [ + bench "small" $ nf (format "hi {}") (Only (T.pack "mom")) + , bench "medium" $ nf (format "hi {}") (Only (T.replicate 64 "mom")) + , bench "large" $ nf (format "hi {}") (Only (T.replicate 1024 "mom")) + ] + , bgroup "lazytext" [ + bench "small" $ nf (format "hi {}") (Only (L.pack "mom")) + , bench "medium" $ nf (format "hi {}") + (Only . L.fromChunks . replicate 64 $ "mom") + , bench "large" $ nf (format "hi {}") + (Only . L.fromChunks . replicate 1024 $ "mom") + ] + ] + ] diff --git a/text-format.cabal b/text-format.cabal --- a/text-format.cabal +++ b/text-format.cabal @@ -1,5 +1,5 @@ name: text-format -version: 0.1.0.0 +version: 0.2.0.0 license: BSD3 license-file: LICENSE homepage: https://github.com/mailrank/text-format @@ -11,13 +11,14 @@ tested-with: GHC == 7.0.3 synopsis: Text formatting cabal-version: >= 1.8 -build-type: Simple +build-type: Simple description: A text formatting library optimized for ease of use and high performance. extra-source-files: README.markdown + tests/Benchmarks.hs flag developer description: operate in developer mode @@ -37,6 +38,7 @@ Data.Text.Format.RealFloat.Fast Data.Text.Format.RealFloat.Fast.Internal Data.Text.Format.RealFloat.Functions + Data.Text.Format.Types.Internal build-depends: array, @@ -51,7 +53,7 @@ ghc-options: -Werror ghc-prof-options: -auto-all - ghc-options: -Wall + ghc-options: -Wall cpp-options: -DINTEGER_GMP @@ -63,8 +65,8 @@ source-repository head type: git - location: http://github.com/mailrank/aeson + location: https://github.com/mailrank/text-format source-repository head type: mercurial - location: http://bitbucket.org/bos/aeson + location: https://bitbucket.org/bos/text-format