diff options
Diffstat (limited to 'src/Grasp')
-rw-r--r-- | src/Grasp/Parser.hs | 64 |
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 [] |