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 -----------------------------------------------------------------------------
15 module Text.Printf(printf, hPrintf) where
18 import Numeric(showEFloat, showFFloat, showGFloat)
23 -- | Format a variable number of arguments with the C-style formatting string.
24 -- The return value is either 'String' or @(IO a)@.
26 -- The format string consists of ordinary characters and /conversion
27 -- specifications/, which specify how to format one of the arguments
28 -- to printf in the output string. A conversion specification begins with the
29 -- character @%@, followed by one or more of the following flags:
31 -- > - left adjust (default is right adjust)
32 -- > 0 pad with zeroes rather than spaces
34 -- followed optionally by a field width:
37 -- > * as num, but taken from argument list
39 -- followed optionally by a precision:
41 -- > .num precision (number of decimal places)
43 -- and finally, a format character:
45 -- > c character Char, Int, Integer
46 -- > d decimal Char, Int, Integer
47 -- > o octal Char, Int, Integer
48 -- > x hexadecimal Char, Int, Integer
49 -- > u unsigned decimal Char, Int, Integer
50 -- > f floating point Float, Double
51 -- > g general format float Float, Double
52 -- > e exponent format float Float, Double
55 -- The @PrintfType@ class provides the variable argument magic for
56 -- 'printf'. Its implementation is intentionally not visible from
57 -- this module. The following argument types are supported: Char, String,
58 -- Int, Integer, Float, Double. If you attempt to pass an argument of a
59 -- different type to 'printf', then the compiler will report it as a
60 -- missing instance of @PrintfArg@.
62 -- Mismatch between the argument types and the format string will cause
63 -- an exception to be thrown at runtime.
67 -- > > printf "%d\n" (23::Int)
69 -- > > printf "%s %s\n" "Hello" "World"
71 -- > > printf "%.2f\n" pi
74 printf :: (PrintfType r) => String -> r
75 printf fmt = spr fmt []
77 -- | Similar to 'printf', except that output is via the specified
78 -- 'Handle'. The return type is restricted to @(IO a)@.
79 hPrintf :: (HPrintfType r) => Handle -> String -> r
80 hPrintf hdl fmt = hspr hdl fmt []
82 class PrintfType t where
83 spr :: String -> [UPrintf] -> t
85 -- | The @HPrintfType@ class provides the variable argument magic for
86 -- 'hPrintf'. Its implementation is intentionally not visible from
88 class HPrintfType t where
89 hspr :: Handle -> String -> [UPrintf] -> t
91 {- not allowed in Haskell 98
92 instance PrintfType String where
93 spr fmt args = uprintf fmt (reverse args)
95 instance (IsChar c) => PrintfType [c] where
96 spr fmt args = map fromChar (uprintf fmt (reverse args))
98 instance PrintfType (IO a) where
100 putStr (uprintf fmt (reverse args))
103 instance HPrintfType (IO a) where
104 hspr hdl fmt args = do
105 hPutStr hdl (uprintf fmt (reverse args))
108 instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
109 spr fmt args = \ a -> spr fmt (toUPrintf a : args)
111 instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
112 hspr hdl fmt args = \ a -> hspr hdl fmt (toUPrintf a : args)
114 class PrintfArg a where
115 toUPrintf :: a -> UPrintf
117 instance PrintfArg Char where
118 toUPrintf c = UChar c
120 {- not allowed in Haskell 98
121 instance PrintfArg String where
122 toUPrintf s = UString s
124 instance (IsChar c) => PrintfArg [c] where
125 toUPrintf s = UString (map toChar s)
127 instance PrintfArg Int where
130 instance PrintfArg Integer where
131 toUPrintf i = UInteger i
133 instance PrintfArg Float where
134 toUPrintf f = UFloat f
136 instance PrintfArg Double where
137 toUPrintf d = UDouble d
141 fromChar :: Char -> c
143 instance IsChar Char where
149 data UPrintf = UChar Char | UString String | UInt Int | UInteger Integer | UFloat Float | UDouble Double
151 uprintf :: String -> [UPrintf] -> String
153 uprintf "" (_:_) = fmterr
154 uprintf ('%':'%':cs) us = '%':uprintf cs us
155 uprintf ('%':_) [] = argerr
156 uprintf ('%':cs) us@(_:_) = fmt cs us
157 uprintf (c:cs) us = c:uprintf cs us
159 fmt :: String -> [UPrintf] -> String
161 let (width, prec, ladj, zero, cs', us') = getSpecs False False cs us
163 let lstr = length str
165 fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else ""
166 in if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str
175 'c' -> adjust ("", [toEnum (toint u)])
176 'd' -> adjust (fmti u)
177 'x' -> adjust ("", fmtu 16 u)
178 'o' -> adjust ("", fmtu 8 u)
179 'u' -> adjust ("", fmtu 10 u)
180 'e' -> adjust (dfmt' c prec u)
181 'f' -> adjust (dfmt' c prec u)
182 'g' -> adjust (dfmt' c prec u)
183 's' -> adjust ("", tostr u)
184 c -> perror ("bad formatting char " ++ [c])
185 ) ++ uprintf cs'' us''
187 fmti (UInt i) = if i < 0 then
188 if i == -i then fmti (UInteger (toInteger i)) else ("-", itos (-i))
191 fmti (UInteger i) = if i < 0 then ("-", itos (-i)) else ("", itos i)
192 fmti (UChar c) = fmti (UInt (fromEnum c))
195 fmtu b (UInt i) = if i < 0 then
196 if i == -i then itosb b (maxi - toInteger (i+1) - 1) else itosb b (maxi - toInteger (-i))
198 itosb b (toInteger i)
199 fmtu b (UInteger i) = itosb b i
200 fmtu b (UChar c) = itosb b (toInteger (fromEnum c))
204 maxi = (toInteger (maxBound::Int) + 1) * 2
207 toint (UInteger i) = toInt i
208 toint (UChar c) = fromEnum c
211 tostr (UString s) = s
216 [toEnum (fromEnum '0' + toInt n)]
218 let (q, r) = quotRem n 10 in
219 itos q ++ [toEnum (fromEnum '0' + toInt r)]
221 chars = array (0,15) (zipWith (,) [0..] "0123456789abcdef")
222 itosb :: Integer -> Integer -> String
227 let (q, r) = quotRem n b in
228 itosb b q ++ [chars!r]
230 stoi :: Int -> String -> (Int, String)
231 stoi a (c:cs) | isDigit c = stoi (a*10 + fromEnum c - fromEnum '0') cs
234 getSpecs :: Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, String, [UPrintf])
235 getSpecs l z ('-':cs) us = getSpecs True z cs us
236 getSpecs l z ('0':cs) us = getSpecs l True cs us
237 getSpecs l z ('*':cs) us =
244 '.':'*':r -> case us' of { [] -> argerr; pu:us'' -> (toint pu, r, us'') }
245 '.':r -> let (n, cs') = stoi 0 r in (n, cs', us')
247 in (n, p, l, z, cs'', us'')
248 getSpecs l z ('.':cs) us =
249 let (p, cs') = stoi 0 cs
250 in (0, p, l, z, cs', us)
251 getSpecs l z cs@(c:_) us | isDigit c =
252 let (n, cs') = stoi 0 cs
253 (p, cs'') = case cs' of
256 in (n, p, l, z, cs'', us)
257 getSpecs l z cs us = (0, -1, l, z, cs, us)
259 dfmt' c p (UDouble d) = dfmt c p d
260 dfmt' c p (UFloat f) = dfmt c p f
264 case (case c of 'e' -> showEFloat; 'f' -> showFFloat; 'g' -> showGFloat)
265 (if p < 0 then Nothing else Just p) d "" of
269 perror s = error ("Printf.printf: "++s)
270 fmterr = perror "formatting string ended prematurely"
271 argerr = perror "argument list ended prematurely"
272 baderr = perror "bad argument"
274 toInt :: (Integral a) => a -> Int
275 toInt x = fromInteger (toInteger x)