diff options
Diffstat (limited to 'src/Grasp')
| -rw-r--r-- | src/Grasp/Parser.hs | 29 |
1 files changed, 17 insertions, 12 deletions
diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs index 47c6ae8..e7c920d 100644 --- a/src/Grasp/Parser.hs +++ b/src/Grasp/Parser.hs @@ -2,6 +2,7 @@ module Grasp.Parser ( GraspProgram(..), parseGrasp, + dup ) where @@ -9,6 +10,7 @@ import Control.Applicative( some ) import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Error import Text.Parsec.Pos +import Text.Read( readMaybe ) import Data.Graph.Inductive.Graph( Node, LNode, LEdge, (&) ) import Data.Graph.Inductive.Graph as Graph import Data.Graph.Inductive.Tree @@ -29,16 +31,16 @@ type StrLEdge a = (String,String,a) parseGrasp :: String -> Either ParseError GraspProgram parseGrasp input = - parse grasp "error" input >>= connected >>= nameCheck + parse grasp "error" input >>= sanityCheck >>= nameCheck >>= return . constructGraph -connected :: ([LNode String],[LEdge String]) -> Either ParseError ([LNode String],[LEdge String]) -connected (nodeList, edgeList) = Right (nodeList, edgeList) +sanityCheck :: ([LNode String],[LEdge String]) -> Either ParseError ([LNode String],[LEdge String]) +sanityCheck (nodeList, edgeList) = Right (nodeList, edgeList) -nameCheck :: ([LNode String],[LEdge String]) -> Either ParseError GraspProgram +nameCheck :: ([LNode String],[LEdge String]) -> Either ParseError ([LNode String],[LEdge String]) nameCheck (nodeList, edgeList) = let nameEdges = filter (\(_,_,z) -> z == "name") edgeList @@ -53,13 +55,13 @@ nameCheck (nodeList, edgeList) = c = graspMainPresent namedNodes in case (a,b,c) of - (Nothing,Nothing,True) -> Right (constructGraph nodeList edgeList) + (Just x,_,_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has multiple names")) (newPos "" 0 0)) - (Nothing,Nothing,False) -> Left (newErrorMessage (Message "could not find grasp:main") (newPos "" 0 0)) + (_,Just x,_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has a numeric name")) (newPos "" 0 0)) - (Nothing,Just x,_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has a numeric name")) (newPos "" 0 0)) + (_,_,False) -> Left (newErrorMessage (Message "could not find grasp:main") (newPos "" 0 0)) - (Just x,_,_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has multiple names")) (newPos "" 0 0)) + (_,_,_) -> Right (nodeList, edgeList) @@ -69,7 +71,10 @@ multiNames = dup . (map fst) nonStringNames :: [(LNode String, String)] -> Maybe (LNode String) -nonStringNames x = Nothing +nonStringNames nodeList = + let f x = readMaybe x :: Maybe Float + nonStringNames = filter (isJust . f . snd) nodeList + in if (nonStringNames == []) then Nothing else Just (fst . head $ nonStringNames) @@ -78,12 +83,12 @@ graspMainPresent = any (\x -> snd x == "grasp:main") -constructGraph :: [LNode String] -> [LEdge String] -> GraspProgram -constructGraph = Graph.mkGraph +constructGraph :: ([LNode String],[LEdge String]) -> GraspProgram +constructGraph = uncurry Graph.mkGraph -dup :: [a] -> Maybe a +dup :: (Eq a) => [a] -> Maybe a dup x = let dup' [] _ = Nothing dup' (x:xs) s = if (x `elem` s) then Just x else dup' xs (x:s) |