formatting-6.3.7/src/0000755000000000000000000000000013413160650012655 5ustar0000000000000000formatting-6.3.7/src/Data/0000755000000000000000000000000013311162750013526 5ustar0000000000000000formatting-6.3.7/src/Data/Text/0000755000000000000000000000000013317113754014460 5ustar0000000000000000formatting-6.3.7/src/Data/Text/Format/0000755000000000000000000000000013311162750015702 5ustar0000000000000000formatting-6.3.7/src/Formatting/0000755000000000000000000000000013413170530014765 5ustar0000000000000000formatting-6.3.7/src/Formatting/Internal/0000755000000000000000000000000013311162750016543 5ustar0000000000000000formatting-6.3.7/test/0000755000000000000000000000000013413170530013043 5ustar0000000000000000formatting-6.3.7/src/Formatting.hs0000644000000000000000000000151613413160650015326 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS -Wall #-} -- | -- Module : Text.Format -- Copyright : (c) 2013 Chris Done, 2013 Shachaf Ben-Kiki -- License : BSD3 -- Maintainer : chrisdone@gmail.com -- Stability : experimental -- Portability : GHC -- -- Combinator-based type-safe formatting (like printf() or FORMAT) for Text. -- -- Example: -- -- >>> format ("Person's name is " % text % ", age is " % hex) "Dave" 54 -- -- See "Formatting.Formatters" for a complete list of formatting combinators. module Formatting ( Format, (%), (%.), now, later, mapf, -- * Top-level functions runFormat, format, sformat, bprint, fprint, hprint, formatToString, -- * Formatting library module Formatting.Formatters ) where import Formatting.Formatters import Formatting.Internal formatting-6.3.7/src/Formatting/Formatters.hs0000644000000000000000000002125713413160650017460 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS -Wall #-} -- | -- Module : Formatting.Formatters -- Copyright : (c) 2013 Chris Done, 2013 Shachaf Ben-Kiki -- License : BSD3 -- Maintainer : chrisdone@gmail.com -- Stability : experimental -- Portability : GHC -- -- Formatting functions. module Formatting.Formatters ( -- * Text/string types text, stext, string, shown, char, builder, fconst, -- * Numbers int, float, fixed, sci, scifmt, shortest, groupInt, commas, ords, plural, asInt, -- * Padding left, right, center, fitLeft, fitRight, -- * Bases base, bin, oct, hex, prefixBin, prefixOct, prefixHex, bytes, -- * Buildables build, Buildable, ) where import Formatting.Internal import Data.Char (chr, ord) import Data.Monoid ((<>)) import Data.Scientific import qualified Data.Text as S import qualified Data.Text as T 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 import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as T import Data.Text.Lazy.Builder.Scientific import Numeric (showIntAtBase) -- | Output a lazy text. text :: Format r (Text -> r) text = later T.fromLazyText -- | Output a strict text. stext :: Format r (S.Text -> r) stext = later T.fromText -- | Output a string. string :: Format r (String -> r) string = later (T.fromText . T.pack) -- | Output a showable value (instance of 'Show') by turning it into -- 'Text': -- -- >>> format ("Value number " % shown % " is " % shown % ".") 42 False -- "Value number 42 is False." shown :: Show a => Format r (a -> r) shown = later (T.fromText . T.pack . show) -- | Output a character. char :: Format r (Char -> r) char = later B.build -- | Build a builder. builder :: Format r (Builder -> r) builder = later id -- | Like `const` but for formatters. fconst :: Builder -> Format r (a -> r) fconst m = later (const m) -- | Build anything that implements the "Buildable" class. build :: Buildable a => Format r (a -> r) build = later B.build -- | Render an integral e.g. 123 -> \"123\", 0 -> \"0\". int :: Integral a => Format r (a -> r) int = base 10 -- | 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 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 using the smallest number of -- digits that correctly represent it. shortest :: Real a => Format r (a -> r) shortest = later T.shortest -- | Render a scientific number. sci :: Format r (Scientific -> r) sci = later scientificBuilder -- | Render a scientific number with options. scifmt :: FPFormat -> Maybe Int -> Format r (Scientific -> r) scifmt f i = later (formatScientificBuilder f i) -- | Shows the Int value of Enum instances using 'fromEnum'. -- -- >>> format ("Got: " % char % " (" % asInt % ")") 'a' 'a' -- "Got: a (97)" asInt :: Enum a => Format r (a -> r) asInt = later (T.shortest . fromEnum) -- | Pad the left hand side of a string until it reaches k characters -- wide, if necessary filling with character c. left :: Buildable a => Int -> Char -> Format r (a -> r) left i c = later (T.left i c) -- | Pad the right hand side of a string until it reaches k characters -- wide, if necessary filling with character c. right :: Buildable a => Int -> Char -> Format r (a -> r) right i c = later (T.right i c) -- | Pad the left & right hand side of a string until it reaches k characters -- wide, if necessary filling with character c. center :: Buildable a => Int -> Char -> Format r (a -> r) center i c = later centerT where centerT = T.fromLazyText . LT.center (fromIntegral i) c . T.toLazyText . B.build -- | 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 (\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) fitLeft size = later (fit (fromIntegral size)) where fit i = T.fromLazyText . LT.take i . T.toLazyText . B.build -- | Fit in the given length, truncating on the right. fitRight :: Buildable a => Int -> Format r (a -> r) fitRight size = later (fit (fromIntegral size)) where fit i = T.fromLazyText . (\t -> LT.drop (LT.length t - i) t) . T.toLazyText . B.build -- | Add commas to an integral, e.g 12000 -> \ "12,000". commas :: (Buildable n,Integral n) => Format r (n -> r) commas = groupInt 3 ',' -- | Add a suffix to an integral, e.g. 1st, 2nd, 3rd, 21st. ords :: Integral n => Format r (n -> r) ords = later go where go n | tens > 3 && tens < 21 = T.fixed 0 n <> "th" | otherwise = T.fixed 0 n <> case n `mod` 10 of 1 -> "st" 2 -> "nd" 3 -> "rd" _ -> "th" where tens = n `mod` 100 -- | English plural suffix for an integral. plural :: (Num a, Eq a) => Text -> Text -> Format r (a -> r) plural s p = later (\i -> if i == 1 then B.build s else B.build p) -- | Render an integral at base n. base :: Integral a => Int -> Format r (a -> r) base numBase = later (B.build . atBase numBase) -- | Render an integer using binary notation. (No leading 0b is -- added.) Defined as @bin = 'base' 2@. bin :: Integral a => Format r (a -> r) bin = base 2 {-# INLINE bin #-} -- | Render an integer using octal notation. (No leading 0o is -- added.) Defined as @oct = 'base' 8@. oct :: Integral a => Format r (a -> r) oct = base 8 {-# INLINE oct #-} -- | Render an integer using hexadecimal notation. (No leading 0x is -- added.) Has a specialized implementation. hex :: Integral a => Format r (a -> r) hex = later T.hex {-# INLINE hex #-} -- | Render an integer using binary notation with a leading 0b. prefixBin :: Integral a => Format r (a -> r) prefixBin = "0b" % bin {-# INLINE prefixBin #-} -- | Render an integer using octal notation with a leading 0o. prefixOct :: Integral a => Format r (a -> r) prefixOct = "0o" % oct {-# INLINE prefixOct #-} -- | Render an integer using hexadecimal notation with a leading 0x. prefixHex :: Integral a => Format r (a -> r) prefixHex = "0x" % hex {-# INLINE prefixHex #-} -- The following code is mostly taken from `Numeric.Lens.' (from -- `lens') and modified. -- | Internal function that converts a number to a base base-2 through -- base-36. atBase :: Integral a => Int -> a -> String atBase b _ | b < 2 || b > 36 = error ("base: Invalid base " ++ show b) atBase b n = showSigned' (showIntAtBase (toInteger b) intToDigit') (toInteger n) "" {-# INLINE atBase #-} -- | A simpler variant of 'Numeric.showSigned' that only prepends a dash and -- doesn't know about parentheses showSigned' :: Real a => (a -> ShowS) -> a -> ShowS showSigned' f n | n < 0 = showChar '-' . f (negate n) | otherwise = f n -- | Like 'Data.Char.intToDigit', but handles up to base-36 intToDigit' :: Int -> Char intToDigit' i | i >= 0 && i < 10 = chr (ord '0' + i) | i >= 10 && i < 36 = chr (ord 'a' + i - 10) | otherwise = error ("intToDigit': Invalid int " ++ show i) -- | Renders a given byte count using an appropiate decimal binary suffix: -- -- >>> format (bytes shortest) 1024 -- "1KB" -- -- >>> format (bytes (fixed 2 % " ")) (1024*1024*5) -- "5.00 MB" -- bytes :: (Ord f,Integral a,Fractional f) => Format Builder (f -> Builder) -- ^ formatter for the decimal part -> Format r (a -> r) bytes d = later go where go bs = bprint d (fromIntegral (signum bs) * dec) <> bytesSuffixes !! i where (dec,i) = getSuffix (abs bs) getSuffix n = until p (\(x,y) -> (x / 1024,y + 1)) (fromIntegral n,0) where p (n',numDivs) = n' < 1024 || numDivs == (length bytesSuffixes - 1) bytesSuffixes = ["B","KB","MB","GB","TB","PB","EB","ZB","YB"] formatting-6.3.7/src/Formatting/ShortFormatters.hs0000644000000000000000000000462513317354363020511 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS -Wall #-} -- | -- Module : Formatting.ShortFormatters -- Copyright : (c) 2013 Chris Done, 2013 Shachaf Ben-Kiki -- License : BSD3 -- Maintainer : chrisdone@gmail.com -- Stability : experimental -- Portability : GHC -- -- Single letters for short formatting. module Formatting.ShortFormatters where import Formatting.Formatters (bin, int, oct) import Formatting.Internal import qualified Data.Text as S import qualified Data.Text 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 = int -- | Render an integer using binary notation. (No leading 0b is -- added.) b :: Integral a => Format r (a -> r) b = bin -- | Render an integer using octal notation. (No leading 0o is added.) o :: Integral a => Format r (a -> r) o = oct -- | Render an integer using hexadecimal notation. (No leading 0x is -- added.) x :: Integral a => Format r (a -> r) x = later T.hex -- | Output a strict text. st :: Format r (S.Text -> r) st = later T.fromText -- | Output a string. s :: Format r (String -> r) s = later (T.fromText . T.pack) -- | Output a showable value (instance of 'Show') by turning it into -- 'Text'. sh :: Show a => Format r (a -> r) sh = later (T.fromText . T.pack . show) -- | Output a character. c :: Format r (Char -> r) c = later B.build -- | 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 using the smallest number of -- digits that correctly represent it. sf :: Real a => Format r (a -> r) sf = later T.shortest -- | Pad the left hand side of a string until it reaches @k@ characters -- wide, if necessary filling with character @ch@. l :: Buildable a => Int -> Char -> Format r (a -> r) l i ch = later (T.left i ch) -- | Pad the right hand side of a string until it reaches @k@ characters -- wide, if necessary filling with character @ch@. r :: Buildable a => Int -> Char -> Format r (a -> r) r i ch = later (T.right i ch) formatting-6.3.7/src/Formatting/Examples.hs0000644000000000000000000000252513311162750017105 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Examples that should always compile. If reading on Haddock, you -- can view the sources to each of these. module Formatting.Examples where import Data.Text.Lazy (Text) import Data.Text.Lazy.Builder (Builder) import Formatting -- | Simple hello, world! hello :: Text hello = format ("Hello, World!") -- | Printing strings. strings :: Text strings = format ("Here comes a string: " % string % " and another " % string) "Hello, World!" "Ahoy!" -- | Printing texts. texts :: Text texts = format ("Here comes a string: " % text % " and another " % text) "Hello, World!" "Ahoy!" -- | Printing builders. builders :: Text builders = format ("Here comes a string: " % builder % " and another " % text) ("Hello, World!" :: Builder) "Ahoy!" -- | Printing integers. integers :: Text integers = format ("Here comes an integer: " % int % " and another: " % int) (23 :: Int) (0 :: Integer) -- | Printing floating points. floats :: Text floats = format ("Here comes a float: " % float) (123.2342 :: Float) -- | Printing integrals in hex (base-16). hexes :: Text hexes = format ("Here comes a hex: " % hex) (123 :: Int) -- | Padding. padding :: Text padding = format ("A left-padded number: " % left 3 '0') (9 :: Int) formatting-6.3.7/src/Formatting/Time.hs0000644000000000000000000002307013311162750016223 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} -- | Formatters for time. module Formatting.Time where import Data.List import Data.Text.Lazy.Builder import Formatting.Formatters hiding (build) import Formatting.Internal import Data.Text (Text) import qualified Data.Text as T import Formatting.Buildable import Data.Time #if MIN_VERSION_time(1,5,0) import System.Locale hiding (defaultTimeLocale) #else import System.Locale #endif -- * For 'TimeZone' (and 'ZonedTime' and 'UTCTime'): -- | Timezone offset on the format @-HHMM@. tz :: FormatTime a => Format r (a -> r) tz = later (build . fmt "%z") -- | Timezone name. tzName :: FormatTime a => Format r (a -> r) tzName = later (build . fmt "%Z") -- | As 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@). datetime :: FormatTime a => Format r (a -> r) datetime = later (build . fmt "%c") -- * For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime'): -- | Same as @%H:%M@. hm :: FormatTime a => Format r (a -> r) hm = later (build . fmt "%R") -- | Same as @%H:%M:%S@. hms :: FormatTime a => Format r (a -> r) hms = later (build . fmt "%T") -- | As 'timeFmt' @locale@ (e.g. @%H:%M:%S@). hmsL :: FormatTime a => Format r (a -> r) hmsL = later (build . fmt "%X") -- | As 'time12Fmt' @locale@ (e.g. @%I:%M:%S %p@). hmsPL :: FormatTime a => Format r (a -> r) hmsPL = later (build . fmt "%r") -- | Day half from ('amPm' @locale@), converted to lowercase, @am@, -- @pm@. dayHalf :: FormatTime a => Format r (a -> r) dayHalf = later (build . fmt "%P") -- | Day half from ('amPm' @locale@), @AM@, @PM@. dayHalfU :: FormatTime a => Format r (a -> r) dayHalfU = later (build . fmt "%p") -- | Hour, 24-hour, leading 0 as needed, @00@ - @23@. hour24 :: FormatTime a => Format r (a -> r) hour24 = later (build . fmt "%H") -- | Hour, 12-hour, leading 0 as needed, @01@ - @12@. hour12 :: FormatTime a => Format r (a -> r) hour12 = later (build . fmt "%I") -- | Hour, 24-hour, leading space as needed, @ 0@ - @23@. hour24S :: FormatTime a => Format r (a -> r) hour24S = later (build . fmt "%k") -- | Hour, 12-hour, leading space as needed, @ 1@ - @12@. hour12S :: FormatTime a => Format r (a -> r) hour12S = later (build . fmt "%l") -- | Minute, @00@ - @59@. minute :: FormatTime a => Format r (a -> r) minute = later (build . fmt "%M") -- | Second, without decimal part, @00@ - @60@. second :: FormatTime a => Format r (a -> r) second = later (build . fmt "%S") -- | Picosecond, including trailing zeros, @000000000000@ - -- @999999999999@. pico :: FormatTime a => Format r (a -> r) pico = later (build . fmt "%q") -- | Decimal point and up to 12 second decimals, without trailing -- zeros. For a whole number of seconds, this produces the empty -- string. decimals :: FormatTime a => Format r (a -> r) decimals = later (build . fmt "%Q") -- * For 'UTCTime' and 'ZonedTime' -- -- Number of whole seconds since the Unix epoch. For times before -- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@ -- the decimals are positive, not negative. For example, 0.9 seconds -- before the Unix epoch is formatted as @-1.1@ with @%s%Q@. epoch :: FormatTime a => Format r (a -> r) epoch = later (build . fmt "%s") -- * For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime'): -- | Same as @%m\/%d\/%y@. dateSlash :: FormatTime a => Format r (a -> r) dateSlash = later (build . fmt "%D") -- | Same as @%Y-%m-%d@. dateDash :: FormatTime a => Format r (a -> r) dateDash = later (build . fmt "%F") -- | As 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@). dateSlashL :: FormatTime a => Format r (a -> r) dateSlashL = later (build . fmt "%x") -- | Year. year :: FormatTime a => Format r (a -> r) year = later (build . fmt "%Y") -- | Last two digits of year, @00@ - @99@. yy :: FormatTime a => Format r (a -> r) yy = later (build . fmt "%y") -- | Century (being the first two digits of the year), @00@ - @99@. century :: FormatTime a => Format r (a -> r) century = later (build . fmt "%C") -- | Month name, long form ('fst' from 'months' @locale@), @January@ - -- @December@. monthName :: FormatTime a => Format r (a -> r) monthName = later (build . fmt "%B") -- | @ %H] month name, short form ('snd' from 'months' @locale@), -- @Jan@ - @Dec@. monthNameShort :: FormatTime a => Format r (a -> r) monthNameShort = later (build . fmt "%b") -- | Month of year, leading 0 as needed, @01@ - @12@. month :: FormatTime a => Format r (a -> r) month = later (build . fmt "%m") -- | Day of month, leading 0 as needed, @01@ - @31@. dayOfMonth :: FormatTime a => Format r (a -> r) dayOfMonth = later (build . fmt "%d") -- | Day of month, @1st@, @2nd@, @25th@, etc. dayOfMonthOrd :: FormatTime a => Format r (a -> r) dayOfMonthOrd = later (bprint ords . toInt) where toInt :: FormatTime a => a -> Int toInt = read . formatTime defaultTimeLocale "%d" -- | Day of month, leading space as needed, @ 1@ - @31@. dayOfMonthS :: FormatTime a => Format r (a -> r) dayOfMonthS = later (build . fmt "%e") -- | Day of year for Ordinal Date format, @001@ - @366@. day :: FormatTime a => Format r (a -> r) day = later (build . fmt "%j") -- | Year for Week Date format e.g. @2013@. weekYear :: FormatTime a => Format r (a -> r) weekYear = later (build . fmt "%G") -- | Last two digits of year for Week Date format, @00@ - @99@. weekYY :: FormatTime a => Format r (a -> r) weekYY = later (build . fmt "%g") -- | Century (first two digits of year) for Week Date format, @00@ - -- @99@. weekCentury :: FormatTime a => Format r (a -> r) weekCentury = later (build . fmt "%f") -- | Week for Week Date format, @01@ - @53@. week :: FormatTime a => Format r (a -> r) week = later (build . fmt "%V") -- | Day for Week Date format, @1@ - @7@. dayOfWeek :: FormatTime a => Format r (a -> r) dayOfWeek = later (build . fmt "%u") -- | Day of week, short form ('snd' from 'wDays' @locale@), @Sun@ - -- @Sat@. dayNameShort :: FormatTime a => Format r (a -> r) dayNameShort = later (build . fmt "%a") -- | Day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ - -- @Saturday@. dayName :: FormatTime a => Format r (a -> r) dayName = later (build . fmt "%A") -- | Week number of year, where weeks start on Sunday (as -- 'sundayStartWeek'), @00@ - @53@. weekFromZero :: FormatTime a => Format r (a -> r) weekFromZero = later (build . fmt "%U") -- | Day of week number, @0@ (= Sunday) - @6@ (= Saturday). dayOfWeekFromZero :: FormatTime a => Format r (a -> r) dayOfWeekFromZero = later (build . fmt "%w") -- | Week number of year, where weeks start on Monday (as -- 'mondayStartWeek'), @00@ - @53@. weekOfYearMon :: FormatTime a => Format r (a -> r) weekOfYearMon = later (build . fmt "%W") -- * Time spans, diffs, 'NominalDiffTime', 'DiffTime', etc. -- | Display a time span as one time relative to another. Input is -- assumed to be seconds. Typical inputs are 'NominalDiffTime' and -- 'DiffTime'. diff :: (RealFrac n) => Bool -- ^ Display 'in/ago'? -> Format r (n -> r) -- ^ Example: '3 seconds ago', 'in three days'.) diff fix = later diffed where diffed ts = case find (\(s,_,_) -> abs ts >= s) (reverse ranges) of Nothing -> "unknown" 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)) :: Int ranges = [(0,int % " milliseconds",0.001) ,(1,int % " seconds",1) ,(minute,fconst "a minute",0) ,(minute*2,int % " minutes",minute) ,(minute*30,fconst "half an hour",0) ,(minute*31,int % " minutes",minute) ,(hour,fconst "an hour",0) ,(hour*2,int % " hours",hour) ,(hour*3,fconst "a few hours",0) ,(hour*4,int % " hours",hour) ,(day,fconst "a day",0) ,(day*2,int % " days",day) ,(week,fconst "a week",0) ,(week*2,int % " weeks",week) ,(month,fconst "a month",0) ,(month*2,int % " months",month) ,(year,fconst "a year",0) ,(year*2,int % " years",year)] where year = month * 12 month = day * 30 week = day * 7 day = hour * 24 hour = minute * 60 minute = 60 -- | Display the absolute value time span in years. years :: (RealFrac n) => Int -- ^ Decimal places. -> Format r (n -> r) years n = later (bprint (fixed n) . abs . count) where count n = n / 365 / 24 / 60 / 60 -- | Display the absolute value time span in days. days :: (RealFrac n) => Int -- ^ Decimal places. -> Format r (n -> r) days n = later (bprint (fixed n) . abs . count) where count n = n / 24 / 60 / 60 -- | Display the absolute value time span in hours. hours :: (RealFrac n) => Int -- ^ Decimal places. -> Format r (n -> r) hours n = later (bprint (fixed n) . abs . count) where count n = n / 60 / 60 -- | Display the absolute value time span in minutes. minutes :: (RealFrac n) => Int -- ^ Decimal places. -> Format r (n -> r) minutes n = later (bprint (fixed n) . abs . count) where count n = n / 60 -- | Display the absolute value time span in seconds. seconds :: (RealFrac n) => Int -- ^ Decimal places. -> Format r (n -> r) seconds n = later (bprint (fixed n) . abs . count) where count n = n -- * Internal. -- | Formatter call. Probably don't want to use this. fmt :: FormatTime a => Text -> a -> Text fmt f = T.pack . formatTime defaultTimeLocale (T.unpack f) -- | Helper for creating custom time formatters customTimeFmt :: FormatTime a => Text -> Format r (a -> r) customTimeFmt f = later (build . fmt f) formatting-6.3.7/src/Formatting/Clock.hs0000644000000000000000000000251013311162750016354 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- | Formatters for high-res, real-time and timer clock values from "System.Clock". module Formatting.Clock (timeSpecs) where import Data.Text.Lazy.Builder import Formatting import Formatting.Internal import System.Clock 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 (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 formatting-6.3.7/src/Formatting/Internal.hs0000644000000000000000000001206213311162750017100 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleInstances #-} -- | Internal format starters. module Formatting.Internal where import Control.Category (Category(..)) import Data.Monoid import qualified Data.Semigroup import Data.String import qualified Data.Text as S (Text) import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as T import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.IO as T import Prelude hiding ((.),id) import System.IO -- | A formatter. When you construct formatters the first type -- parameter, @r@, will remain polymorphic. The second type -- parameter, @a@, will change to reflect the types of the data that -- will be formatted. For example, in -- -- @ -- myFormat :: Formatter r (Text -> Int -> r) -- myFormat = \"Person's name is \" % text % \", age is \" % hex -- @ -- -- the first type parameter remains polymorphic, and the second type -- parameter is @Text -> Int -> r@, which indicates that it formats a -- 'Text' and an 'Int'. -- -- When you run the 'Format', for example with 'format', you provide -- the arguments and they will be formatted into a string. -- -- @ -- \> format (\"Person's name is \" % text % \", age is \" % hex) \"Dave\" 54 -- \"Person's name is Dave, age is 36\" -- @ newtype Format r a = Format {runFormat :: (Builder -> r) -> a} -- | Not particularly useful, but could be. instance Functor (Format r) where fmap f (Format k) = Format (\br -> f (k br)) -- | Useful instance for applying two formatters to the same input -- argument. For example: @format (year <> "/" % month) now@ will -- yield @"2015/01"@. instance Monoid (Format r (a -> r)) where mappend m n = Format (\k a -> runFormat m (\b1 -> runFormat n (\b2 -> k (b1 <> b2)) a) a) mempty = Format (\k _ -> k mempty) instance Data.Semigroup.Semigroup (Format r (a -> r)) where (<>) = mappend -- | Useful instance for writing format string. With this you can -- write @"Foo"@ instead of @now "Foo!"@. instance (a ~ r) => IsString (Format r a) where fromString = now . fromString -- | The same as (%). At present using 'Category' has an import -- overhead, but one day it might be imported as standard. instance Category Format where id = now mempty f . g = f `bind` \a -> g `bind` \b -> now (a `mappend` b) -- | Concatenate two formatters. -- -- @formatter1 % formatter2@ is a formatter that accepts arguments for -- @formatter1@ and @formatter2@ and concatenates their results. For example -- -- @ -- format1 :: Format r (Text -> r) -- format1 = \"Person's name is \" % text -- @ -- -- @ -- format2 :: Format r r -- format2 = \", \" -- @ -- -- @ -- format3 :: Format r (Int -> r) -- format3 = \"age is \" % hex -- @ -- -- @ -- myFormat :: Formatter r (Text -> Int -> r) -- myFormat = format1 % format2 % format3 -- @ -- -- Notice how the argument types of @format1@ and @format3@ are -- gathered into the type of @myFormat@. -- -- (This is actually the composition operator for 'Format''s -- 'Category' instance, but that is (at present) inconvenient to use -- with regular "Prelude". So this function is provided as a -- convenience.) (%) :: Format r a -> Format r' r -> Format r' a (%) = (.) infixr 9 % -- | Function compose two formatters. Will feed the result of one -- formatter into another. (%.) :: Format r (Builder -> r') -> Format r' a -> Format r a (%.) (Format a) (Format b) = Format (b . a) infixr 8 %. -- | Don't format any data, just output a constant 'Builder'. now :: Builder -> Format r r now a = Format ($ a) -- | Monadic indexed bind for holey monoids. bind :: Format r a -> (Builder -> Format r' r) -> Format r' a m `bind` f = Format $ \k -> runFormat m (\a -> runFormat (f a) k) -- | Functorial map over a formatter's input. Example: @format (mapf (drop 1) string) \"hello\"@ mapf :: (a -> b) -> Format r (b -> t) -> Format r (a -> t) mapf f m = Format (\k -> runFormat m k . f) -- | Format a value of type @a@ using a function of type @a -> -- 'Builder'@. For example, @later (f :: Int -> Builder)@ produces -- @Format r (Int -> r)@. later :: (a -> Builder) -> Format r (a -> r) later f = Format (. f) -- | Run the formatter and return a lazy 'Text' value. format :: Format Text a -> a format m = runFormat m T.toLazyText -- | Run the formatter and return a strict 'S.Text' value. sformat :: Format S.Text a -> a sformat m = runFormat m (T.toStrict . T.toLazyText) -- | Run the formatter and return a 'Builder' value. bprint :: Format Builder a -> a bprint m = runFormat m id -- | Run the formatter and print out the text to stdout. fprint :: Format (IO ()) a -> a fprint m = runFormat m (T.putStr . T.toLazyText) -- | Run the formatter and put the output onto the given 'Handle'. hprint :: Handle -> Format (IO ()) a -> a hprint h m = runFormat m (T.hPutStr h . T.toLazyText) -- | Run the formatter and return a list of characters. formatToString :: Format [Char] a -> a formatToString m = runFormat m (TL.unpack . TLB.toLazyText) formatting-6.3.7/src/Formatting/Internal/Raw.hs0000644000000000000000000000055513311162750017635 0ustar0000000000000000-- | Reexports of things that were previously in the @text-format@ package. module Formatting.Internal.Raw ( module Data.Text.Format, module Data.Text.Format.Functions, module Data.Text.Format.Int, module Data.Text.Format.Types ) where import Data.Text.Format import Data.Text.Format.Functions import Data.Text.Format.Int import Data.Text.Format.Types formatting-6.3.7/src/Formatting/Buildable.hs0000644000000000000000000001204313413170530017204 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 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, mconcat) import Data.Int (Int8, Int16, Int32, Int64) import Data.Fixed (Fixed, HasResolution, showFixed) import Data.List (intersperse) import Data.Ratio (Ratio, denominator, numerator) import qualified Data.Text.Format.Functions as F ((<>)) 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) F.<> singleton '/' F.<> build (denominator a) instance Buildable Float where build = build . show {-# INLINE build #-} instance Buildable Double where build = build . show {-# 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" F.<> hexadecimal p instance Buildable WordPtr where build p = fromText "0x" F.<> hexadecimal p instance Buildable (Ptr a) where build = build . ptrToWordPtr instance Buildable Bool where build True = fromText "True" build False = fromText "False" #if MIN_VERSION_base(4,8,0) instance {-# OVERLAPPABLE #-} Buildable a => Buildable [a] where build = \xs -> "[" F.<> mconcat (intersperse "," (map build xs)) F.<> "]" {-# INLINE build #-} #endif formatting-6.3.7/src/Data/Text/Format/Functions.hs0000644000000000000000000000152013311162750020204 0ustar0000000000000000{-# LANGUAGE MagicHash #-} {-# LANGUAGE CPP #-} -- | -- 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) #if MIN_VERSION_base(4,11,0) import Prelude hiding ((<>)) import GHC.Base hiding ((<>)) #else import GHC.Base #endif -- | 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 <> formatting-6.3.7/src/Data/Text/Format/Types.hs0000644000000000000000000000157713311162750017354 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 ( 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) formatting-6.3.7/src/Data/Text/Format.hs0000644000000000000000000000464713311162750016251 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 ( -- * 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 #-} formatting-6.3.7/src/Data/Text/Format/Int.hs0000644000000000000000000001231513311162750016772 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 , integer , hexadecimal , minus ) where import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (mempty) import Data.Text.Format.Functions (i2d) import qualified Data.Text.Format.Functions as F ((<>)) 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 F.<> integer 10 (negate $ fromIntegral i) | i < 0 = minus F.<> go (-i) | otherwise = go i where go n | n < 10 = digit n | otherwise = go (n `quot` 10) F.<> 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 F.<> go (-i) | otherwise = go i where go n | n < 16 = hexDigit n | otherwise = go (n `quot` 16) F.<> 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 F.<> 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 F.<> pblock r F.<> putB ns | otherwise -> int r F.<> 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 F.<> pblock r F.<> 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 F.<> digit r where q = n `quotInt` base r = n `remInt` base formatting-6.3.7/test/Spec.hs0000644000000000000000000000755013413170530014300 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Control.Monad import Data.Int import qualified Data.Monoid import qualified Data.Semigroup import qualified Data.Text.Lazy as LT 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/36" (do it "format (later id <> later id) \"x\"" (shouldBe (format (later id Data.Monoid.<> later id) "x") "xx") it "format (later id <> later id) \"x\"" (shouldBe (format (later id Data.Semigroup.<> later id) "x") "xx")) 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")) it "build (maxBound :: Int)" (shouldBe (format build (maxBound :: Int)) "9223372036854775807")) describe "Floating point" (do it "Fixed" (shouldBe (format (fixed 4) (12.123456 :: Double)) "12.1235") it "Variable" (shouldBe (format float (12.123456 :: Double)) "12.123456")) describe "Buildable a => Buildable [a]" (do it "\"\" :: [Char] (backwards compatibility)" (shouldBe (format build ("" :: String)) "") it "\"hi\" :: [Char] (backwards compatibility)" (shouldBe (format build ("hi" :: String)) "hi") it "[1,2,3] :: [Int]" (shouldBe (format build ([1,2,3] :: [Int])) "[1,2,3]") it "[] :: [Int]" (shouldBe (format build ([] :: [Int])) "[]")) describe "ords" $ do let tests :: [(Int, String)] tests = [ ( 1, "1st") , ( 2, "2nd") , ( 3, "3rd") , ( 4, "4th") , ( 5, "5th") , ( 6, "6th") , ( 7, "7th") , ( 8, "8th") , ( 9, "9th") , (10, "10th") , (11, "11th") , (12, "12th") , (13, "13th") , (14, "14th") , (15, "15th") , (16, "16th") , (17, "17th") , (18, "18th") , (19, "19th") , (20, "20th") , (21, "21st") , (22, "22nd") , (23, "23rd") , (24, "24th") , (25, "25th") , (26, "26th") , (27, "27th") , (28, "28th") , (29, "29th") , (30, "30th") , (31, "31st") , (31, "31st") , (32, "32nd") , (33, "33rd") , (34, "34th") ] forM_ tests $ \(input, output) -> it output $ format ords input `shouldBe` (LT.pack output) formatting-6.3.7/LICENSE0000644000000000000000000000275613311162750013105 0ustar0000000000000000Copyright (c) 2013, Chris Done 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. * Neither the name of Chris Done nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. 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. formatting-6.3.7/Setup.hs0000644000000000000000000000005613311162750013523 0ustar0000000000000000import Distribution.Simple main = defaultMain formatting-6.3.7/formatting.cabal0000644000000000000000000000333513413170564015235 0ustar0000000000000000name: formatting version: 6.3.7 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, Bryan O'Sullivan maintainer: chrisdone@gmail.com 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 Formatting.Internal.Raw 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 >=0.10.4, integer-gmp >= 0.2, semigroups 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, semigroups, text ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N source-repository head type: git location: http://github.com/chrisdone/formatting formatting-6.3.7/CHANGELOG.md0000644000000000000000000000223313413170575013706 0ustar00000000000000006.3.7 * Introduced instance `Buildable a => Buildable [a]`. 6.3.6 * Bring back `int :: Integral a => Format r (a -> r)` 6.3.5 * Avoid pointless conversions on Float/Double. 6.3.3 * The `Data.Text.Format` hierarchy was reexported as `Formatting.Internal.Raw`. 6.3.1 * Proper GHC 7.10 -> GHC 8.4 support 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. 6.2.1 * Added bytesDecimal 6.2.0 * Dropped Holey/HoleyT in favour of simpler Format type. * Added Monoid instance. * Added back Category instance. * Dropped Functor instance. 6.1.1 * Add support for GHC 7.10 (time update). 6.1.0 * Add formatter for TimeSpec. 6.0.0 * Changed the type of `Format`. Now you write `Format r (a -> r)` instead of `Format a`. * Add `formatToString` function.