Moved compile time error checking elsewhere

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