Fwd: add instance PrintfArg Ratio
Dannyu NDos
ndospark320 at gmail.com
Sun Feb 9 06:14:52 UTC 2020
---------- Forwarded message ---------
보낸사람: Dannyu NDos <ndospark320 at gmail.com>
Date: 2020년 2월 9일 (일) 오후 3:14
Subject: Re: add instance PrintfArg Ratio
To: Henning Thielemann <lemming at henning-thielemann.de>
Bugfix:
instance (Integral a, PrintfArg a) => PrintfArg (Ratio a) where
formatArg x f@(FieldFormat w p a s l _ c) = if elem c "gGv"
then let
d = " % " ++ formatArg (denominator x) (FieldFormat Nothing
Nothing Nothing s l "" 'd') ""
(w',a') = case a of
Just LeftAdjust -> (Nothing, Nothing)
_ -> (fmap (subtract (length d)) w, a)
n = formatArg (numerator x) (f {fmtWidth = w', fmtAdjust = a',
fmtChar = 'd'}) ""
in formatArg (n ++ d) (f {fmtPrecision = Nothing, fmtChar =
's'})
else if elem c "doxXb"
then formatArg (round x :: Integer) f
else case p of
Nothing -> error "Text.Printf.formatArg: precision not
given"
Just p' -> if p' <= 0
then formatArg x (f {fmtPrecision = Nothing, fmtChar =
'd'})
else if elem c "fF"
then let
a' = case a of
Just LeftAdjust -> Nothing
_ -> a
digits = formatArg (truncate (x * 10 ^ p') ::
Integer) (f {fmtPrecision = Nothing, fmtAdjust = a', fmtChar = 'd'}) ""
(n,sig) = splitAt (length digits - p') digits
in formatArg (n ++ '.' : sig) (f {fmtPrecision
= Nothing, fmtChar = 's'})
else if elem c "eE"
then let
(q,e) = log10 x
sig = c : show e
(w',a') = case a of
Just LeftAdjust -> (Nothing, Nothing)
_ -> (fmap (subtract (length sig)) w, a)
fp = formatArg q (f {fmtWidth = w',
fmtAdjust = a', fmtChar = 'f'}) ""
in formatArg (fp ++ sig) (f {fmtPrecision =
Nothing, fmtChar = 's'})
else error "Text.Printf.formatArg: bad format
character"
where
goF _ 0 = ""
goF x p = case compare x 0 of
LT -> '-' : goF (negate x) p
EQ -> "0"
GT -> if 1 == p
then show (round (10 * x) :: Integer)
else let
x10 = 10 * x
n = truncate x10
in show n ++ goF (x10 - fromIntegral n) (p - 1)
log10 x
| x < 1 = let
(q,e) = log10 (x * 10)
in (q, e - 1)
| 10 <= x = let
(q,e) = log10 (x / 10)
in (q, e + 1)
| otherwise = (x, 0)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20200209/d6ad9b29/attachment.html>
More information about the Libraries
mailing list