1 -----------------------------------------------------------------------------
3 -- Module : Text.Printf
4 -- Copyright : (c) Lennart Augustsson, 2004-2008
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : lennart@augustsson.net
8 -- Stability : provisional
9 -- Portability : portable
11 -- A C printf like formatter.
13 -----------------------------------------------------------------------------
19 PrintfType, HPrintfType, PrintfArg, IsChar
26 import Numeric(showEFloat, showFFloat, showGFloat)
31 -- | Format a variable number of arguments with the C-style formatting string.
32 -- The return value is either 'String' or @('IO' a)@.
34 -- The format string consists of ordinary characters and /conversion
35 -- specifications/, which specify how to format one of the arguments
36 -- to printf in the output string. A conversion specification begins with the
37 -- character @%@, followed by one or more of the following flags:
39 -- > - left adjust (default is right adjust)
40 -- > + always use a sign (+ or -) for signed conversions
41 -- > 0 pad with zeroes rather than spaces
43 -- followed optionally by a field width:
46 -- > * as num, but taken from argument list
48 -- followed optionally by a precision:
50 -- > .num precision (number of decimal places)
52 -- and finally, a format character:
54 -- > c character Char, Int, Integer, ...
55 -- > d decimal Char, Int, Integer, ...
56 -- > o octal Char, Int, Integer, ...
57 -- > x hexadecimal Char, Int, Integer, ...
58 -- > X hexadecimal Char, Int, Integer, ...
59 -- > u unsigned decimal Char, Int, Integer, ...
60 -- > f floating point Float, Double
61 -- > g general format float Float, Double
62 -- > G general format float Float, Double
63 -- > e exponent format float Float, Double
64 -- > E exponent format float Float, Double
67 -- Mismatch between the argument types and the format string will cause
68 -- an exception to be thrown at runtime.
72 -- > > printf "%d\n" (23::Int)
74 -- > > printf "%s %s\n" "Hello" "World"
76 -- > > printf "%.2f\n" pi
79 printf :: (PrintfType r) => String -> r
80 printf fmts = spr fmts []
82 -- | Similar to 'printf', except that output is via the specified
83 -- 'Handle'. The return type is restricted to @('IO' a)@.
84 hPrintf :: (HPrintfType r) => Handle -> String -> r
85 hPrintf hdl fmts = hspr hdl fmts []
87 -- |The 'PrintfType' class provides the variable argument magic for
88 -- 'printf'. Its implementation is intentionally not visible from
89 -- this module. If you attempt to pass an argument of a type which
90 -- is not an instance of this class to 'printf' or 'hPrintf', then
91 -- the compiler will report it as a missing instance of 'PrintfArg'.
92 class PrintfType t where
93 spr :: String -> [UPrintf] -> t
95 -- | The 'HPrintfType' class provides the variable argument magic for
96 -- 'hPrintf'. Its implementation is intentionally not visible from
98 class HPrintfType t where
99 hspr :: Handle -> String -> [UPrintf] -> t
101 {- not allowed in Haskell 98
102 instance PrintfType String where
103 spr fmt args = uprintf fmt (reverse args)
105 instance (IsChar c) => PrintfType [c] where
106 spr fmts args = map fromChar (uprintf fmts (reverse args))
108 instance PrintfType (IO a) where
110 putStr (uprintf fmts (reverse args))
113 instance HPrintfType (IO a) where
114 hspr hdl fmts args = do
115 hPutStr hdl (uprintf fmts (reverse args))
118 instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
119 spr fmts args = \ a -> spr fmts (toUPrintf a : args)
121 instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
122 hspr hdl fmts args = \ a -> hspr hdl fmts (toUPrintf a : args)
124 class PrintfArg a where
125 toUPrintf :: a -> UPrintf
127 instance PrintfArg Char where
128 toUPrintf c = UChar c
130 {- not allowed in Haskell 98
131 instance PrintfArg String where
132 toUPrintf s = UString s
134 instance (IsChar c) => PrintfArg [c] where
135 toUPrintf = UString . map toChar
137 instance PrintfArg Int where
140 instance PrintfArg Int8 where
143 instance PrintfArg Int16 where
146 instance PrintfArg Int32 where
149 instance PrintfArg Int64 where
153 instance PrintfArg Word where
157 instance PrintfArg Word8 where
160 instance PrintfArg Word16 where
163 instance PrintfArg Word32 where
166 instance PrintfArg Word64 where
169 instance PrintfArg Integer where
170 toUPrintf = UInteger 0
172 instance PrintfArg Float where
175 instance PrintfArg Double where
178 uInteger :: (Integral a, Bounded a) => a -> UPrintf
179 uInteger x = UInteger (toInteger $ minBound `asTypeOf` x) (toInteger x)
183 fromChar :: Char -> c
185 instance IsChar Char where
191 data UPrintf = UChar Char | UString String | UInteger Integer Integer | UFloat Float | UDouble Double
193 uprintf :: String -> [UPrintf] -> String
195 uprintf "" (_:_) = fmterr
196 uprintf ('%':'%':cs) us = '%':uprintf cs us
197 uprintf ('%':_) [] = argerr
198 uprintf ('%':cs) us@(_:_) = fmt cs us
199 uprintf (c:cs) us = c:uprintf cs us
201 fmt :: String -> [UPrintf] -> String
203 let (width, prec, ladj, zero, plus, cs', us') = getSpecs False False False cs us
205 let lstr = length str
207 fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else ""
208 in if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str
209 adjust' ("", str) | plus = adjust ("+", str)
210 adjust' ps = adjust ps
219 'c' -> adjust ("", [toEnum (toint u)])
220 'd' -> adjust' (fmti prec u)
221 'i' -> adjust' (fmti prec u)
222 'x' -> adjust ("", fmtu 16 prec u)
223 'X' -> adjust ("", map toUpper $ fmtu 16 prec u)
224 'o' -> adjust ("", fmtu 8 prec u)
225 'u' -> adjust ("", fmtu 10 prec u)
226 'e' -> adjust' (dfmt' c prec u)
227 'E' -> adjust' (dfmt' c prec u)
228 'f' -> adjust' (dfmt' c prec u)
229 'g' -> adjust' (dfmt' c prec u)
230 'G' -> adjust' (dfmt' c prec u)
231 's' -> adjust ("", tostr prec u)
232 _ -> perror ("bad formatting char " ++ [c])
233 ) ++ uprintf cs'' us''
235 fmti :: Int -> UPrintf -> (String, String)
236 fmti prec (UInteger _ i) = if i < 0 then ("-", integral_prec prec (show (-i))) else ("", integral_prec prec (show i))
237 fmti _ (UChar c) = fmti 0 (uInteger (fromEnum c))
240 fmtu :: Integer -> Int -> UPrintf -> String
241 fmtu b prec (UInteger l i) = integral_prec prec (itosb b (if i < 0 then -2*l + i else i))
242 fmtu b _ (UChar c) = itosb b (toInteger (fromEnum c))
245 integral_prec :: Int -> String -> String
246 integral_prec prec integral = (replicate (prec - (length integral)) '0') ++ integral
248 toint :: UPrintf -> Int
249 toint (UInteger _ i) = fromInteger i
250 toint (UChar c) = fromEnum c
253 tostr :: Int -> UPrintf -> String
254 tostr n (UString s) = if n >= 0 then take n s else s
257 itosb :: Integer -> Integer -> String
260 [intToDigit $ fromInteger n]
262 let (q, r) = quotRem n b in
263 itosb b q ++ [intToDigit $ fromInteger r]
265 stoi :: Int -> String -> (Int, String)
266 stoi a (c:cs) | isDigit c = stoi (a*10 + digitToInt c) cs
269 getSpecs :: Bool -> Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, Bool, String, [UPrintf])
270 getSpecs _ z s ('-':cs) us = getSpecs True z s cs us
271 getSpecs l z _ ('+':cs) us = getSpecs l z True cs us
272 getSpecs l _ s ('0':cs) us = getSpecs l True s cs us
273 getSpecs l z s ('*':cs) us =
274 let (us', n) = getStar us
277 '.':'*':r -> let (us''', p') = getStar us'
279 '.':r -> (stoi 0 r, us')
281 in (n, p, l, z, s, cs'', us'')
282 getSpecs l z s ('.':cs) us =
283 let ((p, cs'), us') =
285 '*':cs'' -> let (us'', p') = getStar us in ((p', cs''), us'')
287 in (0, p, l, z, s, cs', us')
288 getSpecs l z s cs@(c:_) us | isDigit c =
289 let (n, cs') = stoi 0 cs
290 ((p, cs''), us') = case cs' of
291 '.':'*':r -> let (us'', p') = getStar us in ((p', r), us'')
292 '.':r -> (stoi 0 r, us)
294 in (n, p, l, z, s, cs'', us')
295 getSpecs l z s cs us = (0, -1, l, z, s, cs, us)
297 getStar :: [UPrintf] -> ([UPrintf], Int)
301 nu : us' -> (us', toint nu)
304 dfmt' :: Char -> Int -> UPrintf -> (String, String)
305 dfmt' c p (UDouble d) = dfmt c p d
306 dfmt' c p (UFloat f) = dfmt c p f
309 dfmt :: (RealFloat a) => Char -> Int -> a -> (String, String)
311 case (if isUpper c then map toUpper else id) $
316 _ -> error "Printf.dfmt: impossible"
318 (if p < 0 then Nothing else Just p) d "" of
322 perror :: String -> a
323 perror s = error ("Printf.printf: "++s)
324 fmterr, argerr, baderr :: a
325 fmterr = perror "formatting string ended prematurely"
326 argerr = perror "argument list ended prematurely"
327 baderr = perror "bad argument"