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(-)

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