From 54ba705026976ae291ec8259abd83033ca01e4c6 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Thu, 20 Nov 2014 07:42:31 +1100
Subject: Moved compile time error checking elsewhere
---
src/Grasp/Parser.hs | 106 ++--------------------------------------------------
1 file changed, 3 insertions(+), 103 deletions(-)
(limited to 'src')
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
--
cgit