From 35cd5e7bcc74502525166da95d89c5f810a299ce Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Wed, 30 Apr 2014 03:36:35 +1000
Subject: Further progress on checking for parse errors
---
src/Grasp/Parser.hs | 64 ++++++++++++++++++++++++++++++++++++++---------------
1 file changed, 46 insertions(+), 18 deletions(-)
(limited to 'src/Grasp')
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 []
--
cgit