-- |
-- Module      : Text.PercentFormat
-- Copyright   : (c) 2016-2018 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- The "Text.PercentFormat" library provides printf-style string formatting.
-- It provides a '%' operator (as in Ruby or Python)
-- and uses the old C-printf-style format you know and love.
--
-- This library differs from "Text.Printf" in that it does not rely on custom
-- typeclasses -- it works on anything that is a 'Show' instance that produces
-- output in the supported formats.
--
--
-- Formatting one value with '-%':
--
-- > > "Hello %s!" -% "World"
-- > "Hello World!"
--
--
-- Formatting three values, tuple style, with '-%%%':
--
-- > > "load average: %1.2f %1.2f %1.2f" -%%% (0.00, 0.066, 0.11)
-- > "load average: 0.00 0.07 0.11"
--
--
-- Formatting three values, chain style, with '%' and '-%':
--
-- > > "load average: %1.2f %1.2f %1.2f" % 0.00 % 0.066 -% 0.11
-- > "load average: 0.00 0.07 0.11"
--
--
-- To produce a string with a percent sign (@%@),
-- use two percent signs (@%%@):
--
-- > > "memory usage: %i%%" -% 13
-- > "memory usage: 13%"
--
--
-- Percent signs are duplicated when using the '%' operator to allow chaining
-- (further formats):
--
-- > > "percent sign: %s, memory usage: %i%%" % "%" % 87
-- > "percent sign: %%, memory usage: 87%%"
--
-- /Always/ use the '-%' operator when formatting the /last value/
-- to remove duplicate @%@ signs:
--
-- > > "percent sign: %s, memory usage: %i%%" % "%" -% 87
-- > "percent sign: %, memory usage: 87%"
--
-- To print, just prefix you format expression with "@putStrLn $@":
--
-- > > putStrLn $ "Hello %s!" -% "World"
-- > Hello World!
--
--
-- == Supported formats
--
-- * /r/ -- 'show' representation as-is (including quotes for strings).
--
--     > > "%r" % "string"
--     > "\"string\""
--
--     > > "%r" % Just 10
--     > "Just 10"
--
-- * /s/ -- string.  If the argument is 'show'ed as a 'String', intersperse it,
--          otherwise include representation in whole.
--
--     > > "%s" % "string"
--     > "string"
--
--     > > "%s" % 10
--     > "10"
--
--     > > "%s" % Just "string"
--     > "Just \"string\""
--
-- * /c/ -- Argument is converted to a single character.
--   Accepts arguments that when 'show'ed are represented as 'Char's.
--
--     > > "%c" % 'a'
--     > "a"
--
-- * /i/ -- Argument is converted to the nearest decimal integer.
--   Accepts arguments that when 'show'ed are represented as either
--   'Integer's, 'Rational's or 'Double's.
--
--     > > "%i" % 5040
--     > 5040
--
--     > > "%i" % 3.141
--     > 3
--
-- * /d/ -- Argument is converted to a decimal integer.
--   Accepts arguments that when 'show'ed are represented as either
--   'Integer's, 'Rational's or 'Double's.
--
--     > > "%d" % 5040
--     > 5040
--
--     > > "%i" % 3.141
--     > 3.141
--
-- * /x/ -- Argument is converted to hexadecimal format with lowercase letters.
--   Accepts arguments that when 'show'ed are represented as either
--   'Integer's, 'Rational's or 'Double's.
--
--     > > "%x" % 5040
--     > "13b0"
--
--     Differently from C's @printf@, negative integers are printed prefixed with
--     a minus (@-@) sign:
--
--     > > "%x" % (-5040)
--     > "-13b0"
--
--     Differently from C's @printf@, this library is able to show hexadecimal
--     fractional parts:
--
--     > > "%.6x" % pi
--     > "3.243f6b"
--
-- * /X/ -- Argument is converted to hexadecimal format with capital letters.
--   Accepts arguments that when 'show'ed are represented as either
--   'Integer's, 'Rational's or 'Double's.
--
--     > > "%X" % 5040
--     > "13B0"
--
-- * /o/ -- Argument is converted to octal format.
--   Accepts arguments that when 'show'ed are represented as either
--   'Integer's, 'Rational's or 'Double's.
--
--     > > "%o" % 5040
--     > "11660"
--
--     > > "%.6o" % pi
--     > "3.110376"
--
-- * /b/ -- Argument is converted to binary format.
--   Accepts arguments that when 'show'ed are represented as either
--   'Integer's, 'Rational's or 'Double's.
--
--     > > "%b" % 5040
--     > "1001110110000"
--
--     > > "%.6b" % pi
--     > "11.001001"
--
-- * /f/ -- Argument is converted to decimal format with a fractional part
--   (even when the given argument is an integer).
--   Accepts arguments that when 'show'ed are represented as either
--   'Integer's, 'Rational's or 'Double's.
--
--     > > "%f" % 5040
--     > "5040.0"
--
--     > > "%f" % pi
--     > "3.141592653589793"
--
-- * /e/ -- Argument is converted to scientific notation.
--       __This does not work yet.  To be added in a future version.__
--
-- * /q/ -- Argument is converted to a rational number.
--       __This does not work yet.  To be added in a future version.__
--
--
-- == Supported flag charaters
--
-- * /0/ -- the numeric value should be padded by zeros.
--
--     > > "%08i" % 5040
--     > "00005040"
--
-- * /-/ -- left adjusted values.
--
--     > > "%-8i" % 5040
--     > "5040    "
--
-- * / / -- leave a blank before a positive number.
--
--     > > "% i" % 5040
--     > " 5040"
--
--     > > "% i" % (-5040)
--     > "-5040"
--
-- * /+/ -- leave a plus sign before a positive number.
--
--     > > "%+i" % 5040
--     > "+5040"
--
--     > > "%+i" % (-5040)
--     > "-5040"
--
-- * /[1-9][0-9]*/ -- minimum field width.
--
--     > > "%8i" % 5040
--     > "    5040"
--
-- * /.[0-9][0-9]*/ -- precision.
--
--     > > "%.2i" % 5040
--     > "5040.00"
--
--     > > "%9.2i" % 5040
--     > "  5040.00"
--
--
-- == How does it work?
--
-- "Text.PercentFormat" works on values that are 'Show' instances producing
-- results in the expected format.  Take for example the following number type:
--
-- > data Digit = Zero | One | Two | Three
-- > instance Show Digit where
-- >   show Zero   =  "0"
-- >   show One    =  "1"
-- >   show Two    =  "2"
-- >   show Three  =  "3"
--
-- "Text.PercentFormat" works fine on it:
--
-- > > "%d %i %f %.2f" Zero One Two Three
-- > "0 1 2 3.00"
--
-- Because when 'show'ed, values of this @Digit@ type are represented as 'Integer's.
--
--
-- == Error Handling
--
-- This library is designed to avoid raising errors.
-- If conversion cannot be performed an exclamation mark (@!@) is produced.
-- If there are missing format strings an interrogation mark (@?@) is produced.
-- For example:
--
-- > > "%d %d" -% "Ten"
-- > "! ?"
--
-- The only two instances where errors are raised are:
--
-- 1. the argument values contain errors themselves:
--
--     > > "Hello %s!" % error "err"
--     > *** Exception err
--
--     > > error "err" % "World"
--     > *** Exception err
--
-- 2. the format string is not supported:
--
--     > > "%j" % 10
--     > *** Exception: unknown format string `j'
--
--
-- == Known bugs
--
-- * @"%x" % 3.1415926@ takes too long to run.
--
-- * @"%x" % pi@ takes /very very long/ to run.
module Text.PercentFormat
  ( (%)
  , (-%)
  , (/%)

  , (%%)
  , (%%%)
  , (%%%%)
  , (%%%%%)
  , (%%%%%%)

  , (-%%)
  , (-%%%)
  , (-%%%%)
  , (-%%%%%)
  , (-%%%%%%)

  , (+%)
  )
where

import Data.Maybe (listToMaybe, fromMaybe)
import Data.Char (isDigit, toUpper)
import Text.PercentFormat.Spec  as S
import Text.PercentFormat.Utils hiding (align)
import Text.PercentFormat.Quotient (maybeReadQ, digits, Quotient, infinity, nan)
import qualified Text.PercentFormat.Quotient as Q
import qualified Text.PercentFormat.Utils as U
import Prelude hiding (showString, showChar)

-- | Formats a single value into a string without finalizing:
--   leaving duplicate percent signs & remaining format sequences.
--
-- > > "Hello %s!" % "World"
-- > "Hello World!"
--
-- > > "processor usage: %d%%" % 67
-- > "processor usage: 67%%"
--
-- > > "load avg: %.2f %.2f %.2f" % 0.666
-- > "load avg: %0.67 %.2f %.2f"
--
-- Please use '-%' when formatting the last value into a string so that
-- duplicate percent signs are removed.
(%) :: Show a => String -> a -> String
(Char
'%':String
s) % :: forall a. Show a => String -> a -> String
% a
x =
  case Spec -> SpecType
ty Spec
sp of
  SpecType
Percent     -> Char
'%'forall a. a -> [a] -> [a]
:Char
'%'forall a. a -> [a] -> [a]
: String
s' forall a. Show a => String -> a -> String
% a
x
  SpecType
ReprSpec    -> (String -> String
duplicatePercents forall a b. (a -> b) -> a -> b
$ forall a. Show a => Spec -> a -> String
showRepr    Spec
sp a
x) forall a. [a] -> [a] -> [a]
++ String
s'
  SpecType
StringSpec  -> (String -> String
duplicatePercents forall a b. (a -> b) -> a -> b
$ forall a. Show a => Spec -> a -> String
showString  Spec
sp a
x) forall a. [a] -> [a] -> [a]
++ String
s'
  SpecType
CharSpec    -> (String -> String
duplicatePercents forall a b. (a -> b) -> a -> b
$ forall a. Show a => Spec -> a -> String
showChar    Spec
sp a
x) forall a. [a] -> [a] -> [a]
++ String
s'
  SpecType
NumberSpec  -> (String -> String
duplicatePercents forall a b. (a -> b) -> a -> b
$ forall a. Show a => Spec -> a -> String
showDigits  Spec
sp a
x) forall a. [a] -> [a] -> [a]
++ String
s'
  where
  (Spec
sp,String
s') = String -> (Spec, String)
parseSpec String
s
(Char
c:String
s)       % a
x = Char
c forall a. a -> [a] -> [a]
: String
s forall a. Show a => String -> a -> String
% a
x
String
""          % a
x = String
""
infixl 9 %

showRepr :: Show a => Spec -> a -> String
showRepr :: forall a. Show a => Spec -> a -> String
showRepr Spec
spec = Spec -> String -> String
align Spec
spec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

showString :: Show a => Spec -> a -> String
showString :: forall a. Show a => Spec -> a -> String
showString Spec
spec a
s =
  case forall a. Read a => String -> Maybe a
maybeRead (forall a. Show a => a -> String
show a
s) of
  Maybe String
Nothing -> Spec -> String -> String
align Spec
spec (forall a. Show a => a -> String
show a
s)
  Just String
s  -> Spec -> String -> String
align Spec
spec String
s

showChar :: Show a => Spec -> a -> String
showChar :: forall a. Show a => Spec -> a -> String
showChar Spec
spec a
c =
  case forall a. Read a => String -> Maybe a
maybeRead (forall a. Show a => a -> String
show a
c) of
  Maybe Char
Nothing -> Char -> Spec -> String
err Char
'!' Spec
spec
  Just Char
c  -> Spec -> String -> String
align Spec
spec (Char
cforall a. a -> [a] -> [a]
:String
"")

-- TODO: refactor showDigits (currently very hacky)
showDigits :: Show a => Spec -> a -> String
showDigits :: forall a. Show a => Spec -> a -> String
showDigits Spec
spec a
x =
  case String -> Maybe Quotient
maybeReadQ (forall a. Show a => a -> String
show a
x) of
  Maybe Quotient
Nothing -> Char -> Spec -> String
err Char
'!' Spec
spec
  Just Quotient
q -> forall a. Bool -> (a -> a) -> a -> a
applyWhen (Spec -> Char
padWith Spec
spec forall a. Eq a => a -> a -> Bool
/= Char
' ') (forall {a}. (Ord a, Num a) => a -> String
signal Quotient
q forall a. [a] -> [a] -> [a]
++)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quotient -> String -> String
align' Quotient
q
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bool -> (a -> a) -> a -> a
applyWhen (Spec -> Char
padWith Spec
spec forall a. Eq a => a -> a -> Bool
== Char
' ') (forall {a}. (Ord a, Num a) => a -> String
signal Quotient
q forall a. [a] -> [a] -> [a]
++)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (\([Int]
ids,[Int]
fds,[Int]
pds) -> String -> String
capitalize forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int] -> Maybe Int -> String
showds [Int]
ids [Int]
fds [Int]
pds (Spec -> Maybe Int
precision Spec
spec))
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Quotient -> Either String ([Int], [Int], [Int])
digits (Spec -> Int
base Spec
spec)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Quotient -> Quotient
round' (Spec -> Int
base Spec
spec) (Spec -> Maybe Int
precision Spec
spec)
          forall a b. (a -> b) -> a -> b
$ Quotient
q
  where
  capitalize :: String -> String
capitalize = forall a. Bool -> (a -> a) -> a -> a
applyWhen (Spec -> Bool
capitalizeDigits Spec
spec) (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper)
  signal :: a -> String
signal a
q | a
q forall a. Eq a => a -> a -> Bool
/= a
q = Spec -> String
positivePrefix Spec
spec -- NaN
           | a
q forall a. Ord a => a -> a -> Bool
>= a
0 = Spec -> String
positivePrefix Spec
spec
           | a
q forall a. Ord a => a -> a -> Bool
<  a
0 = String
"-"
  align' :: Quotient -> String -> String
  align' :: Quotient -> String -> String
align' Quotient
q = if Spec -> Char
padWith Spec
spec forall a. Eq a => a -> a -> Bool
== Char
' '
               then Spec -> String -> String
align Spec
spec
               else Spec -> String -> String
align Spec
spec{width :: Int
width = Spec -> Int
width Spec
spec forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall {a}. (Ord a, Num a) => a -> String
signal Quotient
q)}
  round' :: Int -> Maybe Int -> Quotient -> Quotient
  round' :: Int -> Maybe Int -> Quotient -> Quotient
round' Int
_ Maybe Int
_ Quotient
q | Quotient -> Bool
Q.isInfinite Quotient
q = Quotient
q
  round' Int
_ Maybe Int
_ Quotient
q | Quotient -> Bool
Q.isNaN Quotient
q      = Quotient
q
  round' Int
_ Maybe Int
Nothing  Quotient
q = Quotient
q
  round' Int
b (Just Int
p) Quotient
q = forall a b. (RealFrac a, Integral b) => a -> b
round (Quotient
q forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p) Integer -> Integer -> Quotient
Q.% forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p
  showds :: [Int] -> [Int] -> [Int] -> Maybe Int -> String
  showds :: [Int] -> [Int] -> [Int] -> Maybe Int -> String
showds [Int]
ids [Int]
fds []  Maybe Int
Nothing  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
fds forall a. Ord a => a -> a -> Bool
< Spec -> Int
minPrecision Spec
spec
                            = [Int] -> [Int] -> [Int] -> Maybe Int -> String
showds [Int]
ids ([Int]
fds forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Spec -> Int
minPrecision Spec
spec forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
fds) Int
0) [] forall a. Maybe a
Nothing
  showds [Int]
ids []  [Int]
_   Maybe Int
Nothing  = [Int] -> String
intsToDigits [Int]
ids
  showds [Int]
ids [Int]
fds [Int]
pds (Just Int
0) = [Int] -> String
intsToDigits [Int]
ids
  showds [Int]
ids [Int]
fds [Int]
pds Maybe Int
Nothing  = [Int] -> String
intsToDigits [Int]
ids forall a. [a] -> [a] -> [a]
++ String
"."
                             forall a. [a] -> [a] -> [a]
++ [Int] -> String
intsToDigits [Int]
fds forall a. [a] -> [a] -> [a]
++ [Int] -> String
showPeriod [Int]
pds
  showds [Int]
ids [Int]
fds [Int]
pds (Just Int
pr) = [Int] -> String
intsToDigits [Int]
ids forall a. [a] -> [a] -> [a]
++ String
"."
                              forall a. [a] -> [a] -> [a]
++ [Int] -> String
intsToDigits (forall a. Int -> [a] -> [a]
take Int
pr ([Int]
fds forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
loop [Int]
pds forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Int
0))
  showPeriod :: [Int] -> String
showPeriod [] = String
""
  showPeriod [Int]
xs = [Int] -> String
intsToDigits [Int]
xs
               forall a. [a] -> [a] -> [a]
++ [Int] -> String
intsToDigits [Int]
xs
               forall a. [a] -> [a] -> [a]
++ [Int] -> String
intsToDigits [Int]
xs
               forall a. [a] -> [a] -> [a]
++ String
"..."

err :: Char -> Spec -> String
err :: Char -> Spec -> String
err Char
c Spec
spec = Spec -> String -> String
align Spec
spec{padWith :: Char
padWith=Char
c} (Char
cforall a. a -> [a] -> [a]
:String
"")

-- | Formats the last value into a string.
--   This finalizes formatting, removing duplicate percent signs and replacing
--   remaining format sequences with interrogation marks.
--
-- > > "Hello %s!" -% "World"
-- > "Hello World!"
--
-- > > "processor usage: %d%%" -% 67
-- > "processor usage: 67%"
--
-- > > "load avg: %.2f %.2f %.2f" % 0.666
-- > "load avg: %0.67 ? ?"
--
-- Please use '%' if you intend to further format values (chaining).
(-%) :: Show a => String -> a -> String
String
s -% :: forall a. Show a => String -> a -> String
-% a
x = String
s forall a. Show a => String -> a -> String
% a
x String -> Char -> String
/% Char
'?'
infixl 9 -%

-- | Replaces "%%" by "%".  Any remaining occurrences of format strings are
--   replaced by the given error character.  Field width is respected when
--   possible.
--
-- > > "100%% %i" /% '?'
-- > "100% ?"
--
-- > > "100%% %03i" /% '?'
-- > "100% ???"
(/%) :: String -> Char -> String
String
s /% :: String -> Char -> String
/% Char
errChar = String -> String
depercent String
s
  where
  depercent :: String -> String
depercent (Char
'%':String
s) = let (Spec
spec,String
s') = String -> (Spec, String)
parseSpec String
s
                          s'' :: String
s'' = case Spec -> SpecType
ty Spec
spec of
                                SpecType
Percent     -> String
"%"
                                SpecType
_           -> Char -> Spec -> String
err Char
errChar Spec
spec
                      in String
s'' forall a. [a] -> [a] -> [a]
++ String -> String
depercent String
s'
  depercent (Char
c:String
s) = Char
c forall a. a -> [a] -> [a]
: String -> String
depercent String
s
  depercent String
"" = String
""

-- | Aligns a string following a given spec.
--
-- > align spec{width=1} "asdf"
-- "asdf"
-- > align spec{width=5} "asdf"
-- " asdf"
-- > align spec{width=5, leftAlign=True} "asdf"
-- "asdf "
align :: Spec -> String -> String
align :: Spec -> String -> String
align Spec
spec = Bool -> Char -> Int -> String -> String
U.align (Spec -> Bool
S.leftAlign Spec
spec) (Spec -> Char
padWith Spec
spec) (Spec -> Int
width Spec
spec)

duplicatePercents :: String -> String
duplicatePercents :: String -> String
duplicatePercents (Char
'%':String
s) = Char
'%'forall a. a -> [a] -> [a]
:Char
'%'forall a. a -> [a] -> [a]
:String -> String
duplicatePercents String
s
duplicatePercents (Char
c:String
s)   = Char
cforall a. a -> [a] -> [a]
:String -> String
duplicatePercents String
s
duplicatePercents String
""      = String
""

-- | Formats two values into a string without finalizing:
--   leaving duplicate percent signs & remaining format sequences.
--
-- > > "%s %s!" %% ("Hello","World")
-- > "Hello World!"
--
-- > > "load avg: %.2f %.2f %.2f" %% (0.666,0.333)
-- > "load avg: %0.67 %0.33 %.2f"
--
-- In general:
--
-- > s %% (x,y) == s % x % y
--
-- Please use '-%%' if you don't intend to format values into a string any further.
(%%) :: (Show a, Show b) => String -> (a,b) -> String
String
s %% :: forall a b. (Show a, Show b) => String -> (a, b) -> String
%% (a
x,b
y) = String
s forall a. Show a => String -> a -> String
% a
x forall a. Show a => String -> a -> String
% b
y

-- | Formats three values into a string without finalizing.
--
-- > > "load avg: %.2f %.2f %.2f" %%% (0.666,0.333,0.1)
-- > "load avg: %0.67 %0.33 %0.10"
(%%%) :: (Show a, Show b, Show c) => String -> (a,b,c) -> String
String
s %%% :: forall a b c.
(Show a, Show b, Show c) =>
String -> (a, b, c) -> String
%%% (a
x,b
y,c
z) = String
s forall a. Show a => String -> a -> String
% a
x forall a. Show a => String -> a -> String
% b
y forall a. Show a => String -> a -> String
% c
z

-- | Formats four values into a string without finalizing.
(%%%%) :: (Show a, Show b, Show c, Show d) => String -> (a,b,c,d) -> String
String
s %%%% :: forall a b c d.
(Show a, Show b, Show c, Show d) =>
String -> (a, b, c, d) -> String
%%%% (a
x,b
y,c
z,d
w) = String
s forall a. Show a => String -> a -> String
% a
x forall a. Show a => String -> a -> String
% b
y forall a. Show a => String -> a -> String
% c
z forall a. Show a => String -> a -> String
% d
w

-- | Formats five values into a string without finalizing.
(%%%%%) :: (Show a, Show b, Show c, Show d, Show e)
        => String -> (a,b,c,d,e) -> String
String
s %%%%% :: forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
String -> (a, b, c, d, e) -> String
%%%%% (a
x,b
y,c
z,d
w,e
v) = String
s forall a. Show a => String -> a -> String
% a
x forall a. Show a => String -> a -> String
% b
y forall a. Show a => String -> a -> String
% c
z forall a. Show a => String -> a -> String
% d
w forall a. Show a => String -> a -> String
% e
v

-- | Formats six values into a string without finalizing.
(%%%%%%) :: (Show a, Show b, Show c, Show d, Show e, Show f)
         => String -> (a,b,c,d,e,f) -> String
String
s %%%%%% :: forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
String -> (a, b, c, d, e, f) -> String
%%%%%% (a
x,b
y,c
z,d
w,e
v,f
u) = String
s forall a. Show a => String -> a -> String
% a
x forall a. Show a => String -> a -> String
% b
y forall a. Show a => String -> a -> String
% c
z forall a. Show a => String -> a -> String
% d
w forall a. Show a => String -> a -> String
% e
v forall a. Show a => String -> a -> String
% f
u

-- | Formats two values into a string and finalizes it:
--   removing duplicate percent signs & replacing remaining format sequences
--   with interrogation marks.
--
-- > > "%s %s!" -%% ("Hello","World")
-- > "Hello World!"
--
-- > > "load avg: %.2f %.2f %.2f" -%% (0.666,0.333)
-- > "load avg: %0.67 %0.33 ?"
--
-- In general:
--
-- > s -%% (x,y) == s % x -% y
--
-- Please use '%%' if you intend to further format values.
(-%%) :: (Show a, Show b) => String -> (a,b) -> String
String
s -%% :: forall a b. (Show a, Show b) => String -> (a, b) -> String
-%% (a, b)
t = String
s forall a b. (Show a, Show b) => String -> (a, b) -> String
%% (a, b)
t String -> Char -> String
/% Char
'?'

-- | Formats three values into a string and finalizes it.
--
-- > > "load avg: %.2f %.2f %.2f" -%%% (0.666,0.333,0.1)
-- > "load avg: %0.67 %0.33 %0.10"
(-%%%) :: (Show a, Show b, Show c) => String -> (a,b,c) -> String
String
s -%%% :: forall a b c.
(Show a, Show b, Show c) =>
String -> (a, b, c) -> String
-%%% (a, b, c)
t = String
s forall a b c.
(Show a, Show b, Show c) =>
String -> (a, b, c) -> String
%%% (a, b, c)
t String -> Char -> String
/% Char
'?'

-- | Formats four values into a string and finalizes it.
(-%%%%) :: (Show a, Show b, Show c, Show d) => String -> (a,b,c,d) -> String
String
s -%%%% :: forall a b c d.
(Show a, Show b, Show c, Show d) =>
String -> (a, b, c, d) -> String
-%%%% (a, b, c, d)
t = String
s forall a b c d.
(Show a, Show b, Show c, Show d) =>
String -> (a, b, c, d) -> String
%%%% (a, b, c, d)
t String -> Char -> String
/% Char
'?'

-- | Formats five values into a string and finalizes it.
(-%%%%%) :: (Show a, Show b, Show c, Show d, Show e)
        => String -> (a,b,c,d,e) -> String
String
s -%%%%% :: forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
String -> (a, b, c, d, e) -> String
-%%%%% (a, b, c, d, e)
t = String
s forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
String -> (a, b, c, d, e) -> String
%%%%% (a, b, c, d, e)
t String -> Char -> String
/% Char
'?'

-- | Formats six values into a stirng and finalizes it.
(-%%%%%%) :: (Show a, Show b, Show c, Show d, Show e, Show f)
         => String -> (a,b,c,d,e,f) -> String
String
s -%%%%%% :: forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
String -> (a, b, c, d, e, f) -> String
-%%%%%% (a, b, c, d, e, f)
t = String
s forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
String -> (a, b, c, d, e, f) -> String
%%%%%% (a, b, c, d, e, f)
t String -> Char -> String
/% Char
'?'

-- | Just an alias to '%' for use whenever "Data.Ratio" is in scope.
--
-- > import Data.Ratio
-- > import Text.PercentFormat hiding ((%))
-- > "..." +% 1 -% 2
(+%) :: Show a => String -> a -> String
+% :: forall a. Show a => String -> a -> String
(+%) = forall a. Show a => String -> a -> String
(%)