diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,15 @@ +6.3.0 + +* Folded the `text-format` package into this package, removed the + `double-conversion` dependency. Lost the following functions in + this: + * `prec` + * `expt` +* Added a test suite with regression tests: + * Fixed: https://github.com/chrisdone/formatting/issues/31 + * Fixed: https://github.com/chrisdone/formatting/issues/28 + * Fixed: https://github.com/bos/text-format/issues/18 + 6.2.5 * Changed microseconds to display as "us" to avoid unicode issues. diff --git a/formatting.cabal b/formatting.cabal --- a/formatting.cabal +++ b/formatting.cabal @@ -1,34 +1,58 @@ name: formatting -version: 6.2.5 +version: 6.3.0 synopsis: Combinator-based type-safe formatting (like printf() or FORMAT) description: Combinator-based type-safe formatting (like printf() or FORMAT), modelled from the HoleyMonoids package. license: BSD3 license-file: LICENSE -author: Chris Done, Shachaf Ben-Kiki, Martijn van Steenbergen, Mike Meyer +author: Chris Done, Shachaf Ben-Kiki, Martijn van Steenbergen, Mike Meyer, Bryan O'Sullivan maintainer: chrisdone@gmail.com -copyright: 2013 Chris Done, Shachaf Ben-Kiki, Martijn van Steenbergen, Mike Meyer +copyright: 2013 Chris Done, Shachaf Ben-Kiki, Martijn van Steenbergen, Mike Meyer, 2011 MailRank, Inc. category: Text build-type: Simple cabal-version: >=1.8 extra-source-files: CHANGELOG.md library - exposed-modules: Formatting, - Formatting.Formatters, - Formatting.ShortFormatters, - Formatting.Examples, - Formatting.Time, - Formatting.Clock, - Formatting.Internal - build-depends: base >= 4.5 && < 5, - text-format, - text >= 0.11.0.8, - time, - old-locale, - scientific >= 0.3.0.0, - clock >= 0.4 + exposed-modules: + Formatting + Formatting.Formatters + Formatting.ShortFormatters + Formatting.Examples + Formatting.Time + Formatting.Clock + Formatting.Internal + Formatting.Buildable + + other-modules: + Data.Text.Format.Functions + Data.Text.Format.Types + Data.Text.Format + Data.Text.Format.Int + + build-depends: + base >= 4.5 && < 5, + text >= 0.11.0.8, + time, + old-locale, + scientific >= 0.3.0.0, + clock >= 0.4, + array, + ghc-prim, + text >= 0.11.0.8, + transformers, + bytestring, + integer-gmp >= 0.2 + hs-source-dirs: src ghc-options: -O2 + cpp-options: -DINTEGER_GMP + +test-suite formatting-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base, formatting, hspec + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N source-repository head type: git diff --git a/src/Data/Text/Format.hs b/src/Data/Text/Format.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Format.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings, RelaxedPolyRec #-} + +-- | +-- Module : Data.Text.Format +-- Copyright : (c) 2011 MailRank, Inc. +-- +-- License : BSD-style +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- Fast, efficient, flexible support for formatting text strings. + +module Data.Text.Format + ( + -- * Format control + left + , right + -- ** Integers + , hex + -- ** Floating point numbers + , fixed + , shortest + ) where + +import Control.Monad.IO.Class (MonadIO(liftIO)) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Builder as L +import Data.Text (Text) +import qualified Data.Text as ST +import qualified Data.Text as T +import qualified Formatting.Buildable as B +import qualified Data.Text.Encoding as T +import Data.Text.Format.Functions ((<>)) +import Data.Text.Format.Types (Shown(..), Hex(..)) +import qualified Data.Text.Lazy as LT +import Data.Text.Lazy.Builder +import qualified Data.Text.Lazy.IO as LT +import Prelude hiding (exp, print) +import System.IO (Handle) +import Text.Printf + +-- | Pad the left hand side of a string until it reaches @k@ +-- characters wide, if necessary filling with character @c@. +left :: B.Buildable a => Int -> Char -> a -> Builder +left k c = + fromLazyText . LT.justifyRight (fromIntegral k) c . toLazyText . B.build + +-- | Pad the right hand side of a string until it reaches @k@ +-- characters wide, if necessary filling with character @c@. +right :: B.Buildable a => Int -> Char -> a -> Builder +right k c = + 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 :: (Real a) => + Int + -- ^ Number of digits of precision after the decimal. + -> a -> Builder +fixed decs = B.build . T.pack . (printf ("%." ++ show decs ++ "f") :: Double->String) . realToFrac +{-# NOINLINE[0] fixed #-} + +-- | Render a floating point number using the smallest number of +-- digits that correctly represent it. +shortest :: (Real a) => a -> Builder +shortest = B.build . T.decodeUtf8 . L.toStrict . L.toLazyByteString . L.doubleDec . realToFrac +{-# NOINLINE[0] shortest #-} + +-- | Render an integer using hexadecimal notation. (No leading "0x" +-- is added.) +hex :: Integral a => a -> Builder +hex = B.build . Hex +{-# INLINE hex #-} diff --git a/src/Data/Text/Format/Functions.hs b/src/Data/Text/Format/Functions.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Format/Functions.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE MagicHash #-} + +-- | +-- Module : Data.Text.Format.Functions +-- Copyright : (c) 2011 MailRank, Inc. +-- +-- License : BSD-style +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- Useful functions and combinators. + +module Data.Text.Format.Functions + ( + (<>) + , i2d + ) where + +import Data.Monoid (mappend) +import Data.Text.Lazy.Builder (Builder) +import GHC.Base + +-- | Unsafe conversion for decimal digits. +{-# INLINE i2d #-} +i2d :: Int -> Char +i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) + +-- | The normal 'mappend' function with right associativity instead of +-- left. +(<>) :: Builder -> Builder -> Builder +(<>) = mappend +{-# INLINE (<>) #-} + +infixr 4 <> diff --git a/src/Data/Text/Format/Int.hs b/src/Data/Text/Format/Int.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Format/Int.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} + +-- Module: Data.Text.Format.Int +-- Copyright: (c) 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: experimental +-- Portability: portable +-- +-- Efficiently serialize an integral value to a 'Builder'. + +module Data.Text.Format.Int + ( + decimal + , integer + , hexadecimal + , minus + ) where + +import Data.Int (Int8, Int16, Int32, Int64) +import Data.Monoid (mempty) +import Data.Text.Format.Functions ((<>), i2d) +import Data.Text.Lazy.Builder +import Data.Word (Word, Word8, Word16, Word32, Word64) +import GHC.Base (quotInt, remInt) +import GHC.Num (quotRemInteger) +import GHC.Types (Int(..)) + +#ifdef __GLASGOW_HASKELL__ +# if __GLASGOW_HASKELL__ < 611 +import GHC.Integer.Internals +# else +import GHC.Integer.GMP.Internals +# endif +#endif + +#ifdef INTEGER_GMP +# define PAIR(a,b) (# a,b #) +#else +# define PAIR(a,b) (a,b) +#endif + +decimal :: (Integral a, Bounded 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 == minBound = + -- special case, since (-i) would not be representable assuming two's + -- compliment: + minus <> integer 10 (negate $ fromIntegral 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) +{-# NOINLINE[0] decimal #-} + +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) +{-# NOINLINE[0] hexadecimal #-} + +digit :: Integral a => a -> Builder +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 = decimal +{-# INLINE int #-} + +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 + go n | n < maxInt = int (fromInteger n) + | otherwise = putH (splitf (maxInt * maxInt) n) + + splitf p n + | p > n = [n] + | otherwise = splith p (splitf (p*p) n) + + splith p (n:ns) = case n `quotRemInteger` p of + PAIR(q,r) | q > 0 -> q : r : splitb p ns + | otherwise -> r : splitb p ns + splith _ _ = error "splith: the impossible happened." + + splitb p (n:ns) = case n `quotRemInteger` p of + PAIR(q,r) -> q : r : splitb p ns + splitb _ _ = [] + + 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 a _) = a + + maxInt | base == 10 = maxInt10 + | otherwise = maxInt16 + maxDigits | base == 10 = maxDigits10 + | otherwise = maxDigits16 + + 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 (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 = 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/src/Data/Text/Format/Types.hs b/src/Data/Text/Format/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Format/Types.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Data.Text.Format.Types.Internal +-- Copyright : (c) 2011 MailRank, Inc. +-- +-- License : BSD-style +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- Types for text mangling. + +module Data.Text.Format.Types + ( + + Shown(..) + -- * Integer format control + , Hex(..) + ) where + +import Data.Monoid (Monoid(..)) +import Data.String (IsString(..)) +import Data.Text (Text) +import Data.Typeable (Typeable) + +-- | Render an integral type in hexadecimal. +newtype Hex a = Hex a + deriving (Eq, Ord, Read, Show, Num, Real, Enum, Integral) + +-- | 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/src/Formatting/Buildable.hs b/src/Formatting/Buildable.hs new file mode 100644 --- /dev/null +++ b/src/Formatting/Buildable.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings #-} + +-- | +-- Module : Data.Text.Buildable +-- Copyright : (c) 2011 MailRank, Inc. +-- +-- License : BSD-style +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- Types that can be rendered to a 'Builder'. + +module Formatting.Buildable + ( + Buildable(..) + ) where + +#if MIN_VERSION_base(4,8,0) +import qualified Data.ByteString.Lazy as L +import Data.Void (Void, absurd) +#endif + +import Data.Monoid (mempty) +import Data.Int (Int8, Int16, Int32, Int64) +import Data.Fixed (Fixed, HasResolution, showFixed) +import Data.Ratio (Ratio, denominator, numerator) +import Data.Text.Format.Functions ((<>)) +import Data.Text.Format.Int (decimal, hexadecimal, integer) +import Data.Text.Format.Types (Hex(..), Shown(..)) +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 +import qualified Data.Text.Encoding as T +import qualified Data.ByteString.Lazy.Builder as L + +-- | The class of types that can be rendered to a 'Builder'. +class Buildable p where + build :: p -> Builder + +instance Buildable Builder where + build = id + +#if MIN_VERSION_base(4,8,0) +instance Buildable Void where + build = absurd +#endif + +instance Buildable LT.Text where + build = fromLazyText + {-# INLINE build #-} + +instance Buildable ST.Text where + build = fromText + {-# INLINE build #-} + +instance Buildable Char where + build = singleton + {-# INLINE build #-} + +instance Buildable [Char] where + build = fromString + {-# INLINE build #-} + +instance (Integral a) => Buildable (Hex a) where + build = hexadecimal + {-# INLINE build #-} + +instance Buildable Int8 where + build = decimal + {-# INLINE build #-} + +instance Buildable Int16 where + build = decimal + {-# INLINE build #-} + +instance Buildable Int32 where + build = decimal + {-# INLINE build #-} + +instance Buildable Int where + build = decimal + {-# INLINE build #-} + +instance Buildable Int64 where + build = decimal + {-# INLINE build #-} + +instance Buildable Integer where + build = integer 10 + {-# INLINE build #-} + +instance (HasResolution a) => Buildable (Fixed a) where + build = build . showFixed False + {-# INLINE build #-} + +instance Buildable Word8 where + build = decimal + {-# INLINE build #-} + +instance Buildable Word16 where + build = decimal + {-# INLINE build #-} + +instance Buildable Word32 where + build = decimal + {-# INLINE build #-} + +instance Buildable Word where + build = decimal + {-# INLINE build #-} + +instance Buildable Word64 where + build = decimal + {-# INLINE build #-} + +instance (Integral a, Buildable a) => Buildable (Ratio a) where + {-# SPECIALIZE instance Buildable (Ratio Integer) #-} + build a = build (numerator a) <> singleton '/' <> build (denominator a) + +instance Buildable Float where + build = fromText . T.decodeUtf8 . L.toStrict . L.toLazyByteString . L.floatDec + {-# INLINE build #-}; + +instance Buildable Double where + build = fromText . T.decodeUtf8 . L.toStrict . L.toLazyByteString . L.doubleDec + {-# INLINE build #-} + +instance Buildable DiffTime where + build = build . Shown + {-# INLINE build #-} + +instance Buildable NominalDiffTime where + build = build . Shown + {-# INLINE build #-} + +instance Buildable UTCTime where + build = build . Shown + {-# INLINE build #-} + +instance Buildable UniversalTime where + build = build . Shown . getModJulianDate + {-# INLINE build #-} + +instance Buildable Day where + build = fromString . showGregorian + {-# INLINE build #-} + +instance (Show a) => Buildable (Shown a) where + build = fromString . show . shown + {-# INLINE build #-} + +instance (Buildable a) => Buildable (Maybe a) where + build Nothing = mempty + build (Just v) = build v + {-# INLINE build #-} + +instance Buildable TimeOfDay where + build = build . Shown + {-# INLINE build #-} + +instance Buildable TimeZone where + build = build . Shown + {-# INLINE build #-} + +instance Buildable LocalTime where + build = build . Shown + {-# INLINE build #-} + +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 + +instance Buildable Bool where + build True = fromText "True" + build False = fromText "False" diff --git a/src/Formatting/Clock.hs b/src/Formatting/Clock.hs --- a/src/Formatting/Clock.hs +++ b/src/Formatting/Clock.hs @@ -4,37 +4,36 @@ -- | Formatters for high-res, real-time and timer clock values from "System.Clock". -module Formatting.Clock where +module Formatting.Clock (timeSpecs) where +import Data.Text.Lazy.Builder import Formatting import Formatting.Internal import System.Clock --- | Format the duration from start to end (args passed in that order). --- --- Examples: --- --- @ --- 4.00 s --- 500.69 ms --- 1.20 ms --- 19.38 µs --- @ +fmt :: Integer -> Builder +fmt diff + | Just i <- scale ((10 ^ 9) * 60 * 60 * 24) = bprint (fixed 2 % " d") i + | Just i <- scale ((10 ^ 9) * 60 * 60) = bprint (fixed 2 % " h") i + | Just i <- scale ((10 ^ 9) * 60) = bprint (fixed 2 % " m") i + | Just i <- scale (10 ^ 9) = bprint (fixed 2 % " s") i + | Just i <- scale (10 ^ 6) = bprint (fixed 2 % " ms") i + | Just i <- scale (10 ^ 3) = bprint (fixed 2 % " us") i + | otherwise = bprint (int % " ns") diff + where + scale :: Integer -> Maybe Double + scale i = + if diff >= i + then Just (fromIntegral diff / fromIntegral i) + else Nothing + +-- | Same as @durationNS@ but works on `TimeSpec` from the clock package. timeSpecs :: Format r (TimeSpec -> TimeSpec -> r) -timeSpecs = Format (\g x y -> g (fmt x y)) - where fmt (TimeSpec s1 n1) (TimeSpec s2 n2) - | Just i <- scale ((10 ^ 9) * 60 * 60 * 24) = bprint (fixed 2 % " d") i - | Just i <- scale ((10 ^ 9) * 60 * 60) = bprint (fixed 2 % " h") i - | Just i <- scale ((10 ^ 9) * 60) = bprint (fixed 2 % " m") i - | Just i <- scale (10 ^ 9) = bprint (fixed 2 % " s") i - | Just i <- scale (10 ^ 6) = bprint (fixed 2 % " ms") i - | Just i <- scale (10 ^ 3) = bprint (fixed 2 % " us") i - | otherwise = bprint (int % " ns") diff - where scale :: Integer -> Maybe Double - scale i = if diff >= i - then Just (fromIntegral diff / fromIntegral i) - else Nothing - diff :: Integer - diff = a2 - a1 - a1 = (fromIntegral s1 * 10 ^ 9) + fromIntegral n1 - a2 = (fromIntegral s2 * 10 ^ 9) + fromIntegral n2 +timeSpecs = Format (\g x y -> g (fmt0 x y)) + where + fmt0 (TimeSpec s1 n1) (TimeSpec s2 n2) = fmt diff + where + diff :: Integer + diff = a2 - a1 + a1 = (fromIntegral s1 * 10 ^ 9) + fromIntegral n1 + a2 = (fromIntegral s2 * 10 ^ 9) + fromIntegral n2 diff --git a/src/Formatting/Examples.hs b/src/Formatting/Examples.hs --- a/src/Formatting/Examples.hs +++ b/src/Formatting/Examples.hs @@ -44,9 +44,8 @@ -- | Printing floating points. floats :: Text floats = - format ("Here comes a float: " % float % " and a double with sci notation: " % prec 6) + format ("Here comes a float: " % float) (123.2342 :: Float) - (13434242423.23420000 :: Double) -- | Printing integrals in hex (base-16). hexes :: Text diff --git a/src/Formatting/Formatters.hs b/src/Formatting/Formatters.hs --- a/src/Formatting/Formatters.hs +++ b/src/Formatting/Formatters.hs @@ -25,9 +25,7 @@ -- * Numbers int, float, - expt, fixed, - prec, sci, scifmt, shortest, @@ -63,8 +61,8 @@ import Data.Scientific import qualified Data.Text as S import qualified Data.Text as T -import Data.Text.Buildable (Buildable) -import qualified Data.Text.Buildable as B (build) +import Formatting.Buildable (Buildable) +import qualified Formatting.Buildable as B (build) import qualified Data.Text.Format as T import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as LT @@ -110,29 +108,18 @@ build = later B.build -- | Render an integral e.g. 123 -> \"123\", 0 -> \"0\". -int :: Integral a => Format r (a -> r) -int = later T.shortest +int :: (Integral a, Buildable a) => Format r (a -> r) +int = later B.build -- | Render some floating point with the usual notation, e.g. 123.32 => \"123.32\" float :: Real a => Format r (a -> r) float = later (T.shortest) --- | Render a floating point number using scientific/engineering --- notation (e.g. 2.3e123), with the given number of decimal places. -expt :: Real a => Int -> Format r (a -> r) -expt i = later (T.expt i) - -- | Render a floating point number using normal notation, with the -- given number of decimal places. fixed :: Real a => Int -> Format r (a -> r) fixed i = later (T.fixed i) --- | Render a floating point number, with the given number of digits --- of precision. Uses decimal notation for values between 0.1 and --- 9,999,999, and scientific notation otherwise. -prec :: Real a => Int -> Format r (a -> r) -prec i = later (T.prec i) - -- | Render a floating point number using the smallest number of -- digits that correctly represent it. shortest :: Real a => Format r (a -> r) @@ -172,22 +159,24 @@ -- | Group integral numbers, e.g. groupInt 2 '.' on 123456 -> \"12.34.56\". groupInt :: (Buildable n,Integral n) => Int -> Char -> Format r (n -> r) groupInt 0 _ = later B.build -groupInt i c = later (commaize) - where commaize = - T.fromLazyText . LT.reverse . - foldr merge "" . - LT.zip (zeros <> cycle' zeros') . - LT.reverse . - T.toLazyText . - B.build - zeros = - LT.replicate (fromIntegral i) - (LT.singleton '0') - zeros' = LT.singleton c <> LT.tail zeros - merge (f,c') rest - | f == c = LT.singleton c <> LT.singleton c' <> rest - | otherwise = LT.singleton c' <> rest - cycle' xs = xs <> cycle' xs +groupInt i c = + later + (\n -> + if n < 0 + then "-" <> commaize (negate n) + else commaize n) + where + commaize = + T.fromLazyText . + LT.reverse . + foldr merge "" . + LT.zip (zeros <> cycle' zeros') . LT.reverse . T.toLazyText . B.build + zeros = LT.replicate (fromIntegral i) (LT.singleton '0') + zeros' = LT.singleton c <> LT.tail zeros + merge (f, c') rest + | f == c = LT.singleton c <> LT.singleton c' <> rest + | otherwise = LT.singleton c' <> rest + cycle' xs = xs <> cycle' xs -- | Fit in the given length, truncating on the left. fitLeft :: Buildable a => Int -> Format r (a -> r) @@ -310,4 +299,3 @@ n' < 1024 || numDivs == (length bytesSuffixes - 1) bytesSuffixes = ["B","KB","MB","GB","TB","PB","EB","ZB","YB"] - diff --git a/src/Formatting/ShortFormatters.hs b/src/Formatting/ShortFormatters.hs --- a/src/Formatting/ShortFormatters.hs +++ b/src/Formatting/ShortFormatters.hs @@ -17,20 +17,20 @@ import Formatting.Formatters (bin, int, oct) import Formatting.Internal -import qualified Data.Text.Buildable as B (build) import qualified Data.Text as S import qualified Data.Text as T -import Data.Text.Buildable (Buildable) -import qualified Data.Text.Format as T +import qualified Data.Text.Format as T import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.Builder as T +import Formatting.Buildable (Buildable) +import qualified Formatting.Buildable as B (build) -- | Output a lazy text. t :: Format r (Text -> r) t = later T.fromLazyText -- | Render an integral e.g. 123 -> \"123\", 0 -> \"0\". -d :: Integral a => Format r (a -> r) +d :: (Integral a, Buildable a) => Format r (a -> r) d = int -- | Render an integer using binary notation. (No leading 0b is @@ -64,21 +64,10 @@ c :: Format r (Char -> r) c = later B.build --- | Render a floating point number using scientific/engineering --- notation (e.g. 2.3e123), with the given number of decimal places. -ef :: Real a => Int -> Format r (a -> r) -ef i = later (T.expt i) - -- | Render a floating point number using normal notation, with the -- given number of decimal places. f :: Real a => Int -> Format r (a -> r) f i = later (T.fixed i) - --- | Render a floating point number, with the given number of digits --- of precision. Uses decimal notation for values between 0.1 and --- 9,999,999, and scientific notation otherwise. -pf :: Real a => Int -> Format r (a -> r) -pf i = later (T.prec i) -- | Render a floating point number using the smallest number of -- digits that correctly represent it. diff --git a/src/Formatting/Time.hs b/src/Formatting/Time.hs --- a/src/Formatting/Time.hs +++ b/src/Formatting/Time.hs @@ -13,7 +13,7 @@ import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Buildable +import Formatting.Buildable import Data.Time #if MIN_VERSION_time(1,5,0) import System.Locale hiding (defaultTimeLocale) @@ -226,7 +226,7 @@ Just (_,f,base) -> bprint (prefix % f % suffix) (toInt ts base) where prefix = now (if fix && ts > 0 then "in " else "") suffix = now (if fix && ts < 0 then " ago" else "") - toInt ts base = abs (round (ts / base)) + toInt ts base = abs (round (ts / base)) :: Int ranges = [(0,int % " milliseconds",0.001) ,(1,int % " seconds",1) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Data.Int +import Formatting as F +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe + "Regression tests" + (do describe + "https://github.com/chrisdone/formatting/issues/31" + (do it + "10^6-1" + (shouldBe + (F.format F.int (10 ^ (16 :: Int) - 1 :: Int)) + "9999999999999999")) + describe + "https://github.com/chrisdone/formatting/issues/28" + (do it + "-100" + (shouldBe (sformat (groupInt 3 ',') (-100 :: Int)) "-100") + it + "-100,000,000" + (shouldBe + (sformat (groupInt 3 ',') (-100000000 :: Int)) + "-100,000,000") + it + "100,000,000" + (shouldBe + (sformat (groupInt 3 ',') (-100000000 :: Int)) + "-100,000,000")) + describe + "https://github.com/bos/text-format/issues/18" + (do it + "build (minBound :: Int)" + (shouldBe (format build (minBound :: Int64)) + "-9223372036854775808")))