[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 14:47:47 UTC 2010
The following commit has been merged in the master branch:
commit da1285e9680b3c5d6a6737c59d6cfed30fb7d75d
Author: John Goerzen <jgoerzen at complete.org>
Date: Fri Nov 19 05:48:59 2004 +0100
Backed out patch-82 through patch-89; going back to separate lexer
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.5--patch-90)
diff --git a/ChangeLog b/ChangeLog
index 019ea85..45ebf7d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,25 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
#
+2004-11-18 22:48:59 GMT John Goerzen <jgoerzen at complete.org> patch-90
+
+ Summary:
+ Backed out patch-82 through patch-89; going back to separate lexer
+ Revision:
+ missingh--head--0.5--patch-90
+
+
+ new files:
+ libsrc/MissingH/ConfigParser/Lexer.hs
+ libsrc/MissingH/ConfigParser/Parser.hs
+
+ removed files:
+ libsrc/MissingH/ConfigParser/Parser.hs
+
+ modified files:
+ ChangeLog testsrc/ConfigParser/Parsertest.hs
+
+
2004-11-18 22:13:17 GMT John Goerzen <jgoerzen at complete.org> patch-89
Summary:
diff --git a/libsrc/MissingH/ConfigParser/Lexer.hs b/libsrc/MissingH/ConfigParser/Lexer.hs
new file mode 100644
index 0000000..7096d03
--- /dev/null
+++ b/libsrc/MissingH/ConfigParser/Lexer.hs
@@ -0,0 +1,96 @@
+{- arch-tag: ConfigParser lexer support
+Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : MissingH.ConfigParser.Lexer
+ Copyright : Copyright (C) 2004 John Goerzen
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John Goerzen,
+ Maintainer : jgoerzen at complete.org
+ Stability : provisional
+ Portability: portable
+
+Lexer support for "MissingH.ConfigParser". This module is not intended to be
+used directly by your programs.
+
+Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
+-}
+module MissingH.ConfigParser.Lexer
+(
+ -- -- * Temporary for testing
+ --comment_chars, eol, optionsep, whitespace_chars, comment_line,
+ --empty_line, sectheader_chars, sectheader, oname_chars, value_chars,
+ --extension_line, optionkey, optionvalue, optionpair
+ loken,
+ CPTok(..)
+) where
+
+import Text.ParserCombinators.Parsec
+import MissingH.Parsec
+
+data CPTok = EOFTOK
+ | NEWSECTION String
+ | NEWSECTION_EOF String
+ | EXTENSIONLINE String
+ | NEWOPTION (String, String)
+ deriving (Eq, Show, Ord)
+
+comment_chars = oneOf "#;"
+eol = string "\n" <|> string "\r\n" <|> string "\r" <?> "End of line"
+optionsep = oneOf ":=" <?> "Option separator"
+whitespace_chars = oneOf " \t" <?> "Whitespace"
+comment_line = do skipMany whitespace_chars <?> "whitespace in comment"
+ comment_chars <?> "start of comment"
+ (many1 $ noneOf "\r\n") <?> "content of comment"
+empty_line = many1 whitespace_chars <?> "empty line"
+sectheader_chars = noneOf "]\r\n"
+sectheader = do char '['
+ sname <- many1 $ sectheader_chars
+ char ']'
+ return sname
+oname_chars = noneOf ":=\r\n"
+value_chars = noneOf "\r\n"
+extension_line = do
+ many1 whitespace_chars
+ c1 <- noneOf "\r\n#;"
+ remainder <- many value_chars
+ return (c1 : remainder)
+
+optionkey = many1 oname_chars
+optionvalue = many1 value_chars
+optionpair = do
+ key <- optionkey
+ optionsep
+ value <- optionvalue
+ return (key, value)
+
+loken :: Parser [CPTok]
+loken =
+ -- Ignore these things
+ do {eol; loken}
+ <|> try (do {comment_line; loken})
+ <|> try (do {empty_line; loken})
+
+ -- Real stuff
+ <|> (do {sname <- sectheader; next <- loken; return $ NEWSECTION sname : next})
+ <|> try (do {pair <- optionpair; next <- loken; return $ NEWOPTION pair : next})
+ <|> (do {extension <- extension_line; next <- loken; return $ EXTENSIONLINE extension : next})
+ <|> do {eof; return [EOFTOK]}
+ <?> "Invalid syntax in configuration file"
+
diff --git a/libsrc/MissingH/ConfigParser/Parser.hs b/libsrc/MissingH/ConfigParser/Parser.hs
index 30f3213..4291420 100644
--- a/libsrc/MissingH/ConfigParser/Parser.hs
+++ b/libsrc/MissingH/ConfigParser/Parser.hs
@@ -1,4 +1,4 @@
-{- arch-tag: ConfigParser parser
+{- arch-tag: ConfigParser parser support
Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
This program is free software; you can redistribute it and/or modify
@@ -26,129 +26,124 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Stability : provisional
Portability: portable
-Lexer support for "MissingH.ConfigParser". This module is not intended to be
+Parser support for "MissingH.ConfigParser". This module is not intended to be
used directly by your programs.
Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
-}
module MissingH.ConfigParser.Parser
(
- parse_string, parse_file, parse_handle, ParseOutput
+ parse_string, parse_file, parse_handle, ParseOutput
+ --satisfyG,
+ --main
) where
-
import Text.ParserCombinators.Parsec
-import MissingH.Parsec
import MissingH.Str
+import MissingH.ConfigParser.Lexer
import System.IO(Handle, hGetContents)
type ParseOutput = [(String, [(String, String)])]
-comment_chars = oneOf "#;" <?> "Comment character"
-eol = string "\n" <|> string "\r\n" <|> string "\r" <?> "End of line"
-eoleof = eol <|> do {eof; return ""}
-optionsep = oneOf ":=" <?> "option separator"
-whitespace_chars = oneOf " \t" <?> "whitespace"
-comment_line = do skipMany whitespace_chars <?> "whitespace in comment"
- comment_chars <?> "start of comment"
- (many $ noneOf "\r\n") <?> "content of comment"
- eoleof
-
-empty_line = do skipMany whitespace_chars
- eoleof
-
-ignore1 = (try comment_line) <|> (try empty_line)
- <?> "an item to ignore"
-ignorestuff = eof
- <|> do {ignore1; ignorestuff}
- <|> return ()
-
-sectheader_chars = noneOf "]\r\n"
-sectheader = do ignorestuff
- char '['
- sname <- many1 $ sectheader_chars
- char ']'
- ignore1
- return sname
- <?> "section header"
-oname_chars = noneOf ":=\r\n"
-value_chars = noneOf "\r\n"
-extension_line = do many1 whitespace_chars
- c1 <- noneOf "\r\n#;"
- remainder <- many value_chars
- eoleof
- return (c1 : remainder)
- <?> "extension line"
-
-optionkey = many1 oname_chars <?> "option key"
-optionvalue = many1 value_chars <?> "option value"
-optionpair = do ignorestuff
- key <- optionkey
- optionsep
- value <- optionvalue
- eoleof
- return (key, value)
- <?> "option pair"
-
-parsemain :: Parser [(String, [(String, String)])]
-parsemain =
- try sectionlist
- <|> try (do o <- optionlist
- s <- sectionlist
- return $ ("DEFAULT", o) : s
- )
- <|> do {o <- optionlist; return $ [("DEFAULT", o)]}
- <?> "High-level error parsing config file"
-
-sectionlist =
- try (do {ignorestuff; eof; return []})
- <|> try (do
- s <- sectionhead
- ignorestuff
- eof
- return [(s, [])]
- )
- <|> do
- s <- section
- sl <- sectionlist
- return (s : sl)
-
-section = do {sh <- sectionhead; ol <- optionlist; return (sh, ol)}
-
-sectionhead = do {s <- sectheader; return $ strip s}
- <?> "start of section"
-
-optionlist = many1 (try coption)
-
-coption = do o <- optionpair
- l <- many (try extension_line)
- return (strip (fst o), valmerge ((snd o) : l))
- <?> "an option"
-
-valmerge :: [String] -> String
-valmerge vallist =
- let vl2 = map strip vallist
- in join "\n" vl2
-
-procparse fp l =
- case l of
- Left err -> error (show err)
- Right reply -> reply
-
----------------------------------------------------------------------
-- Exported funcs
----------------------------------------------------------------------
parse_string :: String -> ParseOutput
parse_string s =
- procparse "(string)" $ parse parsemain "(string)" s
+ detokenize "(string)" $ parse loken "(string)" s
parse_file :: FilePath -> IO ParseOutput
-parse_file f = do r <- parseFromFile parsemain f
- return (procparse f r)
+parse_file f =
+ do o <- parseFromFile loken f
+ return $ detokenize f o
parse_handle :: Handle -> IO ParseOutput
parse_handle h =
do s <- hGetContents h
- let r = parse parsemain (show h) s
- return $ procparse "(Handle)" r
+ let o = parse loken (show h) s
+ return $ detokenize (show h) o
+
+----------------------------------------------------------------------
+-- Private funcs
+----------------------------------------------------------------------
+detokenize fp l =
+ let r = case l of
+ Left err -> error $ "Lexer: " ++ (show err)
+ Right reply -> reply
+ in
+ case runParser main () fp r of
+ Left err -> error $ "Parser: " ++ (show err)
+ Right reply -> reply
+
+main :: GenParser CPTok () [(String, [(String, String)])]
+main =
+ do {s <- sectionlist; return s}
+ <|> try (do
+ o <- optionlist
+ s <- sectionlist
+ return $ ("DEFAULT", o) : s
+ )
+ <|> do {o <- optionlist; return $ [("DEFAULT", o)] }
+ <?> "Error parsing config file tokens"
+
+satisfyG :: (CPTok -> Bool) -> GenParser CPTok () CPTok
+satisfyG f = tokenPrim (\c -> show [c])
+ (\pos _ _ -> pos)
+ (\c -> if f c then Just c else Nothing)
+
+want :: (CPTok -> Maybe a) -> GenParser CPTok () a
+want f = tokenPrim (\c -> show [c])
+ (\pos _ _ -> pos)
+ (\c -> f c)
+
+sectionlist :: GenParser CPTok () [(String, [(String, String)])]
+sectionlist = do {satisfyG (==EOFTOK); return []}
+ <|> try (do
+ s <- sectionhead
+ satisfyG (==EOFTOK)
+ return [(s, [])]
+ )
+ <|> do
+ s <- section
+ sl <- sectionlist
+ return (s : sl)
+
+section :: GenParser CPTok () (String, [(String, String)])
+section = do {sh <- sectionhead; ol <- optionlist; return (sh, ol)}
+sectionhead :: GenParser CPTok () String
+sectionhead =
+ let wf (NEWSECTION x) = Just x
+ wf _ = Nothing
+ in
+ do {s <- want wf; return $ strip s}
+
+optionlist :: GenParser CPTok () [(String, String)]
+optionlist =
+ try (do {c <- coption; ol <- optionlist; return $ c : ol})
+ <|> do {c <- coption; return $ [c]}
+
+extensionlist :: GenParser CPTok () [String]
+extensionlist =
+ let wf (EXTENSIONLINE x) = Just x
+ wf _ = Nothing
+ in
+ try (do {x <- want wf; l <- extensionlist; return $ x : l})
+ <|> do {x <- want wf; return [x]}
+
+coption :: GenParser CPTok () (String, String)
+coption =
+ let wf (NEWOPTION x) = Just x
+ wf _ = Nothing
+ in
+ try (do
+ o <- want wf
+ l <- extensionlist
+ return (strip (fst o), valmerge ((snd o) : l ))
+ )
+ <|> do {o <- want wf; return $ (strip (fst o), strip (snd o))}
+
+valmerge :: [String] -> String
+valmerge vallist =
+ let vl2 = map strip vallist
+ in join "\n" vl2
diff --git a/testsrc/ConfigParser/Parsertest.hs b/testsrc/ConfigParser/Parsertest.hs
index 72f9ce4..5de1690 100644
--- a/testsrc/ConfigParser/Parsertest.hs
+++ b/testsrc/ConfigParser/Parsertest.hs
@@ -23,31 +23,25 @@ import Testutil
import Control.Exception
test_basic =
- let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" exp (parse_string inp) in
- [
+ let f msg inp exp = assertEqual msg exp (parse_string inp) in
+ do
f "empty string" "" []
-
- ,f "one empty line" "\n" []
- ,f "one comment line" "#foo bar" []
- ,f "one comment line with eol" "#foo bar\n" []
- ,f "one empty section" "[emptysect]" [("emptysect", [])]
- ,f "one empty section w/eol" "[emptysect]\n" [("emptysect", [])]
- ,f "comment and empty sect noeol" "#foo bar\n[emptysect]"
- [("emptysect", [])]
- ,f "comment and empty sect" "#foo bar\n[emptysect]\n" [("emptysect", [])]
- ,f "comments2" "# [nonexistant]\n[emptysect]\n" [("emptysect", [])]
- ,f "comments3" "#fo\n[Cemptysect]\n#asdf boo\n \n # fnonexistantg"
+ f "one empty line" "\n" []
+ f "one comment line" "#foo bar" []
+ f "one comment line with eol" "#foo bar\n" []
+ f "one empty section" "[emptysect]" [("emptysect", [])]
+ f "comment and empty sect" "#foo bar\n[emptysect]\n" [("emptysect", [])]
+ f "comments2" "# [nonexistant]\n[emptysect]\n" [("emptysect", [])]
+ f "comments3" "#fo\n[Cemptysect]\n#asdf boo\n \n # fnonexistantg"
[("Cemptysect", [])]
- ,f "comments4" "[emptysect]\n# [nonexistant]\n" [("emptysect", [])]
- ,f "simple section" "[sect1]\nfoo: bar\n" [("sect1", [("foo", "bar")])]
- ,f "comments5" "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2: v2\no3: v3"
- [("sect1", [("o1", "v1"), ("o2", "v2"), ("o3", "v3")])]
- ,f "comments5eol" "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2: v2\no3: v3\n"
+ f "comments4" "[emptysect]\n# [nonexistant]\n" [("emptysect", [])]
+ f "simple section" "[sect1]\nfoo: bar\n" [("sect1", [("foo", "bar")])]
+ f "comments5" "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2: v2\n o3: v3"
[("sect1", [("o1", "v1"), ("o2", "v2"), ("o3", "v3")])]
- ,f "default1" "v1: o1\n[sect1]\nv2: o2" [("DEFAULT", [("v1", "o1")]),
+ f "default1" "v1: o1\n[sect1]\nv2: o2" [("DEFAULT", [("v1", "o1")]),
("sect1", [("v2", "o2")])]
- ,f "simple default" "foo: bar" [("DEFAULT", [("foo", "bar")])]
+ f "simple default" "foo: bar" [("DEFAULT", [("foo", "bar")])]
{-
assertRaises "e test1" (ErrorCall "Lexer: \"(string)\" (line 1, column 5):\nunexpected \"\\n\"\nexpecting Option separator")
(f "" "#foo\nthis is bad data" [])
@@ -55,7 +49,6 @@ test_basic =
assertRaises "e test2" (ErrorCall "Lexer: \"(string)\" (line 2, column 9):\nunexpected \"\\n\"\nexpecting Option separator")
(f "" "[sect1]\n#iiiiii \n extensionline\n#foo" [])
-}
- ]
test_extensionlines =
let f inp exp = exp @=? parse_string inp in
@@ -65,6 +58,6 @@ test_extensionlines =
("baz", "l1\nl2\nl3"),
("quux", "asdf")])]
-tests = TestList [TestLabel "test_basic" (TestList test_basic)
--- TestLabel "test_extensionlines" (TestCase test_extensionlines)
+tests = TestList [TestLabel "test_basic" (TestCase test_basic),
+ TestLabel "test_extensionlines" (TestCase test_extensionlines)
]
\ No newline at end of file
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list