diff options
Diffstat (limited to 'src/Grasp')
-rw-r--r-- | src/Grasp/Parser.hs | 128 |
1 files changed, 100 insertions, 28 deletions
diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs index 129e08e..7b4f685 100644 --- a/src/Grasp/Parser.hs +++ b/src/Grasp/Parser.hs @@ -14,6 +14,7 @@ import Data.Graph.Inductive.Graph as Graph import Data.Graph.Inductive.Tree import Data.List import Data.Maybe +import Data.Char import qualified Data.Map as Map import Grasp.Types @@ -116,70 +117,141 @@ dup x = grasp = do string "digraph {" - whiteSpace - (n,e) <- stmtList ([],[]) + whiteSpac' + (n,e) <- stmtLis' ([],[]) string "}" - eol + eo' eof return (n,e) -stmtList (n,e) = - try (node >>= (\x -> stmtList (x:n,e)) ) - <|> try (edge >>= (\x -> stmtList (n,x:e)) ) +stmtLis' (n,e) = + try (nod' >>= (\x -> stmtLis' (x:n,e)) ) + <|> try (edg' >>= (\x -> stmtLis' (n,x:e)) ) <|> return (reverse n, reverse e) -node = do - i <- ident - l <- labelAttrib - whiteSpace +nod' = do + i <- iden' + l <- labelAttri' + whiteSpac' return (i,l) -edge = do - a <- ident - directedEdge - b <- ident - l <- labelAttrib - whiteSpace +edg' = do + a <- iden' + directedEdg' + b <- iden' + l <- labelAttri' + whiteSpac' return (a,b,l) -ident = do +iden' = do d <- some (noneOf " \t\r\n") - inLineWhSp + inLineWhS' return d -labelAttrib = do +labelAttri' = do char '[' - inLineWhSp + inLineWhS' string "label=\"" - l <- labelID + l <- labelI' char '\"' - inLineWhSp + inLineWhS' string "];" return l -labelID = some (noneOf "\"\r\n\\" <|> escapedChar) +labelI' = some (noneOf "\"\r\n\\" <|> escapedCha') -escapedChar = try (string "\\\"" >> return '\"') +escapedCha' = try (string "\\\"" >> return '\"') <|> try (string "\\\\" >> return '\\') -directedEdge = string "->" >> inLineWhSp +directedEdg' = string "->" >> inLineWhS' -inLineWhSp = many (oneOf "\t ") -whiteSpace = many (oneOf "\n\r\t ") +inLineWhS' = many (oneOf "\t ") +whiteSpac' = many (oneOf "\n\r\t ") -eol = try (string "\r\n") +eo' = try (string "\r\n") <|> try (string "\n\r") <|> try (string "\n") <|> try (string "\r") <?> "end of line" + + + +-- work in progress more complete DOT language parser below this point + +graspDOT = do + optional strict + graphType + ident + openBrace + (n,e) <- stmtList ([],[]) + closeBrace + eof + return (n,e) + + +strict = caseInsensitiveString "strict" + + +graphType = try (caseInsensitiveString "digraph") <?> "digraph" + + +ident = (try alphaNumString) + <|> (try numeral) + <|> (try quotedString) + <?> "ID" + + +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)) ) + <|> return (reverse n, reverse e) + + +-- todo +alphaNumString = return "a" + + +-- todo +numeral = return "0" + + +-- todo +quotedString = return "\"" + + +-- todo +node = return ("1","a") + + +-- todo +edge = return ("1","2","b") + + +-- todo +attr = return "" + + +-- todo +subgraph = return ([],[]) + + +openBrace = char '{' +closeBrace = char '}' + + +caseInsensitiveChar c = char (toLower c) <|> char (toUpper c) +caseInsensitiveString s = mapM caseInsensitiveChar s + |