module Errors (
interr, todo,
ErrorLvl(..), Error, makeError, errorLvl, showError, errorAtPos
) where
import Position (Position(..), isInternalPos)
interr :: String -> a
interr :: String -> a
interr msg :: String
msg = String -> a
forall a. HasCallStack => String -> a
error ("INTERNAL COMPILER ERROR:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
indentMultilineString 2 String
msg
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n")
todo :: String -> a
todo :: String -> a
todo msg :: String
msg = String -> a
forall a. HasCallStack => String -> a
error ("Feature not yet implemented:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
indentMultilineString 2 String
msg
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n")
data ErrorLvl = WarningErr
| ErrorErr
| FatalErr
deriving (ErrorLvl -> ErrorLvl -> Bool
(ErrorLvl -> ErrorLvl -> Bool)
-> (ErrorLvl -> ErrorLvl -> Bool) -> Eq ErrorLvl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorLvl -> ErrorLvl -> Bool
$c/= :: ErrorLvl -> ErrorLvl -> Bool
== :: ErrorLvl -> ErrorLvl -> Bool
$c== :: ErrorLvl -> ErrorLvl -> Bool
Eq, Eq ErrorLvl
Eq ErrorLvl =>
(ErrorLvl -> ErrorLvl -> Ordering)
-> (ErrorLvl -> ErrorLvl -> Bool)
-> (ErrorLvl -> ErrorLvl -> Bool)
-> (ErrorLvl -> ErrorLvl -> Bool)
-> (ErrorLvl -> ErrorLvl -> Bool)
-> (ErrorLvl -> ErrorLvl -> ErrorLvl)
-> (ErrorLvl -> ErrorLvl -> ErrorLvl)
-> Ord ErrorLvl
ErrorLvl -> ErrorLvl -> Bool
ErrorLvl -> ErrorLvl -> Ordering
ErrorLvl -> ErrorLvl -> ErrorLvl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorLvl -> ErrorLvl -> ErrorLvl
$cmin :: ErrorLvl -> ErrorLvl -> ErrorLvl
max :: ErrorLvl -> ErrorLvl -> ErrorLvl
$cmax :: ErrorLvl -> ErrorLvl -> ErrorLvl
>= :: ErrorLvl -> ErrorLvl -> Bool
$c>= :: ErrorLvl -> ErrorLvl -> Bool
> :: ErrorLvl -> ErrorLvl -> Bool
$c> :: ErrorLvl -> ErrorLvl -> Bool
<= :: ErrorLvl -> ErrorLvl -> Bool
$c<= :: ErrorLvl -> ErrorLvl -> Bool
< :: ErrorLvl -> ErrorLvl -> Bool
$c< :: ErrorLvl -> ErrorLvl -> Bool
compare :: ErrorLvl -> ErrorLvl -> Ordering
$ccompare :: ErrorLvl -> ErrorLvl -> Ordering
$cp1Ord :: Eq ErrorLvl
Ord)
data Error = Error ErrorLvl Position [String]
instance Eq Error where
(Error lvl1 :: ErrorLvl
lvl1 pos1 :: Position
pos1 _) == :: Error -> Error -> Bool
== (Error lvl2 :: ErrorLvl
lvl2 pos2 :: Position
pos2 _) = ErrorLvl
lvl1 ErrorLvl -> ErrorLvl -> Bool
forall a. Eq a => a -> a -> Bool
== ErrorLvl
lvl2 Bool -> Bool -> Bool
&& Position
pos1 Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
pos2
instance Ord Error where
(Error lvl1 :: ErrorLvl
lvl1 pos1 :: Position
pos1 _) < :: Error -> Error -> Bool
< (Error lvl2 :: ErrorLvl
lvl2 pos2 :: Position
pos2 _) = Position
pos1 Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
pos2
Bool -> Bool -> Bool
|| (Position
pos1 Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
pos2 Bool -> Bool -> Bool
&& ErrorLvl
lvl1 ErrorLvl -> ErrorLvl -> Bool
forall a. Ord a => a -> a -> Bool
< ErrorLvl
lvl2)
e1 :: Error
e1 <= :: Error -> Error -> Bool
<= e2 :: Error
e2 = Error
e1 Error -> Error -> Bool
forall a. Ord a => a -> a -> Bool
< Error
e2 Bool -> Bool -> Bool
|| Error
e1 Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
e2
makeError :: ErrorLvl -> Position -> [String] -> Error
makeError :: ErrorLvl -> Position -> [String] -> Error
makeError = ErrorLvl -> Position -> [String] -> Error
Error
errorLvl :: Error -> ErrorLvl
errorLvl :: Error -> ErrorLvl
errorLvl (Error lvl :: ErrorLvl
lvl _ _) = ErrorLvl
lvl
showError :: Error -> String
showError :: Error -> String
showError (Error _ pos :: Position
pos (l :: String
l:ls :: [String]
ls)) | Position -> Bool
isInternalPos Position
pos =
"INTERNAL ERROR!\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " >>> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String -> String
indentMultilineString 2 (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines) [String]
ls
showError (Error lvl :: ErrorLvl
lvl (Position fname :: String
fname row :: Int
row col :: Int
col) (l :: String
l:ls :: [String]
ls)) =
let
prefix :: String
prefix = String
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
row::Int) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "(column "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
col::Int)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ ") ["
String -> String -> String
forall a. [a] -> [a] -> [a]
++ ErrorLvl -> String
showErrorLvl ErrorLvl
lvl
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "] "
showErrorLvl :: ErrorLvl -> String
showErrorLvl WarningErr = "WARNING"
showErrorLvl ErrorErr = "ERROR"
showErrorLvl FatalErr = "FATAL"
in
String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " >>> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String -> String
indentMultilineString 2 (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines) [String]
ls
showError (Error _ _ [] ) = String -> String
forall a. String -> a
interr "Errors: showError:\
\ Empty error message!"
errorAtPos :: Position -> [String] -> a
errorAtPos :: Position -> [String] -> a
errorAtPos pos :: Position
pos msg :: [String]
msg = (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
showError (Error -> String) -> ([String] -> Error) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorLvl -> Position -> [String] -> Error
makeError ErrorLvl
ErrorErr Position
pos) [String]
msg
indentMultilineString :: Int -> String -> String
indentMultilineString :: Int -> String -> String
indentMultilineString n :: Int
n = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
spacesString -> String -> String
forall a. [a] -> [a] -> [a]
++)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
where
spaces :: String
spaces = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (Char -> String
forall a. a -> [a]
repeat ' ')