text-format-0.3.1.1/0000755000000000000000000000000012306137345012316 5ustar0000000000000000text-format-0.3.1.1/LICENSE0000644000000000000000000000245112306137345013325 0ustar0000000000000000Copyright (c) 2011 MailRank, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. text-format-0.3.1.1/README.markdown0000644000000000000000000000132612306137345015021 0ustar0000000000000000# Welcome to text-format text-format is a fast and easy-to-use Haskell library for formatting text strings. # Join in! We are happy to receive bug reports, fixes, documentation enhancements, and other improvements. Please report bugs via the [github issue tracker](https://github.com/bos/text-format/issues). Master [git repository](https://github.com/bos/text-format): * `git clone git://github.com/bos/text-format.git` There's also a [Mercurial mirror](https://bitbucket.org/bos/text-format): * `hg clone https://bitbucket.org/bos/text-format` (You can create and contribute changes using either git or Mercurial.) Authors ------- This library is written and maintained by Bryan O'Sullivan, . text-format-0.3.1.1/Setup.lhs0000644000000000000000000000011412306137345014122 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain text-format-0.3.1.1/text-format.cabal0000644000000000000000000000311012306137345015547 0ustar0000000000000000name: text-format version: 0.3.1.1 license: BSD3 license-file: LICENSE homepage: https://github.com/bos/text-format bug-reports: https://github.com/bos/text-format/issues category: Text author: Bryan O'Sullivan maintainer: Bryan O'Sullivan stability: experimental tested-with: GHC == 7.0.3 synopsis: Text formatting cabal-version: >= 1.8 build-type: Simple description: A text formatting library optimized for both ease of use and high performance. extra-source-files: README.markdown benchmarks/Makefile benchmarks/*.c benchmarks/*.hs flag developer description: operate in developer mode default: False library exposed-modules: Data.Text.Format Data.Text.Buildable Data.Text.Format.Params Data.Text.Format.Types other-modules: Data.Text.Format.Functions Data.Text.Format.Int Data.Text.Format.Types.Internal build-depends: array, base == 4.*, double-conversion >= 0.2.0.0, ghc-prim, old-locale, text >= 0.11.0.8, time, transformers if flag(developer) ghc-options: -Werror ghc-prof-options: -auto-all ghc-options: -Wall cpp-options: -DINTEGER_GMP if impl(ghc >= 6.11) build-depends: integer-gmp >= 0.2 if impl(ghc >= 6.9) && impl(ghc < 6.11) build-depends: integer >= 0.1 && < 0.2 source-repository head type: git location: https://github.com/bos/text-format source-repository head type: mercurial location: https://bitbucket.org/bos/text-format text-format-0.3.1.1/benchmarks/0000755000000000000000000000000012306137345014433 5ustar0000000000000000text-format-0.3.1.1/benchmarks/Benchmarks.hs0000644000000000000000000000740012306137345017045 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Criterion.Main import Data.Text.Format import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Text.Printf as P printf1 :: (P.PrintfArg a) => String -> a -> String printf1 f a = P.printf f a printf2 :: (P.PrintfArg a, P.PrintfArg b) => String -> (a,b) -> String printf2 f (a,b) = P.printf f a b printf3 :: (P.PrintfArg a, P.PrintfArg b, P.PrintfArg c) => String -> (a,b,c) -> String printf3 f (a,b,c) = P.printf f a b c 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 "comparison" [ bench "format1" $ nf (format "hi mom {}\n") (Only (pi::Double)) , bench "printf1" $ nf (printf1 "hi mom %f\n") (pi::Double) , bench "show1" $ nf (\d -> "hi mom " ++ show d ++ "\n") (pi::Double) , bench "format2" $ nf (format "hi mom {} {}\n") (pi::Double, "yeah"::T.Text) , bench "printf2" $ nf (printf2 "hi mom %f %s\n") (pi::Double, "yeah"::String) , bench "show2" $ nf (\(d,s) -> "hi mom " ++ show d ++ " " ++ show s ++ "\n") (pi::Double, "yeah"::String) , bench "format3" $ nf (format "hi mom {} {} {}\n") (pi::Double, "yeah"::T.Text, 21212121::Int) , bench "printf3" $ nf (printf3 "hi mom %f %s %d\n") (pi::Double, "yeah"::String, 21212121::Int) , bench "show3" $ nf (\(d,s,i) -> "hi mom " ++ show d ++ " " ++ show s ++ "\n") (pi::Double, "yeah"::String, 21212121::Int) ] , 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" [ 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 "double" [ 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 "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") ] ] ] text-format-0.3.1.1/benchmarks/Makefile0000644000000000000000000000044312306137345016074 0ustar0000000000000000ghc := ghc programs := bm simple c-printf c-wprintf all: $(programs) bm: Benchmarks.hs $(ghc) -rtsopts -O -o $@ $< simple: Simple.hs $(ghc) -rtsopts -O -o $@ $< c-printf: printf.c $(CC) -O2 -o $@ $< c-wprintf: wprintf.c $(CC) -O2 -o $@ $< clean: -rm -f $(programs) *.hi *.o *.hp text-format-0.3.1.1/benchmarks/printf.c0000644000000000000000000000120112306137345016073 0ustar0000000000000000#include #include #include #include double gettime(void) { struct timeval tv; gettimeofday(&tv, NULL); return tv.tv_sec + (tv.tv_usec / 1e6); } void loop(int count) { int i; for (i = 0; i < count; i++) printf("hi mom %g\n", (double) i * M_PI); } int main(int argc, char **argv) { double start, elapsed; int i, count; count = argc == 2 ? atoi(argv[1]) : 1600000; start = gettime(); loop(count); elapsed = gettime() - start; fprintf(stderr, "%d iterations in %g secs (%g thousand/sec)\n", count, elapsed, count / elapsed / 1e3); } text-format-0.3.1.1/benchmarks/Simple.hs0000644000000000000000000000600612306137345016222 0ustar0000000000000000{-# LANGUAGE BangPatterns, OverloadedStrings #-} --module Main (main) where import Control.Monad import Data.Char import Data.Bits import System.Environment import Data.Text.Format as T import Data.Time.Clock import Data.Text (Text) import qualified Data.Text as T import Data.Text.Lazy.Encoding import qualified Data.ByteString.Lazy as L import System.IO counting :: Int -> (Int -> () -> IO ()) -> IO () counting count act = loop 0 where loop !i | i < count = act i () >> loop (i+1) | otherwise = return () {-# NOINLINE counting #-} idle count = counting count $ \_ x -> return () plain count = counting count $ \_ x -> do L.putStr . encodeUtf8 $ "hi mom\n" unit count = counting count $ \_ x -> do let t = T.format "hi mom\n" x L.putStr . encodeUtf8 $ t int count = counting count $ \i x -> do let t = T.format "hi mom {}\n" (Only i) L.putStr . encodeUtf8 $ t bigint count = counting count $ \i x -> do let t = T.format "hi mom {}\n" (Only (i+100000)) L.putStr . encodeUtf8 $ t double count = counting count $ \i x -> do let t = T.format "hi mom {}\n" (Only (fromIntegral i * dpi)) L.putStr . encodeUtf8 $ t p6 count = counting count $ \i x -> do let t = T.format "hi mom {}\n" (Only (prec 6 $! fromIntegral i * dpi)) L.putStr . encodeUtf8 $ t arg :: Int -> Text arg i = "fnord" `T.append` (T.take (i `mod` 6) "foobar") {-# NOINLINE arg #-} one count = counting count $ \i x -> do let k = arg i let t = {-# SCC "one/format" #-} T.format "hi mom {}\n" (Only k) L.putStr . encodeUtf8 $ t two count = counting count $ \i x -> do let k = arg i let t = {-# SCC "two/format" #-} T.format "hi mom {} {}\n" (k,k) L.putStr . encodeUtf8 $ t three count = counting count $ \i x -> do let k = arg i let t = {-# SCC "three/format" #-} T.format "hi mom {} {} {}\n" (k,k,k) L.putStr . encodeUtf8 $ t four count = counting count $ \i x -> do let k = arg i let t = {-# SCC "four/format" #-} T.format "hi mom {} {} {} {}\n" (k,k,k,k) L.putStr . encodeUtf8 $ t five count = counting count $ \i x -> do let k = arg i let t = {-# SCC "five/format" #-} T.format "hi mom {} {} {} {} {}\n" (k,k,k,k,k) L.putStr . encodeUtf8 $ t dpi :: Double dpi = pi main = do args <- getArgs let count = case args of (_:x:_) -> read x _ -> 100000 let bm = case args of ("idle":_) -> idle ("plain":_) -> plain ("unit":_) -> unit ("double":_) -> double ("p6":_) -> p6 ("int":_) -> int ("bigint":_) -> bigint ("one":_) -> one ("two":_) -> two ("three":_) -> three ("four":_) -> four ("five":_) -> five _ -> error "wut?" start <- getCurrentTime bm count elapsed <- (`diffUTCTime` start) `fmap` getCurrentTime T.hprint stderr "{} iterations in {} secs ({} thousand/sec)\n" (count, elapsed, fromRational (toRational count / toRational elapsed / 1e3) :: Double) text-format-0.3.1.1/benchmarks/wprintf.c0000644000000000000000000000122612306137345016271 0ustar0000000000000000#include #include #include #include #include double gettime(void) { struct timeval tv; gettimeofday(&tv, NULL); return tv.tv_sec + (tv.tv_usec / 1e6); } void loop(int count) { int i; for (i = 0; i < count; i++) wprintf(L"hi mom %g\n", (double) i * M_PI); } int main(int argc, char **argv) { double start, elapsed; int i, count; count = argc == 2 ? atoi(argv[1]) : 1600000; start = gettime(); loop(count); elapsed = gettime() - start; fprintf(stderr, "%d iterations in %g secs (%g thousand/sec)\n", count, elapsed, count / elapsed / 1e3); } text-format-0.3.1.1/Data/0000755000000000000000000000000012306137345013167 5ustar0000000000000000text-format-0.3.1.1/Data/Text/0000755000000000000000000000000012306137345014113 5ustar0000000000000000text-format-0.3.1.1/Data/Text/Buildable.hs0000644000000000000000000001040012306137345016325 0ustar0000000000000000{-# LANGUAGE 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 Data.Text.Buildable ( Buildable(..) ) where import Data.Monoid (mempty) import Data.Int (Int8, Int16, Int32, Int64) import Data.Ratio (Ratio, denominator, numerator) import Data.Text.Format.Functions ((<>)) import Data.Text.Format.Int (decimal, hexadecimal) 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.Double.Conversion.Text as C import qualified Data.Text as ST import qualified Data.Text.Lazy as LT -- | The class of types that can be rendered to a 'Builder'. class Buildable p where build :: p -> Builder instance Buildable Builder where build = id 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 = decimal {-# 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 . C.toPrecision 6 . realToFrac {-# INLINE build #-} instance Buildable Double where build = fromText . C.toPrecision 6 {-# 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" text-format-0.3.1.1/Data/Text/Format.hs0000644000000000000000000001211412306137345015676 0ustar0000000000000000{-# 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 ( -- * Types Format , Only(..) -- ** Types for format control , Shown(..) -- * Rendering , format , print , hprint , build -- * Format control , left , right -- ** Integers , hex -- ** Floating point numbers , expt , fixed , prec , shortest ) where import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Text.Format.Functions ((<>)) import Data.Text.Format.Params (Params(..)) import Data.Text.Format.Types.Internal (Format(..), Only(..), Shown(..)) import Data.Text.Format.Types.Internal (Hex(..)) import Data.Text.Lazy.Builder import Prelude hiding (exp, print) import System.IO (Handle) import qualified Data.Double.Conversion.Text as C import qualified Data.Text as ST import qualified Data.Text.Buildable as B import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.IO as LT -- Format strings are almost always constants, and they're expensive -- to interpret (which we refer to as "cracking" here). We'd really -- like to have GHC memoize the cracking of a known-constant format -- string, so that it occurs at most once. -- -- To achieve this, we arrange to have the cracked version of a format -- string let-floated out as a CAF, by inlining the definitions of -- build and functions that invoke it. This works well with GHC 7. -- | Render a format string and arguments to a 'Builder'. build :: Params ps => Format -> ps -> Builder build fmt ps = zipParams (crack fmt) (buildParams ps) {-# INLINE build #-} zipParams :: [Builder] -> [Builder] -> Builder zipParams fragments params = go fragments params where go (f:fs) (y:ys) = f <> y <> go fs ys go [f] [] = f go _ _ = error . LT.unpack $ format "Data.Text.Format.build: {} sites, but {} parameters" (length fragments - 1, length params) crack :: Format -> [Builder] crack = map fromText . ST.splitOn "{}" . fromFormat -- | Render a format string and arguments to a 'LT.Text'. format :: Params ps => Format -> ps -> LT.Text format fmt ps = toLazyText $ build fmt ps {-# INLINE format #-} -- | Render a format string and arguments, then print the result. print :: (MonadIO m, Params ps) => Format -> ps -> m () print fmt ps = liftIO . LT.putStr . toLazyText $ build fmt ps {-# INLINE print #-} -- | Render a format string and arguments, then print the result to -- the given file handle. hprint :: (MonadIO m, Params ps) => Handle -> Format -> ps -> m () hprint h fmt ps = liftIO . LT.hPutStr h . toLazyText $ build fmt ps {-# INLINE hprint #-} -- | 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, 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 -- ^ Number of digits of precision. -> a -> Builder {-# RULES "prec/Double" forall d x. prec d (x::Double) = B.build (C.toPrecision d x) #-} prec digits = B.build . C.toPrecision digits . realToFrac {-# NOINLINE[0] prec #-} -- | 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 . C.toFixed decs . realToFrac {-# RULES "fixed/Double" forall d x. fixed d (x::Double) = B.build (C.toFixed d x) #-} {-# NOINLINE[0] fixed #-} -- | Render a floating point number using scientific/engineering -- notation (e.g. @2.3e123@), with the given number of decimal places. expt :: (Real a) => Int -- ^ Number of digits of precision after the decimal. -> a -> Builder expt decs = B.build . C.toExponential decs . realToFrac {-# RULES "expt/Double" forall d x. expt d (x::Double) = B.build (C.toExponential d x) #-} {-# NOINLINE[0] expt #-} -- | Render a floating point number using the smallest number of -- digits that correctly represent it. shortest :: (Real a) => a -> Builder shortest = B.build . C.toShortest . realToFrac {-# RULES "shortest/Double" forall x. shortest (x::Double) = B.build (C.toShortest x) #-} {-# 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 #-} text-format-0.3.1.1/Data/Text/Format/0000755000000000000000000000000012306137345015343 5ustar0000000000000000text-format-0.3.1.1/Data/Text/Format/Functions.hs0000644000000000000000000000132612306137345017651 0ustar0000000000000000{-# 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 <> text-format-0.3.1.1/Data/Text/Format/Int.hs0000644000000000000000000001166712306137345016444 0ustar0000000000000000{-# 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 , 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 => 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) {-# 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 text-format-0.3.1.1/Data/Text/Format/Params.hs0000644000000000000000000001741212306137345017127 0ustar0000000000000000-- | -- Module : Data.Text.Format.Params -- Copyright : (c) 2011 MailRank, Inc. -- -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC -- -- Types that can be used as a collection of arguments for formatting. module Data.Text.Format.Params ( Params(..) ) where import Data.Text.Buildable import Data.Text.Format.Types import Data.Text.Lazy.Builder -- | The class of types that can be used as a collection of arguments -- for formatting. class Params ps where buildParams :: ps -> [Builder] instance Params () where buildParams _ = [] instance (Buildable a) => Params (Only a) where buildParams (Only a) = [build a] instance (Buildable a) => Params [a] where buildParams = map build instance (Buildable a, Buildable b) => Params (a,b) where buildParams (a,b) = [build a, build b] instance (Buildable a, Buildable b, Buildable c) => Params (a,b,c) where buildParams (a,b,c) = [build a, build b, build c] instance (Buildable a, Buildable b, Buildable c, Buildable d) => Params (a,b,c,d) where buildParams (a,b,c,d) = [build a, build b, build c, build d] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e) => Params (a,b,c,d,e) where buildParams (a,b,c,d,e) = [build a, build b, build c, build d, build e] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f) => Params (a,b,c,d,e,f) where buildParams (a,b,c,d,e,f) = [build a, build b, build c, build d, build e, build f] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g) => Params (a,b,c,d,e,f,g) where buildParams (a,b,c,d,e,f,g) = [build a, build b, build c, build d, build e, build f, build g] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h) => Params (a,b,c,d,e,f,g,h) where buildParams (a,b,c,d,e,f,g,h) = [build a, build b, build c, build d, build e, build f, build g, build h] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i) => Params (a,b,c,d,e,f,g,h,i) where buildParams (a,b,c,d,e,f,g,h,i) = [build a, build b, build c, build d, build e, build f, build g, build h, build i] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j) => Params (a,b,c,d,e,f,g,h,i,j) where buildParams (a,b,c,d,e,f,g,h,i,j) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k) => Params (a,b,c,d,e,f,g,h,i,j,k) where buildParams (a,b,c,d,e,f,g,h,i,j,k) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l) => Params (a,b,c,d,e,f,g,h,i,j,k,l) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l, Buildable m) => Params (a,b,c,d,e,f,g,h,i,j,k,l,m) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l, build m] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l, Buildable m, Buildable n) => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l, build m, build n] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l, Buildable m, Buildable n, Buildable o) => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l, build m, build n, build o] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, Buildable p) => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l, build m, build n, build o, build p] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, Buildable p, Buildable r) => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l, build m, build n, build o, build p, build r] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, Buildable p, Buildable r, Buildable s) => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l, build m, build n, build o, build p, build r, build s] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, Buildable p, Buildable r, Buildable s, Buildable t) => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l, build m, build n, build o, build p, build r, build s, build t] instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, Buildable p, Buildable r, Buildable s, Buildable t, Buildable u) => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t,u) where buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t,u) = [build a, build b, build c, build d, build e, build f, build g, build h, build i, build j, build k, build l, build m, build n, build o, build p, build r, build s, build t, build u] text-format-0.3.1.1/Data/Text/Format/Types.hs0000644000000000000000000000073612306137345017011 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} -- | -- Module : Data.Text.Format.Types -- 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 ( Format , Only(..) , Shown(..) -- * Integer format control , Hex(..) ) where import Data.Text.Format.Types.Internal text-format-0.3.1.1/Data/Text/Format/Types/0000755000000000000000000000000012306137345016447 5ustar0000000000000000text-format-0.3.1.1/Data/Text/Format/Types/Internal.hs0000644000000000000000000000424312306137345020562 0ustar0000000000000000{-# 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.Internal ( Format(..) , Only(..) , Shown(..) -- * Integer format control , Hex(..) ) 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 { fromFormat :: Text } deriving (Eq, Ord, Typeable, Show) 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) -- | 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)