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