content: {-# LANGUAGE Safe #-}
  {-# LANGUAGE GADTs #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Text.Printf
  -- Copyright   :  (c) Lennart Augustsson and Bart Massey 2013
  -- License     :  BSD-style (see the file LICENSE in this distribution)
  --
  -- Maintainer  :  Bart Massey <bart@cs.pdx.edu>
  -- Stability   :  provisional
  -- Portability :  portable
  --
  -- A C @printf(3)@-like formatter. This version has been
  -- extended by Bart Massey as per the recommendations of
  -- John Meacham and Simon Marlow
  -- \<<http://comments.gmane.org/gmane.comp.lang.haskell.libraries/4726>\>
  -- to support extensible formatting for new datatypes.  It
  -- has also been extended to support almost all C
  -- @printf(3)@ syntax.
  -----------------------------------------------------------------------------
  
  module Text.Printf(
  -- * Printing Functions
     printf, hPrintf,
  -- * Extending To New Types
  --
  -- | This 'printf' can be extended to format types
  -- other than those provided for by default. This
  -- is done by instancing 'PrintfArg' and providing
  -- a 'formatArg' for the type. It is possible to
  -- provide a 'parseFormat' to process type-specific
  -- modifiers, but the default instance is usually
  -- the best choice.
  --
  -- For example:
  --
  -- > instance PrintfArg () where
  -- >   formatArg x fmt | fmtChar (vFmt 'U' fmt) == 'U' =
  -- >     formatString "()" (fmt { fmtChar = 's', fmtPrecision = Nothing })
  -- >   formatArg _ fmt = errorBadFormat $ fmtChar fmt
  -- >
  -- > main :: IO ()
  -- > main = printf "[%-3.1U]\n" ()
  --
  -- prints \"@[() ]@\". Note the use of 'formatString' to
  -- take care of field formatting specifications in a convenient
  -- way.
     PrintfArg(..),
     FieldFormatter,
     FieldFormat(..),
     FormatAdjustment(..), FormatSign(..),
     vFmt,
  -- ** Handling Type-specific Modifiers
  --
  -- | In the unlikely case that modifier characters of
  -- some kind are desirable for a user-provided type,
  -- a 'ModifierParser' can be provided to process these
  -- characters. The resulting modifiers will appear in
  -- the 'FieldFormat' for use by the type-specific formatter.
     ModifierParser, FormatParse(..),
  -- ** Standard Formatters
  --
  -- | These formatters for standard types are provided for
  -- convenience in writting new type-specific formatters:
  -- a common pattern is to throw to 'formatString' or
  -- 'formatInteger' to do most of the format handling for
  -- a new type.
     formatString, formatChar, formatInt,
     formatInteger, formatRealFloat,
  -- ** Raising Errors
  --
  -- | These functions are used internally to raise various
  -- errors, and are exported for use by new type-specific
  -- formatters.
    errorBadFormat, errorShortFormat, errorMissingArgument,
    errorBadArgument,
    perror,
  -- * Implementation Internals
  -- | These types are needed for implementing processing
  -- variable numbers of arguments to 'printf' and 'hPrintf'.
  -- Their implementation is intentionally not visible from
  -- this module. If you attempt to pass an argument of a type
  -- which is not an instance of the appropriate class to
  -- 'printf' or 'hPrintf', then the compiler will report it
  -- as a missing instance of 'PrintfArg'.  (All 'PrintfArg'
  -- instances are 'PrintfType' instances.)
    PrintfType, HPrintfType,
  -- | This class is needed as a Haskell98 compatibility
  -- workaround for the lack of FlexibleInstances.
    IsChar(..)
  ) where
  
  import Data.Char
  import Data.Int
  import Data.List
  import Data.Word
  import Numeric
  import Numeric.Natural
  import System.IO
  
  -------------------
  
  -- | Format a variable number of arguments with the C-style formatting string.
  -- The return value is either 'String' or @('IO' a)@ (which
  -- should be @('IO' '()')@, but Haskell's type system
  -- makes this hard).
  --
  -- The format string consists of ordinary characters and
  -- /conversion specifications/, which specify how to format
  -- one of the arguments to 'printf' in the output string. A
  -- format specification is introduced by the @%@ character;
  -- this character can be self-escaped into the format string
  -- using @%%@. A format specification ends with a /format
  -- character/ that provides the primary information about
  -- how to format the value. The rest of the conversion
  -- specification is optional.  In order, one may have flag
  -- characters, a width specifier, a precision specifier, and
  -- type-specific modifier characters.
  --
  -- Unlike C @printf(3)@, the formatting of this 'printf'
  -- is driven by the argument type; formatting is type specific. The
  -- types formatted by 'printf' \"out of the box\" are:
  --
  --   * 'Integral' types, including 'Char'
  --
  --   * 'String'
  --
  --   * 'RealFloat' types
  --
  -- 'printf' is also extensible to support other types: see below.
  --
  -- A conversion specification begins with the
  -- character @%@, followed by zero or more of the following flags:
  --
  -- >    -      left adjust (default is right adjust)
  -- >    +      always use a sign (+ or -) for signed conversions
  -- >    space  leading space for positive numbers in signed conversions
  -- >    0      pad with zeros rather than spaces
  -- >    #      use an \"alternate form\": see below
  --
  -- When both flags are given, @-@ overrides @0@ and @+@ overrides space.
  -- A negative width specifier in a @*@ conversion is treated as
  -- positive but implies the left adjust flag.
  --
  -- The \"alternate form\" for unsigned radix conversions is
  -- as in C @printf(3)@:
  --
  -- >    %o           prefix with a leading 0 if needed
  -- >    %x           prefix with a leading 0x if nonzero
  -- >    %X           prefix with a leading 0X if nonzero
  -- >    %b           prefix with a leading 0b if nonzero
  -- >    %[eEfFgG]    ensure that the number contains a decimal point
  --
  -- Any flags are followed optionally by a field width:
  --
  -- >    num    field width
  -- >    *      as num, but taken from argument list
  --
  -- The field width is a minimum, not a maximum: it will be
  -- expanded as needed to avoid mutilating a value.
  --
  -- Any field width is followed optionally by a precision:
  --
  -- >    .num   precision
  -- >    .      same as .0
  -- >    .*     as num, but taken from argument list
  --
  -- Negative precision is taken as 0. The meaning of the
  -- precision depends on the conversion type.
  --
  -- >    Integral    minimum number of digits to show
  -- >    RealFloat   number of digits after the decimal point
  -- >    String      maximum number of characters
  --
  -- The precision for Integral types is accomplished by zero-padding.
  -- If both precision and zero-pad are given for an Integral field,
  -- the zero-pad is ignored.
  --
  -- Any precision is followed optionally for Integral types
  -- by a width modifier; the only use of this modifier being
  -- to set the implicit size of the operand for conversion of
  -- a negative operand to unsigned:
  --
  -- >    hh     Int8
  -- >    h      Int16
  -- >    l      Int32
  -- >    ll     Int64
  -- >    L      Int64
  --
  -- The specification ends with a format character:
  --
  -- >    c      character               Integral
  -- >    d      decimal                 Integral
  -- >    o      octal                   Integral
  -- >    x      hexadecimal             Integral
  -- >    X      hexadecimal             Integral
  -- >    b      binary                  Integral
  -- >    u      unsigned decimal        Integral
  -- >    f      floating point          RealFloat
  -- >    F      floating point          RealFloat
  -- >    g      general format float    RealFloat
  -- >    G      general format float    RealFloat
  -- >    e      exponent format float   RealFloat
  -- >    E      exponent format float   RealFloat
  -- >    s      string                  String
  -- >    v      default format          any type
  --
  -- The \"%v\" specifier is provided for all built-in types,
  -- and should be provided for user-defined type formatters
  -- as well. It picks a \"best\" representation for the given
  -- type. For the built-in types the \"%v\" specifier is
  -- converted as follows:
  --
  -- >    c      Char
  -- >    u      other unsigned Integral
  -- >    d      other signed Integral
  -- >    g      RealFloat
  -- >    s      String
  --
  -- Mismatch between the argument types and the format
  -- string, as well as any other syntactic or semantic errors
  -- in the format string, will cause an exception to be
  -- thrown at runtime.
  --
  -- Note that the formatting for 'RealFloat' types is
  -- currently a bit different from that of C @printf(3)@,
  -- conforming instead to 'Numeric.showEFloat',
  -- 'Numeric.showFFloat' and 'Numeric.showGFloat' (and their
  -- alternate versions 'Numeric.showFFloatAlt' and
  -- 'Numeric.showGFloatAlt'). This is hard to fix: the fixed
  -- versions would format in a backward-incompatible way.
  -- In any case the Haskell behavior is generally more
  -- sensible than the C behavior.  A brief summary of some
  -- key differences:
  --
  -- * Haskell 'printf' never uses the default \"6-digit\" precision
  --   used by C printf.
  --
  -- * Haskell 'printf' treats the \"precision\" specifier as
  --   indicating the number of digits after the decimal point.
  --
  -- * Haskell 'printf' prints the exponent of e-format
  --   numbers without a gratuitous plus sign, and with the
  --   minimum possible number of digits.
  --
  -- * Haskell 'printf' will place a zero after a decimal point when
  --   possible.
  --
  -- ==== __Examples__
  --
  -- >   > printf "%d\n" (23::Int)
  -- >   23
  -- >   > printf "%s %s\n" "Hello" "World"
  -- >   Hello World
  -- >   > printf "%.2f\n" pi
  -- >   3.14
  --
  printf :: (PrintfType r) => String -> r
  printf fmts = spr fmts []
  
  -- | Similar to 'printf', except that output is via the specified
  -- 'Handle'.  The return type is restricted to @('IO' a)@.
  hPrintf :: (HPrintfType r) => Handle -> String -> r
  hPrintf hdl fmts = hspr hdl fmts []
  
  -- |The 'PrintfType' class provides the variable argument magic for
  -- 'printf'.  Its implementation is intentionally not visible from
  -- this module. If you attempt to pass an argument of a type which
  -- is not an instance of this class to 'printf' or 'hPrintf', then
  -- the compiler will report it as a missing instance of 'PrintfArg'.
  class PrintfType t where
      spr :: String -> [UPrintf] -> t
  
  -- | The 'HPrintfType' class provides the variable argument magic for
  -- 'hPrintf'.  Its implementation is intentionally not visible from
  -- this module.
  class HPrintfType t where
      hspr :: Handle -> String -> [UPrintf] -> t
  
  {- not allowed in Haskell 2010
  instance PrintfType String where
      spr fmt args = uprintf fmt (reverse args)
  -}
  instance (IsChar c) => PrintfType [c] where
      spr fmts args = map fromChar (uprintf fmts (reverse args))
  
  -- Note that this should really be (IO ()), but GHC's
  -- type system won't readily let us say that without
  -- bringing the GADTs. So we go conditional for these defs.
  
  instance (a ~ ()) => PrintfType (IO a) where
      spr fmts args =
          putStr $ map fromChar $ uprintf fmts $ reverse args
  
  instance (a ~ ()) => HPrintfType (IO a) where
      hspr hdl fmts args = do
          hPutStr hdl (uprintf fmts (reverse args))
  
  instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
      spr fmts args = \ a -> spr fmts
                               ((parseFormat a, formatArg a) : args)
  
  instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
      hspr hdl fmts args = \ a -> hspr hdl fmts
                                    ((parseFormat a, formatArg a) : args)
  
  -- | Typeclass of 'printf'-formattable values. The 'formatArg' method
  -- takes a value and a field format descriptor and either fails due
  -- to a bad descriptor or produces a 'ShowS' as the result. The
  -- default 'parseFormat' expects no modifiers: this is the normal
  -- case. Minimal instance: 'formatArg'.
  class PrintfArg a where
      -- | @since 4.7.0.0
      formatArg :: a -> FieldFormatter
      -- | @since 4.7.0.0
      parseFormat :: a -> ModifierParser
      parseFormat _ (c : cs) = FormatParse "" c cs
      parseFormat _ "" = errorShortFormat
  
  instance PrintfArg Char where
      formatArg = formatChar
      parseFormat _ cf = parseIntFormat (undefined :: Int) cf
  
  instance (IsChar c) => PrintfArg [c] where
      formatArg = formatString
  
  instance PrintfArg Int where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Int8 where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Int16 where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Int32 where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Int64 where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Word where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Word8 where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Word16 where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Word32 where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Word64 where
      formatArg = formatInt
      parseFormat = parseIntFormat
  
  instance PrintfArg Integer where
      formatArg = formatInteger
      parseFormat = parseIntFormat
  
  instance PrintfArg Natural where
      formatArg = formatInteger . toInteger
      parseFormat = parseIntFormat
  
  instance PrintfArg Float where
      formatArg = formatRealFloat
  
  instance PrintfArg Double where
      formatArg = formatRealFloat
  
  -- | This class, with only the one instance, is used as
  -- a workaround for the fact that 'String', as a concrete
  -- type, is not allowable as a typeclass instance. 'IsChar'
  -- is exported for backward-compatibility.
  class IsChar c where
      -- | @since 4.7.0.0
      toChar :: c -> Char
      -- | @since 4.7.0.0
      fromChar :: Char -> c
  
  instance IsChar Char where
      toChar c = c
      fromChar c = c
  
  -------------------
  
  -- | Whether to left-adjust or zero-pad a field. These are
  -- mutually exclusive, with 'LeftAdjust' taking precedence.
  --
  -- @since 4.7.0.0
  data FormatAdjustment = LeftAdjust | ZeroPad
  
  -- | How to handle the sign of a numeric field.  These are
  -- mutually exclusive, with 'SignPlus' taking precedence.
  --
  -- @since 4.7.0.0
  data FormatSign = SignPlus | SignSpace
  
  -- | Description of field formatting for 'formatArg'. See UNIX `printf`(3)
  -- for a description of how field formatting works.
  --
  -- @since 4.7.0.0
  data FieldFormat = FieldFormat {
    fmtWidth :: Maybe Int,       -- ^ Total width of the field.
    fmtPrecision :: Maybe Int,   -- ^ Secondary field width specifier.
    fmtAdjust :: Maybe FormatAdjustment,  -- ^ Kind of filling or padding
                                          --   to be done.
    fmtSign :: Maybe FormatSign, -- ^ Whether to insist on a
                                 -- plus sign for positive
                                 -- numbers.
    fmtAlternate :: Bool,        -- ^ Indicates an "alternate
                                 -- format".  See printf(3)
                                 -- for the details, which
                                 -- vary by argument spec.
    fmtModifiers :: String,      -- ^ Characters that appeared
                                 -- immediately to the left of
                                 -- 'fmtChar' in the format
                                 -- and were accepted by the
                                 -- type's 'parseFormat'.
                                 -- Normally the empty string.
    fmtChar :: Char              -- ^ The format character
                                 -- 'printf' was invoked
                                 -- with. 'formatArg' should
                                 -- fail unless this character
                                 -- matches the type. It is
                                 -- normal to handle many
                                 -- different format
                                 -- characters for a single
                                 -- type.
    }
  
  -- | The \"format parser\" walks over argument-type-specific
  -- modifier characters to find the primary format character.
  -- This is the type of its result.
  --
  -- @since 4.7.0.0
  data FormatParse = FormatParse {
    fpModifiers :: String,   -- ^ Any modifiers found.
    fpChar :: Char,          -- ^ Primary format character.
    fpRest :: String         -- ^ Rest of the format string.
    }
  
  -- Contains the "modifier letters" that can precede an
  -- integer type.
  intModifierMap :: [(String, Integer)]
  intModifierMap = [
    ("hh", toInteger (minBound :: Int8)),
    ("h", toInteger (minBound :: Int16)),
    ("l", toInteger (minBound :: Int32)),
    ("ll", toInteger (minBound :: Int64)),
    ("L", toInteger (minBound :: Int64)) ]
  
  parseIntFormat :: Integral a => a -> String -> FormatParse
  parseIntFormat _ s =
    case foldr matchPrefix Nothing intModifierMap of
      Just m -> m
      Nothing ->
        case s of
          c : cs -> FormatParse "" c cs
          "" -> errorShortFormat
    where
      matchPrefix (p, _) m@(Just (FormatParse p0 _ _))
        | length p0 >= length p = m
        | otherwise = case getFormat p of
            Nothing -> m
            Just fp -> Just fp
      matchPrefix (p, _) Nothing =
        getFormat p
      getFormat p =
        stripPrefix p s >>= fp
        where
          fp (c : cs) = Just $ FormatParse p c cs
          fp "" = errorShortFormat
  
  -- | This is the type of a field formatter reified over its
  -- argument.
  --
  -- @since 4.7.0.0
  type FieldFormatter = FieldFormat -> ShowS
  
  -- | Type of a function that will parse modifier characters
  -- from the format string.
  --
  -- @since 4.7.0.0
  type ModifierParser = String -> FormatParse
  
  -- | Substitute a \'v\' format character with the given
  -- default format character in the 'FieldFormat'. A
  -- convenience for user-implemented types, which should
  -- support \"%v\".
  --
  -- @since 4.7.0.0
  vFmt :: Char -> FieldFormat -> FieldFormat
  vFmt c ufmt@(FieldFormat {fmtChar = 'v'}) = ufmt {fmtChar = c}
  vFmt _ ufmt = ufmt
  
  -- | Formatter for 'Char' values.
  --
  -- @since 4.7.0.0
  formatChar :: Char -> FieldFormatter
  formatChar x ufmt =
    formatIntegral (Just 0) (toInteger $ ord x) $ vFmt 'c' ufmt
  
  -- | Formatter for 'String' values.
  --
  -- @since 4.7.0.0
  formatString :: IsChar a => [a] -> FieldFormatter
  formatString x ufmt =
    case fmtChar $ vFmt 's' ufmt of
      's' -> map toChar . (adjust ufmt ("", ts) ++)
             where
               ts = map toChar $ trunc $ fmtPrecision ufmt
                 where
                   trunc Nothing = x
                   trunc (Just n) = take n x
      c   -> errorBadFormat c
  
  -- Possibly apply the int modifiers to get a new
  -- int width for conversion.
  fixupMods :: FieldFormat -> Maybe Integer -> Maybe Integer
  fixupMods ufmt m =
    let mods = fmtModifiers ufmt in
    case mods of
      "" -> m
      _ -> case lookup mods intModifierMap of
        Just m0 -> Just m0
        Nothing -> perror "unknown format modifier"
  
  -- | Formatter for 'Int' values.
  --
  -- @since 4.7.0.0
  formatInt :: (Integral a, Bounded a) => a -> FieldFormatter
  formatInt x ufmt =
    let lb = toInteger $ minBound `asTypeOf` x
        m = fixupMods ufmt (Just lb)
        ufmt' = case lb of
          0 -> vFmt 'u' ufmt
          _ -> ufmt
    in
    formatIntegral m (toInteger x) ufmt'
  
  -- | Formatter for 'Integer' values.
  --
  -- @since 4.7.0.0
  formatInteger :: Integer -> FieldFormatter
  formatInteger x ufmt =
    let m = fixupMods ufmt Nothing in
    formatIntegral m x ufmt
  
  -- All formatting for integral types is handled
  -- consistently.  The only difference is between Integer and
  -- bounded types; this difference is handled by the 'm'
  -- argument containing the lower bound.
  formatIntegral :: Maybe Integer -> Integer -> FieldFormatter
  formatIntegral m x ufmt0 =
    let prec = fmtPrecision ufmt0 in
    case fmtChar ufmt of
      'd' -> (adjustSigned ufmt (fmti prec x) ++)
      'i' -> (adjustSigned ufmt (fmti prec x) ++)
      'x' -> (adjust ufmt (fmtu 16 (alt "0x" x) prec m x) ++)
      'X' -> (adjust ufmt (upcase $ fmtu 16 (alt "0X" x) prec m x) ++)
      'b' -> (adjust ufmt (fmtu 2 (alt "0b" x) prec m x) ++)
      'o' -> (adjust ufmt (fmtu 8 (alt "0" x) prec m x) ++)
      'u' -> (adjust ufmt (fmtu 10 Nothing prec m x) ++)
      'c' | x >= fromIntegral (ord (minBound :: Char)) &&
            x <= fromIntegral (ord (maxBound :: Char)) &&
            fmtPrecision ufmt == Nothing &&
            fmtModifiers ufmt == "" ->
              formatString [chr $ fromIntegral x] (ufmt { fmtChar = 's' })
      'c' -> perror "illegal char conversion"
      c   -> errorBadFormat c
    where
      ufmt = vFmt 'd' $ case ufmt0 of
        FieldFormat { fmtPrecision = Just _, fmtAdjust = Just ZeroPad } ->
          ufmt0 { fmtAdjust = Nothing }
        _ -> ufmt0
      alt _ 0 = Nothing
      alt p _ = case fmtAlternate ufmt of
        True -> Just p
        False -> Nothing
      upcase (s1, s2) = (s1, map toUpper s2)
  
  -- | Formatter for 'RealFloat' values.
  --
  -- @since 4.7.0.0
  formatRealFloat :: RealFloat a => a -> FieldFormatter
  formatRealFloat x ufmt =
    let c = fmtChar $ vFmt 'g' ufmt
        prec = fmtPrecision ufmt
        alt = fmtAlternate ufmt
    in
     case c of
       'e' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
       'E' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
       'f' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
       'F' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
       'g' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
       'G' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
       _   -> errorBadFormat c
  
  -- This is the type carried around for arguments in
  -- the varargs code.
  type UPrintf = (ModifierParser, FieldFormatter)
  
  -- Given a format string and a list of formatting functions
  -- (the actual argument value having already been baked into
  -- each of these functions before delivery), return the
  -- actual formatted text string.
  uprintf :: String -> [UPrintf] -> String
  uprintf s us = uprintfs s us ""
  
  -- This function does the actual work, producing a ShowS
  -- instead of a string, for future expansion and for
  -- misguided efficiency.
  uprintfs :: String -> [UPrintf] -> ShowS
  uprintfs ""       []       = id
  uprintfs ""       (_:_)    = errorShortFormat
  uprintfs ('%':'%':cs) us   = ('%' :) . uprintfs cs us
  uprintfs ('%':_)  []       = errorMissingArgument
  uprintfs ('%':cs) us@(_:_) = fmt cs us
  uprintfs (c:cs)   us       = (c :) . uprintfs cs us
  
  -- Given a suffix of the format string starting just after
  -- the percent sign, and the list of remaining unprocessed
  -- arguments in the form described above, format the portion
  -- of the output described by this field description, and
  -- then continue with 'uprintfs'.
  fmt :: String -> [UPrintf] -> ShowS
  fmt cs0 us0 =
    case getSpecs False False Nothing False cs0 us0 of
      (_, _, []) -> errorMissingArgument
      (ufmt, cs, (_, u) : us) -> u ufmt . uprintfs cs us
  
  -- Given field formatting information, and a tuple
  -- consisting of a prefix (for example, a minus sign) that
  -- is supposed to go before the argument value and a string
  -- representing the value, return the properly padded and
  -- formatted result.
  adjust :: FieldFormat -> (String, String) -> String
  adjust ufmt (pre, str) =
    let naturalWidth = length pre + length str
        zero = case fmtAdjust ufmt of
          Just ZeroPad -> True
          _ -> False
        left = case fmtAdjust ufmt of
          Just LeftAdjust -> True
          _ -> False
        fill = case fmtWidth ufmt of
          Just width | naturalWidth < width ->
            let fillchar = if zero then '0' else ' ' in
            replicate (width - naturalWidth) fillchar
          _ -> ""
    in
     if left
     then pre ++ str ++ fill
     else if zero
          then pre ++ fill ++ str
          else fill ++ pre ++ str
  
  -- For positive numbers with an explicit sign field ("+" or
  -- " "), adjust accordingly.
  adjustSigned :: FieldFormat -> (String, String) -> String
  adjustSigned ufmt@(FieldFormat {fmtSign = Just SignPlus}) ("", str) =
    adjust ufmt ("+", str)
  adjustSigned ufmt@(FieldFormat {fmtSign = Just SignSpace}) ("", str) =
    adjust ufmt (" ", str)
  adjustSigned ufmt ps =
    adjust ufmt ps
  
  -- Format a signed integer in the "default" fashion.
  -- This will be subjected to adjust subsequently.
  fmti :: Maybe Int -> Integer -> (String, String)
  fmti prec i
    | i < 0 = ("-", integral_prec prec (show (-i)))
    | otherwise = ("", integral_prec prec (show i))
  
  -- Format an unsigned integer in the "default" fashion.
  -- This will be subjected to adjust subsequently.  The 'b'
  -- argument is the base, the 'pre' argument is the prefix,
  -- and the '(Just m)' argument is the implicit lower-bound
  -- size of the operand for conversion from signed to
  -- unsigned. Thus, this function will refuse to convert an
  -- unbounded negative integer to an unsigned string.
  fmtu :: Integer -> Maybe String -> Maybe Int -> Maybe Integer -> Integer
       -> (String, String)
  fmtu b (Just pre) prec m i =
    let ("", s) = fmtu b Nothing prec m i in
    case pre of
      "0" -> case s of
        '0' : _ -> ("", s)
        _ -> (pre, s)
      _ -> (pre, s)
  fmtu b Nothing prec0 m0 i0 =
    case fmtu' prec0 m0 i0 of
      Just s -> ("", s)
      Nothing -> errorBadArgument
    where
      fmtu' :: Maybe Int -> Maybe Integer -> Integer -> Maybe String
      fmtu' prec (Just m) i | i < 0 =
        fmtu' prec Nothing (-2 * m + i)
      fmtu' (Just prec) _ i | i >= 0 =
        fmap (integral_prec (Just prec)) $ fmtu' Nothing Nothing i
      fmtu' Nothing _ i | i >= 0 =
        Just $ showIntAtBase b intToDigit i ""
      fmtu' _ _ _ = Nothing
  
  
  -- This is used by 'fmtu' and 'fmti' to zero-pad an
  -- int-string to a required precision.
  integral_prec :: Maybe Int -> String -> String
  integral_prec Nothing integral = integral
  integral_prec (Just 0) "0" = ""
  integral_prec (Just prec) integral =
    replicate (prec - length integral) '0' ++ integral
  
  stoi :: String -> (Int, String)
  stoi cs =
    let (as, cs') = span isDigit cs in
    case as of
      "" -> (0, cs')
      _ -> (read as, cs')
  
  -- Figure out the FormatAdjustment, given:
  --   width, precision, left-adjust, zero-fill
  adjustment :: Maybe Int -> Maybe a -> Bool -> Bool
             -> Maybe FormatAdjustment
  adjustment w p l z =
    case w of
      Just n | n < 0 -> adjl p True z
      _ -> adjl p l z
    where
      adjl _ True _ = Just LeftAdjust
      adjl _ False True = Just ZeroPad
      adjl _ _ _ = Nothing
  
  -- Parse the various format controls to get a format specification.
  getSpecs :: Bool -> Bool -> Maybe FormatSign -> Bool -> String -> [UPrintf]
           -> (FieldFormat, String, [UPrintf])
  getSpecs _ z s a ('-' : cs0) us = getSpecs True z s a cs0 us
  getSpecs l z _ a ('+' : cs0) us = getSpecs l z (Just SignPlus) a cs0 us
  getSpecs l z s a (' ' : cs0) us =
    getSpecs l z ss a cs0 us
    where
      ss = case s of
        Just SignPlus -> Just SignPlus
        _ -> Just SignSpace
  getSpecs l _ s a ('0' : cs0) us = getSpecs l True s a cs0 us
  getSpecs l z s _ ('#' : cs0) us = getSpecs l z s True cs0 us
  getSpecs l z s a ('*' : cs0) us =
    let (us', n) = getStar us
        ((p, cs''), us'') = case cs0 of
          '.':'*':r ->
            let (us''', p') = getStar us' in ((Just p', r), us''')
          '.':r ->
            let (p', r') = stoi r in ((Just p', r'), us')
          _ ->
            ((Nothing, cs0), us')
        FormatParse ms c cs =
          case us'' of
            (ufmt, _) : _ -> ufmt cs''
            [] -> errorMissingArgument
    in
     (FieldFormat {
         fmtWidth = Just (abs n),
         fmtPrecision = p,
         fmtAdjust = adjustment (Just n) p l z,
         fmtSign = s,
         fmtAlternate = a,
         fmtModifiers = ms,
         fmtChar = c}, cs, us'')
  getSpecs l z s a ('.' : cs0) us =
    let ((p, cs'), us') = case cs0 of
          '*':cs'' -> let (us'', p') = getStar us in ((p', cs''), us'')
          _ ->        (stoi cs0, us)
        FormatParse ms c cs =
          case us' of
            (ufmt, _) : _ -> ufmt cs'
            [] -> errorMissingArgument
    in
     (FieldFormat {
         fmtWidth = Nothing,
         fmtPrecision = Just p,
         fmtAdjust = adjustment Nothing (Just p) l z,
         fmtSign = s,
         fmtAlternate = a,
         fmtModifiers = ms,
         fmtChar = c}, cs, us')
  getSpecs l z s a cs0@(c0 : _) us | isDigit c0 =
    let (n, cs') = stoi cs0
        ((p, cs''), us') = case cs' of
          '.' : '*' : r ->
            let (us'', p') = getStar us in ((Just p', r), us'')
          '.' : r ->
            let (p', r') = stoi r in ((Just p', r'), us)
          _ ->
            ((Nothing, cs'), us)
        FormatParse ms c cs =
          case us' of
            (ufmt, _) : _ -> ufmt cs''
            [] -> errorMissingArgument
    in
     (FieldFormat {
         fmtWidth = Just (abs n),
         fmtPrecision = p,
         fmtAdjust = adjustment (Just n) p l z,
         fmtSign = s,
         fmtAlternate = a,
         fmtModifiers = ms,
         fmtChar = c}, cs, us')
  getSpecs l z s a cs0@(_ : _) us =
    let FormatParse ms c cs =
          case us of
            (ufmt, _) : _ -> ufmt cs0
            [] -> errorMissingArgument
    in
     (FieldFormat {
         fmtWidth = Nothing,
         fmtPrecision = Nothing,
         fmtAdjust = adjustment Nothing Nothing l z,
         fmtSign = s,
         fmtAlternate = a,
         fmtModifiers = ms,
         fmtChar = c}, cs, us)
  getSpecs _ _ _ _ ""       _  =
    errorShortFormat
  
  -- Process a star argument in a format specification.
  getStar :: [UPrintf] -> ([UPrintf], Int)
  getStar us =
    let ufmt = FieldFormat {
          fmtWidth = Nothing,
          fmtPrecision = Nothing,
          fmtAdjust = Nothing,
          fmtSign = Nothing,
          fmtAlternate = False,
          fmtModifiers = "",
          fmtChar = 'd' } in
    case us of
      [] -> errorMissingArgument
      (_, nu) : us' -> (us', read (nu ufmt ""))
  
  -- Format a RealFloat value.
  dfmt :: (RealFloat a) => Char -> Maybe Int -> Bool -> a -> (String, String)
  dfmt c p a d =
    let caseConvert = if isUpper c then map toUpper else id
        showFunction = case toLower c of
          'e' -> showEFloat
          'f' -> if a then showFFloatAlt else showFFloat
          'g' -> if a then showGFloatAlt else showGFloat
          _   -> perror "internal error: impossible dfmt"
        result = caseConvert $ showFunction p d ""
    in
     case result of
       '-' : cs -> ("-", cs)
       cs       -> ("" , cs)
  
  
  -- | Raises an 'error' with a printf-specific prefix on the
  -- message string.
  --
  -- @since 4.7.0.0
  perror :: String -> a
  perror s = error $ "printf: " ++ s
  
  -- | Calls 'perror' to indicate an unknown format letter for
  -- a given type.
  --
  -- @since 4.7.0.0
  errorBadFormat :: Char -> a
  errorBadFormat c = perror $ "bad formatting char " ++ show c
  
  errorShortFormat, errorMissingArgument, errorBadArgument :: a
  -- | Calls 'perror' to indicate that the format string ended
  -- early.
  --
  -- @since 4.7.0.0
  errorShortFormat = perror "formatting string ended prematurely"
  -- | Calls 'perror' to indicate that there is a missing
  -- argument in the argument list.
  --
  -- @since 4.7.0.0
  errorMissingArgument = perror "argument list ended prematurely"
  -- | Calls 'perror' to indicate that there is a type
  -- error or similar in the given argument.
  --
  -- @since 4.7.0.0
  errorBadArgument = perror "bad argument"
  