1 -----------------------------------------------------------------------------
3 -- Module : Text.Printf
4 -- Copyright : (c) Lennart Augustsson, 2004
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 -----------------------------------------------------------------------------
17 PrintfType, HPrintfType, PrintfArg, IsChar
24 import Numeric(showEFloat, showFFloat, showGFloat)
29 -- | Format a variable number of arguments with the C-style formatting string.
30 -- The return value is either 'String' or @('IO' a)@.
32 -- The format string consists of ordinary characters and /conversion
33 -- specifications/, which specify how to format one of the arguments
34 -- to printf in the output string. A conversion specification begins with the
35 -- character @%@, followed by one or more of the following flags:
37 -- > - left adjust (default is right adjust)
38 -- > + always use a sign (+ or -) for signed conversions
39 -- > 0 pad with zeroes rather than spaces
41 -- followed optionally by a field width:
44 -- > * as num, but taken from argument list
46 -- followed optionally by a precision:
48 -- > .num precision (number of decimal places)
50 -- and finally, a format character:
52 -- > c character Char, Int, Integer, ...
53 -- > d decimal Char, Int, Integer, ...
54 -- > o octal Char, Int, Integer, ...
55 -- > x hexadecimal Char, Int, Integer, ...
56 -- > X hexadecimal Char, Int, Integer, ...
57 -- > u unsigned decimal Char, Int, Integer, ...
58 -- > f floating point Float, Double
59 -- > g general format float Float, Double
60 -- > G general format float Float, Double
61 -- > e exponent format float Float, Double
62 -- > E exponent format float Float, Double
65 -- Mismatch between the argument types and the format string will cause
66 -- an exception to be thrown at runtime.
70 -- > > printf "%d\n" (23::Int)
72 -- > > printf "%s %s\n" "Hello" "World"
74 -- > > printf "%.2f\n" pi
77 printf :: (PrintfType r) => String -> r
78 printf fmts = spr fmts []
80 -- | Similar to 'printf', except that output is via the specified
81 -- 'Handle'. The return type is restricted to @('IO' a)@.
82 hPrintf :: (HPrintfType r) => Handle -> String -> r
83 hPrintf hdl fmts = hspr hdl fmts []
85 -- |The 'PrintfType' class provides the variable argument magic for
86 -- 'printf'. Its implementation is intentionally not visible from
87 -- this module. If you attempt to pass an argument of a type which
88 -- is not an instance of this class to 'printf' or 'hPrintf', then
89 -- the compiler will report it as a missing instance of 'PrintfArg'.
90 class PrintfType t where
91 spr :: String -> [UPrintf] -> t
93 -- | The 'HPrintfType' class provides the variable argument magic for
94 -- 'hPrintf'. Its implementation is intentionally not visible from
96 class HPrintfType t where
97 hspr :: Handle -> String -> [UPrintf] -> t
99 {- not allowed in Haskell 98
100 instance PrintfType String where
101 spr fmt args = uprintf fmt (reverse args)
103 instance (IsChar c) => PrintfType [c] where
104 spr fmts args = map fromChar (uprintf fmts (reverse args))
106 instance PrintfType (IO a) where
108 putStr (uprintf fmts (reverse args))
111 instance HPrintfType (IO a) where
112 hspr hdl fmts args = do
113 hPutStr hdl (uprintf fmts (reverse args))
116 instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
117 spr fmts args = \ a -> spr fmts (toUPrintf a : args)
119 instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
120 hspr hdl fmts args = \ a -> hspr hdl fmts (toUPrintf a : args)
122 class PrintfArg a where
123 toUPrintf :: a -> UPrintf
125 instance PrintfArg Char where
126 toUPrintf c = UChar c
128 {- not allowed in Haskell 98
129 instance PrintfArg String where
130 toUPrintf s = UString s
132 instance (IsChar c) => PrintfArg [c] where
133 toUPrintf = UString . map toChar
135 instance PrintfArg Int where
138 instance PrintfArg Int8 where
141 instance PrintfArg Int16 where
144 instance PrintfArg Int32 where
147 instance PrintfArg Int64 where
151 instance PrintfArg Word where
155 instance PrintfArg Word8 where
158 instance PrintfArg Word16 where
161 instance PrintfArg Word32 where
164 instance PrintfArg Word64 where
167 instance PrintfArg Integer where
168 toUPrintf = UInteger 0
170 instance PrintfArg Float where
173 instance PrintfArg Double where
176 uInteger :: (Integral a, Bounded a) => a -> UPrintf
177 uInteger x = UInteger (toInteger $ minBound `asTypeOf` x) (toInteger x)
181 fromChar :: Char -> c
183 instance IsChar Char where
189 data UPrintf = UChar Char | UString String | UInteger Integer Integer | UFloat Float | UDouble Double
191 uprintf :: String -> [UPrintf] -> String
193 uprintf "" (_:_) = fmterr
194 uprintf ('%':'%':cs) us = '%':uprintf cs us
195 uprintf ('%':_) [] = argerr
196 uprintf ('%':cs) us@(_:_) = fmt cs us
197 uprintf (c:cs) us = c:uprintf cs us
199 fmt :: String -> [UPrintf] -> String
201 let (width, prec, ladj, zero, plus, cs', us') = getSpecs False False False cs us
203 let lstr = length str
205 fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else ""
206 in if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str
207 adjust' ("", str) | plus = adjust ("+", str)
208 adjust' ps = adjust ps
217 'c' -> adjust ("", [toEnum (toint u)])
218 'd' -> adjust' (fmti u)
219 'i' -> adjust' (fmti u)
220 'x' -> adjust ("", fmtu 16 u)
221 'X' -> adjust ("", map toUpper $ fmtu 16 u)
222 'o' -> adjust ("", fmtu 8 u)
223 'u' -> adjust ("", fmtu 10 u)
224 'e' -> adjust' (dfmt' c prec u)
225 'E' -> adjust' (dfmt' c prec u)
226 'f' -> adjust' (dfmt' c prec u)
227 'g' -> adjust' (dfmt' c prec u)
228 'G' -> adjust' (dfmt' c prec u)
229 's' -> adjust ("", tostr u)
230 _ -> perror ("bad formatting char " ++ [c])
231 ) ++ uprintf cs'' us''
233 fmti :: UPrintf -> (String, String)
234 fmti (UInteger _ i) = if i < 0 then ("-", show (-i)) else ("", show i)
235 fmti (UChar c) = fmti (uInteger (fromEnum c))
238 fmtu :: Integer -> UPrintf -> String
239 fmtu b (UInteger l i) = itosb b (if i < 0 then -2*l + i else i)
240 fmtu b (UChar c) = itosb b (toInteger (fromEnum c))
243 toint :: UPrintf -> Int
244 toint (UInteger _ i) = fromInteger i
245 toint (UChar c) = fromEnum c
248 tostr :: UPrintf -> String
249 tostr (UString s) = s
252 itosb :: Integer -> Integer -> String
255 [intToDigit $ fromInteger n]
257 let (q, r) = quotRem n b in
258 itosb b q ++ [intToDigit $ fromInteger r]
260 stoi :: Int -> String -> (Int, String)
261 stoi a (c:cs) | isDigit c = stoi (a*10 + digitToInt c) cs
264 getSpecs :: Bool -> Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, Bool, String, [UPrintf])
265 getSpecs _ z s ('-':cs) us = getSpecs True z s cs us
266 getSpecs l z _ ('+':cs) us = getSpecs l z True cs us
267 getSpecs l _ s ('0':cs) us = getSpecs l True s cs us
268 getSpecs l z s ('*':cs) us =
275 '.':'*':r -> case us' of { [] -> argerr; pu:us''' -> (toint pu, r, us''') }
276 '.':r -> let (n', cs') = stoi 0 r in (n', cs', us')
278 in (n, p, l, z, s, cs'', us'')
279 getSpecs l z s ('.':cs) us =
280 let (p, cs') = stoi 0 cs
281 in (0, p, l, z, s, cs', us)
282 getSpecs l z s cs@(c:_) us | isDigit c =
283 let (n, cs') = stoi 0 cs
284 (p, cs'') = case cs' of
287 in (n, p, l, z, s, cs'', us)
288 getSpecs l z s cs us = (0, -1, l, z, s, cs, us)
290 dfmt' :: Char -> Int -> UPrintf -> (String, String)
291 dfmt' c p (UDouble d) = dfmt c p d
292 dfmt' c p (UFloat f) = dfmt c p f
295 dfmt :: (RealFloat a) => Char -> Int -> a -> (String, String)
297 case (if isUpper c then map toUpper else id) $
302 _ -> error "Printf.dfmt: impossible"
304 (if p < 0 then Nothing else Just p) d "" of
308 perror :: String -> a
309 perror s = error ("Printf.printf: "++s)
310 fmterr, argerr, baderr :: a
311 fmterr = perror "formatting string ended prematurely"
312 argerr = perror "argument list ended prematurely"
313 baderr = perror "bad argument"