From ad5753341c15632ddeac36f7bce38a259637887d Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Sun, 4 May 2014 14:03:45 +1000
Subject: Near completion of improved DOT language based grasp parser
---
src/Grasp/Parser.hs | 92 ++++++++++++++++++++++++++++++++++++++++++++---------
1 file changed, 77 insertions(+), 15 deletions(-)
(limited to 'src/Grasp')
diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs
index 7b4f685..0e6f8e3 100644
--- a/src/Grasp/Parser.hs
+++ b/src/Grasp/Parser.hs
@@ -216,40 +216,102 @@ stmtList (n,e) =
try (node >>= (\x -> stmtList (x:n,e)) )
<|> try (edge >>= (\x -> stmtList (n,x:e)) )
<|> try (attr >> stmtList (n,e))
- <|> try (subgraph >>= (\(x,y) -> stmtList (x ++ n, y ++ e)) )
+ <|> try (subgraph >>= (\(x,y) -> stmtList ((reverse x) ++ n, (reverse y) ++ e)) )
<|> return (reverse n, reverse e)
--- todo
-alphaNumString = return "a"
+alphaNumString = do
+ a <- nonDigitChar
+ b <- many alphaNumChar
+ return (a:b)
--- todo
-numeral = return "0"
+nonDigitChar = letter <|> char '_'
+alphaNumChar = alphaNum <|> char '_'
--- todo
-quotedString = return "\""
+numeral = try negativeNum <|> positiveNum
+negativeNum = char '-' >> positiveNum >>= return . ('-':)
+positiveNum = try pointNum <|> try floatNum <|> wholeNum
+pointNum = char '.' >> some digit >>= return . ('.':)
+wholeNum = some digit
+floatNum = do { a <- some digit; char '.'; b <- many digit; return (a ++ "." ++ b)}
--- todo
-node = return ("1","a")
+quotedString = do
+ char '\"'
+ s <- some quotedChar
+ char '\"'
+ return s
+
+
+quotedChar = noneOf "\"\r\n" <|> try (char '\\' >> char '\"')
+
+
+node = do
+ n <- ident
+ a <- attrList
+ return (n,a)
+
+
+edge = do
+ a <- ident
+ edgeOp
+ b <- ident
+ c <- attrList
+ return (a,b,c)
+
+
+edgeOp = string "->"
--- todo
-edge = return ("1","2","b")
+attr = attrType >> attrList
+attrType = caseInsensitiveString "graph"
+ <|> caseInsensitiveString "node"
+ <|> caseInsensitiveString "edge"
--- todo
-attr = return ""
+attrList = do
+ a <- many aList
+ let r = filter (\x -> fst x == "label") (concat a)
+ case (length r) of
+ 0 -> fail "expected node/edge label"
+ 1 -> return . snd . head $ r
+ _ -> fail "unexpected multiple labels for single node/edge"
--- todo
-subgraph = return ([],[])
+aList = do
+ openBracket
+ a <- many equAttr
+ closeBracket
+ return a
+
+
+equAttr = do
+ e <- equ
+ optional (char ';' <|> char ',')
+ return e
+
+
+equ = do
+ a <- ident
+ char '='
+ b <- ident
+ return (a,b)
+
+
+subgraph = do
+ optional (caseInsensitiveString "subgraph" >> optional ident)
+ openBrace
+ (n,e) <- stmtList ([],[])
+ closeBrace
+ return (n,e)
openBrace = char '{'
closeBrace = char '}'
+openBracket = char '['
+closeBracket = char ']'
caseInsensitiveChar c = char (toLower c) <|> char (toUpper c)
--
cgit