From 812706747c66439616aebccc1ee5ad17dca5b1b4 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Mon, 24 Nov 2014 11:04:03 +1100
Subject: Now just returns a list each of GNodes and GEdges

---
 src/Grasp/Parser.hs | 141 ++++++++++++++++++++++++++--------------------------
 1 file changed, 71 insertions(+), 70 deletions(-)

diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs
index 06d4b59..8c0e4b4 100644
--- a/src/Grasp/Parser.hs
+++ b/src/Grasp/Parser.hs
@@ -4,17 +4,17 @@ module Grasp.Parser (
 
 
 import Control.Applicative( some )
+import Data.Char( toLower, toUpper )
 import Text.ParserCombinators.Parsec
-import qualified Grasp.Graph as G
+import Grasp.Types( Instruction(..), EdgeLabel(..), GNode(..), GEdge(..) )
 
 
 
 
-parseGrasp :: String -> Either ParseError GraspProgram
+parseGrasp :: String -> Either ParseError ([GNode],[GEdge])
 parseGrasp input =
-	parse removeComments "error" input >>=
-	parse graspDOT "error" >>=
-	return . G.construct
+    parse removeComments "error" input >>=
+    parse graspDOT "error"
 
 
 
@@ -42,29 +42,30 @@ thing = try (some (noneOf "\r\n\"/#"))
 
 
 singleLineComment =
-	    (string "//" >> many (noneOf "\r\n") >> return "")
-	<|> (string "#" >> many (noneOf "\r\n") >> return "")
+        (string "//" >> many (noneOf "\r\n") >> return "")
+    <|> (string "#" >> many (noneOf "\r\n") >> return "")
 
 
 multiLineComment = do
-	string "/*"
-	many (noneOf "*" <|> (char '*' >> notFollowedBy (char '/') >> return '*'))
-	return ""
+    string "/*"
+    many (noneOf "*" <|> (char '*' >> notFollowedBy (char '/') >> return '*'))
+    string "*/"
+    return ""
 
 
 
 -- parses a DOT graph language file into the data for a grasp program
 
 graspDOT = do
-	optional strict
-	graphType
-	optional ident
-	openBrace
-	(n,e) <- stmtList ([],[])
-	closeBrace
-	many blankLine
-	eof
-	return (n,e)
+    optional strict
+    graphType
+    optional ident
+    openBrace
+    (n,e) <- stmtList ([],[])
+    closeBrace
+    many blankLine
+    eof
+    return (n,e)
 
 
 strict = caseInsensitiveString "strict" >>= (\x -> whiteSpace >> return x)
@@ -80,21 +81,21 @@ ident = ((try alphaNumString)
 
 
 stmtList (n,e) =
-	    try (whiteSpace >> node >>= (\x -> stmtList (x:n,e)) )
-	<|> try (whiteSpace >> edge >>= (\x -> stmtList (n,x:e)) )
-	<|> try (whiteSpace >> attr >> stmtList (n,e))
-	<|> try (whiteSpace >> subgraph >>= (\(x,y) -> stmtList ((reverse x) ++ n, (reverse y) ++ e)) )
-	<|> try (blankLine >> stmtList (n,e))
-	<|> return (reverse n, reverse e)
+        try (whiteSpace >> node >>= (\x -> stmtList (x:n,e)) )
+    <|> try (whiteSpace >> edge >>= (\x -> stmtList (n,x:e)) )
+    <|> try (whiteSpace >> attr >> stmtList (n,e))
+    <|> try (whiteSpace >> 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
-	return (a:b)
+    a <- nonDigitChar
+    b <- many alphaNumChar
+    return (a:b)
 
 
 nonDigitChar = letter <|> char '_'
@@ -110,31 +111,31 @@ floatNum = do { a <- some digit; char '.'; b <- many digit; return (a ++ "." ++
 
 
 quotedString = do
-	char '\"'
-	s <- some quotedChar
-	char '\"'
-	return s
+    char '\"'
+    s <- some quotedChar
+    char '\"'
+    return s
 
 
 quotedChar = noneOf "\"\r\n" <|> try (char '\\' >> char '\"')
 
 
 node = do
-	n <- ident
-	a <- attrList
-	optional (char ';')
-	whiteSpace
-	return (n,a)
+    n <- ident
+    a <- attrList
+    optional (char ';')
+    whiteSpace
+    return (GNode (n, Instruction a))
 
 
 edge = do
-	a <- ident
-	edgeOp
-	b <- ident
-	c <- attrList
-	optional (char ';')
-	whiteSpace
-	return (a,b,c)
+    a <- ident
+    edgeOp
+    b <- ident
+    c <- attrList
+    optional (char ';')
+    whiteSpace
+    return (GEdge (a,b, EdgeLabel c))
 
 
 edgeOp = string "->" >> whiteSpace >> return "->"
@@ -147,44 +148,44 @@ attrType = (caseInsensitiveString "graph"
 
 
 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"
+    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"
 
 
 aList = do
-	openBracket
-	a <- many equAttr
-	closeBracket
-	whiteSpace
-	return a
+    openBracket
+    a <- many equAttr
+    closeBracket
+    whiteSpace
+    return a
 
 
 equAttr = do
-	e <- equ
-	optional (char ';' <|> char ',')
-	whiteSpace
-	return e
+    e <- equ
+    optional (char ';' <|> char ',')
+    whiteSpace
+    return e
 
 
 equ = do
-	a <- ident
-	equalsChar
-	b <- ident
-	return (a,b)
+    a <- ident
+    equalsChar
+    b <- ident
+    return (a,b)
 
 
 subgraph = do
-	optional (caseInsensitiveString "subgraph" >> optional ident)
-	openBrace
-	(n,e) <- stmtList ([],[])
-	closeBrace
-	optional (char ';')
-	whiteSpace
-	return (n,e)
+    optional (caseInsensitiveString "subgraph" >> optional ident)
+    openBrace
+    (n,e) <- stmtList ([],[])
+    closeBrace
+    optional (char ';')
+    whiteSpace
+    return (n,e)
 
 
 openBrace = char '{' >> whiteSpace >> return '{'
-- 
cgit