Add Haddock `/Since: 4.7.0.0/` comments to new symbols
[packages/base.git] / Text / Printf.hs
1 {-# LANGUAGE Safe #-}
2 {-# LANGUAGE CPP #-}
3 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 700
4 {-# LANGUAGE GADTs #-}
5 #endif
6
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module : Text.Printf
10 -- Copyright : (c) Lennart Augustsson and Bart Massey 2013
11 -- License : BSD-style (see the file LICENSE in this distribution)
12 --
13 -- Maintainer : Bart Massey <bart@cs.pdx.edu>
14 -- Stability : provisional
15 -- Portability : portable
16 --
17 -- A C @printf(3)@-like formatter. This version has been
18 -- extended by Bart Massey as per the recommendations of
19 -- John Meacham and Simon Marlow
20 -- \<<http://comments.gmane.org/gmane.comp.lang.haskell.libraries/4726>\>
21 -- to support extensible formatting for new datatypes. It
22 -- has also been extended to support almost all C
23 -- @printf(3)@ syntax.
24 -----------------------------------------------------------------------------
25
26 module Text.Printf(
27 -- * Printing Functions
28 printf, hPrintf,
29 -- * Extending To New Types
30 --
31 -- | This 'printf' can be extended to format types
32 -- other than those provided for by default. This
33 -- is done by instancing 'PrintfArg' and providing
34 -- a 'formatArg' for the type. It is possible to
35 -- provide a 'parseFormat' to process type-specific
36 -- modifiers, but the default instance is usually
37 -- the best choice.
38 --
39 -- For example:
40 --
41 -- > instance PrintfArg () where
42 -- > formatArg x fmt | fmtChar (vFmt 'U' fmt) == 'U' =
43 -- > formatString "()" (fmt { fmtChar = 's', fmtPrecision = Nothing })
44 -- > formatArg _ fmt = errorBadFormat $ fmtChar fmt
45 -- >
46 -- > main :: IO ()
47 -- > main = printf "[%-3.1U]\n" ()
48 --
49 -- prints \"@[() ]@\". Note the use of 'formatString' to
50 -- take care of field formatting specifications in a convenient
51 -- way.
52 PrintfArg(..),
53 FieldFormatter,
54 FieldFormat(..),
55 FormatAdjustment(..), FormatSign(..),
56 vFmt,
57 -- ** Handling Type-specific Modifiers
58 --
59 -- | In the unlikely case that modifier characters of
60 -- some kind are desirable for a user-provided type,
61 -- a 'ModifierParser' can be provided to process these
62 -- characters. The resulting modifiers will appear in
63 -- the 'FieldFormat' for use by the type-specific formatter.
64 ModifierParser, FormatParse(..),
65 -- ** Standard Formatters
66 --
67 -- | These formatters for standard types are provided for
68 -- convenience in writting new type-specific formatters:
69 -- a common pattern is to throw to 'formatString' or
70 -- 'formatInteger' to do most of the format handling for
71 -- a new type.
72 formatString, formatChar, formatInt,
73 formatInteger, formatRealFloat,
74 -- ** Raising Errors
75 --
76 -- | These functions are used internally to raise various
77 -- errors, and are exported for use by new type-specific
78 -- formatters.
79 errorBadFormat, errorShortFormat, errorMissingArgument,
80 errorBadArgument,
81 perror,
82 -- * Implementation Internals
83 -- | These types are needed for implementing processing
84 -- variable numbers of arguments to 'printf' and 'hPrintf'.
85 -- Their implementation is intentionally not visible from
86 -- this module. If you attempt to pass an argument of a type
87 -- which is not an instance of the appropriate class to
88 -- 'printf' or 'hPrintf', then the compiler will report it
89 -- as a missing instance of 'PrintfArg'. (All 'PrintfArg'
90 -- instances are 'PrintfType' instances.)
91 PrintfType, HPrintfType,
92 -- | This class is needed as a Haskell98 compatibility
93 -- workaround for the lack of FlexibleInstances.
94 IsChar(..)
95 ) where
96
97 import Prelude
98 import Data.Char
99 import Data.Int
100 import Data.List
101 import Data.Word
102 import Numeric
103 import System.IO
104
105 -------------------
106
107 -- | Format a variable number of arguments with the C-style formatting string.
108 -- The return value is either 'String' or @('IO' a)@ (which
109 -- should be @('IO' '()')@, but Haskell's type system
110 -- makes this hard).
111 --
112 -- The format string consists of ordinary characters and
113 -- /conversion specifications/, which specify how to format
114 -- one of the arguments to 'printf' in the output string. A
115 -- format specification is introduced by the @%@ character;
116 -- this character can be self-escaped into the format string
117 -- using @%%@. A format specification ends with a /format
118 -- character/ that provides the primary information about
119 -- how to format the value. The rest of the conversion
120 -- specification is optional. In order, one may have flag
121 -- characters, a width specifier, a precision specifier, and
122 -- type-specific modifier characters.
123 --
124 -- Unlike C @printf(3)@, the formatting of this 'printf'
125 -- is driven by the argument type; formatting is type specific. The
126 -- types formatted by 'printf' \"out of the box\" are:
127 --
128 -- * 'Integral' types, including 'Char'
129 --
130 -- * 'String'
131 --
132 -- * 'RealFloat' types
133 --
134 -- 'printf' is also extensible to support other types: see below.
135 --
136 -- A conversion specification begins with the
137 -- character @%@, followed by zero or more of the following flags:
138 --
139 -- > - left adjust (default is right adjust)
140 -- > + always use a sign (+ or -) for signed conversions
141 -- > space leading space for positive numbers in signed conversions
142 -- > 0 pad with zeros rather than spaces
143 -- > # use an \"alternate form\": see below
144 --
145 -- When both flags are given, @-@ overrides @0@ and @+@ overrides space.
146 -- A negative width specifier in a @*@ conversion is treated as
147 -- positive but implies the left adjust flag.
148 --
149 -- The \"alternate form\" for unsigned radix conversions is
150 -- as in C @printf(3)@:
151 --
152 -- > %o prefix with a leading 0 if needed
153 -- > %x prefix with a leading 0x if nonzero
154 -- > %X prefix with a leading 0X if nonzero
155 -- > %b prefix with a leading 0b if nonzero
156 -- > %[eEfFgG] ensure that the number contains a decimal point
157 --
158 -- Any flags are followed optionally by a field width:
159 --
160 -- > num field width
161 -- > * as num, but taken from argument list
162 --
163 -- The field width is a minimum, not a maximum: it will be
164 -- expanded as needed to avoid mutilating a value.
165 --
166 -- Any field width is followed optionally by a precision:
167 --
168 -- > .num precision
169 -- > . same as .0
170 -- > .* as num, but taken from argument list
171 --
172 -- Negative precision is taken as 0. The meaning of the
173 -- precision depends on the conversion type.
174 --
175 -- > Integral minimum number of digits to show
176 -- > RealFloat number of digits after the decimal point
177 -- > String maximum number of characters
178 --
179 -- The precision for Integral types is accomplished by zero-padding.
180 -- If both precision and zero-pad are given for an Integral field,
181 -- the zero-pad is ignored.
182 --
183 -- Any precision is followed optionally for Integral types
184 -- by a width modifier; the only use of this modifier being
185 -- to set the implicit size of the operand for conversion of
186 -- a negative operand to unsigned:
187 --
188 -- > hh Int8
189 -- > h Int16
190 -- > l Int32
191 -- > ll Int64
192 -- > L Int64
193 --
194 -- The specification ends with a format character:
195 --
196 -- > c character Integral
197 -- > d decimal Integral
198 -- > o octal Integral
199 -- > x hexadecimal Integral
200 -- > X hexadecimal Integral
201 -- > b binary Integral
202 -- > u unsigned decimal Integral
203 -- > f floating point RealFloat
204 -- > F floating point RealFloat
205 -- > g general format float RealFloat
206 -- > G general format float RealFloat
207 -- > e exponent format float RealFloat
208 -- > E exponent format float RealFloat
209 -- > s string String
210 -- > v default format any type
211 --
212 -- The \"%v\" specifier is provided for all built-in types,
213 -- and should be provided for user-defined type formatters
214 -- as well. It picks a \"best\" representation for the given
215 -- type. For the built-in types the \"%v\" specifier is
216 -- converted as follows:
217 --
218 -- > c Char
219 -- > u other unsigned Integral
220 -- > d other signed Integral
221 -- > g RealFloat
222 -- > s String
223 --
224 -- Mismatch between the argument types and the format
225 -- string, as well as any other syntactic or semantic errors
226 -- in the format string, will cause an exception to be
227 -- thrown at runtime.
228 --
229 -- Note that the formatting for 'RealFloat' types is
230 -- currently a bit different from that of C @printf(3)@,
231 -- conforming instead to 'Numeric.showEFloat',
232 -- 'Numeric.showFFloat' and 'Numeric.showGFloat' (and their
233 -- alternate versions 'Numeric.showFFloatAlt' and
234 -- 'Numeric.showGFloatAlt'). This is hard to fix: the fixed
235 -- versions would format in a backward-incompatible way.
236 -- In any case the Haskell behavior is generally more
237 -- sensible than the C behavior. A brief summary of some
238 -- key differences:
239 --
240 -- * Haskell 'printf' never uses the default \"6-digit\" precision
241 -- used by C printf.
242 --
243 -- * Haskell 'printf' treats the \"precision\" specifier as
244 -- indicating the number of digits after the decimal point.
245 --
246 -- * Haskell 'printf' prints the exponent of e-format
247 -- numbers without a gratuitous plus sign, and with the
248 -- minimum possible number of digits.
249 --
250 -- * Haskell 'printf' will place a zero after a decimal point when
251 -- possible.
252 --
253 -- Examples:
254 --
255 -- > > printf "%d\n" (23::Int)
256 -- > 23
257 -- > > printf "%s %s\n" "Hello" "World"
258 -- > Hello World
259 -- > > printf "%.2f\n" pi
260 -- > 3.14
261 --
262 printf :: (PrintfType r) => String -> r
263 printf fmts = spr fmts []
264
265 -- | Similar to 'printf', except that output is via the specified
266 -- 'Handle'. The return type is restricted to @('IO' a)@.
267 hPrintf :: (HPrintfType r) => Handle -> String -> r
268 hPrintf hdl fmts = hspr hdl fmts []
269
270 -- |The 'PrintfType' class provides the variable argument magic for
271 -- 'printf'. Its implementation is intentionally not visible from
272 -- this module. If you attempt to pass an argument of a type which
273 -- is not an instance of this class to 'printf' or 'hPrintf', then
274 -- the compiler will report it as a missing instance of 'PrintfArg'.
275 class PrintfType t where
276 spr :: String -> [UPrintf] -> t
277
278 -- | The 'HPrintfType' class provides the variable argument magic for
279 -- 'hPrintf'. Its implementation is intentionally not visible from
280 -- this module.
281 class HPrintfType t where
282 hspr :: Handle -> String -> [UPrintf] -> t
283
284 {- not allowed in Haskell 2010
285 instance PrintfType String where
286 spr fmt args = uprintf fmt (reverse args)
287 -}
288 instance (IsChar c) => PrintfType [c] where
289 spr fmts args = map fromChar (uprintf fmts (reverse args))
290
291 -- Note that this should really be (IO ()), but GHC's
292 -- type system won't readily let us say that without
293 -- bringing the GADTs. So we go conditional for these defs.
294
295 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 700
296
297 instance (a ~ ()) => PrintfType (IO a) where
298 spr fmts args =
299 putStr $ map fromChar $ uprintf fmts $ reverse args
300
301 instance (a ~ ()) => HPrintfType (IO a) where
302 hspr hdl fmts args = do
303 hPutStr hdl (uprintf fmts (reverse args))
304
305 #else
306
307 instance PrintfType (IO a) where
308 spr fmts args = do
309 putStr $ map fromChar $ uprintf fmts $ reverse args
310 return (error "PrintfType (IO a): result should not be used.")
311
312 instance HPrintfType (IO a) where
313 hspr hdl fmts args = do
314 hPutStr hdl (uprintf fmts (reverse args))
315 return (error "HPrintfType (IO a): result should not be used.")
316
317 #endif
318
319
320 instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
321 spr fmts args = \ a -> spr fmts
322 ((parseFormat a, formatArg a) : args)
323
324 instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
325 hspr hdl fmts args = \ a -> hspr hdl fmts
326 ((parseFormat a, formatArg a) : args)
327
328 -- | Typeclass of 'printf'-formattable values. The 'formatArg' method
329 -- takes a value and a field format descriptor and either fails due
330 -- to a bad descriptor or produces a 'ShowS' as the result. The
331 -- default 'parseFormat' expects no modifiers: this is the normal
332 -- case. Minimal instance: 'formatArg'.
333 class PrintfArg a where
334 -- | /Since: 4.7.0.0/
335 formatArg :: a -> FieldFormatter
336 -- | /Since: 4.7.0.0/
337 parseFormat :: a -> ModifierParser
338 parseFormat _ (c : cs) = FormatParse "" c cs
339 parseFormat _ "" = errorShortFormat
340
341 instance PrintfArg Char where
342 formatArg = formatChar
343 parseFormat _ cf = parseIntFormat (undefined :: Int) cf
344
345 instance (IsChar c) => PrintfArg [c] where
346 formatArg = formatString
347
348 instance PrintfArg Int where
349 formatArg = formatInt
350 parseFormat = parseIntFormat
351
352 instance PrintfArg Int8 where
353 formatArg = formatInt
354 parseFormat = parseIntFormat
355
356 instance PrintfArg Int16 where
357 formatArg = formatInt
358 parseFormat = parseIntFormat
359
360 instance PrintfArg Int32 where
361 formatArg = formatInt
362 parseFormat = parseIntFormat
363
364 instance PrintfArg Int64 where
365 formatArg = formatInt
366 parseFormat = parseIntFormat
367
368 instance PrintfArg Word where
369 formatArg = formatInt
370 parseFormat = parseIntFormat
371
372 instance PrintfArg Word8 where
373 formatArg = formatInt
374 parseFormat = parseIntFormat
375
376 instance PrintfArg Word16 where
377 formatArg = formatInt
378 parseFormat = parseIntFormat
379
380 instance PrintfArg Word32 where
381 formatArg = formatInt
382 parseFormat = parseIntFormat
383
384 instance PrintfArg Word64 where
385 formatArg = formatInt
386 parseFormat = parseIntFormat
387
388 instance PrintfArg Integer where
389 formatArg = formatInteger
390 parseFormat = parseIntFormat
391
392 instance PrintfArg Float where
393 formatArg = formatRealFloat
394
395 instance PrintfArg Double where
396 formatArg = formatRealFloat
397
398 -- | This class, with only the one instance, is used as
399 -- a workaround for the fact that 'String', as a concrete
400 -- type, is not allowable as a typeclass instance. 'IsChar'
401 -- is exported for backward-compatibility.
402 class IsChar c where
403 -- | /Since: 4.7.0.0/
404 toChar :: c -> Char
405 -- | /Since: 4.7.0.0/
406 fromChar :: Char -> c
407
408 instance IsChar Char where
409 toChar c = c
410 fromChar c = c
411
412 -------------------
413
414 -- | Whether to left-adjust or zero-pad a field. These are
415 -- mutually exclusive, with 'LeftAdjust' taking precedence.
416 --
417 -- /Since: 4.7.0.0/
418 data FormatAdjustment = LeftAdjust | ZeroPad
419
420 -- | How to handle the sign of a numeric field. These are
421 -- mutually exclusive, with 'SignPlus' taking precedence.
422 --
423 -- /Since: 4.7.0.0/
424 data FormatSign = SignPlus | SignSpace
425
426 -- | Description of field formatting for 'formatArg'. See UNIX `printf`(3)
427 -- for a description of how field formatting works.
428 --
429 -- /Since: 4.7.0.0/
430 data FieldFormat = FieldFormat {
431 fmtWidth :: Maybe Int, -- ^ Total width of the field.
432 fmtPrecision :: Maybe Int, -- ^ Secondary field width specifier.
433 fmtAdjust :: Maybe FormatAdjustment, -- ^ Kind of filling or padding
434 -- to be done.
435 fmtSign :: Maybe FormatSign, -- ^ Whether to insist on a
436 -- plus sign for positive
437 -- numbers.
438 fmtAlternate :: Bool, -- ^ Indicates an "alternate
439 -- format". See printf(3)
440 -- for the details, which
441 -- vary by argument spec.
442 fmtModifiers :: String, -- ^ Characters that appeared
443 -- immediately to the left of
444 -- 'fmtChar' in the format
445 -- and were accepted by the
446 -- type's 'parseFormat'.
447 -- Normally the empty string.
448 fmtChar :: Char -- ^ The format character
449 -- 'printf' was invoked
450 -- with. 'formatArg' should
451 -- fail unless this character
452 -- matches the type. It is
453 -- normal to handle many
454 -- different format
455 -- characters for a single
456 -- type.
457 }
458
459 -- | The \"format parser\" walks over argument-type-specific
460 -- modifier characters to find the primary format character.
461 -- This is the type of its result.
462 --
463 -- /Since: 4.7.0.0/
464 data FormatParse = FormatParse {
465 fpModifiers :: String, -- ^ Any modifiers found.
466 fpChar :: Char, -- ^ Primary format character.
467 fpRest :: String -- ^ Rest of the format string.
468 }
469
470 -- Contains the "modifier letters" that can precede an
471 -- integer type.
472 intModifierMap :: [(String, Integer)]
473 intModifierMap = [
474 ("hh", toInteger (minBound :: Int8)),
475 ("h", toInteger (minBound :: Int16)),
476 ("l", toInteger (minBound :: Int32)),
477 ("ll", toInteger (minBound :: Int64)),
478 ("L", toInteger (minBound :: Int64)) ]
479
480 parseIntFormat :: Integral a => a -> String -> FormatParse
481 parseIntFormat _ s =
482 case foldr matchPrefix Nothing intModifierMap of
483 Just m -> m
484 Nothing ->
485 case s of
486 c : cs -> FormatParse "" c cs
487 "" -> errorShortFormat
488 where
489 matchPrefix (p, _) m@(Just (FormatParse p0 _ _))
490 | length p0 >= length p = m
491 | otherwise = case getFormat p of
492 Nothing -> m
493 Just fp -> Just fp
494 matchPrefix (p, _) Nothing =
495 getFormat p
496 getFormat p =
497 stripPrefix p s >>= fp
498 where
499 fp (c : cs) = Just $ FormatParse p c cs
500 fp "" = errorShortFormat
501
502 -- | This is the type of a field formatter reified over its
503 -- argument.
504 --
505 -- /Since: 4.7.0.0/
506 type FieldFormatter = FieldFormat -> ShowS
507
508 -- | Type of a function that will parse modifier characters
509 -- from the format string.
510 --
511 -- /Since: 4.7.0.0/
512 type ModifierParser = String -> FormatParse
513
514 -- | Substitute a \'v\' format character with the given
515 -- default format character in the 'FieldFormat'. A
516 -- convenience for user-implemented types, which should
517 -- support \"%v\".
518 --
519 -- /Since: 4.7.0.0/
520 vFmt :: Char -> FieldFormat -> FieldFormat
521 vFmt c ufmt@(FieldFormat {fmtChar = 'v'}) = ufmt {fmtChar = c}
522 vFmt _ ufmt = ufmt
523
524 -- | Formatter for 'Char' values.
525 --
526 -- /Since: 4.7.0.0/
527 formatChar :: Char -> FieldFormatter
528 formatChar x ufmt =
529 formatIntegral (Just 0) (toInteger $ ord x) $ vFmt 'c' ufmt
530
531 -- | Formatter for 'String' values.
532 --
533 -- /Since: 4.7.0.0/
534 formatString :: IsChar a => [a] -> FieldFormatter
535 formatString x ufmt =
536 case fmtChar $ vFmt 's' ufmt of
537 's' -> map toChar . (adjust ufmt ("", ts) ++)
538 where
539 ts = map toChar $ trunc $ fmtPrecision ufmt
540 where
541 trunc Nothing = x
542 trunc (Just n) = take n x
543 c -> errorBadFormat c
544
545 -- Possibly apply the int modifiers to get a new
546 -- int width for conversion.
547 fixupMods :: FieldFormat -> Maybe Integer -> Maybe Integer
548 fixupMods ufmt m =
549 let mods = fmtModifiers ufmt in
550 case mods of
551 "" -> m
552 _ -> case lookup mods intModifierMap of
553 Just m0 -> Just m0
554 Nothing -> perror "unknown format modifier"
555
556 -- | Formatter for 'Int' values.
557 --
558 -- /Since: 4.7.0.0/
559 formatInt :: (Integral a, Bounded a) => a -> FieldFormatter
560 formatInt x ufmt =
561 let lb = toInteger $ minBound `asTypeOf` x
562 m = fixupMods ufmt (Just lb)
563 ufmt' = case lb of
564 0 -> vFmt 'u' ufmt
565 _ -> ufmt
566 in
567 formatIntegral m (toInteger x) ufmt'
568
569 -- | Formatter for 'Integer' values.
570 --
571 -- /Since: 4.7.0.0/
572 formatInteger :: Integer -> FieldFormatter
573 formatInteger x ufmt =
574 let m = fixupMods ufmt Nothing in
575 formatIntegral m x ufmt
576
577 -- All formatting for integral types is handled
578 -- consistently. The only difference is between Integer and
579 -- bounded types; this difference is handled by the 'm'
580 -- argument containing the lower bound.
581 formatIntegral :: Maybe Integer -> Integer -> FieldFormatter
582 formatIntegral m x ufmt0 =
583 let prec = fmtPrecision ufmt0 in
584 case fmtChar ufmt of
585 'd' -> (adjustSigned ufmt (fmti prec x) ++)
586 'i' -> (adjustSigned ufmt (fmti prec x) ++)
587 'x' -> (adjust ufmt (fmtu 16 (alt "0x" x) prec m x) ++)
588 'X' -> (adjust ufmt (upcase $ fmtu 16 (alt "0X" x) prec m x) ++)
589 'b' -> (adjust ufmt (fmtu 2 (alt "0b" x) prec m x) ++)
590 'o' -> (adjust ufmt (fmtu 8 (alt "0" x) prec m x) ++)
591 'u' -> (adjust ufmt (fmtu 10 Nothing prec m x) ++)
592 'c' | x >= fromIntegral (ord (minBound :: Char)) &&
593 x <= fromIntegral (ord (maxBound :: Char)) &&
594 fmtPrecision ufmt == Nothing &&
595 fmtModifiers ufmt == "" ->
596 formatString [chr $ fromIntegral x] (ufmt { fmtChar = 's' })
597 'c' -> perror "illegal char conversion"
598 c -> errorBadFormat c
599 where
600 ufmt = vFmt 'd' $ case ufmt0 of
601 FieldFormat { fmtPrecision = Just _, fmtAdjust = Just ZeroPad } ->
602 ufmt0 { fmtAdjust = Nothing }
603 _ -> ufmt0
604 alt _ 0 = Nothing
605 alt p _ = case fmtAlternate ufmt of
606 True -> Just p
607 False -> Nothing
608 upcase (s1, s2) = (s1, map toUpper s2)
609
610 -- | Formatter for 'RealFloat' values.
611 --
612 -- /Since: 4.7.0.0/
613 formatRealFloat :: RealFloat a => a -> FieldFormatter
614 formatRealFloat x ufmt =
615 let c = fmtChar $ vFmt 'g' ufmt
616 prec = fmtPrecision ufmt
617 alt = fmtAlternate ufmt
618 in
619 case c of
620 'e' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
621 'E' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
622 'f' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
623 'F' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
624 'g' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
625 'G' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
626 _ -> errorBadFormat c
627
628 -- This is the type carried around for arguments in
629 -- the varargs code.
630 type UPrintf = (ModifierParser, FieldFormatter)
631
632 -- Given a format string and a list of formatting functions
633 -- (the actual argument value having already been baked into
634 -- each of these functions before delivery), return the
635 -- actual formatted text string.
636 uprintf :: String -> [UPrintf] -> String
637 uprintf s us = uprintfs s us ""
638
639 -- This function does the actual work, producing a ShowS
640 -- instead of a string, for future expansion and for
641 -- misguided efficiency.
642 uprintfs :: String -> [UPrintf] -> ShowS
643 uprintfs "" [] = id
644 uprintfs "" (_:_) = errorShortFormat
645 uprintfs ('%':'%':cs) us = ('%' :) . uprintfs cs us
646 uprintfs ('%':_) [] = errorMissingArgument
647 uprintfs ('%':cs) us@(_:_) = fmt cs us
648 uprintfs (c:cs) us = (c :) . uprintfs cs us
649
650 -- Given a suffix of the format string starting just after
651 -- the percent sign, and the list of remaining unprocessed
652 -- arguments in the form described above, format the portion
653 -- of the output described by this field description, and
654 -- then continue with 'uprintfs'.
655 fmt :: String -> [UPrintf] -> ShowS
656 fmt cs0 us0 =
657 case getSpecs False False Nothing False cs0 us0 of
658 (_, _, []) -> errorMissingArgument
659 (ufmt, cs, (_, u) : us) -> u ufmt . uprintfs cs us
660
661 -- Given field formatting information, and a tuple
662 -- consisting of a prefix (for example, a minus sign) that
663 -- is supposed to go before the argument value and a string
664 -- representing the value, return the properly padded and
665 -- formatted result.
666 adjust :: FieldFormat -> (String, String) -> String
667 adjust ufmt (pre, str) =
668 let naturalWidth = length pre + length str
669 zero = case fmtAdjust ufmt of
670 Just ZeroPad -> True
671 _ -> False
672 left = case fmtAdjust ufmt of
673 Just LeftAdjust -> True
674 _ -> False
675 fill = case fmtWidth ufmt of
676 Just width | naturalWidth < width ->
677 let fillchar = if zero then '0' else ' ' in
678 replicate (width - naturalWidth) fillchar
679 _ -> ""
680 in
681 if left
682 then pre ++ str ++ fill
683 else if zero
684 then pre ++ fill ++ str
685 else fill ++ pre ++ str
686
687 -- For positive numbers with an explicit sign field ("+" or
688 -- " "), adjust accordingly.
689 adjustSigned :: FieldFormat -> (String, String) -> String
690 adjustSigned ufmt@(FieldFormat {fmtSign = Just SignPlus}) ("", str) =
691 adjust ufmt ("+", str)
692 adjustSigned ufmt@(FieldFormat {fmtSign = Just SignSpace}) ("", str) =
693 adjust ufmt (" ", str)
694 adjustSigned ufmt ps =
695 adjust ufmt ps
696
697 -- Format a signed integer in the "default" fashion.
698 -- This will be subjected to adjust subsequently.
699 fmti :: Maybe Int -> Integer -> (String, String)
700 fmti prec i
701 | i < 0 = ("-", integral_prec prec (show (-i)))
702 | otherwise = ("", integral_prec prec (show i))
703
704 -- Format an unsigned integer in the "default" fashion.
705 -- This will be subjected to adjust subsequently. The 'b'
706 -- argument is the base, the 'pre' argument is the prefix,
707 -- and the '(Just m)' argument is the implicit lower-bound
708 -- size of the operand for conversion from signed to
709 -- unsigned. Thus, this function will refuse to convert an
710 -- unbounded negative integer to an unsigned string.
711 fmtu :: Integer -> Maybe String -> Maybe Int -> Maybe Integer -> Integer
712 -> (String, String)
713 fmtu b (Just pre) prec m i =
714 let ("", s) = fmtu b Nothing prec m i in
715 case pre of
716 "0" -> case s of
717 '0' : _ -> ("", s)
718 _ -> (pre, s)
719 _ -> (pre, s)
720 fmtu b Nothing prec0 m0 i0 =
721 case fmtu' prec0 m0 i0 of
722 Just s -> ("", s)
723 Nothing -> errorBadArgument
724 where
725 fmtu' :: Maybe Int -> Maybe Integer -> Integer -> Maybe String
726 fmtu' prec (Just m) i | i < 0 =
727 fmtu' prec Nothing (-2 * m + i)
728 fmtu' (Just prec) _ i | i >= 0 =
729 fmap (integral_prec (Just prec)) $ fmtu' Nothing Nothing i
730 fmtu' Nothing _ i | i >= 0 =
731 Just $ showIntAtBase b intToDigit i ""
732 fmtu' _ _ _ = Nothing
733
734
735 -- This is used by 'fmtu' and 'fmti' to zero-pad an
736 -- int-string to a required precision.
737 integral_prec :: Maybe Int -> String -> String
738 integral_prec Nothing integral = integral
739 integral_prec (Just 0) "0" = ""
740 integral_prec (Just prec) integral =
741 replicate (prec - length integral) '0' ++ integral
742
743 stoi :: String -> (Int, String)
744 stoi cs =
745 let (as, cs') = span isDigit cs in
746 case as of
747 "" -> (0, cs')
748 _ -> (read as, cs')
749
750 -- Figure out the FormatAdjustment, given:
751 -- width, precision, left-adjust, zero-fill
752 adjustment :: Maybe Int -> Maybe a -> Bool -> Bool
753 -> Maybe FormatAdjustment
754 adjustment w p l z =
755 case w of
756 Just n | n < 0 -> adjl p True z
757 _ -> adjl p l z
758 where
759 adjl _ True _ = Just LeftAdjust
760 adjl _ False True = Just ZeroPad
761 adjl _ _ _ = Nothing
762
763 -- Parse the various format controls to get a format specification.
764 getSpecs :: Bool -> Bool -> Maybe FormatSign -> Bool -> String -> [UPrintf]
765 -> (FieldFormat, String, [UPrintf])
766 getSpecs _ z s a ('-' : cs0) us = getSpecs True z s a cs0 us
767 getSpecs l z _ a ('+' : cs0) us = getSpecs l z (Just SignPlus) a cs0 us
768 getSpecs l z s a (' ' : cs0) us =
769 getSpecs l z ss a cs0 us
770 where
771 ss = case s of
772 Just SignPlus -> Just SignPlus
773 _ -> Just SignSpace
774 getSpecs l _ s a ('0' : cs0) us = getSpecs l True s a cs0 us
775 getSpecs l z s _ ('#' : cs0) us = getSpecs l z s True cs0 us
776 getSpecs l z s a ('*' : cs0) us =
777 let (us', n) = getStar us
778 ((p, cs''), us'') = case cs0 of
779 '.':'*':r ->
780 let (us''', p') = getStar us' in ((Just p', r), us''')
781 '.':r ->
782 let (p', r') = stoi r in ((Just p', r'), us')
783 _ ->
784 ((Nothing, cs0), us')
785 FormatParse ms c cs =
786 case us'' of
787 (ufmt, _) : _ -> ufmt cs''
788 [] -> errorMissingArgument
789 in
790 (FieldFormat {
791 fmtWidth = Just (abs n),
792 fmtPrecision = p,
793 fmtAdjust = adjustment (Just n) p l z,
794 fmtSign = s,
795 fmtAlternate = a,
796 fmtModifiers = ms,
797 fmtChar = c}, cs, us'')
798 getSpecs l z s a ('.' : cs0) us =
799 let ((p, cs'), us') = case cs0 of
800 '*':cs'' -> let (us'', p') = getStar us in ((p', cs''), us'')
801 _ -> (stoi cs0, us)
802 FormatParse ms c cs =
803 case us' of
804 (ufmt, _) : _ -> ufmt cs'
805 [] -> errorMissingArgument
806 in
807 (FieldFormat {
808 fmtWidth = Nothing,
809 fmtPrecision = Just p,
810 fmtAdjust = adjustment Nothing (Just p) l z,
811 fmtSign = s,
812 fmtAlternate = a,
813 fmtModifiers = ms,
814 fmtChar = c}, cs, us')
815 getSpecs l z s a cs0@(c0 : _) us | isDigit c0 =
816 let (n, cs') = stoi cs0
817 ((p, cs''), us') = case cs' of
818 '.' : '*' : r ->
819 let (us'', p') = getStar us in ((Just p', r), us'')
820 '.' : r ->
821 let (p', r') = stoi r in ((Just p', r'), us)
822 _ ->
823 ((Nothing, cs'), us)
824 FormatParse ms c cs =
825 case us' of
826 (ufmt, _) : _ -> ufmt cs''
827 [] -> errorMissingArgument
828 in
829 (FieldFormat {
830 fmtWidth = Just (abs n),
831 fmtPrecision = p,
832 fmtAdjust = adjustment (Just n) p l z,
833 fmtSign = s,
834 fmtAlternate = a,
835 fmtModifiers = ms,
836 fmtChar = c}, cs, us')
837 getSpecs l z s a cs0@(_ : _) us =
838 let FormatParse ms c cs =
839 case us of
840 (ufmt, _) : _ -> ufmt cs0
841 [] -> errorMissingArgument
842 in
843 (FieldFormat {
844 fmtWidth = Nothing,
845 fmtPrecision = Nothing,
846 fmtAdjust = adjustment Nothing Nothing l z,
847 fmtSign = s,
848 fmtAlternate = a,
849 fmtModifiers = ms,
850 fmtChar = c}, cs, us)
851 getSpecs _ _ _ _ "" _ =
852 errorShortFormat
853
854 -- Process a star argument in a format specification.
855 getStar :: [UPrintf] -> ([UPrintf], Int)
856 getStar us =
857 let ufmt = FieldFormat {
858 fmtWidth = Nothing,
859 fmtPrecision = Nothing,
860 fmtAdjust = Nothing,
861 fmtSign = Nothing,
862 fmtAlternate = False,
863 fmtModifiers = "",
864 fmtChar = 'd' } in
865 case us of
866 [] -> errorMissingArgument
867 (_, nu) : us' -> (us', read (nu ufmt ""))
868
869 -- Format a RealFloat value.
870 dfmt :: (RealFloat a) => Char -> Maybe Int -> Bool -> a -> (String, String)
871 dfmt c p a d =
872 let caseConvert = if isUpper c then map toUpper else id
873 showFunction = case toLower c of
874 'e' -> showEFloat
875 'f' -> if a then showFFloatAlt else showFFloat
876 'g' -> if a then showGFloatAlt else showGFloat
877 _ -> perror "internal error: impossible dfmt"
878 result = caseConvert $ showFunction p d ""
879 in
880 case result of
881 '-' : cs -> ("-", cs)
882 cs -> ("" , cs)
883
884
885 -- | Raises an 'error' with a printf-specific prefix on the
886 -- message string.
887 --
888 -- /Since: 4.7.0.0/
889 perror :: String -> a
890 perror s = error $ "printf: " ++ s
891
892 -- | Calls 'perror' to indicate an unknown format letter for
893 -- a given type.
894 --
895 -- /Since: 4.7.0.0/
896 errorBadFormat :: Char -> a
897 errorBadFormat c = perror $ "bad formatting char " ++ show c
898
899 errorShortFormat, errorMissingArgument, errorBadArgument :: a
900 -- | Calls 'perror' to indicate that the format string ended
901 -- early.
902 --
903 -- /Since: 4.7.0.0/
904 errorShortFormat = perror "formatting string ended prematurely"
905 -- | Calls 'perror' to indicate that there is a missing
906 -- argument in the argument list.
907 --
908 -- /Since: 4.7.0.0/
909 errorMissingArgument = perror "argument list ended prematurely"
910 -- | Calls 'perror' to indicate that there is a type
911 -- error or similar in the given argument.
912 --
913 -- /Since: 4.7.0.0/
914 errorBadArgument = perror "bad argument"