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
150 instance PrintfArg Word where
153 instance PrintfArg Word8 where
156 instance PrintfArg Word16 where
159 instance PrintfArg Word32 where
162 instance PrintfArg Word64 where
165 instance PrintfArg Integer where
166 toUPrintf = UInteger 0
168 instance PrintfArg Float where
171 instance PrintfArg Double where
174 uInteger :: (Integral a, Bounded a) => a -> UPrintf
175 uInteger x = UInteger (toInteger $ minBound `asTypeOf` x) (toInteger x)
179 fromChar :: Char -> c
181 instance IsChar Char where
187 data UPrintf = UChar Char | UString String | UInteger Integer Integer | UFloat Float | UDouble Double
189 uprintf :: String -> [UPrintf] -> String
191 uprintf "" (_:_) = fmterr
192 uprintf ('%':'%':cs) us = '%':uprintf cs us
193 uprintf ('%':_) [] = argerr
194 uprintf ('%':cs) us@(_:_) = fmt cs us
195 uprintf (c:cs) us = c:uprintf cs us
197 fmt :: String -> [UPrintf] -> String
199 let (width, prec, ladj, zero, plus, cs', us') = getSpecs False False False cs us
201 let lstr = length str
203 fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else ""
204 in if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str
205 adjust' ("", str) | plus = adjust ("+", str)
206 adjust' ps = adjust ps
215 'c' -> adjust ("", [toEnum (toint u)])
216 'd' -> adjust' (fmti u)
217 'i' -> adjust' (fmti u)
218 'x' -> adjust ("", fmtu 16 u)
219 'X' -> adjust ("", map toUpper $ fmtu 16 u)
220 'o' -> adjust ("", fmtu 8 u)
221 'u' -> adjust ("", fmtu 10 u)
222 'e' -> adjust' (dfmt' c prec u)
223 'E' -> adjust' (dfmt' c prec u)
224 'f' -> adjust' (dfmt' c prec u)
225 'g' -> adjust' (dfmt' c prec u)
226 'G' -> adjust' (dfmt' c prec u)
227 's' -> adjust ("", tostr u)
228 _ -> perror ("bad formatting char " ++ [c])
229 ) ++ uprintf cs'' us''
231 fmti :: UPrintf -> (String, String)
232 fmti (UInteger _ i) = if i < 0 then ("-", show (-i)) else ("", show i)
233 fmti (UChar c) = fmti (uInteger (fromEnum c))
236 fmtu :: Integer -> UPrintf -> String
237 fmtu b (UInteger l i) = itosb b (if i < 0 then -2*l + i else i)
238 fmtu b (UChar c) = itosb b (toInteger (fromEnum c))
241 toint :: UPrintf -> Int
242 toint (UInteger _ i) = fromInteger i
243 toint (UChar c) = fromEnum c
246 tostr :: UPrintf -> String
247 tostr (UString s) = s
250 itosb :: Integer -> Integer -> String
253 [intToDigit $ fromInteger n]
255 let (q, r) = quotRem n b in
256 itosb b q ++ [intToDigit $ fromInteger r]
258 stoi :: Int -> String -> (Int, String)
259 stoi a (c:cs) | isDigit c = stoi (a*10 + digitToInt c) cs
262 getSpecs :: Bool -> Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, Bool, String, [UPrintf])
263 getSpecs _ z s ('-':cs) us = getSpecs True z s cs us
264 getSpecs l z _ ('+':cs) us = getSpecs l z True cs us
265 getSpecs l _ s ('0':cs) us = getSpecs l True s cs us
266 getSpecs l z s ('*':cs) us =
273 '.':'*':r -> case us' of { [] -> argerr; pu:us''' -> (toint pu, r, us''') }
274 '.':r -> let (n', cs') = stoi 0 r in (n', cs', us')
276 in (n, p, l, z, s, cs'', us'')
277 getSpecs l z s ('.':cs) us =
278 let (p, cs') = stoi 0 cs
279 in (0, p, l, z, s, cs', us)
280 getSpecs l z s cs@(c:_) us | isDigit c =
281 let (n, cs') = stoi 0 cs
282 (p, cs'') = case cs' of
285 in (n, p, l, z, s, cs'', us)
286 getSpecs l z s cs us = (0, -1, l, z, s, cs, us)
288 dfmt' :: Char -> Int -> UPrintf -> (String, String)
289 dfmt' c p (UDouble d) = dfmt c p d
290 dfmt' c p (UFloat f) = dfmt c p f
293 dfmt :: (RealFloat a) => Char -> Int -> a -> (String, String)
295 case (if isUpper c then map toUpper else id) $
300 _ -> error "Printf.dfmt: impossible"
302 (if p < 0 then Nothing else Just p) d "" of
306 perror :: String -> a
307 perror s = error ("Printf.printf: "++s)
308 fmterr, argerr, baderr :: a
309 fmterr = perror "formatting string ended prematurely"
310 argerr = perror "argument list ended prematurely"
311 baderr = perror "bad argument"