[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 34cb2b6700704fd8b9084817171f23c3cb2e2ad3
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Nov 15 10:22:42 2004 +0100

    Fixed precision handling
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.5--patch-48)

diff --git a/ChangeLog b/ChangeLog
index 6909106..a085459 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,20 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
 #
 
+2004-11-15 03:22:42 GMT	John Goerzen <jgoerzen at complete.org>	patch-48
+
+    Summary:
+      Fixed precision handling
+    Revision:
+      missingh--head--0.5--patch-48
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Printf.hs
+     libsrc/MissingH/Printf/Printer.lhs
+     libsrc/MissingH/Printf/Types.lhs
+
+
 2004-11-15 03:18:46 GMT	John Goerzen <jgoerzen at complete.org>	patch-47
 
     Summary:
diff --git a/libsrc/MissingH/Printf.hs b/libsrc/MissingH/Printf.hs
index bea3e8d..7d1a3b1 100644
--- a/libsrc/MissingH/Printf.hs
+++ b/libsrc/MissingH/Printf.hs
@@ -103,7 +103,11 @@ sprintf ('%' : xs) (y : ys) =
          --Just (_, _, r, x) -> "<" ++ show x ++ ">" ++ sprintf r ys
          Just (_, _, remainder, [flagstr, widthstr, precstr, [fmt]]) ->
              let width = if widthstr == "" then Nothing else Just ((read widthstr)::Width)
-                 prec = if precstr == "" then Nothing else Just precstr
+                 prec = if precstr == "" 
+                        then Nothing 
+                        else Just (if length precstr >= 1
+                                   then abs $ read (drop 1 precstr)
+                                   else 0)
                  flags = mkflags flagstr
                  in
                  --(show width) ++ sprintf remainder ys
diff --git a/libsrc/MissingH/Printf/Printer.lhs b/libsrc/MissingH/Printf/Printer.lhs
index 87ce43c..9a30180 100644
--- a/libsrc/MissingH/Printf/Printer.lhs
+++ b/libsrc/MissingH/Printf/Printer.lhs
@@ -8,7 +8,7 @@ import Maybe (fromMaybe)
 import Numeric (showEFloat, showFFloat)
 import Char (toLower, toUpper)
 import MissingH.Printf.Types
-import Data.List(genericLength, genericReplicate)
+import Data.List(genericLength, genericReplicate, genericTake)
 
 {-
 xn where n is an integer refers to an argument to the function
@@ -48,7 +48,7 @@ get_conversion_func c = fromMaybe (error (c:": CF unknown")) $ lookup c cfs
 print_signed_int :: ConversionFunc
 print_signed_int argv flags mw mp = res
     where arg = (fromValue argv)::Integer
-          preci = read (fromMaybe "1" mp)
+          preci = fromMaybe 1 mp
           width = fromMaybe 0 mw
           disp | Thousands `elem` flags = thousandify . show
                | otherwise              =               show
@@ -71,7 +71,7 @@ print_signed_int argv flags mw mp = res
 print_unsigned_int :: Char -> ConversionFunc
 print_unsigned_int base argv flags mw mp = res
     where arg = (fromValue argv)::Integer
-          preci = read (fromMaybe "1"  mp)
+          preci = fromMaybe 1  mp
           width = fromMaybe 0 mw
           w = if ZeroPadded `elem` flags then (preci) `max` width
                                          else  preci
@@ -101,7 +101,7 @@ print_unsigned_int base argv flags mw mp = res
 print_exponent_double :: Char -> ConversionFunc
 print_exponent_double e argv flags mw mp = res
     where arg = (fromValue argv)::Double
-          preci = read (fromMaybe "6" mp)
+          preci = fromMaybe 6 mp
           width = fromMaybe 0 mw
           plus_sign = if Plus `elem` flags
                       then "+"
@@ -110,7 +110,7 @@ print_exponent_double e argv flags mw mp = res
                       else ""
           keep_dot = AlternateForm `elem` flags
           res =    let to_show = (fromRational $ toRational arg) :: Double
-                       shown = showEFloat (Just (preci)) (abs to_show) ""
+                       shown = showEFloat (Just (fromInteger preci)) (abs to_show) ""
                        sign = if to_show < 0 then "-" else plus_sign
                        fix_prec0 = if (preci) == 0
                                    then case break (== '.') shown of
@@ -134,7 +134,7 @@ print_exponent_double e argv flags mw mp = res
 print_fixed_double :: Char -> ConversionFunc
 print_fixed_double f argv flags mw mp = res
     where arg = (fromValue argv)::Double
-          preci = read (fromMaybe "6"  mp)
+          preci = fromMaybe 6  mp
           width = fromMaybe 0  mw
           plus_sign = if Plus `elem` flags
                       then "+"
@@ -145,7 +145,7 @@ print_fixed_double f argv flags mw mp = res
           fix_case | f == 'f'  = map toLower
                    | otherwise = map toUpper
           res =    let to_show = (fromRational $ toRational arg) :: Double
-                       shown = showFFloat (Just (preci)) (abs to_show) ""
+                       shown = showFFloat (Just (fromInteger preci)) (abs to_show) ""
                        shown' = if add_dot && (preci) == 0 then shown ++ "."
                                                           else shown
                        sign = if to_show < 0 then "-" else plus_sign
@@ -162,7 +162,7 @@ print_char arg _ _ _ = [(fromValue arg)::Char]
 print_string :: ConversionFunc
 print_string argv _ _ mp
     = case mp of
-          Just preci -> if (read preci) < 0 then arg else take (read preci) arg
+          Just preci -> if preci < 0 then arg else genericTake preci arg
           Nothing -> arg
       where arg = fromValue argv
 
diff --git a/libsrc/MissingH/Printf/Types.lhs b/libsrc/MissingH/Printf/Types.lhs
index ea8be67..586d3bf 100644
--- a/libsrc/MissingH/Printf/Types.lhs
+++ b/libsrc/MissingH/Printf/Types.lhs
@@ -73,7 +73,7 @@ data Format = Literal String
 type ArgNum = Integer
 type Arg = Value
 type Width = Integer
-type Precision = String
+type Precision = Integer
 data Flag = AlternateForm       -- "#"
           | ZeroPadded          -- "0"
           | LeftAdjust          -- "-"

-- 
haskell-testpack