module Debugger where

import Char
import Graphics.UI.WX	
import Graphics.UI.WXCORE
import HXML
import MyParserSpec
import Sim
import Format
import EvalTree
 

sinTicks string = filter (/=''') string 

union [] list2 = list2
union list1 list2 = if (elem (show (head list1)) (map show list2))
		    then (union (tail list1) list2)
		    else (head list1):(union (tail list1) list2)

filtermark [] = []
filtermark (x:xs) = case x of
				(Tree (ELNode el m) args) -> if ((head el) == '#') 
							     then (Tree (ELNode el m) (filtermark args)):(filtermark xs)
						     	     else (filtermark xs)	
				(Tree (TXNode el) [])     -> if ((head el)=='#')
							     then (Tree (TXNode el) []):(filtermark xs)
							     else (filtermark xs)
				otherwise                 -> [] 
				 


markpart [] = []
markpart (t:ts) = case t of
			(Tree (ELNode el m) [])   -> if ((head el) == '#') 
						     then (Tree (ELNode el m) []):(markpart ts)
						     else (markpart ts)	
			(Tree (ELNode el m) args) -> if ((head el) == '#')
						     then (Tree (ELNode el m) (filtermark args)):(markpart ts) 
						     else (markpart ts)	
			otherwise                 -> error("PARSE ERROR: Malformed rhs");
					   

plainText [] = []
plainText (x:xs) |(x=='<' || x=='>' || x=='/') = plainText xs
		 | otherwise = x:(plainText xs)

cand tset req filenames candfiles
	|(null tset) = do{ return []}
	|otherwise = do {vertexlist<-varCreate [];
			 sim<-simulation (head (markpart [req])) (head tset) vertexlist;
			 
			 if (not (null sim))
			 then do{
				vertlist<-varGet vertexlist;
				candaux<-varGet candfiles;
				varSet candfiles ((head filenames):(candaux));
				rest<-cand (tail tset) (head (markpart [req])) (tail filenames) candfiles;
				return ((vertlist,(head tset)):rest)}
			 else do{
				rest<-cand (tail tset) (head (markpart [req])) (tail filenames) candfiles;
				return rest}
                        }		

missingerr singreq candid filenames 
		|(not (null candid))= do {
				      	 vertexlist<-varCreate [];
					       sim<-simulation singreq (snd (head candid)) vertexlist;
					       vertlist<-varGet vertexlist;
					       --firstvertexlist<-return (fst (head candid));
					       --if ((null sim) || (not (setEq vertlist (fst (head candid)))))
					       if (null sim)
					       then do{
					         rest<-(missingerr singreq (tail candid) (tail filenames));
					 	 return (("WARNING:\n page <"++(head filenames)++"> is incomplete w.r.t requirement  "++(showPropSpec singreq)++"\"\n"):(rest))}
					       else do {
					 	 ret<-(missingerr singreq (tail candid) (tail filenames));
					 	 return ret
					  	 }
					}
		|otherwise = do{ return []}
 
setInclusion list1 list2
	|(null list1) = True
	|(elem (head list1) list2) = setInclusion (tail list1) list2
	|otherwise  = False	

setEq list1 list2 
	|(setInclusion list1 list2) && (setInclusion list2 list1) = True
	|otherwise = False

errorsReq  t (Tree (ELNode "error" []) [Tree (TXNode mess) []]) webnames = do{return [mess]}

errorsReq  t singreq webnames = do{ 
				     candfilenames<-varCreate [];  
       				     candidates<-cand t singreq webnames candfilenames;
				  
				   
				     if (null candidates) 
			             then 
				         do {return ["WARNING:\n page "++(showPropSpec singreq)++" IS MISSING!\n"]}
				     else 
				         do {
					     candnames<-varGet candfilenames;
					     miss<-missingerr singreq candidates (reverse candnames);
					     return miss}
				  } 

errorsAll web req webnames 
	|not (null req) = do{
			   err1<-(errorsReq web (head req) webnames);
			   err2<-(errorsAll web (tail req) webnames);
			   return (err1:err2)	 
			   }
	|otherwise      = do{
			   return []
			   }


markterm s = if ((head s)=='#')
	     then s
	     else ('#':s)

markTree (Tree (TXNode term) []) = (Tree (TXNode (markterm term)) [])
markTree (Tree (ELNode name att) args) = (Tree (ELNode (markterm name) att) args)  

exChangeExp _ [] = ""
exChangeExp varsub (x:xs) | x == (head(fst varsub)) = (show(sinTicks(plainText(unMark(showXML(snd varsub))))))++(exChangeExp varsub xs)
		       |otherwise = ([x]++(exChangeExp varsub xs))

substitute tree [] = do {return [tree]}
substitute rhs sub = case rhs of
			  Tree (TXNode val) []-> if (isVar val)
					       	 then case (lookup (unMark val) sub) of
									Nothing -> do {return [rhs]}
									Just s -> if ((head val)=='#')
										  then do{ return [(markTree s)]}
										  else do{ return [s]}
					       	 else
						   if ((head val) == '&')
						     then if (not(elem ((fst.head) sub) (map fst (tail sub))))
							  then do{ saux<-(substitute (Tree (TXNode (exChangeExp (head sub) val)) []) (tail sub));
								   --putStrLn "Saux: expresion con las sustituciones de las variables";
								   --print saux;
								   first<-evalExpress saux;
								   --putStrLn "First: expresion evaluada";
								   print first;	
								   return first;
							           }
							  else do{ saux<-(substitute (Tree (TXNode val) []) (tail sub));
								   sauxlist<-return ((Tree (TXNode (exChangeExp (head sub) val)) []):(saux));
								   sol<-evalExpress sauxlist;
								   return sol}

						     else do{ return [rhs]}
			  Tree (ELNode x _) []->do{return [rhs]}
			  Tree (ELNode node m) args->do{saux<-(substituteAux args sub);
							return [Tree (ELNode node m) saux]}
			  otherwise-> do {return [rhs]}	
			

substituteAux args sub 
	|not (null args) = do{saux<-(substitute (head args) sub);
			      sauxp<-(substituteAux (tail args) sub);
			      return (saux++sauxp)}  		
	|otherwise = do {return []}

substitutions _ [] = do{return []}
substitutions rhs subs = do {s1<-(substitute rhs (head subs));
			     s2<-(substitutions rhs (tail subs));
			     return (s1++s2)}

substitutionsList [] subs = do{return []}
substitutionsList expr subs = do{
				first<-substitutions (head expr) subs;
				rest<-substitutionsList (tail expr) subs;
				return (first:rest)
				}



addAmp (Tree (TXNode exp) []) = (Tree (TXNode ('&':exp++"&")) [])

isIntree x (Tree (TXNode y) []) | x==y = True
				|otherwise = False

trueCond lists =if (or (map null lists))
		then False
		else
		 if (and (map (isIntree "'True'") (map head lists)))
		 then True
		 else trueCond (map tail lists) 

myshowXML (Tree (TXNode text) []) = text 

myshowXMLAux listtree = if (null (tail listtree))
			then (myshowXML (head listtree))
			else (myshowXML (head listtree))++","++(myshowXMLAux (tail listtree))

partialRewrite t (lhs,Tree (ELNode "error" []) expr) tname = if (null expr)
							     then do{vertexlist<-varCreate [];
								   subs<-simulation lhs t vertexlist;
							      	   if (not (null subs))
								   then do {return [Tree (ELNode "error"[]) [Tree (TXNode ("WARNING:\n page <"++tname++"> is incorrect w.r.t. rule "++(showPropSpec lhs)++" -> error\n"))[]]]}
								   else do {return []}								   
								   }
                					      else do{vertexlist<-varCreate [];
								   subs<-simulation lhs t vertexlist;
							      	   if (not (null subs))
								   then do{
									   rsigerr<-(substitutionsList expr subs);
							                   if (trueCond rsigerr) 
									   then do {return [Tree (ELNode "error"[]) [Tree (TXNode ("WARNING:\n page <"++tname++"> is incorrect w.r.t. rule "++(showPropSpec lhs)++" -> error | "++(myshowXMLAux expr)++"\n"))[]]]}    
									   else do {return []}}	
								   else do{return []}

						         }

partialRewrite t r tname= do{
			vertexlist<-varCreate [];
			subs<-simulation (fst r) t vertexlist;  
			if (not (null subs))
			then 
			    do{
				 rsigmas<-(substitutions (snd r) subs);
				 return rsigmas}
			else do{
				return []}
			}
		 


operatorTaux _ [] _ = do {return []}
operatorTaux first spec firstname = do{
			    partial<-partialRewrite first (head spec) firstname;
			    partrest<-operatorTaux first (tail spec) firstname;
			    return (partial:partrest)
			   }

operatorT [] _ _ = do {return []}
operatorT web spec webnames = do{
			it<-operatorTaux (head web) spec (head webnames);
			rest<-operatorT (tail web) spec (tail webnames);
			return (it:rest)
			}



partialRewritereq t (lhs,Tree (ELNode "error" []) exp) namet = if (null exp)
								then do{vertexlist<-varCreate [];
								   	subs<-simulationp lhs t vertexlist;
							      	   	if (not (null subs))
								   	then do{
									   	return [Tree (ELNode "error"[]) [Tree (TXNode ("WARNING:\n page <"++namet++"> is incorrect w.r.t. rule "++(showPropSpec lhs)++" -> error\n"))[]]]}
									else do {return []}}
								else do{
									vertexlist<-varCreate [];
							   	 	subs<-simulationp lhs t vertexlist;
						      	   	 	if (not (null subs))
							   	 	then do{
										rsigerr<-(substitutionsList exp subs);
										if (trueCond rsigerr) 
								        	then do {return [Tree (ELNode "error"[]) [Tree (TXNode ("WARNING:\n page <"++namet++"> is incorrect w.r.t. rule "++(showPropSpec lhs)++" -> error |"++(showXML (head exp))++"\n"))[]]]}    
								        	else do {return []}}
									else do{return []}
								}					
partialRewritereq t r namet= do{
				vertexlist<-varCreate [];
				subs<-simulationp (fst r) t vertexlist;				
				if (not (null subs))
				then do{
					rsigmas<-(substitutions (snd r) subs);
					return rsigmas}
				else do{
					return []}
				}
		 


operatorTreqaux _ [] _= do {return []}
operatorTreqaux first spec firstname = do{
			    		partial<-partialRewritereq first (head spec) firstname;
			    		partrest<-operatorTreqaux first (tail spec) firstname;
			    		return (partial:partrest)
			   		}	

operatorTreq [] _ _= do {return []}
operatorTreq web spec webnames = do{
				it<-operatorTreqaux (head web) spec (head webnames);
				rest<-operatorTreq (tail web) spec (tail webnames);
				return (it:rest)
				}



fixpointTest est spec webnames = do{
				    nextstaux<-(operatorTreq est spec webnames);
				    
				    nextst<-return (union (concat (concat nextstaux)) est);
				    
				    if (length nextst)==(length est)
				    then do{ return Nothing}
				    else do{ return (Just nextst)}
				} 
	
fixPointT init spec webnames =do {
				maybest<-fixpointTest init spec webnames;
				case maybest of
				    Nothing->do{return init}
				    Just next->fixPointT next spec webnames
				}



debug web spec webnames=do{
			 reqaux<-operatorT web spec webnames;	
			 initreq<-return (concat(concat reqaux));
			 finalreq<-fixPointT initreq spec webnames;
			 ret<-errorsAll web finalreq webnames;
			 return ret
			 }


