[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 ce362b82ea27d6cf7b70b18f8db761675c5cf613
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Nov 16 03:41:19 2004 +0100

    Association list printing working
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.5--patch-62)

diff --git a/ChangeLog b/ChangeLog
index 3f9ae2e..5f8c119 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
 #
 
+2004-11-15 20:41:19 GMT	John Goerzen <jgoerzen at complete.org>	patch-62
+
+    Summary:
+      Association list printing working
+    Revision:
+      missingh--head--0.5--patch-62
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Printf.hs testsrc/Printftest.hs
+
+
 2004-11-15 20:27:31 GMT	John Goerzen <jgoerzen at complete.org>	patch-61
 
     Summary:
diff --git a/libsrc/MissingH/Printf.hs b/libsrc/MissingH/Printf.hs
index 6b4b0ba..595899a 100644
--- a/libsrc/MissingH/Printf.hs
+++ b/libsrc/MissingH/Printf.hs
@@ -56,6 +56,7 @@ module MissingH.Printf(-- * Introduction
                        sprintf,
                        printf,
                        fprintf,
+                       sprintfAL,
                        -- ** Utility Function
                        v,
                        -- * Differences from C
@@ -108,7 +109,6 @@ mkflags x =
         in
         flags''
 
---type LookupFunc a :: String -> a -> (String, String, a)
 normLookup :: String -> [Value] -> (String, String, [Value])
 normLookup xs (y : ys) =
     case matchRegexAll sprintfre xs of
@@ -126,7 +126,23 @@ normLookup xs (y : ys) =
                  --(show width) ++ sprintf remainder ys
                  (fix_width flags width ((get_conversion_func fmt y flags width prec)), remainder, ys)
          _ -> error $ "Problem matching format string at %" ++ xs
-    
+
+alre = mkRegex "^\\(([^)]+)\\)"
+alLookup :: String -> PrintfAL -> (String, String)
+alLookup xs y =
+    case matchRegexAll alre xs of
+         Nothing -> error $ "No varname in keyed lookup at %" ++ xs
+         Just (_, _, remainder, [varname]) ->
+             let val = case lookup varname y of
+                               Just z -> z
+                               Nothing -> error $ 
+                                          "Failed to find key " ++ varname ++
+                                          " in keyed lookup table"
+                 in
+                 case normLookup remainder [val] of
+                      (a, b, _) -> (a, b)
+         _ -> error $ "Problem finding key in lookup at %" ++ xs
+
 {- | List version of 'vsprintf'. -}
 sprintf :: String -> [Value] -> String
 sprintf [] [] = []
@@ -137,18 +153,16 @@ sprintf ('%' : xs) y =
         this ++ sprintf remainder ys
 sprintf (x:xs) y = x : sprintf xs y
 
-{-
-sprintf :: String -> [Value] -> String
-sprintf = sprintfG id sprintf
--}
-
-{-
 {- | Association list printing -}
 sprintfAL :: String -> PrintfAL -> String
 sprintfAL [] _ = []
 sprintfAL ('%' : '%' : xs) y = '%' : sprintfAL xs y
-sprintfAL ('%' : xs) (y : ys) =
--}
+sprintfAL ('%' : xs) y =
+    let (this, remainder) = alLookup xs y
+        in
+        this ++ sprintfAL remainder y
+sprintfAL (x:xs) y = x : sprintfAL xs y
+
 {- | Given a format string and zero or more arguments, return a string
 that has formatted them appropriately.  This is the variable argument version
 of 'sprintf'. -}
diff --git a/testsrc/Printftest.hs b/testsrc/Printftest.hs
index b4a58ee..fdb72db 100644
--- a/testsrc/Printftest.hs
+++ b/testsrc/Printftest.hs
@@ -40,6 +40,18 @@ test_vsprintf =
     "John, your age is 10\n" @=? sprintf "%s, your age is %d\n" [v "John",
                                                                  v (10::Integer)]
 
+test_al =
+    let testal = [("foo", v (1::Int)),
+                  ("bar", v "asdf"),
+                  ("baz", v (3.14::Double))]
+        f exp inp = exp @=? sprintfAL inp testal
+        in do
+           f "" ""
+           f "asdf" "%(bar)s"
+           f "001" "%(foo)03d"
+           f "asdf " "%(bar)-5s"
+           f "3.140" "%(baz).3f"
+
 test_vsprintf_generics =
     do
     "foo: 5" @=? vsprintf "%s: %d" "foo" (5::Int)
@@ -69,5 +81,6 @@ test_vsprintf_strings =
     
 tests = TestList [TestLabel "vsprintf" (TestCase test_vsprintf),
                   TestLabel "vsprintf generics" (TestCase test_vsprintf_generics),
-                  TestLabel "vsprintf strings" (TestCase test_vsprintf_strings)
+                  TestLabel "vsprintf strings" (TestCase test_vsprintf_strings),
+                  TestLabel "vsprintf AL" (TestCase test_al)
                  ]
\ No newline at end of file

-- 
haskell-testpack