formatting-6.2.5/src/0000755000000000000000000000000013155716517012666 5ustar0000000000000000formatting-6.2.5/src/Formatting/0000755000000000000000000000000013155716517015000 5ustar0000000000000000formatting-6.2.5/src/Formatting.hs0000644000000000000000000000154513155716517015341 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, -- * Formatting library module Formatting.Formatters, -- * Other functions formatToString ) where import Formatting.Formatters import Formatting.Internal formatting-6.2.5/src/Formatting/Formatters.hs0000644000000000000000000002221713006654675017467 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, expt, fixed, prec, 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 Data.Text.Buildable (Buildable) import qualified Data.Text.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 = later T.shortest -- | Render some floating point with the usual notation, e.g. 123.32 => \"123.32\" float :: Real a => Format r (a -> r) float = later (T.shortest) -- | Render a floating point number using scientific/engineering -- notation (e.g. 2.3e123), with the given number of decimal places. expt :: Real a => Int -> Format r (a -> r) expt i = later (T.expt i) -- | Render a floating point number using normal notation, with the -- given number of decimal places. fixed :: Real a => Int -> Format r (a -> r) fixed i = later (T.fixed i) -- | Render a floating point number, with the given number of digits -- of precision. Uses decimal notation for values between 0.1 and -- 9,999,999, and scientific notation otherwise. prec :: Real a => Int -> Format r (a -> r) prec i = later (T.prec i) -- | Render a floating point number using the smallest number of -- digits that correctly represent it. shortest :: Real a => Format r (a -> r) 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 (commaize) where commaize = T.fromLazyText . LT.reverse . foldr merge "" . LT.zip (zeros <> cycle' zeros') . LT.reverse . T.toLazyText . B.build zeros = LT.replicate (fromIntegral i) (LT.singleton '0') zeros' = LT.singleton c <> LT.tail zeros merge (f,c') rest | f == c = LT.singleton c <> LT.singleton c' <> rest | otherwise = LT.singleton c' <> rest cycle' xs = xs <> cycle' xs -- | 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.shortest n <> "th" | otherwise = T.shortest 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.2.5/src/Formatting/ShortFormatters.hs0000644000000000000000000000553613006654675020514 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.Buildable as B (build) import qualified Data.Text as S import qualified Data.Text as T import Data.Text.Buildable (Buildable) import qualified Data.Text.Format as T import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.Builder as T -- | 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 scientific/engineering -- notation (e.g. 2.3e123), with the given number of decimal places. ef :: Real a => Int -> Format r (a -> r) ef i = later (T.expt i) -- | Render a floating point number using normal notation, with the -- given number of decimal places. f :: Real a => Int -> Format r (a -> r) f i = later (T.fixed i) -- | Render a floating point number, with the given number of digits -- of precision. Uses decimal notation for values between 0.1 and -- 9,999,999, and scientific notation otherwise. pf :: Real a => Int -> Format r (a -> r) pf i = later (T.prec i) -- | Render a floating point number using the smallest number of -- digits that correctly represent it. 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.2.5/src/Formatting/Examples.hs0000644000000000000000000000265613006654675017124 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 % " and a double with sci notation: " % prec 6) (123.2342 :: Float) (13434242423.23420000 :: Double) -- | 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.2.5/src/Formatting/Time.hs0000644000000000000000000002306013006654675016234 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 Data.Text.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)) 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.2.5/src/Formatting/Clock.hs0000644000000000000000000000266313155716517016376 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 where import Formatting import Formatting.Internal import System.Clock -- | Format the duration from start to end (args passed in that order). -- -- Examples: -- -- @ -- 4.00 s -- 500.69 ms -- 1.20 ms -- 19.38 µs -- @ timeSpecs :: Format r (TimeSpec -> TimeSpec -> r) timeSpecs = Format (\g x y -> g (fmt x y)) where fmt (TimeSpec s1 n1) (TimeSpec s2 n2) | Just i <- scale ((10 ^ 9) * 60 * 60 * 24) = bprint (fixed 2 % " d") i | Just i <- scale ((10 ^ 9) * 60 * 60) = bprint (fixed 2 % " h") i | Just i <- scale ((10 ^ 9) * 60) = bprint (fixed 2 % " m") i | Just i <- scale (10 ^ 9) = bprint (fixed 2 % " s") i | Just i <- scale (10 ^ 6) = bprint (fixed 2 % " ms") i | Just i <- scale (10 ^ 3) = bprint (fixed 2 % " us") i | otherwise = bprint (int % " ns") diff where scale :: Integer -> Maybe Double scale i = if diff >= i then Just (fromIntegral diff / fromIntegral i) else Nothing diff :: Integer diff = a2 - a1 a1 = (fromIntegral s1 * 10 ^ 9) + fromIntegral n1 a2 = (fromIntegral s2 * 10 ^ 9) + fromIntegral n2 formatting-6.2.5/src/Formatting/Internal.hs0000644000000000000000000001170413015601677017106 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleInstances #-} -- | Internal format starters. module Formatting.Internal where import Control.Category (Category(..)) import Data.Monoid 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) -- | 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.2.5/LICENSE0000644000000000000000000000275613006654675013117 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.2.5/Setup.hs0000644000000000000000000000005613006654675013535 0ustar0000000000000000import Distribution.Simple main = defaultMain formatting-6.2.5/formatting.cabal0000644000000000000000000000250413155716663015240 0ustar0000000000000000name: formatting version: 6.2.5 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 maintainer: chrisdone@gmail.com copyright: 2013 Chris Done, Shachaf Ben-Kiki, Martijn van Steenbergen, Mike Meyer category: Text build-type: Simple cabal-version: >=1.8 extra-source-files: CHANGELOG.md library exposed-modules: Formatting, Formatting.Formatters, Formatting.ShortFormatters, Formatting.Examples, Formatting.Time, Formatting.Clock, Formatting.Internal build-depends: base >= 4.5 && < 5, text-format, text >= 0.11.0.8, time, old-locale, scientific >= 0.3.0.0, clock >= 0.4 hs-source-dirs: src ghc-options: -O2 source-repository head type: git location: http://github.com/chrisdone/formatting formatting-6.2.5/CHANGELOG.md0000644000000000000000000000073113155716737013715 0ustar00000000000000006.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.