summaryrefslogtreecommitdiff
path: root/src/Grasp
diff options
context:
space:
mode:
Diffstat (limited to 'src/Grasp')
-rw-r--r--src/Grasp/Parser.hs128
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
+