From b7d88e8bd9cf29976514c1bf5efa172b72cd5afa Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Sun, 4 May 2014 23:30:13 +1000
Subject: Improved parser almost complete, needs whitespace handling
---
src/Grasp/Parser.hs | 66 +++++++++++++++++++++++++++++++++++++++++++----------
1 file changed, 54 insertions(+), 12 deletions(-)
(limited to 'src')
diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs
index 0e6f8e3..534e211 100644
--- a/src/Grasp/Parser.hs
+++ b/src/Grasp/Parser.hs
@@ -187,12 +187,43 @@ eo' = try (string "\r\n")
+
+removeComments = gline `sepEndBy` eol >>= return . concat
+
+
+eol = try (string "\r\n")
+ <|> try (string "\n\r")
+ <|> try (string "\n")
+ <|> try (string "\r")
+ <?> "end of line"
+
+
+gline = many thing >>= return . concat
+
+
+thing = try (some (noneOf "\r\n\"/#"))
+ <|> try (quotedString >>= return . ("\"" ++) . (++ "\""))
+ <|> try singleLineComment
+ <|> try multiLineComment
+ <|> (anyChar >>= return . (:[]) )
+
+
+singleLineComment =
+ (string "//" >> many (noneOf "\r\n") >> return "")
+ <|> (string "#" >> many (noneOf "\r\n") >> return "")
+
+
+multiLineComment = do
+ string "/*"
+ many (noneOf "*" <|> (char '*' >> notFollowedBy (char '/') >> return '*'))
+ return ""
+
-- work in progress more complete DOT language parser below this point
graspDOT = do
optional strict
graphType
- ident
+ optional ident
openBrace
(n,e) <- stmtList ([],[])
closeBrace
@@ -200,15 +231,15 @@ graspDOT = do
return (n,e)
-strict = caseInsensitiveString "strict"
+strict = caseInsensitiveString "strict" >>= (\x -> whiteSpace >> return x)
-graphType = try (caseInsensitiveString "digraph") <?> "digraph"
+graphType = try (caseInsensitiveString "digraph" >>= (\x -> whiteSpace >> return x)) <?> "digraph"
-ident = (try alphaNumString)
- <|> (try numeral)
- <|> (try quotedString)
+ident = ((try alphaNumString)
+ <|> (try numeral)
+ <|> (try quotedString)) >>= (\x -> whiteSpace >> return x)
<?> "ID"
@@ -217,9 +248,13 @@ stmtList (n,e) =
<|> try (edge >>= (\x -> stmtList (n,x:e)) )
<|> try (attr >> stmtList (n,e))
<|> try (subgraph >>= (\(x,y) -> stmtList ((reverse x) ++ n, (reverse y) ++ e)) )
+ <|> try (blankLine >> stmtList (n,e))
<|> return (reverse n, reverse e)
+blankLine = whiteSpace >> eol
+
+
alphaNumString = do
a <- nonDigitChar
b <- many alphaNumChar
@@ -262,7 +297,7 @@ edge = do
return (a,b,c)
-edgeOp = string "->"
+edgeOp = string "->" >> whiteSpace >> return "->"
attr = attrType >> attrList
@@ -284,18 +319,20 @@ aList = do
openBracket
a <- many equAttr
closeBracket
+ whiteSpace
return a
equAttr = do
e <- equ
optional (char ';' <|> char ',')
+ whiteSpace
return e
equ = do
a <- ident
- char '='
+ equalsChar
b <- ident
return (a,b)
@@ -305,15 +342,20 @@ subgraph = do
openBrace
(n,e) <- stmtList ([],[])
closeBrace
+ whiteSpace
return (n,e)
-openBrace = char '{'
-closeBrace = char '}'
-openBracket = char '['
-closeBracket = char ']'
+openBrace = char '{' >> whiteSpace >> return '{'
+closeBrace = char '}' >> whiteSpace >> return '}'
+openBracket = char '[' >> whiteSpace >> return '['
+closeBracket = char ']' >> whiteSpace >> return ']'
+equalsChar = char '='
caseInsensitiveChar c = char (toLower c) <|> char (toUpper c)
caseInsensitiveString s = mapM caseInsensitiveChar s
+
+whiteSpace = many (oneOf " \t")
+
--
cgit