diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Grasp/Parser.hs | 106 |
1 files changed, 3 insertions, 103 deletions
diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs index 8d6097f..06d4b59 100644 --- a/src/Grasp/Parser.hs +++ b/src/Grasp/Parser.hs @@ -1,31 +1,11 @@ module Grasp.Parser ( - parseGrasp, - dup + parseGrasp ) where 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 -import Data.List -import Data.Maybe -import Data.Char -import qualified Data.Map as Map -import Grasp.Types - - - - -type StrLNode a = (String,a) - -type StrLEdge a = (String,String,a) - -type GraspData = ([StrLNode String],[StrLEdge String]) +import qualified Grasp.Graph as G @@ -34,87 +14,7 @@ parseGrasp :: String -> Either ParseError GraspProgram parseGrasp input = parse removeComments "error" input >>= parse graspDOT "error" >>= - sanityCheck >>= - nameCheck >>= - return . constructGraph - - - -sanityCheck :: GraspData -> Either ParseError GraspData -sanityCheck (nodeList, edgeList) = - let n = map fst nodeList - - a = multiCheck nodeList - b = filter (\(x,y,_) -> x `notElem` n || y `notElem` n) edgeList - - in case (a,b) of - (Just x,_) -> Left (newErrorMessage (Message ("multiple declaration of node " ++ (show x))) (newPos "" 0 0)) - - (_,(x:_)) -> Left (newErrorMessage (Message ("edge " ++ (show x) ++ " is unconnected")) (newPos "" 0 0)) - - _ -> Right (nodeList, edgeList) - - - -nameCheck :: GraspData -> Either ParseError GraspData -nameCheck (nodeList, edgeList) = - let nameEdges = filter (\(_,_,z) -> z == "name") edgeList - - -- 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 = multiCheck namedNodes - b = nonStringNames namedNodes - c = graspMainPresent namedNodes - - in case (a,b,c) of - (Just x,_,_) -> Left (newErrorMessage (Message ("node " ++ (show x) ++ " has multiple names")) (newPos "" 0 0)) - - (_,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)) - - _ -> Right (nodeList, edgeList) - - - -multiCheck :: (Eq a) => [(a, b)] -> Maybe a -multiCheck = dup . (map fst) - - - -nonStringNames :: (Eq a) => [(a, String)] -> Maybe a -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) - - - -graspMainPresent :: [(a, String)] -> Bool -graspMainPresent = any (\x -> snd x == "grasp:main") - - - -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 - - - -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) - in dup' x [] + return . G.construct |