From 60d8f688a0c66759bdb7645c9dd4c232bc433c9f Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Mon, 15 Aug 2022 12:11:10 +0100
Subject: Unify error reporting

---
 src/Compiler.hs |  6 +++---
 src/Error.hs    | 10 ++++++++--
 src/Main.hs     |  4 ++--
 3 files changed, 13 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/Compiler.hs b/src/Compiler.hs
index 0d90143..49af369 100644
--- a/src/Compiler.hs
+++ b/src/Compiler.hs
@@ -54,7 +54,7 @@ typecheckCall args params
             else
               if all (\(a, b) -> a == b) $ zip t params -- compare types
                 then return $ Nothing -- all good!
-                else return $ Just ("type mismatch in function call:\n  unexpected " ++ A.showList t ++ "\n   expecting " ++ A.showList params)
+                else return $ Just ("type mismatch in function call\n  unexpected " ++ A.showList t ++ "\n   expecting " ++ A.showList params)
         Nothing ->
           -- there was an error in on argument
           return $ Nothing
@@ -67,14 +67,14 @@ showMaybet (Just t) = show t
 -- returning a string decribing an error or Nothing in case of a type match.
 typecheckReturn :: Maybe A.Expr -> Maybe A.Type -> State CompState (Maybe String)
 typecheckReturn Nothing Nothing = return $ Nothing
-typecheckReturn Nothing fret = return $ Just $ "invalid return value:\n  unexpected ()\n   expecting " ++ showMaybet fret
+typecheckReturn Nothing fret = return $ Just $ "invalid return value\n  unexpected ()\n   expecting " ++ showMaybet fret
 typecheckReturn (Just value) fret = do
   r <- compile value
   case r of
     Right r ->
       if r == fret
         then return $ Nothing
-        else return $ Just $ "invalid return value:\n  unexpected " ++ showMaybet r ++ "\n   expecting " ++ showMaybet fret
+        else return $ Just $ "invalid return value\n  unexpected " ++ showMaybet r ++ "\n   expecting " ++ showMaybet fret
     Left _ -> return $ Nothing -- error resolving return value
 
 compile :: A.Expr -> State CompState CompResult
diff --git a/src/Error.hs b/src/Error.hs
index 96b02dc..f61cea2 100644
--- a/src/Error.hs
+++ b/src/Error.hs
@@ -1,13 +1,19 @@
 module Error where
 
 import Data.List (sort)
-import Text.Parsec (SourcePos)
+import Text.Parsec (SourcePos, errorPos)
+import Text.Parsec.Error (ParseError, errorMessages, showErrorMessages)
 
 data Error = Error String SourcePos deriving (Eq)
 
 instance Show Error where
   show (Error message pos) =
-    "error: " ++ show pos ++ ":\n" ++ message
+    show pos ++ " error: " ++ message
+
+showParserError :: ParseError -> String
+showParserError error =
+  show (errorPos error) ++ " error: syntax error"
+    ++ showErrorMessages "or" "unknown parser error" "   expecting" "  unexpected" "end of input" (errorMessages error)
 
 instance Ord Error where
   compare (Error _ pos1) (Error _ pos2) = compare pos1 pos2
diff --git a/src/Main.hs b/src/Main.hs
index 6df7e6c..47fd883 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -3,7 +3,7 @@ module Main where
 import Compiler
 import Control.Monad.State (evalState)
 import qualified Data.Map as Map
-import Error (showErrorList)
+import Error (showErrorList, showParserError)
 import Lexer (scan)
 import Parser (parse, parseFromFile)
 import System.Exit (exitFailure)
@@ -13,7 +13,7 @@ main :: IO ()
 main = do
   res <- parseFromFile (scan parse) "input"
   case res of
-    Left err -> hPutStrLn stderr ("error: " ++ show err) >> exitFailure
+    Left err -> hPutStrLn stderr (showParserError err) >> exitFailure
     Right ast -> do
       res <- return $ evalState (compileAll ast) startState
       case res of
-- 
cgit v1.2.3