3 -----------------------------------------------------------------------------
5 -- Module : Text.Printf
6 -- Copyright : (c) Lennart Augustsson, 2004-2008
7 -- License : BSD-style (see the file libraries/base/LICENSE)
9 -- Maintainer : lennart@augustsson.net
10 -- Stability : provisional
11 -- Portability : portable
13 -- A C printf like formatter.
15 -----------------------------------------------------------------------------
21 PrintfType, HPrintfType, PrintfArg, IsChar
28 import Numeric(showEFloat, showFFloat, showGFloat)
33 -- | Format a variable number of arguments with the C-style formatting string.
34 -- The return value is either 'String' or @('IO' a)@.
36 -- The format string consists of ordinary characters and /conversion
37 -- specifications/, which specify how to format one of the arguments
38 -- to printf in the output string. A conversion specification begins with the
39 -- character @%@, followed by one or more of the following flags:
41 -- > - left adjust (default is right adjust)
42 -- > + always use a sign (+ or -) for signed conversions
43 -- > 0 pad with zeroes rather than spaces
45 -- followed optionally by a field width:
48 -- > * as num, but taken from argument list
50 -- followed optionally by a precision:
52 -- > .num precision (number of decimal places)
54 -- and finally, a format character:
56 -- > c character Char, Int, Integer, ...
57 -- > d decimal Char, Int, Integer, ...
58 -- > o octal Char, Int, Integer, ...
59 -- > x hexadecimal Char, Int, Integer, ...
60 -- > X hexadecimal Char, Int, Integer, ...
61 -- > u unsigned decimal Char, Int, Integer, ...
62 -- > f floating point Float, Double
63 -- > g general format float Float, Double
64 -- > G general format float Float, Double
65 -- > e exponent format float Float, Double
66 -- > E exponent format float Float, Double
69 -- Mismatch between the argument types and the format string will cause
70 -- an exception to be thrown at runtime.
74 -- > > printf "%d\n" (23::Int)
76 -- > > printf "%s %s\n" "Hello" "World"
78 -- > > printf "%.2f\n" pi
81 printf :: (PrintfType r) => String -> r
82 printf fmts = spr fmts []
84 -- | Similar to 'printf', except that output is via the specified
85 -- 'Handle'. The return type is restricted to @('IO' a)@.
86 hPrintf :: (HPrintfType r) => Handle -> String -> r
87 hPrintf hdl fmts = hspr hdl fmts []
89 -- |The 'PrintfType' class provides the variable argument magic for
90 -- 'printf'. Its implementation is intentionally not visible from
91 -- this module. If you attempt to pass an argument of a type which
92 -- is not an instance of this class to 'printf' or 'hPrintf', then
93 -- the compiler will report it as a missing instance of 'PrintfArg'.
94 class PrintfType t where
95 spr :: String -> [UPrintf] -> t
97 -- | The 'HPrintfType' class provides the variable argument magic for
98 -- 'hPrintf'. Its implementation is intentionally not visible from
100 class HPrintfType t where
101 hspr :: Handle -> String -> [UPrintf] -> t
103 {- not allowed in Haskell 98
104 instance PrintfType String where
105 spr fmt args = uprintf fmt (reverse args)
107 instance (IsChar c) => PrintfType [c] where
108 spr fmts args = map fromChar (uprintf fmts (reverse args))
110 instance PrintfType (IO a) where
112 putStr (uprintf fmts (reverse args))
115 instance HPrintfType (IO a) where
116 hspr hdl fmts args = do
117 hPutStr hdl (uprintf fmts (reverse args))
120 instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
121 spr fmts args = \ a -> spr fmts (toUPrintf a : args)
123 instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
124 hspr hdl fmts args = \ a -> hspr hdl fmts (toUPrintf a : args)
126 class PrintfArg a where
127 toUPrintf :: a -> UPrintf
129 instance PrintfArg Char where
130 toUPrintf c = UChar c
132 {- not allowed in Haskell 98
133 instance PrintfArg String where
134 toUPrintf s = UString s
136 instance (IsChar c) => PrintfArg [c] where
137 toUPrintf = UString . map toChar
139 instance PrintfArg Int where
142 instance PrintfArg Int8 where
145 instance PrintfArg Int16 where
148 instance PrintfArg Int32 where
151 instance PrintfArg Int64 where
155 instance PrintfArg Word where
159 instance PrintfArg Word8 where
162 instance PrintfArg Word16 where
165 instance PrintfArg Word32 where
168 instance PrintfArg Word64 where
171 instance PrintfArg Integer where
172 toUPrintf = UInteger 0
174 instance PrintfArg Float where
177 instance PrintfArg Double where
180 uInteger :: (Integral a, Bounded a) => a -> UPrintf
181 uInteger x = UInteger (toInteger $ minBound `asTypeOf` x) (toInteger x)
185 fromChar :: Char -> c
187 instance IsChar Char where
193 data UPrintf = UChar Char | UString String | UInteger Integer Integer | UFloat Float | UDouble Double
195 uprintf :: String -> [UPrintf] -> String
197 uprintf "" (_:_) = fmterr
198 uprintf ('%':'%':cs) us = '%':uprintf cs us
199 uprintf ('%':_) [] = argerr
200 uprintf ('%':cs) us@(_:_) = fmt cs us
201 uprintf (c:cs) us = c:uprintf cs us
203 fmt :: String -> [UPrintf] -> String
205 let (width, prec, ladj, zero, plus, cs', us') = getSpecs False False False cs us
207 let lstr = length str
209 fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else ""
210 in if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str
211 adjust' ("", str) | plus = adjust ("+", str)
212 adjust' ps = adjust ps
221 'c' -> adjust ("", [toEnum (toint u)])
222 'd' -> adjust' (fmti prec u)
223 'i' -> adjust' (fmti prec u)
224 'x' -> adjust ("", fmtu 16 prec u)
225 'X' -> adjust ("", map toUpper $ fmtu 16 prec u)
226 'o' -> adjust ("", fmtu 8 prec u)
227 'u' -> adjust ("", fmtu 10 prec u)
228 'e' -> adjust' (dfmt' c prec u)
229 'E' -> adjust' (dfmt' c prec u)
230 'f' -> adjust' (dfmt' c prec u)
231 'g' -> adjust' (dfmt' c prec u)
232 'G' -> adjust' (dfmt' c prec u)
233 's' -> adjust ("", tostr prec u)
234 _ -> perror ("bad formatting char " ++ [c])
235 ) ++ uprintf cs'' us''
237 fmti :: Int -> UPrintf -> (String, String)
238 fmti prec (UInteger _ i) = if i < 0 then ("-", integral_prec prec (show (-i))) else ("", integral_prec prec (show i))
239 fmti _ (UChar c) = fmti 0 (uInteger (fromEnum c))
242 fmtu :: Integer -> Int -> UPrintf -> String
243 fmtu b prec (UInteger l i) = integral_prec prec (itosb b (if i < 0 then -2*l + i else i))
244 fmtu b _ (UChar c) = itosb b (toInteger (fromEnum c))
247 integral_prec :: Int -> String -> String
248 integral_prec prec integral = (replicate (prec - (length integral)) '0') ++ integral
250 toint :: UPrintf -> Int
251 toint (UInteger _ i) = fromInteger i
252 toint (UChar c) = fromEnum c
255 tostr :: Int -> UPrintf -> String
256 tostr n (UString s) = if n >= 0 then take n s else s
259 itosb :: Integer -> Integer -> String
262 [intToDigit $ fromInteger n]
264 let (q, r) = quotRem n b in
265 itosb b q ++ [intToDigit $ fromInteger r]
267 stoi :: Int -> String -> (Int, String)
268 stoi a (c:cs) | isDigit c = stoi (a*10 + digitToInt c) cs
271 getSpecs :: Bool -> Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, Bool, String, [UPrintf])
272 getSpecs _ z s ('-':cs) us = getSpecs True z s cs us
273 getSpecs l z _ ('+':cs) us = getSpecs l z True cs us
274 getSpecs l _ s ('0':cs) us = getSpecs l True s cs us
275 getSpecs l z s ('*':cs) us =
276 let (us', n) = getStar us
279 '.':'*':r -> let (us''', p') = getStar us'
281 '.':r -> (stoi 0 r, us')
283 in (n, p, l, z, s, cs'', us'')
284 getSpecs l z s ('.':cs) us =
285 let ((p, cs'), us') =
287 '*':cs'' -> let (us'', p') = getStar us in ((p', cs''), us'')
289 in (0, p, l, z, s, cs', us')
290 getSpecs l z s cs@(c:_) us | isDigit c =
291 let (n, cs') = stoi 0 cs
292 ((p, cs''), us') = case cs' of
293 '.':'*':r -> let (us'', p') = getStar us in ((p', r), us'')
294 '.':r -> (stoi 0 r, us)
296 in (n, p, l, z, s, cs'', us')
297 getSpecs l z s cs us = (0, -1, l, z, s, cs, us)
299 getStar :: [UPrintf] -> ([UPrintf], Int)
303 nu : us' -> (us', toint nu)
306 dfmt' :: Char -> Int -> UPrintf -> (String, String)
307 dfmt' c p (UDouble d) = dfmt c p d
308 dfmt' c p (UFloat f) = dfmt c p f
311 dfmt :: (RealFloat a) => Char -> Int -> a -> (String, String)
313 case (if isUpper c then map toUpper else id) $
318 _ -> error "Printf.dfmt: impossible"
320 (if p < 0 then Nothing else Just p) d "" of
324 perror :: String -> a
325 perror s = error ("Printf.printf: "++s)
326 fmterr, argerr, baderr :: a
327 fmterr = perror "formatting string ended prematurely"
328 argerr = perror "argument list ended prematurely"
329 baderr = perror "bad argument"