Further progress on checking for parse errors

1 files changed, 46 insertions, 18 deletions

diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs
index 5c2c83c..47c6ae8 100644
--- a/src/Grasp/Parser.hs
+++ b/src/Grasp/Parser.hs
@@ -12,54 +12,82 @@ import Text.Parsec.Pos
 import Data.Graph.Inductive.Graph( Node, LNode, LEdge, (&) )
 import Data.Graph.Inductive.Graph as Graph
 import Data.Graph.Inductive.Tree
+import Data.List
+import Data.Maybe
 
 
 
 
 type GraspProgram = Gr String String
 
+type StrLNode a = (String,a)
+
+type StrLEdge a = (String,String,a)
+
 
 
 
 parseGrasp :: String -> Either ParseError GraspProgram
-parseGrasp input = parse grasp "error" input >>= validate
+parseGrasp input =
+	parse grasp "error" input >>= connected >>= nameCheck
+
 
 
+connected :: ([LNode String],[LEdge String]) -> Either ParseError ([LNode String],[LEdge String])
+connected (nodeList, edgeList) = Right (nodeList, edgeList)
 
-validate :: ([LNode String],[LEdge String]) -> Either ParseError GraspProgram
-validate (nodeList, edgeList) =
+
+
+nameCheck :: ([LNode String],[LEdge String]) -> Either ParseError GraspProgram
+nameCheck (nodeList, edgeList) =
 	let nameEdges = filter (\(_,_,z) -> z == "name") edgeList
 
-	    nameNodes = map (\(_,x,_) -> x) nameEdges
-	    nameLNodes = filter (\(x,_) -> x `elem` nameNodes) nodeList
+        -- designed to convert the edges into (lnode,name) pairs
+	    findNode n l = find (\(x,_) -> x == n) l
+	    mapFunc (x,y,_) = (fromJust (findNode x nodeList), snd . fromJust $ (findNode y nodeList))
+
+	    namedNodes = map mapFunc nameEdges
 
-	    a = multiNames nameEdges
-	    b = nonStringNames nameLNodes
-	    c = noGraspMain nameLNodes
+	    a = multiNames namedNodes
+	    b = nonStringNames namedNodes
+	    c = graspMainPresent namedNodes
 
 	in case (a,b,c) of
-		([],[],False) -> Right (Graph.mkGraph nodeList edgeList)
+		(Nothing,Nothing,True) -> Right (constructGraph nodeList edgeList)
+
+		(Nothing,Nothing,False) -> Left (newErrorMessage (Message "could not find grasp:main") (newPos "" 0 0))
+
+		(Nothing,Just x,_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has a numeric name")) (newPos "" 0 0))
+
+		(Just x,_,_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has multiple names")) (newPos "" 0 0))
+
+
+
+multiNames :: [(LNode String, String)] -> Maybe (LNode String)
+multiNames = dup . (map fst)
 
-		([],[],True) -> Left (newErrorMessage (Message "could not find grasp:main") (newPos "" 0 0))
 
-		([],(x:_),_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has a numeric name")) (newPos "" 0 0))
 
-		((x:_),_,_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has multiple names")) (newPos "" 0 0))
+nonStringNames :: [(LNode String, String)] -> Maybe (LNode String)
+nonStringNames x = Nothing
 
 
 
-multiNames :: [LEdge String] -> [LNode String]
-multiNames x = []
+graspMainPresent :: [(LNode String, String)] -> Bool
+graspMainPresent = any (\x -> snd x == "grasp:main")
 
 
 
-nonStringNames :: [LNode String] -> [LNode String]
-nonStringNames x = []
+constructGraph :: [LNode String] -> [LEdge String] -> GraspProgram
+constructGraph = Graph.mkGraph
 
 
 
-noGraspMain :: [LNode String] -> Bool
-noGraspMain x = False
+dup :: [a] -> Maybe a
+dup x =
+	let dup' [] _ = Nothing
+	    dup' (x:xs) s = if (x `elem` s) then Just x else dup' xs (x:s)
+	in dup' x []