Errores custom

MateFun/src/MateFun.hs

@@ -51,7 +51,7 @@ isPreFlag _ = False
 
 
 logo = " __  __       _       _____          \n" ++
-       "|  \\/  | __ _| |_ ___|  ___|   _ _ __ v 0.4.1 \n" ++
+       "|  \\/  | __ _| |_ ___|  ___|   _ _ __ v 0.4.2 \n" ++
        "| |\\/| |/ _` | __/ _ \\ |_ | | | | '_ \\   \n" ++
        "| |  | | (_| | ||  __/  _|| |_| | | | |  \n" ++
        "|_|  |_|\\__,_|\\__\\___|_|   \\__,_|_| |_|  \n\n" 
@@ -129,47 +129,76 @@ insord (v,x) ((v',x'):xs) | v <  v'   = (v,x): ((v',x'):xs)
  
 {- Imprimir errores custom -} 
 
+removeDuplicates :: Eq a => [a] -> [a]
+removeDuplicates = rdHelper []
+    where rdHelper seen [] = seen
+          rdHelper seen (x:xs)
+              | x `elem` seen = rdHelper seen xs
+              | otherwise = rdHelper (seen ++ [x]) xs
 
-{- errorMessages  ParseError -> [Message] -}
+removeDuplicatedErrors :: [Message] -> [Message]
+removeDuplicatedErrors xs = removeDuplicates xs
+
+getExpecteds :: [Message] -> [Message]
+getExpecteds [] = []
+getExpecteds (Expect s:xs) = (Expect s):(getExpecteds xs)
+getExpecteds (x:xs) = getExpecteds xs
+
+getFounds :: [Message] -> [Message]
+getFounds [] = []
+getFounds (SysUnExpect s:xs) = (SysUnExpect s):(getFounds xs)
+getFounds (UnExpect s:xs) = (UnExpect s):(getFounds xs)
+getFounds (x:xs) = getFounds xs
+
+colapseExpected :: [Message] -> String
+colapseExpected [] = []
+colapseExpected (Expect s:xs) = if(s=="") then colapseExpected xs else ", pero se esperaba " ++ traslate (colapseExpected2 (Expect s:xs))
+
+unwords2 :: [String] -> String
+unwords2 [] = []
+unwords2 (x:[]) = x
+unwords2 (x:xs) = if(x=="") then unwords2 xs else x ++ " o " ++ unwords2 xs
+
+traslate :: String -> String
+traslate xs = replace xs "operator" "operador"
+
+colapseExpected2 :: [Message] -> String
+colapseExpected2 xs = unwords2 $ removeDuplicates $colapseExpectedAux xs 
+
+colapseExpectedAux :: [Message] ->  [String]
+colapseExpectedAux [] = []
+colapseExpectedAux (Expect s:xs) = s:colapseExpectedAux xs
+
+colapseFounds :: [Message] -> String
+colapseFounds [] = []
+colapseFounds (SysUnExpect s:xs) = "Se enocntró " ++ colapseFounds2 (SysUnExpect s:xs)
+colapseFounds (UnExpect s:xs) = "Se enocntró " ++ colapseFounds2 (UnExpect s:xs)
+
+colapseFoundsAux :: [Message] ->  [String]
+colapseFoundsAux [] = []
+colapseFoundsAux (SysUnExpect s:xs) = s:colapseFoundsAux xs
+colapseFoundsAux (UnExpect s:xs) = s:colapseFoundsAux xs
+
+removeSpaces :: String -> String
+removeSpaces [] = []
+removeSpaces (x:xs) = if(x==' ' || x=='\"') then removeSpaces xs else x:(removeSpaces xs)
+
+colapseFounds2 :: [Message] -> String
+colapseFounds2 xs = "\"" ++(removeSpaces $ unwords $ removeDuplicates $colapseFoundsAux xs) ++ "\""
+
+
+{- extract pos x y-}
+getPosError :: ParseError -> (String,String)
+getPosError err = (show (sourceLine $ errorPos err),show (sourceColumn $errorPos err))
+
+{- Custom error formateer -}
+customShow :: ParseError -> String
+customShow err = "Error en línea " ++ fst coord ++ ", columna " ++ snd coord ++ "\n" ++
+                  " "  ++ (colapseFounds (getFounds errs)) ++ (colapseExpected $ getExpecteds errs)
+ where
+  coord = getPosError err
+  errs =  errorMessages err
 
-{-
-   data Message = SysUnExpect !String -- @ library generated unexpect
-             | UnExpect    !String -- @ unexpected something
-             | Expect      !String -- @ expecting something
-             | Message     !String -- @ raw message
-
-   errorPos :: ParseError -> SourcePos
-   sourceLine :: SourcePos -> Line
-   sourceColumn :: SourcePos -> Column
- -}
-
-customMessageShow (SysUnExpect s) = "Se encontro " ++ s
-customMessageShow (UnExpect s) = "Se encontro " ++ s
-customMessageShow (Expect s) =  if(s=="") then "" else ", pero se esperaba " ++ (replace s "operator" "operador")
-customMessageShow (Message s) = ""; 
-
-esSeEsperaba :: String -> Bool
-esSeEsperaba s = isPrefixOf ", pero se esperaba" s
-
-eliminarRedundancia :: [String] -> [String]
-eliminarRedundancia [] = []
-eliminarRedundancia (x:[]) = (x:[])
-eliminarRedundancia (x:y:xs) = if((esSeEsperaba x) && (esSeEsperaba y)) then
-                                "pero se esperaba " ++ (getSeEsperaba x:y:xs)
-                               else
-                                [x] ++ eliminarRedundancia (y:xs)
-
-getSeEsperaba :: [String] -> String
-getSeEsperaba [] = []
-getSeEsperaba (x:[]) = (words x)!!4 
-getSeEsperaba (x:y:xs) = ((words x) !! 4) ++ " o " ++ (getSeEsperaba y:xs)
-
-joinMessages :: [String] -> String
-joinMessages [] = []
-joinMessages (x:xs) = if (elem x xs || x=="") then
-                        joinMessages  xs
-                      else
-                        x ++ (joinMessages xs)      
 
 
 replace :: Eq a => [a] -> [a] -> [a] -> [a]
@@ -179,15 +208,9 @@ replace s find repl =
         then repl ++ (replace (drop (length find) s) find repl)
         else [head s] ++ (replace (tail s) find repl)
 
-customShowPos :: ParseError -> String
-customShowPos err =   " linea: " ++ (show (sourceColumn $ errorPos err)) ++ " columna:" ++ (show (sourceLine $errorPos err)) ++ "} \n "
-
 stripLeadingWhitespace :: String -> String
 stripLeadingWhitespace = unlines . map (dropWhile isSpace) . lines
 
-miParseErrorShow :: ParseError -> String
-miParseErrorShow err = (customShowPos err) ++ joinMessages ( filter (\x->not((stripLeadingWhitespace x)=="\n")) (eliminarRedundancia $ map customMessageShow (errorMessages err)))
-
 evalInterp :: Interp -> Ctx -> IO (Maybe (String, Ctx))
 evalInterp None            ctx   = just ("",ctx)
 evalInterp Reload          ctx   = evalInterp (Load (fst (ctxFile ctx))) ctx
@@ -198,7 +221,7 @@ evalInterp (Load fn)       ctx   = do let pre   = snd $ ctxFile ctx
                                       prg <- parseFiles [fn] pre [] [] [] 
                                       case prg of
                                        -- Left err  -> just (carga ++ show err, emptyCtx ctx) 
-                                       Left err  -> just (errorMsg ++ (miParseErrorShow err) , emptyCtx ctx) 
+                                       Left err  -> just (customShow err , emptyCtx ctx) 
                                        Right ans -> case runCheck ans (initCtx fn pre (wrn ctx) (wrnA ctx) ans) of
                                                         (ctx,[]) -> case runCstProp ctx of
                                                                       (ctx',[]) -> if wrn ctx' || wrnA ctx'