Fix incorrect parsing of escaped strings in Wasp (#699)

* Fixed incorrect handling of escaped strings in parser.

* Refactored Parser golden tests a bit.

* Moved PrettyPrinter for Parser AST to Parser.

* fix

waspc/src/Wasp/Analyzer/Parser/AST/PrettyPrinter.hs

@@ -0,0 +1,67 @@
+module Wasp.Analyzer.Parser.AST.PrettyPrinter
+  ( prettyPrintAST,
+    prettyPrintStmt,
+    prettyPrintExpr,
+    prettyPrintCtx,
+    prettyPrintWithCtx,
+  )
+where
+
+import Wasp.Analyzer.Parser.AST (AST (AST), Expr (..), ExtImportName (..), Stmt (..))
+import Wasp.Analyzer.Parser.Ctx (Ctx (Ctx), WithCtx (..))
+import Wasp.Analyzer.Parser.SourcePosition (SourcePosition (SourcePosition))
+import Wasp.Analyzer.Parser.SourceRegion (SourceRegion (SourceRegion))
+import Wasp.Util (indent)
+
+prettyPrintAST :: AST -> String
+prettyPrintAST (AST stmts) = "(AST\n" ++ indent 2 (concatMap prettyPrintStmt stmts) ++ ")\n"
+
+prettyPrintStmt :: WithCtx Stmt -> String
+prettyPrintStmt (WithCtx ctx (Decl typ name body)) =
+  prettyPrintWithCtx "(Decl" ctx ++ " type=" ++ typ ++ " name=" ++ name ++ "\n"
+    ++ indent 2 (prettyPrintExpr body)
+    ++ ")\n"
+
+prettyPrintExpr :: WithCtx Expr -> String
+prettyPrintExpr (WithCtx ctx expr) = "(" ++ prettyPrintWithCtx (exprName expr) ctx ++ showDetails expr ++ ")\n"
+  where
+    exprName (Dict _) = "Dict"
+    exprName (List _) = "List"
+    exprName (Tuple _) = "Tuple"
+    exprName (StringLiteral _) = "String"
+    exprName (IntegerLiteral _) = "Integer"
+    exprName (DoubleLiteral _) = "Double"
+    exprName (BoolLiteral _) = "Bool"
+    exprName (ExtImport _ _) = "ExtImport"
+    exprName (Var _) = "Var"
+    exprName (Quoter _ _) = "Quoter"
+
+    showDetails (Dict []) = ""
+    showDetails (Dict entries) = "\n" ++ indent 2 (concatMap showEntry entries)
+    showDetails (List []) = ""
+    showDetails (List values) = "\n" ++ indent 2 (concatMap prettyPrintExpr values)
+    showDetails (Tuple (a, b, cs)) = "\n" ++ indent 2 (concatMap prettyPrintExpr (a : b : cs))
+    showDetails (StringLiteral s) = showLiteral s
+    showDetails (IntegerLiteral n) = showLiteral n
+    showDetails (DoubleLiteral n) = showLiteral n
+    showDetails (BoolLiteral b) = showLiteral b
+    showDetails (ExtImport name path) = " " ++ showExtImportName name ++ " path=" ++ show path
+    showDetails (Var v) = " variable=" ++ v
+    showDetails (Quoter tag contents) = " tag=" ++ tag ++ "\n" ++ indent 2 ("{=" ++ contents ++ "=}") ++ "\n"
+
+    showEntry (key, value) = "(DictEntry key=" ++ key ++ "\n" ++ indent 2 (prettyPrintExpr value) ++ ")\n"
+
+    showExtImportName (ExtImportField name) = "field=" ++ name
+    showExtImportName (ExtImportModule name) = "module=" ++ name
+
+    showLiteral :: Show a => a -> String
+    showLiteral value = " value=" ++ show value
+
+prettyPrintWithCtx :: String -> Ctx -> String
+prettyPrintWithCtx name ctx = name ++ "@" ++ prettyPrintCtx ctx
+
+prettyPrintCtx :: Ctx -> String
+prettyPrintCtx (Ctx (SourceRegion (SourcePosition startLine startColumn) (SourcePosition endLine endColumn)))
+  | startLine == endLine && startColumn == endColumn = show startLine ++ ":" ++ show startColumn
+  | startLine == endLine = show startLine ++ ":" ++ show startColumn ++ "-" ++ show endColumn
+  | otherwise = show startLine ++ ":" ++ show startColumn ++ "-" ++ show endLine ++ ":" ++ show endColumn

waspc/src/Wasp/Analyzer/Parser/AbstractParser.hs

@@ -91,7 +91,7 @@ coerceExpr (SyntaxNode kind width children : remaining)
   | otherwise = do
       startPos <- gets pstateStartPos
       expr <- case kind of
-        S.String -> AST.StringLiteral . tail . init <$> consume width
+        S.String -> AST.StringLiteral . read <$> consume width
         S.Int -> AST.IntegerLiteral . read <$> consume width
         S.Double -> AST.DoubleLiteral . read <$> consume width
         S.BoolTrue -> advance width >> return (AST.BoolLiteral True)

waspc/src/Wasp/Analyzer/Parser/PrettyPrinter.hs

@@ -0,0 +1,16 @@
+module Wasp.Analyzer.Parser.PrettyPrinter
+  ( prettyPrintParserResult,
+  )
+where
+
+import Wasp.Analyzer.Parser.AST (AST)
+import Wasp.Analyzer.Parser.AST.PrettyPrinter (prettyPrintAST, prettyPrintCtx)
+import Wasp.Analyzer.Parser.ParseError (ParseError, getErrorMessageAndCtx)
+import Wasp.Util (indent)
+
+prettyPrintParserResult :: Either ParseError AST -> String
+prettyPrintParserResult (Right ast) = prettyPrintAST ast
+prettyPrintParserResult (Left err) = "Parse error at " ++ locationStr ++ ":\n" ++ indent 2 message ++ "\n"
+  where
+    (message, ctx) = getErrorMessageAndCtx err
+    locationStr = prettyPrintCtx ctx

waspc/test/Analyzer/ParserTest.hs

@@ -7,8 +7,7 @@ import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.Golden (findByExtension, goldenVsStringDiff)
 import Test.Tasty.Hspec
 import Wasp.Analyzer.Parser hiding (withCtx)
-import Wasp.Analyzer.Parser.ParseError (getErrorMessageAndCtx)
-import Wasp.Util (indent)
+import Wasp.Analyzer.Parser.PrettyPrinter (prettyPrintParserResult)
 
 spec_IsValidWaspIdentifier :: Spec
 spec_IsValidWaspIdentifier = do
@@ -29,9 +28,13 @@ spec_ParseExpression = do
   it "Parses int literals" $ do
     parseExpression "5" `shouldBe` Right (IntegerLiteral 5)
 
--- | To add more test cases to the parser, create a `.wasp` and `.golden` file
--- in the `parserTests` directory with wasp source code to parse and the expected
--- output, respectively.
+test_ParseStatements :: IO TestTree
+test_ParseStatements = do
+  -- To make writing tests easier, we use golden files to define our tests here.
+  --
+  -- In parseStatementsTests/ dir there are .wasp files and .golden files, where
+  -- each .wasp source file represents input of a single test,
+  -- while corresponding .golden file represents expected output of that test.
   --
   -- See `declsDictsAndLiterals` for an example of a test case with a successful
   -- parse.
@@ -45,85 +48,27 @@ spec_ParseExpression = do
   --
   -- When the golden file does not match the actual output, a diff will be shown
   -- in the terminal.
-test_Parser :: IO TestTree
-test_Parser = do
-  waspFiles <- findByExtension [".wasp"] "./test/Analyzer/parserTests"
-  return $ testGroup "Wasp.Analyzer.Parser" $ map testCase waspFiles
+  waspFiles <- findByExtension [".wasp"] "./test/Analyzer/ParserTest/parseStatementsTests"
+  return $
+    testGroup "Wasp.Analyzer.Parser.parseStatements" $
+      makeParseStatementsGoldenTest <$> waspFiles
 
--- | Run a single golden test case for the given wasp file.
-testCase :: FilePath -> TestTree
-testCase waspFile =
-  let astFile = replaceExtension waspFile ".golden"
+-- | Make a golden test where given wasp source file is parsed with
+-- @parseStatements@ and the AST that is the result of parsing is the output of test.
+-- This means that AST will be persisted to codebase as a "golden" output and compared
+-- against the next time this test is run -> any difference is reported as failed test.
+-- If no such file exists yet on the disk, it is created.
+makeParseStatementsGoldenTest :: FilePath -> TestTree
+makeParseStatementsGoldenTest waspFile =
+  let goldenAstFile = replaceExtension waspFile ".golden"
+      testCaseName = takeBaseName waspFile
+      diffCmd = \ref new -> ["diff", "-u", ref, new]
    in goldenVsStringDiff
-        (takeBaseName waspFile) -- Test case name
-        (\ref new -> ["diff", "-u", ref, new]) -- Diff command
-        astFile -- Golden file path
+        testCaseName
+        diffCmd
+        goldenAstFile
         ( do
-            -- Read from wasp file and return parse result
+            -- Read from wasp file and return parse result.
             source <- BSC.unpack <$> BS.readFile waspFile
-            return $ BSC.pack $ showResult $ parseStatements source
+            return $ BSC.pack $ prettyPrintParserResult $ parseStatements source
         )
-
--- | Pretty print the result of a parse. The purpose of a custom implementation
--- here is to make golden file diffs readable/useful.
---
--- To see examples of pretty prints, see the golden files in `./parserTests`.
-showResult :: Either ParseError AST -> String
-showResult (Left err) =
-  let (message, ctx) = getErrorMessageAndCtx err
-      locationStr = "at " ++ showCtx ctx
-   in "Parse error " ++ locationStr ++ ":\n" ++ indent 2 message ++ "\n"
-showResult (Right ast) = showAST ast
-
-showAST :: AST -> String
-showAST (AST stmts) = "(AST\n" ++ indent 2 (concatMap showStmt stmts) ++ ")\n"
-
-showStmt :: WithCtx Stmt -> String
-showStmt (WithCtx ctx (Decl typ name body)) =
-  withCtx "(Decl" ctx ++ " type=" ++ typ ++ " name=" ++ name ++ "\n"
-    ++ indent 2 (showExpr body)
-    ++ ")\n"
-
-showExpr :: WithCtx Expr -> String
-showExpr (WithCtx ctx expr) = "(" ++ withCtx (exprName expr) ctx ++ showDetails expr ++ ")\n"
-  where
-    exprName (Dict _) = "Dict"
-    exprName (List _) = "List"
-    exprName (Tuple _) = "Tuple"
-    exprName (StringLiteral _) = "String"
-    exprName (IntegerLiteral _) = "Integer"
-    exprName (DoubleLiteral _) = "Double"
-    exprName (BoolLiteral _) = "Bool"
-    exprName (ExtImport _ _) = "ExtImport"
-    exprName (Var _) = "Var"
-    exprName (Quoter _ _) = "Quoter"
-
-    showDetails (Dict []) = ""
-    showDetails (Dict entries) = "\n" ++ indent 2 (concatMap showEntry entries)
-    showDetails (List []) = ""
-    showDetails (List values) = "\n" ++ indent 2 (concatMap showExpr values)
-    showDetails (Tuple (a, b, cs)) = "\n" ++ indent 2 (concatMap showExpr (a : b : cs))
-    showDetails (StringLiteral s) = showLiteral s
-    showDetails (IntegerLiteral n) = showLiteral n
-    showDetails (DoubleLiteral n) = showLiteral n
-    showDetails (BoolLiteral b) = showLiteral b
-    showDetails (ExtImport name path) = " " ++ showExtImportName name ++ " path=" ++ show path
-    showDetails (Var v) = " variable=" ++ v
-    showDetails (Quoter tag contents) = " tag=" ++ tag ++ "\n" ++ indent 2 ("{=" ++ contents ++ "=}") ++ "\n"
-
-    showEntry (key, value) = "(DictEntry key=" ++ key ++ "\n" ++ indent 2 (showExpr value) ++ ")\n"
-
-    showExtImportName (ExtImportField name) = "field=" ++ name
-    showExtImportName (ExtImportModule name) = "module=" ++ name
-
-    showLiteral :: Show a => a -> String
-    showLiteral value = " value=" ++ show value
-
-withCtx :: String -> Ctx -> String
-withCtx name ctx = name ++ "@" ++ showCtx ctx
-
-showCtx :: Ctx -> String
-showCtx (Ctx (SourceRegion (SourcePosition sl sc) (SourcePosition el ec)))
-  | sl == el && sc == ec = show sl ++ ":" ++ show sc
-  | sl == el = show sl ++ ":" ++ show sc ++ "-" ++ show ec
-  | otherwise = show sl ++ ":" ++ show sc ++ "-" ++ show el ++ ":" ++ show ec

waspc/test/Analyzer/ParserTest/parseStatementsTests/declsDictsAndLiterals.golden

@@ -5,7 +5,7 @@
         (String@2:11-25 value="Hello Wasp =}")
       )
       (DictEntry key=escapedString
-        (String@3:18-29 value="Look, a \\\"")
+        (String@3:18-29 value="Look, a \"")
       )
       (DictEntry key=integer
         (Integer@4:12-13 value=42)

waspc/waspc.cabal

@@ -128,6 +128,7 @@ library
       Wasp.Analyzer.Evaluator.EvaluationError
       Wasp.Analyzer.Parser
       Wasp.Analyzer.Parser.AST
+      Wasp.Analyzer.Parser.AST.PrettyPrinter
       Wasp.Analyzer.Parser.Ctx
       Wasp.Analyzer.Parser.ConcreteParser
       Wasp.Analyzer.Parser.ConcreteParser.ParseError
@@ -137,6 +138,7 @@ library
       Wasp.Analyzer.Parser.Lexer.Lexer
       Wasp.Analyzer.Parser.Lexer.Internal
       Wasp.Analyzer.Parser.ParseError
+      Wasp.Analyzer.Parser.PrettyPrinter
       Wasp.Analyzer.Parser.AbstractParser
       Wasp.Analyzer.Parser.AbstractParser.Monad
       Wasp.Analyzer.Parser.SourcePosition