mirror of
https://github.com/wasp-lang/wasp.git
synced 2024-09-11 15:26:19 +03:00
[Analyzer] Reverse the order of Wasp error messages (#500)
* Reverse the order for TypeError messages * Remove redundant import and unused pragma * Remove redundant import and unused pragma * Reverse additional type error messages * Remove redundant import * Format util test file * Address PR comments * Add empty line to TypeError.hs * Address PR comments * Format TypeError.hs * Reverse message order in evaluation errors * Extract common error message functions * Add tests for EvaluationErrors * Improve naming in Wasp.ErrorMessage * Fix formatting * Fix formatting * Format code * Change naming and syntax in ErrorMessage * hange names in EvaluationError tests * Add full stops to documentation * Fix formatting in tests
This commit is contained in:
parent
1995ccdb9d
commit
52badd651e
17
waspc/src/Wasp/Analyzer/ErrorMessage.hs
Normal file
17
waspc/src/Wasp/Analyzer/ErrorMessage.hs
Normal file
@ -0,0 +1,17 @@
|
||||
module Wasp.Analyzer.ErrorMessage
|
||||
( makeFullErrorMsg,
|
||||
)
|
||||
where
|
||||
|
||||
import Wasp.Util (indent)
|
||||
|
||||
makeFullErrorMsg :: String -> [String] -> String
|
||||
makeFullErrorMsg errorMsg errorCtxMsgs =
|
||||
errorMsg ++ (if null errorCtxMsgs then "" else "\n\n" ++ concatErrorCtxMsgs errorCtxMsgs)
|
||||
|
||||
concatErrorCtxMsgs :: [String] -> String
|
||||
concatErrorCtxMsgs [] = ""
|
||||
concatErrorCtxMsgs msgChain = prefix ++ foldr1 appendMsg msgChain
|
||||
where
|
||||
prefix = "-> "
|
||||
appendMsg currMsg = (++) (currMsg ++ ":\n") . indent 2 . (prefix ++)
|
@ -8,12 +8,12 @@ module Wasp.Analyzer.Evaluator.EvaluationError
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Arrow (first)
|
||||
import Data.List (intercalate)
|
||||
import qualified Text.Parsec
|
||||
import Wasp.Analyzer.ErrorMessage (makeFullErrorMsg)
|
||||
import Wasp.Analyzer.Parser.Ctx (Ctx, WithCtx (..))
|
||||
import Wasp.Analyzer.Type (Type)
|
||||
import Wasp.Util (concatPrefixAndText, indent)
|
||||
import Wasp.Util (concatPrefixAndText, indent, second3)
|
||||
|
||||
newtype EvaluationError = EvaluationError (WithCtx EvaluationError')
|
||||
deriving (Show, Eq)
|
||||
@ -61,56 +61,59 @@ mkEvaluationError :: Ctx -> EvaluationError' -> EvaluationError
|
||||
mkEvaluationError ctx e = EvaluationError $ WithCtx ctx e
|
||||
|
||||
getErrorMessageAndCtx :: EvaluationError -> (String, Ctx)
|
||||
getErrorMessageAndCtx (EvaluationError (WithCtx ctx evalError)) = case evalError of
|
||||
getErrorMessageAndCtx err = (makeFullErrorMsg errorMsg errorCtxMsgs, ctx)
|
||||
where
|
||||
(errorMsg, errorCtxMsgs, ctx) = getErrorMsgAndErrorCtxMsgsAndParsingCtx err
|
||||
|
||||
getErrorMsgAndErrorCtxMsgsAndParsingCtx :: EvaluationError -> (String, [String], Ctx)
|
||||
getErrorMsgAndErrorCtxMsgsAndParsingCtx (EvaluationError (WithCtx ctx evalError)) = case evalError of
|
||||
ExpectedType expectedType actualType ->
|
||||
( intercalate
|
||||
makeMainMsg $
|
||||
intercalate
|
||||
"\n"
|
||||
[ concatPrefixAndText "Expected type: " (show expectedType),
|
||||
concatPrefixAndText "Actual type: " (show actualType)
|
||||
],
|
||||
ctx
|
||||
)
|
||||
]
|
||||
ExpectedDictType actualType ->
|
||||
( intercalate
|
||||
makeMainMsg $
|
||||
intercalate
|
||||
"\n"
|
||||
[ "Expected a dictionary.",
|
||||
concatPrefixAndText "Actual type: " (show actualType)
|
||||
],
|
||||
ctx
|
||||
)
|
||||
]
|
||||
ExpectedListType actualType ->
|
||||
( intercalate
|
||||
makeMainMsg $
|
||||
intercalate
|
||||
"\n"
|
||||
[ "Expected a list.",
|
||||
concatPrefixAndText "Actual type: " (show actualType)
|
||||
],
|
||||
ctx
|
||||
)
|
||||
]
|
||||
ExpectedTupleType expectedTupleSize actualType ->
|
||||
( intercalate
|
||||
makeMainMsg $
|
||||
intercalate
|
||||
"\n"
|
||||
[ "Expected a tuple of size " ++ show expectedTupleSize ++ ".",
|
||||
concatPrefixAndText "Actual type: " (show actualType)
|
||||
],
|
||||
ctx
|
||||
)
|
||||
UndefinedVariable varName -> ("Undefined variable " ++ varName, ctx)
|
||||
]
|
||||
UndefinedVariable varName -> makeMainMsg $ "Undefined variable " ++ varName
|
||||
InvalidEnumVariant enumType validEnumVariants actualEnumVariant ->
|
||||
( "Expected value of enum type '" ++ enumType
|
||||
makeMainMsg $
|
||||
"Expected value of enum type '" ++ enumType
|
||||
++ "' but got value '"
|
||||
++ actualEnumVariant
|
||||
++ "'\n"
|
||||
++ "Valid values: "
|
||||
++ intercalate " | " validEnumVariants,
|
||||
ctx
|
||||
)
|
||||
MissingDictField fieldName -> ("Missing dictionary field '" ++ fieldName ++ "'", ctx)
|
||||
ParseError (EvaluationParseErrorParsec e) -> ("Parse error:\n" ++ indent 2 (show e), ctx)
|
||||
ParseError (EvaluationParseError msg) -> ("Parse error:\n" ++ indent 2 msg, ctx)
|
||||
WithEvalErrorCtx evalCtx subError ->
|
||||
let evalCtxMsg = case evalCtx of
|
||||
InField fieldName -> "In dictionary field '" ++ fieldName ++ "':"
|
||||
InList -> "In list:"
|
||||
InTuple -> "In tuple:"
|
||||
ForVariable varName -> "For variable '" ++ varName ++ "':"
|
||||
in first (((evalCtxMsg ++ "\n") ++) . indent 2) $ getErrorMessageAndCtx subError
|
||||
++ intercalate " | " validEnumVariants
|
||||
MissingDictField fieldName -> makeMainMsg $ "Missing dictionary field '" ++ fieldName ++ "'"
|
||||
ParseError (EvaluationParseErrorParsec e) -> makeMainMsg ("Parse error:\n" ++ indent 2 (show e))
|
||||
ParseError (EvaluationParseError msg) -> makeMainMsg ("Parse error:\n" ++ indent 2 msg)
|
||||
WithEvalErrorCtx evalCtx subError -> second3 (evalCtxMsg evalCtx :) $ getErrorMsgAndErrorCtxMsgsAndParsingCtx subError
|
||||
where
|
||||
makeMainMsg msg = (msg, [], ctx)
|
||||
|
||||
evalCtxMsg :: EvalErrorCtx -> String
|
||||
evalCtxMsg evalCtx = case evalCtx of
|
||||
(InField fieldName) -> "For dictionary field '" ++ fieldName ++ "'"
|
||||
InList -> "In list"
|
||||
InTuple -> "In tuple"
|
||||
(ForVariable varName) -> "For variable '" ++ varName ++ "'"
|
||||
|
@ -8,12 +8,12 @@ module Wasp.Analyzer.TypeChecker.TypeError
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Arrow (first)
|
||||
import Data.List (intercalate)
|
||||
import Wasp.Analyzer.ErrorMessage
|
||||
import Wasp.Analyzer.Parser.Ctx (Ctx)
|
||||
import Wasp.Analyzer.Type
|
||||
import Wasp.Analyzer.TypeChecker.AST
|
||||
import Wasp.Util (concatPrefixAndText, concatShortPrefixAndText, indent)
|
||||
import Wasp.Util (concatPrefixAndText, concatShortPrefixAndText, second3)
|
||||
|
||||
newtype TypeError = TypeError (WithCtx TypeError')
|
||||
deriving (Show, Eq)
|
||||
@ -80,23 +80,6 @@ data TypeCoercionErrorReason e
|
||||
ReasonDictWrongKeyType String e
|
||||
deriving (Eq, Show)
|
||||
|
||||
getTypeCoercionErrorMessageAndCtx :: (Type -> TypedExpr -> String) -> TypeCoercionError -> (String, Ctx)
|
||||
getTypeCoercionErrorMessageAndCtx getUncoercableTypesMsg (TypeCoercionError (WithCtx ctx texpr) t reason) =
|
||||
case reason of
|
||||
ReasonList e ->
|
||||
first (("For list element:\n" ++) . indent 2) $
|
||||
getTypeCoercionErrorMessageAndCtx getUncoercableTypesMsg e
|
||||
ReasonDictWrongKeyType key e ->
|
||||
first ((("For dictionary field '" ++ key ++ "':\n") ++) . indent 2) $
|
||||
getTypeCoercionErrorMessageAndCtx getUncoercableTypesMsg e
|
||||
ReasonDictNoKey key -> ("Missing required dictionary field '" ++ key ++ "'", ctx)
|
||||
ReasonDictExtraKey key -> ("Unexpected dictionary field '" ++ key ++ "'", ctx)
|
||||
ReasonDecl -> uncoercableTypesMsgAndCtx
|
||||
ReasonEnum -> uncoercableTypesMsgAndCtx
|
||||
ReasonUncoercable -> uncoercableTypesMsgAndCtx
|
||||
where
|
||||
uncoercableTypesMsgAndCtx = (getUncoercableTypesMsg t texpr, ctx)
|
||||
|
||||
getUnificationErrorMessageAndCtx :: TypeCoercionError -> (String, Ctx)
|
||||
getUnificationErrorMessageAndCtx = getTypeCoercionErrorMessageAndCtx $
|
||||
\t texpr ->
|
||||
@ -115,3 +98,35 @@ getWeakenErrorMessageAndCtx = getTypeCoercionErrorMessageAndCtx $
|
||||
[ concatPrefixAndText "Expected type: " (show t),
|
||||
concatPrefixAndText "Actual type: " (show $ exprType texpr)
|
||||
]
|
||||
|
||||
getTypeCoercionErrorMessageAndCtx :: (Type -> TypedExpr -> String) -> TypeCoercionError -> (String, Ctx)
|
||||
getTypeCoercionErrorMessageAndCtx getUncoercableTypesMsg typeCoercionError = (fullErrorMsg, ctx)
|
||||
where
|
||||
(errorMsg, ctxMsgs, ctx) =
|
||||
getUncoercableTypesErrorMsgAndCtxInfoAndParsingCtx getUncoercableTypesMsg typeCoercionError
|
||||
fullErrorMsg = makeFullErrorMsg errorMsg ctxMsgs
|
||||
|
||||
-- | Recursively traverses the error hierarchy and returns a tuple containing:
|
||||
-- - The original type coercion error message.
|
||||
-- - An array of contextual messages further explaining the original error.
|
||||
-- - The error's context.
|
||||
--
|
||||
-- It takes two arguments:
|
||||
-- - A function for constructing a type coercion error message,
|
||||
-- - A `TypeCoercionError` to process.
|
||||
getUncoercableTypesErrorMsgAndCtxInfoAndParsingCtx ::
|
||||
(Type -> TypedExpr -> String) ->
|
||||
TypeCoercionError ->
|
||||
(String, [String], Ctx)
|
||||
getUncoercableTypesErrorMsgAndCtxInfoAndParsingCtx getUncoercableTypesMsg (TypeCoercionError (WithCtx ctx texpr) t reason) =
|
||||
case reason of
|
||||
ReasonList e -> second3 ("In list" :) $ getFurtherMsgsAndCtx e
|
||||
ReasonDictWrongKeyType key e -> second3 (("For dictionary field '" ++ key ++ "'") :) $ getFurtherMsgsAndCtx e
|
||||
ReasonDictNoKey key -> ("Missing required dictionary field '" ++ key ++ "'", [], ctx)
|
||||
ReasonDictExtraKey key -> ("Unexpected dictionary field '" ++ key ++ "'", [], ctx)
|
||||
ReasonDecl -> uncoercableTypesMsgAndCtx
|
||||
ReasonEnum -> uncoercableTypesMsgAndCtx
|
||||
ReasonUncoercable -> uncoercableTypesMsgAndCtx
|
||||
where
|
||||
getFurtherMsgsAndCtx = getUncoercableTypesErrorMsgAndCtxInfoAndParsingCtx getUncoercableTypesMsg
|
||||
uncoercableTypesMsgAndCtx = (getUncoercableTypesMsg t texpr, [], ctx)
|
||||
|
@ -10,6 +10,7 @@ module Wasp.Util
|
||||
toLowerFirst,
|
||||
toUpperFirst,
|
||||
headSafe,
|
||||
second3,
|
||||
jsonSet,
|
||||
indent,
|
||||
concatShortPrefixAndText,
|
||||
@ -32,7 +33,7 @@ import qualified Crypto.Hash.SHA256 as SHA256
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.UTF8 as BSU
|
||||
import Data.Char (isUpper, toLower, toUpper)
|
||||
import Data.Char (isSpace, isUpper, toLower, toUpper)
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import Data.List (intercalate)
|
||||
import Data.List.Split (splitOn)
|
||||
@ -68,12 +69,20 @@ headSafe :: [a] -> Maybe a
|
||||
headSafe [] = Nothing
|
||||
headSafe xs = Just (head xs)
|
||||
|
||||
second3 :: (b -> d) -> (a, b, c) -> (a, d, c)
|
||||
second3 f (x, y, z) = (x, f y, z)
|
||||
|
||||
jsonSet :: Text.Text -> Aeson.Value -> Aeson.Value -> Aeson.Value
|
||||
jsonSet key value (Aeson.Object o) = Aeson.Object $ M.insert key value o
|
||||
jsonSet _ _ _ = error "Input JSON must be an object"
|
||||
|
||||
indent :: Int -> String -> String
|
||||
indent numSpaces = intercalate "\n" . map (replicate numSpaces ' ' ++) . splitOn "\n"
|
||||
indent numSpaces = intercalate "\n" . map (toEmptyStringIfAllWhiteSpace . (indentation ++)) . splitOn "\n"
|
||||
where
|
||||
indentation = replicate numSpaces ' '
|
||||
toEmptyStringIfAllWhiteSpace str
|
||||
| all isSpace str = ""
|
||||
| otherwise = str
|
||||
|
||||
-- | Given a prefix and text, concatenates them in the following manner:
|
||||
-- <prefix> <text_line_1>
|
||||
|
@ -1,27 +1,80 @@
|
||||
module Analyzer.Evaluation.EvaluationErrorTest where
|
||||
|
||||
import Analyzer.TestUtil (ctx)
|
||||
import Data.List (intercalate)
|
||||
import Test.Tasty.Hspec
|
||||
import Wasp.Analyzer.Evaluator.EvaluationError
|
||||
import Wasp.Analyzer.Parser.Ctx
|
||||
import Wasp.Analyzer.Type (Type (..))
|
||||
|
||||
ctx1 :: Ctx
|
||||
ctx1 = ctx (1, 4) (2, 5)
|
||||
|
||||
wrapEvalErrors :: EvaluationError -> [EvalErrorCtx] -> EvaluationError
|
||||
wrapEvalErrors boottomError wrapperErrors = foldr wrap boottomError wrapperErrors
|
||||
where
|
||||
wrap evalErrorCtx = mkEvaluationError ctx1 . WithEvalErrorCtx evalErrorCtx
|
||||
|
||||
spec_EvaluationError :: Spec
|
||||
spec_EvaluationError = do
|
||||
describe "Analyzer.Evaluator.EvaluationError" $ do
|
||||
describe "getErrorMessageAndCtx works correctly for" $ do
|
||||
let expectedTypeErrorNumberAndStringForCtx1 = mkEvaluationError ctx1 $ ExpectedType NumberType StringType
|
||||
let expectedTypeErrorNumberAndStringMsgForCtx1 = "Expected type: number\nActual type: string"
|
||||
|
||||
it "InvalidEnumVariant error" $ do
|
||||
let ctx1 = ctx (1, 1) (1, 10)
|
||||
let err = mkEvaluationError ctx1 $ InvalidEnumVariant "Animal" ["Cow", "Dog"] "Car"
|
||||
getErrorMessageAndCtx err
|
||||
`shouldBe` ( "Expected value of enum type 'Animal' but got value 'Car'"
|
||||
++ "\nValid values: Cow | Dog",
|
||||
ctx1
|
||||
)
|
||||
|
||||
it "ExpectedType error" $ do
|
||||
let ctx1 = ctx (1, 4) (2, 5)
|
||||
let err = mkEvaluationError ctx1 $ ExpectedType NumberType StringType
|
||||
getErrorMessageAndCtx err `shouldBe` ("Expected type: number\nActual type: string", ctx1)
|
||||
getErrorMessageAndCtx expectedTypeErrorNumberAndStringForCtx1 `shouldBe` (expectedTypeErrorNumberAndStringMsgForCtx1, ctx1)
|
||||
|
||||
it "ExpectedTupleType error" $ do
|
||||
let ctx1 = ctx (1, 4) (2, 5)
|
||||
let err = mkEvaluationError ctx1 $ ExpectedTupleType 3 StringType
|
||||
getErrorMessageAndCtx err `shouldBe` ("Expected a tuple of size 3.\nActual type: string", ctx1)
|
||||
let expectedTupleTypeError = mkEvaluationError ctx1 $ ExpectedTupleType 3 StringType
|
||||
let expectedTupleTypeErrorMsg = "Expected a tuple of size 3.\nActual type: string"
|
||||
getErrorMessageAndCtx expectedTupleTypeError `shouldBe` (expectedTupleTypeErrorMsg, ctx1)
|
||||
|
||||
it "ExpectedType error nested in WithEvalContextError" $ do
|
||||
let err = wrapEvalErrors expectedTypeErrorNumberAndStringForCtx1 [InField "key"]
|
||||
let (actualMessage, actualCtx) = getErrorMessageAndCtx err
|
||||
actualCtx `shouldBe` ctx1
|
||||
actualMessage
|
||||
`shouldBe` intercalate
|
||||
"\n"
|
||||
[ "Expected type: number",
|
||||
"Actual type: string",
|
||||
"",
|
||||
"-> For dictionary field 'key'"
|
||||
]
|
||||
|
||||
it "ExpectedType error nested in two levels of WithEvalContextError" $ do
|
||||
let err = wrapEvalErrors expectedTypeErrorNumberAndStringForCtx1 [InTuple, InField "key"]
|
||||
let (actualMessage, actualCtx) = getErrorMessageAndCtx err
|
||||
actualCtx `shouldBe` ctx1
|
||||
actualMessage
|
||||
`shouldBe` intercalate
|
||||
"\n"
|
||||
[ expectedTypeErrorNumberAndStringMsgForCtx1,
|
||||
"",
|
||||
"-> In tuple:",
|
||||
" -> For dictionary field 'key'"
|
||||
]
|
||||
|
||||
it "ExpectedType error nested in many levels of WithEvalContextError" $ do
|
||||
let err = wrapEvalErrors expectedTypeErrorNumberAndStringForCtx1 [InList, ForVariable "var", InTuple, InField "key"]
|
||||
let (actualMessage, actualCtx) = getErrorMessageAndCtx err
|
||||
actualCtx `shouldBe` ctx1
|
||||
actualMessage
|
||||
`shouldBe` intercalate
|
||||
"\n"
|
||||
[ expectedTypeErrorNumberAndStringMsgForCtx1,
|
||||
"",
|
||||
"-> In list:",
|
||||
" -> For variable 'var':",
|
||||
" -> In tuple:",
|
||||
" -> For dictionary field 'key'"
|
||||
]
|
||||
|
@ -208,9 +208,10 @@ spec_Analyzer = do
|
||||
intercalate
|
||||
"\n"
|
||||
[ "Type error:",
|
||||
" For dictionary field 'to':",
|
||||
" Expected type: page (declaration type)",
|
||||
" Actual type: route (declaration type)"
|
||||
" Expected type: page (declaration type)",
|
||||
" Actual type: route (declaration type)",
|
||||
"",
|
||||
" -> For dictionary field 'to'"
|
||||
]
|
||||
)
|
||||
|
||||
@ -239,10 +240,11 @@ spec_Analyzer = do
|
||||
intercalate
|
||||
"\n"
|
||||
[ "Type error:",
|
||||
" For dictionary field 'dependencies':",
|
||||
" For list element:",
|
||||
" Expected type: (string, string)",
|
||||
" Actual type: (string, number)"
|
||||
" Expected type: (string, string)",
|
||||
" Actual type: (string, number)",
|
||||
"",
|
||||
" -> For dictionary field 'dependencies':",
|
||||
" -> In list"
|
||||
]
|
||||
)
|
||||
|
||||
@ -262,10 +264,11 @@ spec_Analyzer = do
|
||||
intercalate
|
||||
"\n"
|
||||
[ "Type error:",
|
||||
" For dictionary field 'version':",
|
||||
" Can't mix the following types:",
|
||||
" - number",
|
||||
" - string"
|
||||
" Can't mix the following types:",
|
||||
" - number",
|
||||
" - string",
|
||||
"",
|
||||
" -> For dictionary field 'version'"
|
||||
]
|
||||
)
|
||||
|
||||
|
@ -35,6 +35,11 @@ spec_toUpperFirst = do
|
||||
it "Capitalizes first letter of string" $ do
|
||||
toUpperFirst "fooBar" `shouldBe` "FooBar"
|
||||
|
||||
spec_second3 :: Spec
|
||||
spec_second3 = do
|
||||
it "Applies the function to the second element of a tuple of size 3." $ do
|
||||
second3 negate ("1" :: String, 2 :: Int, True) `shouldBe` ("1", -2, True)
|
||||
|
||||
spec_jsonSet :: Spec
|
||||
spec_jsonSet = do
|
||||
let inputObj =
|
||||
@ -64,13 +69,17 @@ spec_jsonSet = do
|
||||
|
||||
spec_indent :: Spec
|
||||
spec_indent = do
|
||||
describe "indent should indent given text correctly" $ do
|
||||
it "when just one line of text" $ do
|
||||
describe "Should indent the given text correctly" $ do
|
||||
it "When given only a single line of text" $ do
|
||||
indent 2 "foo" `shouldBe` " foo"
|
||||
it "when multiple lines of text" $ do
|
||||
it "When given multiple lines of text" $ do
|
||||
indent 3 "foo\nbar" `shouldBe` " foo\n bar"
|
||||
it "when text is already somewhat indented" $ do
|
||||
indent 4 " foo\n bar" `shouldBe` " foo\n bar"
|
||||
it "When given a single line of text with existing indentation" $ do
|
||||
indent 4 " foo" `shouldBe` " foo"
|
||||
it "When given multiple lines of text with existing indentation" $ do
|
||||
indent 4 "foo\n bar" `shouldBe` " foo\n bar"
|
||||
it "When given text containing empty lines" $ do
|
||||
indent 4 "foo\n\nbar\n baz\n\n ban" `shouldBe` " foo\n\n bar\n baz\n\n ban"
|
||||
|
||||
spec_concatShortPrefixAndText :: Spec
|
||||
spec_concatShortPrefixAndText = do
|
||||
|
@ -115,6 +115,7 @@ library
|
||||
FilePath.Extra
|
||||
Wasp.Analyzer
|
||||
Wasp.Analyzer.AnalyzeError
|
||||
Wasp.Analyzer.ErrorMessage
|
||||
Wasp.Analyzer.Evaluator
|
||||
Wasp.Analyzer.Evaluator.Bindings
|
||||
Wasp.Analyzer.Evaluator.Evaluation
|
||||
|
Loading…
Reference in New Issue
Block a user