From 54a7ae48ca42198d8eb72498af36ecbe1ece2678 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 3 May 2014 21:58:16 +1000 Subject: Parser now handles nodes with arbitrary names instead of just numbers --- src/Grasp/Parser.hs | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs index 9bea358..42af644 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 qualified Data.Map as Map import Grasp.Types @@ -34,12 +35,12 @@ parseGrasp input = -sanityCheck :: ([LNode String],[LEdge String]) -> Either ParseError ([LNode String],[LEdge String]) +sanityCheck :: GraspData -> Either ParseError GraspData sanityCheck (nodeList, edgeList) = Right (nodeList, edgeList) -nameCheck :: ([LNode String],[LEdge String]) -> Either ParseError ([LNode String],[LEdge String]) +nameCheck :: GraspData -> Either ParseError GraspData nameCheck (nodeList, edgeList) = let nameEdges = filter (\(_,_,z) -> z == "name") edgeList @@ -64,12 +65,12 @@ nameCheck (nodeList, edgeList) = -multiNames :: [(LNode String, String)] -> Maybe (LNode String) +multiNames :: [(StrLNode String, String)] -> Maybe (StrLNode String) multiNames = dup . (map fst) -nonStringNames :: [(LNode String, String)] -> Maybe (LNode String) +nonStringNames :: [(StrLNode String, String)] -> Maybe (StrLNode String) nonStringNames nodeList = let f x = readMaybe x :: Maybe Float nonStringNames = filter (isJust . f . snd) nodeList @@ -77,13 +78,19 @@ nonStringNames nodeList = -graspMainPresent :: [(LNode String, String)] -> Bool +graspMainPresent :: [(StrLNode String, String)] -> Bool graspMainPresent = any (\x -> snd x == "grasp:main") -constructGraph :: ([LNode String],[LEdge String]) -> GraspProgram -constructGraph = uncurry Graph.mkGraph +constructGraph :: GraspData -> GraspProgram +constructGraph (sn, se) = + let strNodeList = map fst sn + nmap = Map.fromList (zip strNodeList [1..]) + change x = fromJust (Map.lookup x nmap) + n = map (\(x,y) -> (change x, y)) sn + e = map (\(x,y,z) -> (change x, change y, z)) se + in Graph.mkGraph n e @@ -131,7 +138,7 @@ edge = do ident = do d <- some digit inLineWhSp - return (read d) + return d labelAttrib = do -- cgit