text-format-0.3.2/0000755000000000000000000000000013326124715012160 5ustar0000000000000000text-format-0.3.2/CHANGELOG.md0000644000000000000000000000011413326124715013765 0ustar0000000000000000# O.3.2 [Non-maintainer upload] - Semigroup-Monoid compatibility (GHC-8.4) text-format-0.3.2/Setup.lhs0000644000000000000000000000011413326124715013764 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain text-format-0.3.2/README.markdown0000644000000000000000000000132613326124715014663 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.2/LICENSE0000644000000000000000000000245113326124715013167 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.2/text-format.cabal0000644000000000000000000000332413326124715015420 0ustar0000000000000000name: text-format version: 0.3.2 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 synopsis: Text formatting cabal-version: >= 1.8 build-type: Simple description: A text formatting library optimized for both ease of use and high performance. tested-with: GHC == 7.0.4 || == 7.2.2 || == 7.4.2 || == 7.6.3 || == 7.8.4 || == 7.10.3 || == 8.0.2 || == 8.2.2 || == 8.4.3 || == 8.6.1 extra-source-files: README.markdown CHANGELOG.md benchmarks/Makefile benchmarks/*.c benchmarks/*.hs flag developer description: operate in developer mode default: False manual: True library exposed-modules: Data.Text.Format Data.Text.Buildable Data.Text.Format.Params Data.Text.Format.Types Data.Text.Format.Types.Internal other-modules: Data.Text.Format.Functions Data.Text.Format.Int build-depends: array, base >=4.3 && <4.12, integer-gmp >= 0.2, 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 >= 8.0) build-depends: semigroups >= 0.18.5 && < 0.19 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.2/benchmarks/0000755000000000000000000000000013326124715014275 5ustar0000000000000000text-format-0.3.2/benchmarks/Benchmarks.hs0000644000000000000000000000740013326124715016707 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.2/benchmarks/printf.c0000644000000000000000000000120113326124715015735 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.2/benchmarks/Simple.hs0000644000000000000000000000600613326124715016064 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.2/benchmarks/Makefile0000644000000000000000000000044313326124715015736 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.2/benchmarks/wprintf.c0000644000000000000000000000122613326124715016133 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.2/Data/0000755000000000000000000000000013326124715013031 5ustar0000000000000000text-format-0.3.2/Data/Text/0000755000000000000000000000000013326124715013755 5ustar0000000000000000text-format-0.3.2/Data/Text/Format.hs0000644000000000000000000001210013326124715015533 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 Data.Semigroup ((<>)) import Control.Monad.IO.Class (MonadIO(liftIO)) 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.2/Data/Text/Buildable.hs0000644000000000000000000001107413326124715016177 0ustar0000000000000000{-# 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 Data.Text.Buildable ( Buildable(..) ) where #if MIN_VERSION_base(4,8,0) import Data.Void (Void, absurd) #endif import Data.Semigroup ((<>)) 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.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 #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 = decimal {-# 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 . 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.2/Data/Text/Format/0000755000000000000000000000000013326124715015205 5ustar0000000000000000text-format-0.3.2/Data/Text/Format/Int.hs0000644000000000000000000001171613326124715016301 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.Semigroup ((<>)) 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.2/Data/Text/Format/Types.hs0000644000000000000000000000073613326124715016653 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.2/Data/Text/Format/Functions.hs0000644000000000000000000000144613326124715017516 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 ( (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 {-# DEPRECATED (<>) "Use <> from Data.Semigroup" #-} {-# INLINE (<>) #-} infixr 4 <> text-format-0.3.2/Data/Text/Format/Params.hs0000644000000000000000000001741213326124715016771 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.2/Data/Text/Format/Types/0000755000000000000000000000000013326124715016311 5ustar0000000000000000text-format-0.3.2/Data/Text/Format/Types/Internal.hs0000644000000000000000000000436713326124715020433 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.Semigroup (Semigroup (..)) 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 Semigroup Format where Format a <> Format b = Format (a `mappend` b) instance Monoid Format where mempty = Format mempty mappend = (<>) 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)