[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 08bcee77d6422724bda1d68fabf43ec2723eae0f
Author: John Goerzen <jgoerzen at complete.org>
Date:   Fri Nov 19 22:36:53 2004 +0100

    Checkpointing a few bug fixes
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.5--patch-100)

diff --git a/ChangeLog b/ChangeLog
index 081ec24..46d355a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
 #
 
+2004-11-19 15:36:53 GMT	John Goerzen <jgoerzen at complete.org>	patch-100
+
+    Summary:
+      Checkpointing a few bug fixes
+    Revision:
+      missingh--head--0.5--patch-100
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/ConfigParser/Lexer.hs
+     libsrc/MissingH/Parsec.hs testsrc/ConfigParser/Parsertest.hs
+
+
 2004-11-19 15:02:15 GMT	John Goerzen <jgoerzen at complete.org>	patch-99
 
     Summary:
diff --git a/libsrc/MissingH/ConfigParser/Lexer.hs b/libsrc/MissingH/ConfigParser/Lexer.hs
index fbcf8bb..14b885a 100644
--- a/libsrc/MissingH/ConfigParser/Lexer.hs
+++ b/libsrc/MissingH/ConfigParser/Lexer.hs
@@ -55,38 +55,39 @@ data CPTok = IGNOREDATA
 comment_chars = oneOf "#;"
 eol = string "\n" <|> string "\r\n" <|> string "\r" <?> "End of line"
 eoleof = eof <|> do {eol; return ()}
-optionsep = oneOf ":=" <?> "Option separator"
-whitespace_chars = oneOf " \t" <?> "Whitespace"
-comment_line = do skipMany whitespace_chars <?> "whitespace in comment"
+optionsep = oneOf ":=" <?> "option separator"
+whitespace_chars = oneOf " \t" <?> "whitespace"
+comment_line = do skipMany whitespace_chars
                   comment_chars             <?> "start of comment"
                   (many $ noneOf "\r\n")   <?> "content of comment"
                   eoleof
 eolstuff = (try comment_line) <|> (try empty_line)
-empty_line = do many whitespace_chars         <?> "empty line"
+empty_line = do many whitespace_chars
                 eoleof
+             <?> "empty line"
 sectheader_chars = noneOf "]\r\n"
 sectheader = do char '['
                 sname <- many1 $ sectheader_chars
                 char ']'
                 eolstuff
                 return sname
+             <?> "start of section"
 oname_chars = noneOf ":=\r\n"
 value_chars = noneOf "\r\n"
-extension_line = do
-                 many1 whitespace_chars
-                 c1 <- noneOf "\r\n#;"
-                 remainder <- many value_chars
-                 eolstuff
-                 return (c1 : remainder)
+extension_line = do many1 whitespace_chars
+                    c1 <- noneOf "\r\n#;"
+                    remainder <- many value_chars
+                    eolstuff
+                    return (c1 : remainder)
 
 optionkey = many1 oname_chars
 optionvalue = many1 value_chars
-optionpair = do
-             key <- optionkey
-             optionsep
-             value <- optionvalue
-             eolstuff
-             return (key, value)
+optionpair = do key <- optionkey
+                optionsep
+                value <- optionvalue
+                eolstuff
+                return (key, value)
+             <?> "key/value option"
 
 iloken :: Parser (GeneralizedToken CPTok)
 iloken =
@@ -98,7 +99,7 @@ iloken =
     <|> (do {sname <- sectheader; togtok $ NEWSECTION sname})
     <|> try (do {extension <- extension_line; togtok $ EXTENSIONLINE extension})
     <|> try (do {pair <- optionpair; togtok $ NEWOPTION pair})
-    <?> "Invalid syntax in configuration file"
+--    <?> "Invalid syntax in configuration file"
         
 loken :: Parser [GeneralizedToken CPTok]
 loken = do x <- manyTill iloken eof
diff --git a/libsrc/MissingH/Parsec.hs b/libsrc/MissingH/Parsec.hs
index e1e38b6..94eb206 100644
--- a/libsrc/MissingH/Parsec.hs
+++ b/libsrc/MissingH/Parsec.hs
@@ -54,26 +54,26 @@ togtok tok = do
 {- | Retrieve the next token from a 'GeneralizedToken' stream.
    The given function should return the value to use, or Nothing
    to cause an error. -}
-tokeng :: (a -> Maybe b) -> GeneralizedTokenParser a st b
+tokeng :: (Show a) => (a -> Maybe b) -> GeneralizedTokenParser a st b
 tokeng test =
-    token (show . fst) (fst) (test . snd)
+    token (show . snd) (fst) (test . snd)
 
 {- | A shortcut to 'tokeng'; the test here is just a function that returns
 a Bool.  If the result is true; return that value -- otherwise, an error.
 -}
-satisfyg :: (a -> Bool) -> GeneralizedTokenParser a st a
+satisfyg :: (Show a) => (a -> Bool) -> GeneralizedTokenParser a st a
 satisfyg test = tokeng (\t -> if test t then Just t else Nothing)
 
 {- | Matches one item in a list and returns it. -}
-oneOfg :: (Eq a) => [a] -> GeneralizedTokenParser a st a
+oneOfg :: (Eq a, Show a) => [a] -> GeneralizedTokenParser a st a
 oneOfg i = satisfyg (\x -> elem x i)
 
 {- | Matches all items and returns them -}
-allg :: GeneralizedTokenParser a st [a]
+allg :: (Show a) => GeneralizedTokenParser a st [a]
 allg = many $ satisfyg (\_ -> True)
 
 {- | Matches one item not in a list and returns it. -}
-noneOfg :: (Eq a) => [a] -> GeneralizedTokenParser a st a
+noneOfg :: (Eq a, Show a) => [a] -> GeneralizedTokenParser a st a
 noneOfg l = satisfyg (\x -> not (elem x l))
 
 {- | Matches one specific token and returns it. -}
diff --git a/testsrc/ConfigParser/Parsertest.hs b/testsrc/ConfigParser/Parsertest.hs
index 65c88da..bc3d01c 100644
--- a/testsrc/ConfigParser/Parsertest.hs
+++ b/testsrc/ConfigParser/Parsertest.hs
@@ -57,9 +57,10 @@ test_basic =
 
 test_asserts =
         do
+        {-
         assertRaises "e test1" (ErrorCall "Lexer: \"(string)\" (line 1, column 5):\nunexpected \"\\n\"\nexpecting Option separator")
                       ([] @=? parse_string "#foo\nthis is bad data")
-        
+        -}
         assertRaises "e test2" (ErrorCall "Lexer: \"(string)\" (line 2, column 9):\nunexpected \"\\n\"\nexpecting Option separator")
                      ([] @=? parse_string "[sect1]\n#iiiiii \n  extensionline\n#foo")
 
@@ -72,6 +73,6 @@ test_extensionlines =
                       ("quux", "asdf")])]
 
 tests = TestList [TestLabel "test_basic" (TestList test_basic),
---                  TestLabel "test_asserts" (TestCase test_asserts)
+                  TestLabel "test_asserts" (TestCase test_asserts),
                   TestLabel "test_extensionlines" (TestCase test_extensionlines)
                  ]
\ No newline at end of file

-- 
haskell-testpack