{-# 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 instantiating '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.
--
-- >>> printf "%s, %d, %.4f" "hello" 123 pi
-- hello, 123, 3.1416
--
-- 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.
printf :: (PrintfType r) => String -> r
printf :: String -> r
printf fmts :: String
fmts = String -> [UPrintf] -> r
forall t. PrintfType t => String -> [UPrintf] -> t
spr String
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 :: Handle -> String -> r
hPrintf hdl :: Handle
hdl fmts :: String
fmts = Handle -> String -> [UPrintf] -> r
forall t. HPrintfType t => Handle -> String -> [UPrintf] -> t
hspr Handle
hdl String
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)
-}
-- | @since 2.01
instance (IsChar c) => PrintfType [c] where
    spr :: String -> [UPrintf] -> [c]
spr fmts :: String
fmts args :: [UPrintf]
args = (Char -> c) -> String -> [c]
forall a b. (a -> b) -> [a] -> [b]
map Char -> c
forall c. IsChar c => Char -> c
fromChar (String -> [UPrintf] -> String
uprintf String
fmts ([UPrintf] -> [UPrintf]
forall a. [a] -> [a]
reverse [UPrintf]
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.

-- | @since 4.7.0.0
instance (a ~ ()) => PrintfType (IO a) where
    spr :: String -> [UPrintf] -> IO a
spr fmts :: String
fmts args :: [UPrintf]
args =
        String -> IO a
String -> IO ()
putStr (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
forall c. IsChar c => Char -> c
fromChar (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> [UPrintf] -> String
uprintf String
fmts ([UPrintf] -> String) -> [UPrintf] -> String
forall a b. (a -> b) -> a -> b
$ [UPrintf] -> [UPrintf]
forall a. [a] -> [a]
reverse [UPrintf]
args

-- | @since 4.7.0.0
instance (a ~ ()) => HPrintfType (IO a) where
    hspr :: Handle -> String -> [UPrintf] -> IO a
hspr hdl :: Handle
hdl fmts :: String
fmts args :: [UPrintf]
args = do
        Handle -> String -> IO ()
hPutStr Handle
hdl (String -> [UPrintf] -> String
uprintf String
fmts ([UPrintf] -> [UPrintf]
forall a. [a] -> [a]
reverse [UPrintf]
args))

-- | @since 2.01
instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
    spr :: String -> [UPrintf] -> a -> r
spr fmts :: String
fmts args :: [UPrintf]
args = \ a :: a
a -> String -> [UPrintf] -> r
forall t. PrintfType t => String -> [UPrintf] -> t
spr String
fmts
                             ((a -> ModifierParser
forall a. PrintfArg a => a -> ModifierParser
parseFormat a
a, a -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg a
a) UPrintf -> [UPrintf] -> [UPrintf]
forall a. a -> [a] -> [a]
: [UPrintf]
args)

-- | @since 2.01
instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
    hspr :: Handle -> String -> [UPrintf] -> a -> r
hspr hdl :: Handle
hdl fmts :: String
fmts args :: [UPrintf]
args = \ a :: a
a -> Handle -> String -> [UPrintf] -> r
forall t. HPrintfType t => Handle -> String -> [UPrintf] -> t
hspr Handle
hdl String
fmts
                                  ((a -> ModifierParser
forall a. PrintfArg a => a -> ModifierParser
parseFormat a
a, a -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg a
a) UPrintf -> [UPrintf] -> [UPrintf]
forall a. a -> [a] -> [a]
: [UPrintf]
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 :: Char
c : cs :: String
cs) = String -> Char -> ModifierParser
FormatParse "" Char
c String
cs
    parseFormat _ "" = FormatParse
forall a. a
errorShortFormat

-- | @since 2.01
instance PrintfArg Char where
    formatArg :: Char -> FieldFormatter
formatArg = Char -> FieldFormatter
formatChar
    parseFormat :: Char -> ModifierParser
parseFormat _ cf :: String
cf = Int -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat (Int
forall a. HasCallStack => a
undefined :: Int) String
cf

-- | @since 2.01
instance (IsChar c) => PrintfArg [c] where
    formatArg :: [c] -> FieldFormatter
formatArg = [c] -> FieldFormatter
forall c. IsChar c => [c] -> FieldFormatter
formatString

-- | @since 2.01
instance PrintfArg Int where
    formatArg :: Int -> FieldFormatter
formatArg = Int -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Int -> ModifierParser
parseFormat = Int -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Int8 where
    formatArg :: Int8 -> FieldFormatter
formatArg = Int8 -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Int8 -> ModifierParser
parseFormat = Int8 -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Int16 where
    formatArg :: Int16 -> FieldFormatter
formatArg = Int16 -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Int16 -> ModifierParser
parseFormat = Int16 -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Int32 where
    formatArg :: Int32 -> FieldFormatter
formatArg = Int32 -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Int32 -> ModifierParser
parseFormat = Int32 -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Int64 where
    formatArg :: Int64 -> FieldFormatter
formatArg = Int64 -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Int64 -> ModifierParser
parseFormat = Int64 -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Word where
    formatArg :: Word -> FieldFormatter
formatArg = Word -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Word -> ModifierParser
parseFormat = Word -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Word8 where
    formatArg :: Word8 -> FieldFormatter
formatArg = Word8 -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Word8 -> ModifierParser
parseFormat = Word8 -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Word16 where
    formatArg :: Word16 -> FieldFormatter
formatArg = Word16 -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Word16 -> ModifierParser
parseFormat = Word16 -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Word32 where
    formatArg :: Word32 -> FieldFormatter
formatArg = Word32 -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Word32 -> ModifierParser
parseFormat = Word32 -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Word64 where
    formatArg :: Word64 -> FieldFormatter
formatArg = Word64 -> FieldFormatter
forall a. (Integral a, Bounded a) => a -> FieldFormatter
formatInt
    parseFormat :: Word64 -> ModifierParser
parseFormat = Word64 -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Integer where
    formatArg :: Integer -> FieldFormatter
formatArg = Integer -> FieldFormatter
formatInteger
    parseFormat :: Integer -> ModifierParser
parseFormat = Integer -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 4.8.0.0
instance PrintfArg Natural where
    formatArg :: Natural -> FieldFormatter
formatArg = Integer -> FieldFormatter
formatInteger (Integer -> FieldFormatter)
-> (Natural -> Integer) -> Natural -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
    parseFormat :: Natural -> ModifierParser
parseFormat = Natural -> ModifierParser
forall a. a -> ModifierParser
parseIntFormat

-- | @since 2.01
instance PrintfArg Float where
    formatArg :: Float -> FieldFormatter
formatArg = Float -> FieldFormatter
forall a. RealFloat a => a -> FieldFormatter
formatRealFloat

-- | @since 2.01
instance PrintfArg Double where
    formatArg :: Double -> FieldFormatter
formatArg = Double -> FieldFormatter
forall a. RealFloat a => a -> FieldFormatter
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

-- | @since 2.01
instance IsChar Char where
    toChar :: Char -> Char
toChar c :: Char
c = Char
c
    fromChar :: Char -> Char
fromChar c :: Char
c = Char
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 {
  FieldFormat -> Maybe Int
fmtWidth :: Maybe Int,       -- ^ Total width of the field.
  FieldFormat -> Maybe Int
fmtPrecision :: Maybe Int,   -- ^ Secondary field width specifier.
  FieldFormat -> Maybe FormatAdjustment
fmtAdjust :: Maybe FormatAdjustment,  -- ^ Kind of filling or padding
                                        --   to be done.
  FieldFormat -> Maybe FormatSign
fmtSign :: Maybe FormatSign, -- ^ Whether to insist on a
                               -- plus sign for positive
                               -- numbers.
  FieldFormat -> Bool
fmtAlternate :: Bool,        -- ^ Indicates an "alternate
                               -- format".  See @printf(3)@
                               -- for the details, which
                               -- vary by argument spec.
  FieldFormat -> String
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.
  FieldFormat -> Char
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 {
  FormatParse -> String
fpModifiers :: String,   -- ^ Any modifiers found.
  FormatParse -> Char
fpChar :: Char,          -- ^ Primary format character.
  FormatParse -> String
fpRest :: String         -- ^ Rest of the format string.
  }

-- Contains the "modifier letters" that can precede an
-- integer type.
intModifierMap :: [(String, Integer)]
intModifierMap :: [(String, Integer)]
intModifierMap = [
  ("hh", Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int8
forall a. Bounded a => a
minBound :: Int8)),
  ("h", Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int16
forall a. Bounded a => a
minBound :: Int16)),
  ("l", Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32
forall a. Bounded a => a
minBound :: Int32)),
  ("ll", Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
minBound :: Int64)),
  ("L", Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
minBound :: Int64)) ]

parseIntFormat :: a -> String -> FormatParse
parseIntFormat :: a -> ModifierParser
parseIntFormat _ s :: String
s =
  case ((String, Integer) -> Maybe FormatParse -> Maybe FormatParse)
-> Maybe FormatParse -> [(String, Integer)] -> Maybe FormatParse
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String, Integer) -> Maybe FormatParse -> Maybe FormatParse
matchPrefix Maybe FormatParse
forall a. Maybe a
Nothing [(String, Integer)]
intModifierMap of
    Just m :: FormatParse
m -> FormatParse
m
    Nothing ->
      case String
s of
        c :: Char
c : cs :: String
cs -> String -> Char -> ModifierParser
FormatParse "" Char
c String
cs
        "" -> FormatParse
forall a. a
errorShortFormat
  where
    matchPrefix :: (String, Integer) -> Maybe FormatParse -> Maybe FormatParse
matchPrefix (p :: String
p, _) m :: Maybe FormatParse
m@(Just (FormatParse p0 :: String
p0 _ _))
      | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p = Maybe FormatParse
m
      | Bool
otherwise = case String -> Maybe FormatParse
getFormat String
p of
          Nothing -> Maybe FormatParse
m
          Just fp :: FormatParse
fp -> FormatParse -> Maybe FormatParse
forall a. a -> Maybe a
Just FormatParse
fp
    matchPrefix (p :: String
p, _) Nothing =
      String -> Maybe FormatParse
getFormat String
p
    getFormat :: String -> Maybe FormatParse
getFormat p :: String
p =
      String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
p String
s Maybe String -> (String -> Maybe FormatParse) -> Maybe FormatParse
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe FormatParse
fp
      where
        fp :: String -> Maybe FormatParse
fp (c :: Char
c : cs :: String
cs) = FormatParse -> Maybe FormatParse
forall a. a -> Maybe a
Just (FormatParse -> Maybe FormatParse)
-> FormatParse -> Maybe FormatParse
forall a b. (a -> b) -> a -> b
$ String -> Char -> ModifierParser
FormatParse String
p Char
c String
cs
        fp "" = Maybe FormatParse
forall a. a
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 :: Char -> FieldFormat -> FieldFormat
vFmt c :: Char
c ufmt :: FieldFormat
ufmt@(FieldFormat {fmtChar :: FieldFormat -> Char
fmtChar = Char
'v'}) = FieldFormat
ufmt {fmtChar :: Char
fmtChar = Char
c}
vFmt _ ufmt :: FieldFormat
ufmt = FieldFormat
ufmt

-- | Formatter for 'Char' values.
--
-- @since 4.7.0.0
formatChar :: Char -> FieldFormatter
formatChar :: Char -> FieldFormatter
formatChar x :: Char
x ufmt :: FieldFormat
ufmt =
  Maybe Integer -> Integer -> FieldFormatter
formatIntegral (Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
x) FieldFormatter -> FieldFormatter
forall a b. (a -> b) -> a -> b
$ Char -> FieldFormat -> FieldFormat
vFmt 'c' FieldFormat
ufmt

-- | Formatter for 'String' values.
--
-- @since 4.7.0.0
formatString :: IsChar a => [a] -> FieldFormatter
formatString :: [a] -> FieldFormatter
formatString x :: [a]
x ufmt :: FieldFormat
ufmt =
  case FieldFormat -> Char
fmtChar (FieldFormat -> Char) -> FieldFormat -> Char
forall a b. (a -> b) -> a -> b
$ Char -> FieldFormat -> FieldFormat
vFmt 's' FieldFormat
ufmt of
    's' -> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
forall c. IsChar c => c -> Char
toChar (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt ("", String
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
           where
             ts :: String
ts = (a -> Char) -> [a] -> String
forall a b. (a -> b) -> [a] -> [b]
map a -> Char
forall c. IsChar c => c -> Char
toChar ([a] -> String) -> [a] -> String
forall a b. (a -> b) -> a -> b
$ Maybe Int -> [a]
trunc (Maybe Int -> [a]) -> Maybe Int -> [a]
forall a b. (a -> b) -> a -> b
$ FieldFormat -> Maybe Int
fmtPrecision FieldFormat
ufmt
               where
                 trunc :: Maybe Int -> [a]
trunc Nothing = [a]
x
                 trunc (Just n :: Int
n) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
x
    c :: Char
c   -> Char -> String -> String
forall a. Char -> a
errorBadFormat Char
c

-- Possibly apply the int modifiers to get a new
-- int width for conversion.
fixupMods :: FieldFormat -> Maybe Integer -> Maybe Integer
fixupMods :: FieldFormat -> Maybe Integer -> Maybe Integer
fixupMods ufmt :: FieldFormat
ufmt m :: Maybe Integer
m =
  let mods :: String
mods = FieldFormat -> String
fmtModifiers FieldFormat
ufmt in
  case String
mods of
    "" -> Maybe Integer
m
    _ -> case String -> [(String, Integer)] -> Maybe Integer
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
mods [(String, Integer)]
intModifierMap of
      Just m0 :: Integer
m0 -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
m0
      Nothing -> String -> Maybe Integer
forall a. String -> a
perror "unknown format modifier"

-- | Formatter for 'Int' values.
--
-- @since 4.7.0.0
formatInt :: (Integral a, Bounded a) => a -> FieldFormatter
formatInt :: a -> FieldFormatter
formatInt x :: a
x ufmt :: FieldFormat
ufmt =
  let lb :: Integer
lb = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a -> Integer) -> a -> Integer
forall a b. (a -> b) -> a -> b
$ a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
x
      m :: Maybe Integer
m = FieldFormat -> Maybe Integer -> Maybe Integer
fixupMods FieldFormat
ufmt (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
lb)
      ufmt' :: FieldFormat
ufmt' = case Integer
lb of
        0 -> Char -> FieldFormat -> FieldFormat
vFmt 'u' FieldFormat
ufmt
        _ -> FieldFormat
ufmt
  in
  Maybe Integer -> Integer -> FieldFormatter
formatIntegral Maybe Integer
m (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x) FieldFormat
ufmt'

-- | Formatter for 'Integer' values.
--
-- @since 4.7.0.0
formatInteger :: Integer -> FieldFormatter
formatInteger :: Integer -> FieldFormatter
formatInteger x :: Integer
x ufmt :: FieldFormat
ufmt =
  let m :: Maybe Integer
m = FieldFormat -> Maybe Integer -> Maybe Integer
fixupMods FieldFormat
ufmt Maybe Integer
forall a. Maybe a
Nothing in
  Maybe Integer -> Integer -> FieldFormatter
formatIntegral Maybe Integer
m Integer
x FieldFormat
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 :: Maybe Integer -> Integer -> FieldFormatter
formatIntegral m :: Maybe Integer
m x :: Integer
x ufmt0 :: FieldFormat
ufmt0 =
  let prec :: Maybe Int
prec = FieldFormat -> Maybe Int
fmtPrecision FieldFormat
ufmt0 in
  case FieldFormat -> Char
fmtChar FieldFormat
ufmt of
    'd' -> (FieldFormat -> (String, String) -> String
adjustSigned FieldFormat
ufmt (Maybe Int -> Integer -> (String, String)
fmti Maybe Int
prec Integer
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    'i' -> (FieldFormat -> (String, String) -> String
adjustSigned FieldFormat
ufmt (Maybe Int -> Integer -> (String, String)
fmti Maybe Int
prec Integer
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    'x' -> (FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt (Integer
-> Maybe String
-> Maybe Int
-> Maybe Integer
-> Integer
-> (String, String)
fmtu 16 (String -> Integer -> Maybe String
alt "0x" Integer
x) Maybe Int
prec Maybe Integer
m Integer
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    'X' -> (FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt ((String, String) -> (String, String)
forall a. (a, String) -> (a, String)
upcase ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ Integer
-> Maybe String
-> Maybe Int
-> Maybe Integer
-> Integer
-> (String, String)
fmtu 16 (String -> Integer -> Maybe String
alt "0X" Integer
x) Maybe Int
prec Maybe Integer
m Integer
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    'b' -> (FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt (Integer
-> Maybe String
-> Maybe Int
-> Maybe Integer
-> Integer
-> (String, String)
fmtu 2 (String -> Integer -> Maybe String
alt "0b" Integer
x) Maybe Int
prec Maybe Integer
m Integer
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    'o' -> (FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt (Integer
-> Maybe String
-> Maybe Int
-> Maybe Integer
-> Integer
-> (String, String)
fmtu 8 (String -> Integer -> Maybe String
alt "0" Integer
x) Maybe Int
prec Maybe Integer
m Integer
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    'u' -> (FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt (Integer
-> Maybe String
-> Maybe Int
-> Maybe Integer
-> Integer
-> (String, String)
fmtu 10 Maybe String
forall a. Maybe a
Nothing Maybe Int
prec Maybe Integer
m Integer
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    'c' | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord (Char
forall a. Bounded a => a
minBound :: Char)) Bool -> Bool -> Bool
&&
          Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord (Char
forall a. Bounded a => a
maxBound :: Char)) Bool -> Bool -> Bool
&&
          FieldFormat -> Maybe Int
fmtPrecision FieldFormat
ufmt Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
          FieldFormat -> String
fmtModifiers FieldFormat
ufmt String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" ->
            String -> FieldFormatter
forall c. IsChar c => [c] -> FieldFormatter
formatString [Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x] (FieldFormat
ufmt { fmtChar :: Char
fmtChar = 's' })
    'c' -> String -> String -> String
forall a. String -> a
perror "illegal char conversion"
    c :: Char
c   -> Char -> String -> String
forall a. Char -> a
errorBadFormat Char
c
  where
    ufmt :: FieldFormat
ufmt = Char -> FieldFormat -> FieldFormat
vFmt 'd' (FieldFormat -> FieldFormat) -> FieldFormat -> FieldFormat
forall a b. (a -> b) -> a -> b
$ case FieldFormat
ufmt0 of
      FieldFormat { fmtPrecision :: FieldFormat -> Maybe Int
fmtPrecision = Just _, fmtAdjust :: FieldFormat -> Maybe FormatAdjustment
fmtAdjust = Just ZeroPad } ->
        FieldFormat
ufmt0 { fmtAdjust :: Maybe FormatAdjustment
fmtAdjust = Maybe FormatAdjustment
forall a. Maybe a
Nothing }
      _ -> FieldFormat
ufmt0
    alt :: String -> Integer -> Maybe String
alt _ 0 = Maybe String
forall a. Maybe a
Nothing
    alt p :: String
p _ = case FieldFormat -> Bool
fmtAlternate FieldFormat
ufmt of
      True -> String -> Maybe String
forall a. a -> Maybe a
Just String
p
      False -> Maybe String
forall a. Maybe a
Nothing
    upcase :: (a, String) -> (a, String)
upcase (s1 :: a
s1, s2 :: String
s2) = (a
s1, (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
s2)

-- | Formatter for 'RealFloat' values.
--
-- @since 4.7.0.0
formatRealFloat :: RealFloat a => a -> FieldFormatter
formatRealFloat :: a -> FieldFormatter
formatRealFloat x :: a
x ufmt :: FieldFormat
ufmt =
  let c :: Char
c = FieldFormat -> Char
fmtChar (FieldFormat -> Char) -> FieldFormat -> Char
forall a b. (a -> b) -> a -> b
$ Char -> FieldFormat -> FieldFormat
vFmt 'g' FieldFormat
ufmt
      prec :: Maybe Int
prec = FieldFormat -> Maybe Int
fmtPrecision FieldFormat
ufmt
      alt :: Bool
alt = FieldFormat -> Bool
fmtAlternate FieldFormat
ufmt
  in
   case Char
c of
     'e' -> (FieldFormat -> (String, String) -> String
adjustSigned FieldFormat
ufmt (Char -> Maybe Int -> Bool -> a -> (String, String)
forall a.
RealFloat a =>
Char -> Maybe Int -> Bool -> a -> (String, String)
dfmt Char
c Maybe Int
prec Bool
alt a
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
     'E' -> (FieldFormat -> (String, String) -> String
adjustSigned FieldFormat
ufmt (Char -> Maybe Int -> Bool -> a -> (String, String)
forall a.
RealFloat a =>
Char -> Maybe Int -> Bool -> a -> (String, String)
dfmt Char
c Maybe Int
prec Bool
alt a
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
     'f' -> (FieldFormat -> (String, String) -> String
adjustSigned FieldFormat
ufmt (Char -> Maybe Int -> Bool -> a -> (String, String)
forall a.
RealFloat a =>
Char -> Maybe Int -> Bool -> a -> (String, String)
dfmt Char
c Maybe Int
prec Bool
alt a
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
     'F' -> (FieldFormat -> (String, String) -> String
adjustSigned FieldFormat
ufmt (Char -> Maybe Int -> Bool -> a -> (String, String)
forall a.
RealFloat a =>
Char -> Maybe Int -> Bool -> a -> (String, String)
dfmt Char
c Maybe Int
prec Bool
alt a
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
     'g' -> (FieldFormat -> (String, String) -> String
adjustSigned FieldFormat
ufmt (Char -> Maybe Int -> Bool -> a -> (String, String)
forall a.
RealFloat a =>
Char -> Maybe Int -> Bool -> a -> (String, String)
dfmt Char
c Maybe Int
prec Bool
alt a
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
     'G' -> (FieldFormat -> (String, String) -> String
adjustSigned FieldFormat
ufmt (Char -> Maybe Int -> Bool -> a -> (String, String)
forall a.
RealFloat a =>
Char -> Maybe Int -> Bool -> a -> (String, String)
dfmt Char
c Maybe Int
prec Bool
alt a
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
     _   -> Char -> String -> String
forall a. Char -> a
errorBadFormat Char
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 :: String -> [UPrintf] -> String
uprintf s :: String
s us :: [UPrintf]
us = String -> [UPrintf] -> String -> String
uprintfs String
s [UPrintf]
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 :: String -> [UPrintf] -> String -> String
uprintfs ""       []       = String -> String
forall a. a -> a
id
uprintfs ""       (_:_)    = String -> String
forall a. a
errorShortFormat
uprintfs ('%':'%':cs :: String
cs) us :: [UPrintf]
us   = ('%' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [UPrintf] -> String -> String
uprintfs String
cs [UPrintf]
us
uprintfs ('%':_)  []       = String -> String
forall a. a
errorMissingArgument
uprintfs ('%':cs :: String
cs) us :: [UPrintf]
us@(_:_) = String -> [UPrintf] -> String -> String
fmt String
cs [UPrintf]
us
uprintfs (c :: Char
c:cs :: String
cs)   us :: [UPrintf]
us       = (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [UPrintf] -> String -> String
uprintfs String
cs [UPrintf]
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 :: String -> [UPrintf] -> String -> String
fmt cs0 :: String
cs0 us0 :: [UPrintf]
us0 =
  case Bool
-> Bool
-> Maybe FormatSign
-> Bool
-> String
-> [UPrintf]
-> (FieldFormat, String, [UPrintf])
getSpecs Bool
False Bool
False Maybe FormatSign
forall a. Maybe a
Nothing Bool
False String
cs0 [UPrintf]
us0 of
    (_, _, []) -> String -> String
forall a. a
errorMissingArgument
    (ufmt :: FieldFormat
ufmt, cs :: String
cs, (_, u :: FieldFormatter
u) : us :: [UPrintf]
us) -> FieldFormatter
u FieldFormat
ufmt (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [UPrintf] -> String -> String
uprintfs String
cs [UPrintf]
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 :: FieldFormat -> (String, String) -> String
adjust ufmt :: FieldFormat
ufmt (pre :: String
pre, str :: String
str) =
  let naturalWidth :: Int
naturalWidth = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str
      zero :: Bool
zero = case FieldFormat -> Maybe FormatAdjustment
fmtAdjust FieldFormat
ufmt of
        Just ZeroPad -> Bool
True
        _ -> Bool
False
      left :: Bool
left = case FieldFormat -> Maybe FormatAdjustment
fmtAdjust FieldFormat
ufmt of
        Just LeftAdjust -> Bool
True
        _ -> Bool
False
      fill :: String
fill = case FieldFormat -> Maybe Int
fmtWidth FieldFormat
ufmt of
        Just width :: Int
width | Int
naturalWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
width ->
          let fillchar :: Char
fillchar = if Bool
zero then '0' else ' ' in
          Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
naturalWidth) Char
fillchar
        _ -> ""
  in
   if Bool
left
   then String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fill
   else if Bool
zero
        then String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fill String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
        else String
fill String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str

-- For positive numbers with an explicit sign field ("+" or
-- " "), adjust accordingly.
adjustSigned :: FieldFormat -> (String, String) -> String
adjustSigned :: FieldFormat -> (String, String) -> String
adjustSigned ufmt :: FieldFormat
ufmt@(FieldFormat {fmtSign :: FieldFormat -> Maybe FormatSign
fmtSign = Just SignPlus}) ("", str :: String
str) =
  FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt ("+", String
str)
adjustSigned ufmt :: FieldFormat
ufmt@(FieldFormat {fmtSign :: FieldFormat -> Maybe FormatSign
fmtSign = Just SignSpace}) ("", str :: String
str) =
  FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt (" ", String
str)
adjustSigned ufmt :: FieldFormat
ufmt ps :: (String, String)
ps =
  FieldFormat -> (String, String) -> String
adjust FieldFormat
ufmt (String, String)
ps

-- Format a signed integer in the "default" fashion.
-- This will be subjected to adjust subsequently.
fmti :: Maybe Int -> Integer -> (String, String)
fmti :: Maybe Int -> Integer -> (String, String)
fmti prec :: Maybe Int
prec i :: Integer
i
  | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = ("-", Maybe Int -> String -> String
integral_prec Maybe Int
prec (Integer -> String
forall a. Show a => a -> String
show (-Integer
i)))
  | Bool
otherwise = ("", Maybe Int -> String -> String
integral_prec Maybe Int
prec (Integer -> String
forall a. Show a => a -> String
show Integer
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 :: Integer
-> Maybe String
-> Maybe Int
-> Maybe Integer
-> Integer
-> (String, String)
fmtu b :: Integer
b (Just pre :: String
pre) prec :: Maybe Int
prec m :: Maybe Integer
m i :: Integer
i =
  let ("", s :: String
s) = Integer
-> Maybe String
-> Maybe Int
-> Maybe Integer
-> Integer
-> (String, String)
fmtu Integer
b Maybe String
forall a. Maybe a
Nothing Maybe Int
prec Maybe Integer
m Integer
i in
  case String
pre of
    "0" -> case String
s of
      '0' : _ -> ("", String
s)
      _ -> (String
pre, String
s)
    _ -> (String
pre, String
s)
fmtu b :: Integer
b Nothing prec0 :: Maybe Int
prec0 m0 :: Maybe Integer
m0 i0 :: Integer
i0 =
  case Maybe Int -> Maybe Integer -> Integer -> Maybe String
fmtu' Maybe Int
prec0 Maybe Integer
m0 Integer
i0 of
    Just s :: String
s -> ("", String
s)
    Nothing -> (String, String)
forall a. a
errorBadArgument
  where
    fmtu' :: Maybe Int -> Maybe Integer -> Integer -> Maybe String
    fmtu' :: Maybe Int -> Maybe Integer -> Integer -> Maybe String
fmtu' prec :: Maybe Int
prec (Just m :: Integer
m) i :: Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 =
      Maybe Int -> Maybe Integer -> Integer -> Maybe String
fmtu' Maybe Int
prec Maybe Integer
forall a. Maybe a
Nothing (-2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)
    fmtu' (Just prec :: Int
prec) _ i :: Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 =
      (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> String -> String
integral_prec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
prec)) (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Integer -> Integer -> Maybe String
fmtu' Maybe Int
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Integer
i
    fmtu' Nothing _ i :: Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 =
      String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Integer -> (Int -> Char) -> Integer -> String -> String
forall a.
(Integral a, Show a) =>
a -> (Int -> Char) -> a -> String -> String
showIntAtBase Integer
b Int -> Char
intToDigit Integer
i ""
    fmtu' _ _ _ = Maybe String
forall a. Maybe a
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 :: Maybe Int -> String -> String
integral_prec Nothing integral :: String
integral = String
integral
integral_prec (Just 0) "0" = ""
integral_prec (Just prec :: Int
prec) integral :: String
integral =
  Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
integral) '0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
integral

stoi :: String -> (Int, String)
stoi :: String -> (Int, String)
stoi cs :: String
cs =
  let (as :: String
as, cs' :: String
cs') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
cs in
  case String
as of
    "" -> (0, String
cs')
    _ -> (String -> Int
forall a. Read a => String -> a
read String
as, String
cs')

-- Figure out the FormatAdjustment, given:
--   width, precision, left-adjust, zero-fill
adjustment :: Maybe Int -> Maybe a -> Bool -> Bool
           -> Maybe FormatAdjustment
adjustment :: Maybe Int -> Maybe a -> Bool -> Bool -> Maybe FormatAdjustment
adjustment w :: Maybe Int
w p :: Maybe a
p l :: Bool
l z :: Bool
z =
  case Maybe Int
w of
    Just n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> Maybe a -> Bool -> Bool -> Maybe FormatAdjustment
forall p. p -> Bool -> Bool -> Maybe FormatAdjustment
adjl Maybe a
p Bool
True Bool
z
    _ -> Maybe a -> Bool -> Bool -> Maybe FormatAdjustment
forall p. p -> Bool -> Bool -> Maybe FormatAdjustment
adjl Maybe a
p Bool
l Bool
z
  where
    adjl :: p -> Bool -> Bool -> Maybe FormatAdjustment
adjl _ True _ = FormatAdjustment -> Maybe FormatAdjustment
forall a. a -> Maybe a
Just FormatAdjustment
LeftAdjust
    adjl _ False True = FormatAdjustment -> Maybe FormatAdjustment
forall a. a -> Maybe a
Just FormatAdjustment
ZeroPad
    adjl _ _ _ = Maybe FormatAdjustment
forall a. Maybe a
Nothing

-- Parse the various format controls to get a format specification.
getSpecs :: Bool -> Bool -> Maybe FormatSign -> Bool -> String -> [UPrintf]
         -> (FieldFormat, String, [UPrintf])
getSpecs :: Bool
-> Bool
-> Maybe FormatSign
-> Bool
-> String
-> [UPrintf]
-> (FieldFormat, String, [UPrintf])
getSpecs _ z :: Bool
z s :: Maybe FormatSign
s a :: Bool
a ('-' : cs0 :: String
cs0) us :: [UPrintf]
us = Bool
-> Bool
-> Maybe FormatSign
-> Bool
-> String
-> [UPrintf]
-> (FieldFormat, String, [UPrintf])
getSpecs Bool
True Bool
z Maybe FormatSign
s Bool
a String
cs0 [UPrintf]
us
getSpecs l :: Bool
l z :: Bool
z _ a :: Bool
a ('+' : cs0 :: String
cs0) us :: [UPrintf]
us = Bool
-> Bool
-> Maybe FormatSign
-> Bool
-> String
-> [UPrintf]
-> (FieldFormat, String, [UPrintf])
getSpecs Bool
l Bool
z (FormatSign -> Maybe FormatSign
forall a. a -> Maybe a
Just FormatSign
SignPlus) Bool
a String
cs0 [UPrintf]
us
getSpecs l :: Bool
l z :: Bool
z s :: Maybe FormatSign
s a :: Bool
a (' ' : cs0 :: String
cs0) us :: [UPrintf]
us =
  Bool
-> Bool
-> Maybe FormatSign
-> Bool
-> String
-> [UPrintf]
-> (FieldFormat, String, [UPrintf])
getSpecs Bool
l Bool
z Maybe FormatSign
ss Bool
a String
cs0 [UPrintf]
us
  where
    ss :: Maybe FormatSign
ss = case Maybe FormatSign
s of
      Just SignPlus -> FormatSign -> Maybe FormatSign
forall a. a -> Maybe a
Just FormatSign
SignPlus
      _ -> FormatSign -> Maybe FormatSign
forall a. a -> Maybe a
Just FormatSign
SignSpace
getSpecs l :: Bool
l _ s :: Maybe FormatSign
s a :: Bool
a ('0' : cs0 :: String
cs0) us :: [UPrintf]
us = Bool
-> Bool
-> Maybe FormatSign
-> Bool
-> String
-> [UPrintf]
-> (FieldFormat, String, [UPrintf])
getSpecs Bool
l Bool
True Maybe FormatSign
s Bool
a String
cs0 [UPrintf]
us
getSpecs l :: Bool
l z :: Bool
z s :: Maybe FormatSign
s _ ('#' : cs0 :: String
cs0) us :: [UPrintf]
us = Bool
-> Bool
-> Maybe FormatSign
-> Bool
-> String
-> [UPrintf]
-> (FieldFormat, String, [UPrintf])
getSpecs Bool
l Bool
z Maybe FormatSign
s Bool
True String
cs0 [UPrintf]
us
getSpecs l :: Bool
l z :: Bool
z s :: Maybe FormatSign
s a :: Bool
a ('*' : cs0 :: String
cs0) us :: [UPrintf]
us =
  let (us' :: [UPrintf]
us', n :: Int
n) = [UPrintf] -> ([UPrintf], Int)
getStar [UPrintf]
us
      ((p :: Maybe Int
p, cs'' :: String
cs''), us'' :: [UPrintf]
us'') = case String
cs0 of
        '.':'*':r :: String
r ->
          let (us''' :: [UPrintf]
us''', p' :: Int
p') = [UPrintf] -> ([UPrintf], Int)
getStar [UPrintf]
us' in ((Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p', String
r), [UPrintf]
us''')
        '.':r :: String
r ->
          let (p' :: Int
p', r' :: String
r') = String -> (Int, String)
stoi String
r in ((Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p', String
r'), [UPrintf]
us')
        _ ->
          ((Maybe Int
forall a. Maybe a
Nothing, String
cs0), [UPrintf]
us')
      FormatParse ms :: String
ms c :: Char
c cs :: String
cs =
        case [UPrintf]
us'' of
          (ufmt :: ModifierParser
ufmt, _) : _ -> ModifierParser
ufmt String
cs''
          [] -> FormatParse
forall a. a
errorMissingArgument
  in
   (FieldFormat :: Maybe Int
-> Maybe Int
-> Maybe FormatAdjustment
-> Maybe FormatSign
-> Bool
-> String
-> Char
-> FieldFormat
FieldFormat {
       fmtWidth :: Maybe Int
fmtWidth = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
abs Int
n),
       fmtPrecision :: Maybe Int
fmtPrecision = Maybe Int
p,
       fmtAdjust :: Maybe FormatAdjustment
fmtAdjust = Maybe Int -> Maybe Int -> Bool -> Bool -> Maybe FormatAdjustment
forall a.
Maybe Int -> Maybe a -> Bool -> Bool -> Maybe FormatAdjustment
adjustment (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Maybe Int
p Bool
l Bool
z,
       fmtSign :: Maybe FormatSign
fmtSign = Maybe FormatSign
s,
       fmtAlternate :: Bool
fmtAlternate = Bool
a,
       fmtModifiers :: String
fmtModifiers = String
ms,
       fmtChar :: Char
fmtChar = Char
c}, String
cs, [UPrintf]
us'')
getSpecs l :: Bool
l z :: Bool
z s :: Maybe FormatSign
s a :: Bool
a ('.' : cs0 :: String
cs0) us :: [UPrintf]
us =
  let ((p :: Int
p, cs' :: String
cs'), us' :: [UPrintf]
us') = case String
cs0 of
        '*':cs'' :: String
cs'' -> let (us'' :: [UPrintf]
us'', p' :: Int
p') = [UPrintf] -> ([UPrintf], Int)
getStar [UPrintf]
us in ((Int
p', String
cs''), [UPrintf]
us'')
        _ ->        (String -> (Int, String)
stoi String
cs0, [UPrintf]
us)
      FormatParse ms :: String
ms c :: Char
c cs :: String
cs =
        case [UPrintf]
us' of
          (ufmt :: ModifierParser
ufmt, _) : _ -> ModifierParser
ufmt String
cs'
          [] -> FormatParse
forall a. a
errorMissingArgument
  in
   (FieldFormat :: Maybe Int
-> Maybe Int
-> Maybe FormatAdjustment
-> Maybe FormatSign
-> Bool
-> String
-> Char
-> FieldFormat
FieldFormat {
       fmtWidth :: Maybe Int
fmtWidth = Maybe Int
forall a. Maybe a
Nothing,
       fmtPrecision :: Maybe Int
fmtPrecision = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p,
       fmtAdjust :: Maybe FormatAdjustment
fmtAdjust = Maybe Int -> Maybe Int -> Bool -> Bool -> Maybe FormatAdjustment
forall a.
Maybe Int -> Maybe a -> Bool -> Bool -> Maybe FormatAdjustment
adjustment Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p) Bool
l Bool
z,
       fmtSign :: Maybe FormatSign
fmtSign = Maybe FormatSign
s,
       fmtAlternate :: Bool
fmtAlternate = Bool
a,
       fmtModifiers :: String
fmtModifiers = String
ms,
       fmtChar :: Char
fmtChar = Char
c}, String
cs, [UPrintf]
us')
getSpecs l :: Bool
l z :: Bool
z s :: Maybe FormatSign
s a :: Bool
a cs0 :: String
cs0@(c0 :: Char
c0 : _) us :: [UPrintf]
us | Char -> Bool
isDigit Char
c0 =
  let (n :: Int
n, cs' :: String
cs') = String -> (Int, String)
stoi String
cs0
      ((p :: Maybe Int
p, cs'' :: String
cs''), us' :: [UPrintf]
us') = case String
cs' of
        '.' : '*' : r :: String
r ->
          let (us'' :: [UPrintf]
us'', p' :: Int
p') = [UPrintf] -> ([UPrintf], Int)
getStar [UPrintf]
us in ((Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p', String
r), [UPrintf]
us'')
        '.' : r :: String
r ->
          let (p' :: Int
p', r' :: String
r') = String -> (Int, String)
stoi String
r in ((Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p', String
r'), [UPrintf]
us)
        _ ->
          ((Maybe Int
forall a. Maybe a
Nothing, String
cs'), [UPrintf]
us)
      FormatParse ms :: String
ms c :: Char
c cs :: String
cs =
        case [UPrintf]
us' of
          (ufmt :: ModifierParser
ufmt, _) : _ -> ModifierParser
ufmt String
cs''
          [] -> FormatParse
forall a. a
errorMissingArgument
  in
   (FieldFormat :: Maybe Int
-> Maybe Int
-> Maybe FormatAdjustment
-> Maybe FormatSign
-> Bool
-> String
-> Char
-> FieldFormat
FieldFormat {
       fmtWidth :: Maybe Int
fmtWidth = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
abs Int
n),
       fmtPrecision :: Maybe Int
fmtPrecision = Maybe Int
p,
       fmtAdjust :: Maybe FormatAdjustment
fmtAdjust = Maybe Int -> Maybe Int -> Bool -> Bool -> Maybe FormatAdjustment
forall a.
Maybe Int -> Maybe a -> Bool -> Bool -> Maybe FormatAdjustment
adjustment (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Maybe Int
p Bool
l Bool
z,
       fmtSign :: Maybe FormatSign
fmtSign = Maybe FormatSign
s,
       fmtAlternate :: Bool
fmtAlternate = Bool
a,
       fmtModifiers :: String
fmtModifiers = String
ms,
       fmtChar :: Char
fmtChar = Char
c}, String
cs, [UPrintf]
us')
getSpecs l :: Bool
l z :: Bool
z s :: Maybe FormatSign
s a :: Bool
a cs0 :: String
cs0@(_ : _) us :: [UPrintf]
us =
  let FormatParse ms :: String
ms c :: Char
c cs :: String
cs =
        case [UPrintf]
us of
          (ufmt :: ModifierParser
ufmt, _) : _ -> ModifierParser
ufmt String
cs0
          [] -> FormatParse
forall a. a
errorMissingArgument
  in
   (FieldFormat :: Maybe Int
-> Maybe Int
-> Maybe FormatAdjustment
-> Maybe FormatSign
-> Bool
-> String
-> Char
-> FieldFormat
FieldFormat {
       fmtWidth :: Maybe Int
fmtWidth = Maybe Int
forall a. Maybe a
Nothing,
       fmtPrecision :: Maybe Int
fmtPrecision = Maybe Int
forall a. Maybe a
Nothing,
       fmtAdjust :: Maybe FormatAdjustment
fmtAdjust = Maybe Int -> Maybe Any -> Bool -> Bool -> Maybe FormatAdjustment
forall a.
Maybe Int -> Maybe a -> Bool -> Bool -> Maybe FormatAdjustment
adjustment Maybe Int
forall a. Maybe a
Nothing Maybe Any
forall a. Maybe a
Nothing Bool
l Bool
z,
       fmtSign :: Maybe FormatSign
fmtSign = Maybe FormatSign
s,
       fmtAlternate :: Bool
fmtAlternate = Bool
a,
       fmtModifiers :: String
fmtModifiers = String
ms,
       fmtChar :: Char
fmtChar = Char
c}, String
cs, [UPrintf]
us)
getSpecs _ _ _ _ ""       _  =
  (FieldFormat, String, [UPrintf])
forall a. a
errorShortFormat

-- Process a star argument in a format specification.
getStar :: [UPrintf] -> ([UPrintf], Int)
getStar :: [UPrintf] -> ([UPrintf], Int)
getStar us :: [UPrintf]
us =
  let ufmt :: FieldFormat
ufmt = FieldFormat :: Maybe Int
-> Maybe Int
-> Maybe FormatAdjustment
-> Maybe FormatSign
-> Bool
-> String
-> Char
-> FieldFormat
FieldFormat {
        fmtWidth :: Maybe Int
fmtWidth = Maybe Int
forall a. Maybe a
Nothing,
        fmtPrecision :: Maybe Int
fmtPrecision = Maybe Int
forall a. Maybe a
Nothing,
        fmtAdjust :: Maybe FormatAdjustment
fmtAdjust = Maybe FormatAdjustment
forall a. Maybe a
Nothing,
        fmtSign :: Maybe FormatSign
fmtSign = Maybe FormatSign
forall a. Maybe a
Nothing,
        fmtAlternate :: Bool
fmtAlternate = Bool
False,
        fmtModifiers :: String
fmtModifiers = "",
        fmtChar :: Char
fmtChar = 'd' } in
  case [UPrintf]
us of
    [] -> ([UPrintf], Int)
forall a. a
errorMissingArgument
    (_, nu :: FieldFormatter
nu) : us' :: [UPrintf]
us' -> ([UPrintf]
us', String -> Int
forall a. Read a => String -> a
read (FieldFormatter
nu FieldFormat
ufmt ""))

-- Format a RealFloat value.
dfmt :: (RealFloat a) => Char -> Maybe Int -> Bool -> a -> (String, String)
dfmt :: Char -> Maybe Int -> Bool -> a -> (String, String)
dfmt c :: Char
c p :: Maybe Int
p a :: Bool
a d :: a
d =
  let caseConvert :: String -> String
caseConvert = if Char -> Bool
isUpper Char
c then (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper else String -> String
forall a. a -> a
id
      showFunction :: Maybe Int -> a -> String -> String
showFunction = case Char -> Char
toLower Char
c of
        'e' -> Maybe Int -> a -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showEFloat
        'f' -> if Bool
a then Maybe Int -> a -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloatAlt else Maybe Int -> a -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat
        'g' -> if Bool
a then Maybe Int -> a -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showGFloatAlt else Maybe Int -> a -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showGFloat
        _   -> String -> Maybe Int -> a -> String -> String
forall a. String -> a
perror "internal error: impossible dfmt"
      result :: String
result = String -> String
caseConvert (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Maybe Int -> a -> String -> String
showFunction Maybe Int
p a
d ""
  in
   case String
result of
     '-' : cs :: String
cs -> ("-", String
cs)
     cs :: String
cs       -> ("" , String
cs)


-- | Raises an 'error' with a printf-specific prefix on the
-- message string.
--
-- @since 4.7.0.0
perror :: String -> a
perror :: String -> a
perror s :: String
s = String -> a
forall a. String -> a
errorWithoutStackTrace (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "printf: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

-- | Calls 'perror' to indicate an unknown format letter for
-- a given type.
--
-- @since 4.7.0.0
errorBadFormat :: Char -> a
errorBadFormat :: Char -> a
errorBadFormat c :: Char
c = String -> a
forall a. String -> a
perror (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "bad formatting char " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c

errorShortFormat, errorMissingArgument, errorBadArgument :: a
-- | Calls 'perror' to indicate that the format string ended
-- early.
--
-- @since 4.7.0.0
errorShortFormat :: a
errorShortFormat = String -> a
forall a. String -> a
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 :: a
errorMissingArgument = String -> a
forall a. String -> a
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 :: a
errorBadArgument = String -> a
forall a. String -> a
perror "bad argument"