Introduce some parser tests helpers. Use these on the tests for the Underscore patterns, and in particular to test we get the correct error when an Underscore **variable** is attempted to be used in an expression.

compiler/src/Parse/Symbol.hs

@@ -26,6 +26,7 @@ data BadOperator
   | BadArrow
   | BadEquals
   | BadHasType
+  deriving (Show)
 
 operator :: (Row -> Col -> x) -> (BadOperator -> Row -> Col -> x) -> Parser x Name.Name
 operator toExpectation toError =

compiler/src/Reporting/Error/Syntax.hs

@@ -207,6 +207,7 @@ data Expr
   | Space Space Row Col
   | IndentOperatorRight Name.Name Row Col
   | WildCard WildCard Row Col
+  deriving (Show)
 
 data Record
   = RecordOpen Row Col
@@ -223,6 +224,7 @@ data Record
   | RecordIndentField Row Col
   | RecordIndentEquals Row Col
   | RecordIndentExpr Row Col
+  deriving (Show)
 
 data Array
   = ArraySpace Space Row Col
@@ -233,6 +235,7 @@ data Array
     ArrayIndentOpen Row Col
   | ArrayIndentEnd Row Col
   | ArrayIndentExpr Row Col
+  deriving (Show)
 
 data Func
   = FuncSpace Space Row Col
@@ -243,6 +246,7 @@ data Func
     FuncIndentArg Row Col
   | FuncIndentArrow Row Col
   | FuncIndentBody Row Col
+  deriving (Show)
 
 data Case
   = CaseSpace Space Row Col
@@ -258,6 +262,7 @@ data Case
   | CaseIndentArrow Row Col
   | CaseIndentBranch Row Col
   | CasePatternAlignment Word16 Row Col
+  deriving (Show)
 
 data If
   = IfSpace Space Row Col
@@ -274,6 +279,7 @@ data If
   | IfIndentThenBranch Row Col
   | IfIndentElseBranch Row Col
   | IfIndentElse Row Col
+  deriving (Show)
 
 data Let
   = LetSpace Space Row Col
@@ -286,6 +292,7 @@ data Let
   | LetIndentDef Row Col
   | LetIndentIn Row Col
   | LetIndentBody Row Col
+  deriving (Show)
 
 data Parenthesized
   = ParenthesizedOpen Row Col
@@ -298,6 +305,7 @@ data Parenthesized
     ParenthesizedIndentOpen Row Col
   | ParenthesizedIndentEnd Row Col
   | ParenthesizedIndentExpr Row Col
+  deriving (Show)
 
 data Def
   = DefSpace Space Row Col
@@ -311,6 +319,7 @@ data Def
   | DefIndentType Row Col
   | DefIndentBody Row Col
   | DefAlignment Word16 Row Col
+  deriving (Show)
 
 data Destruct
   = DestructSpace Space Row Col
@@ -319,6 +328,7 @@ data Destruct
   | DestructBody Expr Row Col
   | DestructIndentEquals Row Col
   | DestructIndentBody Row Col
+  deriving (Show)
 
 -- PATTERNS
 
@@ -337,6 +347,7 @@ data Pattern
   | --
     PIndentStart Row Col
   | PIndentAlias Row Col
+  deriving (Show)
 
 data PParenthesized
   = PParenthesizedSpace Space Row Col
@@ -344,6 +355,7 @@ data PParenthesized
   | PParenthesizedPattern Pattern Row Col
   | PParenthesizedIndentEnd Row Col
   | PParenthesizedEnd Row Col
+  deriving (Show)
 
 data PRecord
   = PRecordOpen Row Col
@@ -356,6 +368,7 @@ data PRecord
     PRecordIndentOpen Row Col
   | PRecordIndentEnd Row Col
   | PRecordIndentField Row Col
+  deriving (Show)
 
 data PArray
   = PArrayOpen Row Col
@@ -366,6 +379,7 @@ data PArray
     PArrayIndentOpen Row Col
   | PArrayIndentEnd Row Col
   | PArrayIndentExpr Row Col
+  deriving (Show)
 
 -- TYPES
 
@@ -377,6 +391,7 @@ data Type
   | TSpace Space Row Col
   | --
     TIndentStart Row Col
+  deriving (Show)
 
 data TRecord
   = TRecordOpen Row Col
@@ -393,6 +408,7 @@ data TRecord
   | TRecordIndentColon Row Col
   | TRecordIndentType Row Col
   | TRecordIndentEnd Row Col
+  deriving (Show)
 
 data TParenthesis
   = TParenthesisEnd Row Col
@@ -401,6 +417,7 @@ data TParenthesis
   | --
     TParenthesisIndentOpen Row Col
   | TParenthesisIndentEnd Row Col
+  deriving (Show)
 
 -- LITERALS
 
@@ -408,26 +425,31 @@ data Char
   = CharEndless
   | CharEscape Escape
   | CharNotString Word16
+  deriving (Show)
 
 data String
   = StringEndless_Single
   | StringEndless_Multi
   | StringEscape Escape
+  deriving (Show)
 
 data Escape
   = EscapeUnknown
   | BadUnicodeFormat Word16
   | BadUnicodeCode Word16
   | BadUnicodeLength Word16 Int Int
+  deriving (Show)
 
 data Number
   = NumberEnd
   | NumberDot Int
   | NumberHexDigit
   | NumberNoLeadingZero
+  deriving (Show)
 
 data WildCard
   = WildCardAttempt Name.Name
+  deriving (Show)
 
 -- MISC
 

tests/Parse/Helpers.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Parse.Helpers 
+    ( checkParse
+    , checkSuccessfulParse
+    , checkParseError
+    )
+where
+
+import Data.ByteString qualified as BS
+import Parse.Space qualified as Space
+import Parse.Primitives qualified as P
+import Reporting.Annotation qualified as A
+import Test.Hspec (Spec, describe, it)
+import Test.Hspec qualified as Hspec
+
+
+checkParse :: (Show error, Show target) => Space.Parser error (A.Located target) -> (P.Row -> P.Col -> error) -> (Either error (A.Located target, A.Position) -> Bool) -> BS.ByteString -> IO ()
+checkParse parser toBadEnd checkResult str =
+    Hspec.shouldSatisfy
+        ( P.fromByteString parser toBadEnd str)
+        checkResult
+
+
+checkSuccessfulParse :: (Show error, Show target) => Space.Parser error (A.Located target) -> (P.Row -> P.Col -> error) -> (target -> Bool) -> BS.ByteString -> IO ()
+checkSuccessfulParse parser toBadEnd checkTarget =
+    let checkResult result =
+           case result of
+             Right (A.At _ target, _) ->
+                checkTarget target
+             Left _ ->
+                False
+    in
+    checkParse parser toBadEnd checkResult
+
+checkParseError :: (Show error, Show target)=> Space.Parser error (A.Located target) -> (P.Row -> P.Col -> error) -> (error -> Bool) -> BS.ByteString -> IO ()
+checkParseError parser toBadEnd checkError =
+    let checkResult result =
+           case result of
+             Left error  ->
+                checkError error
+             Right _ ->
+                False
+    in
+    checkParse parser toBadEnd checkResult
+    
+

tests/Parse/UnderscorePatternSpec.hs

@@ -4,62 +4,56 @@ module Parse.UnderscorePatternSpec where
 
 import AST.Source qualified as Src
 import Data.ByteString qualified as BS
+import Data.ByteString.Internal qualified as B
+import Data.Name qualified as Name
 import Helpers.Instances ()
+import Parse.Expression qualified as Expression
+import Parse.Helpers qualified as Helpers
 import Parse.Pattern qualified as Pattern
 import Parse.Primitives qualified as P
 import Reporting.Annotation qualified as A
+import Reporting.Error.Syntax qualified as Error.Syntax
 import Test.Hspec (Spec, describe, it)
 import Test.Hspec qualified as Hspec
 
-data ParseError
-  = ExprError P.Row P.Col
-  | OtherError String P.Row P.Col
-  deriving (Show, Eq)
-
 spec :: Spec
 spec = do
   describe "Wildcard patterns" $ do
     it "regression test" $
-      parse "_"
-    it "Newly allowed named wildcard pattern" $ do
-      parse "_argument"
-    it "You can have underscores as part of the lower variable which follows the underscore" $ do
-      parse "_hello_world"
-    it "Keywords are not allowed as the whole variable part of an underscore pattern" $ do
+      parse "" "_"
+    it "Newly allowed named wildcard pattern" $
+      parse "argument" "_argument"
+    it "You can have underscores as part of the lower variable which follows the underscore" $
+      parse "hello_world" "_hello_world"
+    it "Keywords are not allowed as the whole variable part of an underscore pattern" $
       failToParse "_let"
-    it "But you can have a keyword as **part** of a variable name just as for normal variable names." $ do
-      parse "_let_down"
-    it "But you cannot start with multiple underscores" $ do
+    it "But you can have a keyword as **part** of a variable name just as for normal variable names." $
+      parse "let_down" "_let_down"
+    it "But you cannot start with multiple underscores" $
       failToParse "__hello"
-    it "But it must be an lower name, for an underscore pattern" $ do
+    it "But it must be a lower name, for an underscore pattern" $
       failToParse "_Hello"
+    it "We should give the specialised error when we attempt to parse _key as an expression" $
+      let isWildCardAttemptError :: Error.Syntax.Expr -> Bool
+          isWildCardAttemptError error =
+            case error of
+              Error.Syntax.WildCard (Error.Syntax.WildCardAttempt _) _ _ ->
+                True
+              _ ->
+                False
+       in Helpers.checkParseError Expression.expression Error.Syntax.Start isWildCardAttemptError "_key"
 
-attemptParse :: (Either ParseError (Src.Pattern, A.Position) -> Bool) -> BS.ByteString -> IO ()
-attemptParse checkResult str =
-  Hspec.shouldSatisfy
-    ( P.fromByteString
-        (P.specialize (\_ row col -> ExprError row col) Pattern.expression)
-        (OtherError "fromByteString failed")
-        str
-    )
-    checkResult
-
-parse :: BS.ByteString -> IO ()
-parse =
-  let isWildCardPattern :: Either x (Src.Pattern, A.Position) -> Bool
-      isWildCardPattern result =
-        case result of
-          Right (A.At _ (Src.PAnything _), _) -> True
-          _ -> False
-   in attemptParse isWildCardPattern
+parse :: String -> BS.ByteString -> IO ()
+parse expectedName =
+  let isWildCardPattern :: Src.Pattern_ -> Bool
+      isWildCardPattern pattern =
+        case pattern of
+          Src.PAnything name ->
+            expectedName == (Name.toChars name)
+          _ ->
+            False
+   in Helpers.checkSuccessfulParse Pattern.expression Error.Syntax.PStart isWildCardPattern
 
 failToParse :: BS.ByteString -> IO ()
 failToParse =
-  let isError :: Either x (Src.Pattern, A.Position) -> Bool
-      isError result =
-        case result of
-          Left _ ->
-            True
-          _ ->
-            False
-   in attemptParse isError
+  Helpers.checkParseError Pattern.expression Error.Syntax.PStart (\_ -> True)