[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:38 UTC 2010
The following commit has been merged in the master branch:
commit c97c667d1e287ac75aeb208eb40b50ae1536685f
Author: John Goerzen <jgoerzen at complete.org>
Date: Fri Nov 19 03:08:19 2004 +0100
Removed separate lexer
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.5--patch-82)
diff --git a/ChangeLog b/ChangeLog
index fd677e9..d3e7e4c 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 20:08:19 GMT John Goerzen <jgoerzen at complete.org> patch-82
+
+ Summary:
+ Removed separate lexer
+ Revision:
+ missingh--head--0.5--patch-82
+
+
+ new files:
+ libsrc/MissingH/ConfigParser/Parser.hs
+
+ removed files:
+ libsrc/MissingH/ConfigParser/Lexer.hs
+ libsrc/MissingH/ConfigParser/Parser.hs
+
+ modified files:
+ ChangeLog testsrc/ConfigParser/Parsertest.hs
+
+
2004-11-18 19:37:22 GMT John Goerzen <jgoerzen at complete.org> patch-81
Summary:
diff --git a/libsrc/MissingH/ConfigParser/Lexer.hs b/libsrc/MissingH/ConfigParser/Lexer.hs
deleted file mode 100644
index 7096d03..0000000
--- a/libsrc/MissingH/ConfigParser/Lexer.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-{- 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 4291420..1efd389 100644
--- a/libsrc/MissingH/ConfigParser/Parser.hs
+++ b/libsrc/MissingH/ConfigParser/Parser.hs
@@ -1,4 +1,4 @@
-{- arch-tag: ConfigParser parser support
+{- arch-tag: ConfigParser parser
Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
This program is free software; you can redistribute it and/or modify
@@ -26,124 +26,143 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Stability : provisional
Portability: portable
-Parser support for "MissingH.ConfigParser". This module is not intended to be
+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.Parser
(
- parse_string, parse_file, parse_handle, ParseOutput
- --satisfyG,
- --main
+ -- -- * 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
+
+ CPTok(..),
+ parse_string, parse_file, parse_handle, ParseOutput
) 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)])]
-----------------------------------------------------------------------
--- Exported funcs
-----------------------------------------------------------------------
-
-parse_string :: String -> ParseOutput
-parse_string s =
- detokenize "(string)" $ parse loken "(string)" s
-
-parse_file :: FilePath -> IO ParseOutput
-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 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)])]
+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"
+
+ignore1 = eol
+ <|> try (do {comment_line; ignore1})
+ <|> do {empty_line; ignore1}
+ignorestuff = skipMany ignore1
+
+sectheader_chars = noneOf "]\r\n"
+sectheader = do ignorestuff
+ char '['
+ sname <- many1 $ sectheader_chars
+ char ']'
+ return sname
+oname_chars = noneOf ":=\r\n"
+value_chars = noneOf "\r\n"
+extension_line = do
+ ignorestuff
+ many1 whitespace_chars
+ c1 <- noneOf "\r\n#;"
+ remainder <- many value_chars
+ return (c1 : remainder)
+
+optionkey = many1 oname_chars
+optionvalue = many1 value_chars
+optionpair = do
+ ignorestuff
+ key <- optionkey
+ optionsep
+ value <- optionvalue
+ return (key, value)
+
+newsection = sectheader
+newoption = optionpair
+extension = extension_line
+
+main :: Parser [(String, [(String, String)])]
main =
- do {s <- sectionlist; return s}
- <|> try (do
- o <- optionlist
- s <- sectionlist
- return $ ("DEFAULT", o) : s
+ sectionlist
+ <|> 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)])
+ <|> do {o <- optionlist; return $ [("DEFAULT", o)]}
+ <?> "High-level error parsing config file"
+
+sectionlist =
+ do {eof; return []}
+ <|> try (do
+ s <- sectionhead
+ eof
+ return [(s, [])]
+ )
+ <|> do
+ s <- section
+ sl <- sectionlist
+ return (s : sl)
+
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}
+sectionhead = do {s <- newsection; return $ strip s}
-optionlist :: GenParser CPTok () [(String, String)]
-optionlist =
+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]}
+ try (do {x <- extension; l <- extensionlist; return $ x : l})
+ <|> do {x <- extension; 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))}
+ try (do o <- newoption
+ l <- extensionlist
+ return (strip (fst o), valmerge ((snd o) : l))
+ )
+ <|> do {o <- newoption; return $ (strip (fst o), strip (snd o))}
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 main "(string)" s
+
+parse_file :: FilePath -> IO ParseOutput
+parse_file f = do r <- parseFromFile main f
+ return (procparse f r)
+
+parse_handle :: Handle -> IO ParseOutput
+parse_handle h =
+ do s <- hGetContents h
+ let r = parse main (show h) s
+ return $ procparse "(Handle)" r
+
diff --git a/testsrc/ConfigParser/Parsertest.hs b/testsrc/ConfigParser/Parsertest.hs
index 5de1690..c517535 100644
--- a/testsrc/ConfigParser/Parsertest.hs
+++ b/testsrc/ConfigParser/Parsertest.hs
@@ -26,6 +26,7 @@ test_basic =
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" []
@@ -42,6 +43,7 @@ test_basic =
f "default1" "v1: o1\n[sect1]\nv2: o2" [("DEFAULT", [("v1", "o1")]),
("sect1", [("v2", "o2")])]
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" [])
@@ -58,6 +60,6 @@ test_extensionlines =
("baz", "l1\nl2\nl3"),
("quux", "asdf")])]
-tests = TestList [TestLabel "test_basic" (TestCase 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