wasp-lang/wasp
1
1
Fork 0
mirror of https://github.com/wasp-lang/wasp.git synced 2024-09-11 15:26:19 +03:00
Code Issues Projects Releases Wiki Activity

[Analyzer] Reverse the order of Wasp error messages (#500)

Browse Source 
* 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:
Filip Sodić 2022-03-23 13:18:43 +01:00 committed by GitHub
parent 1995ccdb9d
commit 52badd651e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 188 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
waspc/src/Wasp/Analyzer/ErrorMessage.hs Normal file
View 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 ++)

71
waspc/src/Wasp/Analyzer/Evaluator/EvaluationError.hs
View File

@ -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 ++ "'"

53
waspc/src/Wasp/Analyzer/TypeChecker/TypeError.hs
View File

@ -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)

13
waspc/src/Wasp/Util.hs
View File

@ -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>

67
waspc/test/Analyzer/Evaluation/EvaluationErrorTest.hs
View File

@ -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'"
]

25
waspc/test/AnalyzerTest.hs
View File

@ -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'"
]
)

19
waspc/test/UtilTest.hs
View File

@ -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

1
waspc/waspc.cabal
View File

@ -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