From 6a963bf5e0183b8ec39c7f7404529a8640eb6ce8 Mon Sep 17 00:00:00 2001 From: Gilbert Ramirez Date: Sat, 10 Jan 2026 16:17:18 -0600 Subject: [PATCH 1/8] Create a unit test for incomplete exhaustiveness check This is for issue #359 It's a bit fragile, as it directly builds up an AST, instead of relying on the parser to create one. It checks that the "check" fucntion returns an Incomplete. Today, this test fails, of course. --- tests/Nitpick/PatternMatchesSpec.hs | 162 ++++++++++++++++++++++++++++ 1 file changed, 162 insertions(+) create mode 100644 tests/Nitpick/PatternMatchesSpec.hs diff --git a/tests/Nitpick/PatternMatchesSpec.hs b/tests/Nitpick/PatternMatchesSpec.hs new file mode 100644 index 00000000..8f1bab73 --- /dev/null +++ b/tests/Nitpick/PatternMatchesSpec.hs @@ -0,0 +1,162 @@ +module Nitpick.PatternMatchesSpec (spec) where + +import AST.Canonical qualified as Can +import AST.Source qualified as Src +import Data.Index qualified as Index +import Data.Map qualified as Map +import Data.Name qualified as N +import Data.NonEmptyList qualified as NE +import Data.Utf8 qualified as Utf8 +import Data.Word (Word16) +import Gren.ModuleName qualified as ModuleName +import Gren.Package qualified as Pkg +import Reporting.Annotation qualified as A + +import Nitpick.PatternMatches (check, Error (..)) + +import Test.Hspec (Spec, describe, it) + +-- Create a Located +at :: A.Region -> a -> A.Located a +at = A.At + +-- Create a Region +region :: A.Position -> A.Position -> A.Region +region = A.Region + +-- Creat a Position +pos :: Word16 -> Word16 -> A.Position +pos = A.Position + +-- Create a Can.Union for Bool +boolUnion :: Can.Union +boolUnion = + Can.Union + { Can._u_vars = [] + , Can._u_alts = + [ Can.Ctor (N.fromChars "True") (Index.first) 0 [] + , Can.Ctor (N.fromChars "False") (Index.next (Index.first)) 0 [] + ] + , Can._u_numAlts = 2 + , Can._u_opts = Can.Enum + } + +emptyUnions :: Map.Map N.Name Can.Union +emptyUnions = Map.empty + +emptyAliases :: Map.Map N.Name Can.Alias +emptyAliases = Map.empty + +emptyBinops :: Map.Map N.Name Can.Binop +emptyBinops = Map.empty + +packageName :: String -> String -> Pkg.Name +packageName pkgName authorName = + Pkg.Name + { Pkg._author = Utf8.fromChars authorName + , Pkg._project = Utf8.fromChars pkgName + } + +moduleNameCanonical :: String -> String -> String -> ModuleName.Canonical +moduleNameCanonical pkgName authorName modName = + ModuleName.Canonical + { ModuleName._package = packageName pkgName authorName + , ModuleName._module = N.fromChars modName + } + +-- Create a Module from Decls +makeModule :: Can.Decls -> Can.Module +makeModule decls = + Can.Module + { Can._name = moduleNameCanonical "TestPkg" "gren-devs" "TestModule" + -- The region here is made up and has no pertinent meaning + , Can._exports = Can.ExportEverything (region (pos 1 1) (pos 3 3)) + -- The region here is made up and has no pertinent meaning + , Can._docs = Src.NoDocs (region (pos 1 1) (pos 3 3)) + , Can._decls = decls + , Can._unions = emptyUnions + , Can._aliases = emptyAliases + , Can._binops = emptyBinops + , Can._effects = Can.NoEffects + } + +-- In the unit test we may need to induce a failure just to appease +-- the compiler. Use this Region when doing so. +failedRegion :: A.Region +failedRegion = + region (pos 99 99) (pos 99 99) + + + +-- Incomplete Bool Records +{- +fn r = + when r is + { a = False, b = True } -> 1 + { a = True, b = False } -> 2 +-} +-- The AST +-- Debug.Trace trace was used to show the decls during "check", +-- and this function was entered into "gren repl". +-- The result was used to create this AST +incompleteBoolRecordsDecls :: Can.Decls +incompleteBoolRecordsDecls = + Can.Declare + (Can.Def (at (region (pos 2 1) (pos 2 6)) (N.fromChars "fn")) + [ at (region (pos 2 7) (pos 2 8)) (Can.PVar (N.fromChars "r")) ] + (at (region (pos 3 5) (pos 5 37)) + (Can.Case (at (region (pos 3 10) (pos 3 11)) (Can.VarLocal (N.fromChars "r"))) + [ Can.CaseBranch + (at (region (pos 4 9) (pos 4 32)) + (Can.PRecord + [ at (region (pos 4 11) (pos 4 20)) (Can.PRFieldPattern (N.fromChars "a") (at (region (pos 4 15) (pos 4 20)) (Can.PBool boolUnion False))) + , at (region (pos 4 22) (pos 4 30)) (Can.PRFieldPattern (N.fromChars "b") (at (region (pos 4 26) (pos 4 30)) (Can.PBool boolUnion True))) + ] + ) + ) + (at (region (pos 4 36) (pos 4 37)) (Can.Int 1)) + , Can.CaseBranch + (at (region (pos 5 9) (pos 5 32)) + (Can.PRecord + [ at (region (pos 5 11) (pos 5 19)) (Can.PRFieldPattern (N.fromChars "a") (at (region (pos 5 15) (pos 5 19)) (Can.PBool boolUnion True))) + , at (region (pos 5 21) (pos 5 30)) (Can.PRFieldPattern (N.fromChars "b") (at (region (pos 5 25) (pos 5 30)) (Can.PBool boolUnion False))) + ] + ) + ) + (at (region (pos 5 36) (pos 5 37)) (Can.Int 2)) + ] + ) + ) + ) + Can.SaveTheEnvironment + + +spec :: Spec +spec = do + describe "PatternMatches tests" $ do + + it "Incomplete bool matrix fails to compile" $ do + let + -- result is: Either (NE.List Error) () + result = check (makeModule incompleteBoolRecordsDecls) + in + case result of + Left neListError -> + let + err = case NE.toList neListError of + (x : _) -> x + + -- Impossible, as we are using NonEmptyList + -- Return something we know will fail the test + [] -> Redundant failedRegion failedRegion 99 + in + case err of + -- Once we get the checker to return Incomplete, + -- mayb we can test the additional arguments to + -- "Incomplete" + Incomplete _ _ _ -> True + Redundant _ _ _ -> False + + Right () -> + -- The check succeeds, which is NOT what we want. + False From b57adb150140e2cce6aeeea57e696be141c780a0 Mon Sep 17 00:00:00 2001 From: Gilbert Ramirez Date: Sat, 10 Jan 2026 16:22:46 -0600 Subject: [PATCH 2/8] Add the 2 other changed files --- compiler/src/Gren/Package.hs | 2 +- gren.cabal | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/src/Gren/Package.hs b/compiler/src/Gren/Package.hs index 0265f82b..d4e318d2 100644 --- a/compiler/src/Gren/Package.hs +++ b/compiler/src/Gren/Package.hs @@ -50,7 +50,7 @@ import Parse.Primitives qualified as P import Reporting.Suggest qualified as Suggest import System.FilePath (()) --- PACKGE NAMES +-- PACKAGE NAMES data Name = Name { _author :: !Author, diff --git a/gren.cabal b/gren.cabal index af55bd25..112f9c7d 100644 --- a/gren.cabal +++ b/gren.cabal @@ -248,6 +248,7 @@ Test-Suite gren-tests -- tests Generate.VLQSpec + Nitpick.PatternMatchesSpec Parse.AliasSpec Parse.RecordUpdateSpec Parse.SpaceSpec @@ -258,6 +259,7 @@ Test-Suite gren-tests Build-Depends: gren:common, base >= 4.19 && <5, + containers >= 0.6 && < 0.7, utf8-string, bytestring >= 0.11 && < 0.12, hspec >= 2.7.10 && < 3 From 4f2ff0d237e3af1167bbc44a27097bd99c004734 Mon Sep 17 00:00:00 2001 From: Gilbert Ramirez Date: Sun, 11 Jan 2026 06:12:26 -0600 Subject: [PATCH 3/8] Remove helper functions from unit test Also, use A.zero as a "zero" Region, since we don't care about the position of the token within the source code. --- tests/Nitpick/PatternMatchesSpec.hs | 51 +++++++++++------------------ 1 file changed, 20 insertions(+), 31 deletions(-) diff --git a/tests/Nitpick/PatternMatchesSpec.hs b/tests/Nitpick/PatternMatchesSpec.hs index 8f1bab73..04640f32 100644 --- a/tests/Nitpick/PatternMatchesSpec.hs +++ b/tests/Nitpick/PatternMatchesSpec.hs @@ -7,7 +7,6 @@ import Data.Map qualified as Map import Data.Name qualified as N import Data.NonEmptyList qualified as NE import Data.Utf8 qualified as Utf8 -import Data.Word (Word16) import Gren.ModuleName qualified as ModuleName import Gren.Package qualified as Pkg import Reporting.Annotation qualified as A @@ -16,18 +15,6 @@ import Nitpick.PatternMatches (check, Error (..)) import Test.Hspec (Spec, describe, it) --- Create a Located -at :: A.Region -> a -> A.Located a -at = A.At - --- Create a Region -region :: A.Position -> A.Position -> A.Region -region = A.Region - --- Creat a Position -pos :: Word16 -> Word16 -> A.Position -pos = A.Position - -- Create a Can.Union for Bool boolUnion :: Can.Union boolUnion = @@ -65,14 +52,14 @@ moduleNameCanonical pkgName authorName modName = } -- Create a Module from Decls +-- We use A.zero to give an empty Region for exports and docs, as we don't +-- care about their values makeModule :: Can.Decls -> Can.Module makeModule decls = Can.Module { Can._name = moduleNameCanonical "TestPkg" "gren-devs" "TestModule" - -- The region here is made up and has no pertinent meaning - , Can._exports = Can.ExportEverything (region (pos 1 1) (pos 3 3)) - -- The region here is made up and has no pertinent meaning - , Can._docs = Src.NoDocs (region (pos 1 1) (pos 3 3)) + , Can._exports = Can.ExportEverything A.zero + , Can._docs = Src.NoDocs A.zero , Can._decls = decls , Can._unions = emptyUnions , Can._aliases = emptyAliases @@ -84,8 +71,7 @@ makeModule decls = -- the compiler. Use this Region when doing so. failedRegion :: A.Region failedRegion = - region (pos 99 99) (pos 99 99) - + A.Region (A.Position 99 99) (A.Position 99 99) -- Incomplete Bool Records @@ -99,31 +85,34 @@ fn r = -- Debug.Trace trace was used to show the decls during "check", -- and this function was entered into "gren repl". -- The result was used to create this AST +-- +-- Since we don't care about the true column/row range of each token +-- in the source code, we use A.zero for each Region. incompleteBoolRecordsDecls :: Can.Decls incompleteBoolRecordsDecls = Can.Declare - (Can.Def (at (region (pos 2 1) (pos 2 6)) (N.fromChars "fn")) - [ at (region (pos 2 7) (pos 2 8)) (Can.PVar (N.fromChars "r")) ] - (at (region (pos 3 5) (pos 5 37)) - (Can.Case (at (region (pos 3 10) (pos 3 11)) (Can.VarLocal (N.fromChars "r"))) + (Can.Def (A.At A.zero (N.fromChars "fn")) + [ A.At A.zero (Can.PVar (N.fromChars "r")) ] + (A.At A.zero + (Can.Case (A.At A.zero (Can.VarLocal (N.fromChars "r"))) [ Can.CaseBranch - (at (region (pos 4 9) (pos 4 32)) + (A.At A.zero (Can.PRecord - [ at (region (pos 4 11) (pos 4 20)) (Can.PRFieldPattern (N.fromChars "a") (at (region (pos 4 15) (pos 4 20)) (Can.PBool boolUnion False))) - , at (region (pos 4 22) (pos 4 30)) (Can.PRFieldPattern (N.fromChars "b") (at (region (pos 4 26) (pos 4 30)) (Can.PBool boolUnion True))) + [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion False))) + , A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion True))) ] ) ) - (at (region (pos 4 36) (pos 4 37)) (Can.Int 1)) + (A.At A.zero (Can.Int 1)) , Can.CaseBranch - (at (region (pos 5 9) (pos 5 32)) + (A.At A.zero (Can.PRecord - [ at (region (pos 5 11) (pos 5 19)) (Can.PRFieldPattern (N.fromChars "a") (at (region (pos 5 15) (pos 5 19)) (Can.PBool boolUnion True))) - , at (region (pos 5 21) (pos 5 30)) (Can.PRFieldPattern (N.fromChars "b") (at (region (pos 5 25) (pos 5 30)) (Can.PBool boolUnion False))) + [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion True))) + , A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion False))) ] ) ) - (at (region (pos 5 36) (pos 5 37)) (Can.Int 2)) + (A.At A.zero (Can.Int 2)) ] ) ) From d48883eb51ef51f44c1a3217e6e40c2a1fdef93b Mon Sep 17 00:00:00 2001 From: Gilbert Ramirez Date: Sat, 17 Jan 2026 15:31:22 -0600 Subject: [PATCH 4/8] Re-do the unit tests to call checkPattern. Add a 2nd test case. Test the original reported case, and the case which failed after an incorrect fix was attempted. This unit test now takes the [Error] returned by checkPattern, and converts it into a [[String]], making it very easy to test. --- compiler/src/Nitpick/PatternMatches.hs | 1 + tests/Nitpick/PatternMatchesSpec.hs | 325 +++++++++++++++++-------- 2 files changed, 222 insertions(+), 104 deletions(-) diff --git a/compiler/src/Nitpick/PatternMatches.hs b/compiler/src/Nitpick/PatternMatches.hs index 0fd0d90c..f448c263 100644 --- a/compiler/src/Nitpick/PatternMatches.hs +++ b/compiler/src/Nitpick/PatternMatches.hs @@ -7,6 +7,7 @@ module Nitpick.PatternMatches Context (..), Pattern (..), Literal (..), + checkPatterns, ) where diff --git a/tests/Nitpick/PatternMatchesSpec.hs b/tests/Nitpick/PatternMatchesSpec.hs index 04640f32..88c4f33c 100644 --- a/tests/Nitpick/PatternMatchesSpec.hs +++ b/tests/Nitpick/PatternMatchesSpec.hs @@ -1,19 +1,36 @@ module Nitpick.PatternMatchesSpec (spec) where import AST.Canonical qualified as Can -import AST.Source qualified as Src +import AST.Canonical (Pattern_) import Data.Index qualified as Index +import Data.List (intercalate) import Data.Map qualified as Map import Data.Name qualified as N -import Data.NonEmptyList qualified as NE import Data.Utf8 qualified as Utf8 import Gren.ModuleName qualified as ModuleName import Gren.Package qualified as Pkg import Reporting.Annotation qualified as A -import Nitpick.PatternMatches (check, Error (..)) +import Nitpick.PatternMatches (Pattern(..), Literal(..), Context(..), Error(..), + checkPatterns) -import Test.Hspec (Spec, describe, it) +import Test.Hspec (Spec, describe, it, shouldBe) + +-- Create a Pkg.Name +packageName :: String -> String -> Pkg.Name +packageName pkgName authorName = + Pkg.Name + { Pkg._author = Utf8.fromChars authorName + , Pkg._project = Utf8.fromChars pkgName + } + +-- Create a ModuleName.Canonical +moduleNameCanonical :: String -> String -> String -> ModuleName.Canonical +moduleNameCanonical pkgName authorName modName = + ModuleName.Canonical + { ModuleName._package = packageName pkgName authorName + , ModuleName._module = N.fromChars modName + } -- Create a Can.Union for Bool boolUnion :: Can.Union @@ -28,124 +45,224 @@ boolUnion = , Can._u_opts = Can.Enum } -emptyUnions :: Map.Map N.Name Can.Union -emptyUnions = Map.empty +-- Create a Can.Union for Maybe +maybeUnion :: Can.Union +maybeUnion = + Can.Union + { Can._u_vars = [(N.fromChars "a")] + , Can._u_alts = + [ Can.Ctor (N.fromChars "Just") (Index.first) 1 [Can.TVar (N.fromChars "a")] + , Can.Ctor (N.fromChars "Nothing") (Index.next (Index.first)) 0 [] + ] + , Can._u_numAlts = 2 + , Can._u_opts = Can.Normal + } -emptyAliases :: Map.Map N.Name Can.Alias -emptyAliases = Map.empty +-- Create a Pattern_ that is a PCtor for Maybe +maybePCtor :: Bool -> [Can.PatternCtorArg] -> Pattern_ +maybePCtor isJust args = + Can.PCtor + { Can._p_home = moduleNameCanonical "core" "gren-lang" "Maybe" + , Can._p_type = (N.fromChars "Maybe") + , Can._p_union = maybeUnion + , Can._p_name = if isJust then (N.fromChars "Just") else (N.fromChars "Nothing") + , Can._p_index = if isJust then Index.first else (Index.next (Index.first)) + , Can._p_args = args + } -emptyBinops :: Map.Map N.Name Can.Binop -emptyBinops = Map.empty -packageName :: String -> String -> Pkg.Name -packageName pkgName authorName = - Pkg.Name - { Pkg._author = Utf8.fromChars authorName - , Pkg._project = Utf8.fromChars pkgName - } +{- +Test 1: Incomplete Bool Records -moduleNameCanonical :: String -> String -> String -> ModuleName.Canonical -moduleNameCanonical pkgName authorName modName = - ModuleName.Canonical - { ModuleName._package = packageName pkgName authorName - , ModuleName._module = N.fromChars modName - } +This is the original case reported by marias. It exercises +a bug in the compiler. --- Create a Module from Decls --- We use A.zero to give an empty Region for exports and docs, as we don't --- care about their values -makeModule :: Can.Decls -> Can.Module -makeModule decls = - Can.Module - { Can._name = moduleNameCanonical "TestPkg" "gren-devs" "TestModule" - , Can._exports = Can.ExportEverything A.zero - , Can._docs = Src.NoDocs A.zero - , Can._decls = decls - , Can._unions = emptyUnions - , Can._aliases = emptyAliases - , Can._binops = emptyBinops - , Can._effects = Can.NoEffects - } +fn r = + when r is + { a = False, b = True } -> 1 + { a = True, b = False } -> 2 +-} + +-- These are the Can.Patterns produced by the parser and checkCases +test1InputCanPatterns :: [Can.Pattern] +test1InputCanPatterns = + [ (A.At A.zero (Can.PRecord + [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion False))) + , A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion True))) + ])) + , (A.At A.zero (Can.PRecord + [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion True))) + , A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion False))) + ])) + ] + +-- We expect isExhaustive to find these patterns as missing: +-- It finds 1 Error, which has 2 strings, one for each missing pattern +test1Expectation :: [[String]] +test1Expectation = + [ + [ "a : True, b : True" + , "a : False, b : False" + ] + ] --- In the unit test we may need to induce a failure just to appease --- the compiler. Use this Region when doing so. -failedRegion :: A.Region -failedRegion = - A.Region (A.Position 99 99) (A.Position 99 99) --- Incomplete Bool Records {- +Test 2: Record destructuring, as seen in core.git's Dict.gren + +After an incorrect fix for test1 by gilbertr, this case was found +to need extra handling. It *is* exhaustive, but the incorrect fix +found it to be non-exhaustive. + fn r = when r is - { a = False, b = True } -> 1 - { a = True, b = False } -> 2 + Nothing -> "Nothing" + Just { first = { key = lKey, value = lValue }, rest } -> lKey -} --- The AST --- Debug.Trace trace was used to show the decls during "check", --- and this function was entered into "gren repl". --- The result was used to create this AST --- --- Since we don't care about the true column/row range of each token --- in the source code, we use A.zero for each Region. -incompleteBoolRecordsDecls :: Can.Decls -incompleteBoolRecordsDecls = - Can.Declare - (Can.Def (A.At A.zero (N.fromChars "fn")) - [ A.At A.zero (Can.PVar (N.fromChars "r")) ] - (A.At A.zero - (Can.Case (A.At A.zero (Can.VarLocal (N.fromChars "r"))) - [ Can.CaseBranch - (A.At A.zero - (Can.PRecord - [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion False))) - , A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion True))) - ] - ) - ) - (A.At A.zero (Can.Int 1)) - , Can.CaseBranch - (A.At A.zero - (Can.PRecord - [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion True))) - , A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion False))) - ] - ) - ) - (A.At A.zero (Can.Int 2)) - ] - ) + +-- These are the Can.Patterns produced by the parser and checkCases +test2InputCanPatterns :: [Can.Pattern] +test2InputCanPatterns = + [ (A.At A.zero (maybePCtor False [])) + , (A.At A.zero (maybePCtor True + [ Can.PatternCtorArg + { Can._index = Index.first + , Can._type = Can.TVar (N.fromChars "a") + , Can._arg = (A.At A.zero ( + Can.PRecord + [ A.At A.zero (Can.PRFieldPattern (N.fromChars "first") ( + A.At A.zero (Can.PRecord + [ A.At A.zero ( Can.PRFieldPattern (N.fromChars "key") + ( A.At A.zero ( Can.PVar (N.fromChars "lKey")))) + , A.At A.zero ( Can.PRFieldPattern (N.fromChars "value") + ( A.At A.zero ( Can.PVar (N.fromChars "lValue")))) + ]) + ) + ) + , A.At A.zero (Can.PRFieldPattern (N.fromChars "rest") ( + A.At A.zero (Can.PVar (N.fromChars "rest")) + ) + ) + ] + ) -- Can.PRecord + ) + } + ] -- Can.PatternCtorArg + ) ) - ) - Can.SaveTheEnvironment + ] + +-- We expect isExhaustive to find *no* patterns to be missing: +test2Expectation :: [[String]] +test2Expectation = + [] + + +-- Small helper for the unit tests. +-- This takes the input [Can.Pattern] and runs +-- checkPatterns on it. +runCheckPatterns :: [Can.Pattern] -> [Error] +runCheckPatterns patterns = + checkPatterns A.zero BadCase patterns [] + + +-- checkPatterns returns an [Error], +-- which can have [Pattern] in it. +-- This is cumbersome to test in the unit tests. +-- We convert each [Error] (and thus, [Pattern]) to a String, +-- making it a lot easier to assert on in the unit tests. +-- +-- E.g., this [Error] +-- [ Incomplete A.Region Context [Pattern] ] +-- +-- in test 1 has this [Pattern] +-- [ Record (fromList +-- [("a",Ctor boolUnion "True" []) +-- ,("b",Ctor boolUnion "True" []) +-- ]) +-- , Record (fromList +-- [("a",Ctor boolUnion "False" []) +-- ,("b",Ctor boolUnion "False" []) +-- ]) +-- ] +-- +-- which we convert into: +-- [ +-- [ "a: True, b: True", +-- , "b: False, b: False" +-- ] +-- ] + +-- Convert a list of Error into a matrix of Strings +errorsToTestableStrings :: [Error] -> [[String]] +errorsToTestableStrings errors = + map (\err -> + case err of + Incomplete _ _ patterns -> (map (\pattern -> patternToTestableString pattern)) patterns + Redundant _ _ _ -> ["redundant"] + ) errors + +-- Given a list of Patterns, return a string representation +patternsToTestableString :: [Pattern] -> String +patternsToTestableString patterns = + "[ " ++ (intercalate ", " (map patternToTestableString patterns)) ++ " ]" + +-- Convert a single Pattern into a String +patternToTestableString :: Pattern -> String +patternToTestableString pat = + case pat of + Anything -> "anything" + Literal (Chr c) -> Utf8.toChars c + Literal (Str s) -> Utf8.toChars s + Literal (Int n) -> show n -- convert Int to String + + --Array patterns -> "[ " ++ (intercalate ", " (map patternToTestableString patterns)) ++ " ]" + Array patterns -> patternsToTestableString patterns + + Ctor _ vName patterns -> + if null patterns + then N.toChars vName + else (N.toChars vName) ++ (patternsToTestableString patterns) + + Record patternMap -> + let + -- Make a new map with String values + newValuesMap = Map.map (\vPattern -> patternToTestableString vPattern) patternMap + -- Transform the keys into Strings + -- (++) here is a combiner function in case of key collisions + newMap = Map.mapKeysWith (++) (\kName -> (N.toChars kName)) newValuesMap + + -- Convert to sorted list of (key, value) pairs + -- Maps are balanced trees in Haskell, so walking them gives us + -- sorted already + pairs = Map.toList newMap + + -- Map each pair to a single "k : v" string + formattedPairs = map (\(k, v) -> k ++ " : " ++ v) pairs + + in + -- Join them all into one string + intercalate ", " formattedPairs + + + +-- The unit tests spec :: Spec spec = do describe "PatternMatches tests" $ do + it "Test 1 bool matrix is not exhaustive" $ do + let + errors = runCheckPatterns test1InputCanPatterns + errorStrings = errorsToTestableStrings errors + in + errorStrings `shouldBe` test1Expectation - it "Incomplete bool matrix fails to compile" $ do + it "Test 2 record destructruting is exhaustive" $ do let - -- result is: Either (NE.List Error) () - result = check (makeModule incompleteBoolRecordsDecls) + errors = runCheckPatterns test2InputCanPatterns + errorStrings = errorsToTestableStrings errors in - case result of - Left neListError -> - let - err = case NE.toList neListError of - (x : _) -> x - - -- Impossible, as we are using NonEmptyList - -- Return something we know will fail the test - [] -> Redundant failedRegion failedRegion 99 - in - case err of - -- Once we get the checker to return Incomplete, - -- mayb we can test the additional arguments to - -- "Incomplete" - Incomplete _ _ _ -> True - Redundant _ _ _ -> False - - Right () -> - -- The check succeeds, which is NOT what we want. - False + errorStrings `shouldBe` test2Expectation From 2e61355fe7fff58f632b947616e36bf4a0086db5 Mon Sep 17 00:00:00 2001 From: Gilbert Ramirez Date: Sat, 17 Jan 2026 15:46:07 -0600 Subject: [PATCH 5/8] Fix some comments --- tests/Nitpick/PatternMatchesSpec.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/Nitpick/PatternMatchesSpec.hs b/tests/Nitpick/PatternMatchesSpec.hs index 88c4f33c..658458ca 100644 --- a/tests/Nitpick/PatternMatchesSpec.hs +++ b/tests/Nitpick/PatternMatchesSpec.hs @@ -170,7 +170,7 @@ runCheckPatterns patterns = -- checkPatterns returns an [Error], -- which can have [Pattern] in it. -- This is cumbersome to test in the unit tests. --- We convert each [Error] (and thus, [Pattern]) to a String, +-- We convert each Error (and thus, [Pattern]) to a [String], -- making it a lot easier to assert on in the unit tests. -- -- E.g., this [Error] @@ -217,7 +217,6 @@ patternToTestableString pat = Literal (Str s) -> Utf8.toChars s Literal (Int n) -> show n -- convert Int to String - --Array patterns -> "[ " ++ (intercalate ", " (map patternToTestableString patterns)) ++ " ]" Array patterns -> patternsToTestableString patterns Ctor _ vName patterns -> From 781172dc5e340a901ebf9a28d26c36b1c7708dd9 Mon Sep 17 00:00:00 2001 From: Gilbert Ramirez Date: Sun, 25 Jan 2026 05:49:40 -0600 Subject: [PATCH 6/8] Fix isExhaustive pattern checking MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Kudos to ChatGPT, which explains: The bug is in the “record” branch of `isExhaustive`. Right now, when the first column contains (only) records (i.e. `numSeen == 0` and `extractRecordPatterns` succeeds), the code does this: 1. Collect all field names seen anywhere in the matrix (`baseRecord`). 2. For **each field name independently**, check exhaustiveness of that one field (`specializeRowByRecordField fieldName`), then wrap the resulting missing patterns back into a single-field record. That is logically wrong for records: it’s checking **each field in isolation** (like an OR), but exhaustiveness requires the **cartesian product of fields** (like an AND across fields). So your first example slips through because: - for field `a`, both `True` and `False` appear somewhere - for field `b`, both `True` and `False` appear somewhere …but not all **combinations** appear. This is already handled correctly by `simplify`: `Can.PVar _` becomes `Anything`. So destructured names like `{ key = lKey }` do *not* introduce additional constraints. That’s why the `Just { first = { key = lKey, value = lValue }, rest }` pattern should not force enumeration of all `key/value/rest` combinations—those are `Anything` patterns. The fix below preserves that behavior. --- Instead of iterating fields one-by-one with `specializeRowByRecordField`, we must treat a record pattern as a product of its fields: build a consistent “base” field set and specialize the matrix into a vector of field-patterns (one per field) and recurse on that vector. You already have the machinery for this in `isUseful`: - it uses `collectRecordFieldsWithAnyPattern` to get a base map `{fieldName -> Anything}` - then uses `specializeRowByRecord baseMap` to expand a record into `Map.elems specializedMap` `isExhaustive` should do the same. No other code changes are required. --- Patterns: - `{ a = False, b = True }` - `{ a = True, b = False }` After specialization by the base record `{a = _, b = _}`, the algorithm checks exhaustiveness on the **2-column** matrix `[aPattern, bPattern]` and will find missing rows such as: - `{ a = False, b = False }` - `{ a = True, b = True }` So it correctly reports `Incomplete`. Inside `Just { first = { key = lKey, value = lValue }, rest }` all those `lKey/lValue/rest` are `PVar`, so `simplify` turns them into `Anything`. That makes the record subpatterns maximally general, so `Ctor Just [...]` covers all `Just _` cases. Together with `Nothing`, the `Maybe` match is exhaustive, and the record-product recursion won’t introduce spurious missing combinations. --- compiler/src/Nitpick/PatternMatches.hs | 54 ++++++++------------------ 1 file changed, 16 insertions(+), 38 deletions(-) diff --git a/compiler/src/Nitpick/PatternMatches.hs b/compiler/src/Nitpick/PatternMatches.hs index f448c263..aadf2edb 100644 --- a/compiler/src/Nitpick/PatternMatches.hs +++ b/compiler/src/Nitpick/PatternMatches.hs @@ -253,21 +253,22 @@ isExhaustive matrix n = (:) Anything <$> isExhaustive (Maybe.mapMaybe specializeRowByAnything matrix) (n - 1) Just baseRecord -> - let fieldNames = Map.keys baseRecord - - isAltExhaustive fieldName = - map (asRecordPattern fieldName) $ - isExhaustive - (Maybe.mapMaybe (specializeRowByRecordField fieldName) matrix) - n - - asRecordPattern fieldName ptn = - case ptn of - firstValue : _ -> - [Record $ Map.singleton fieldName firstValue] - _ -> - ptn - in concatMap isAltExhaustive fieldNames + -- Treat records as a product of fields (cartesian combination), + -- not each field independently. + let fieldCount = Map.size baseRecord + baseFieldsInOrder = Map.keys baseRecord + + -- Rebuild a record from the first `fieldCount` patterns in a counterexample row + recoverRecord :: [Pattern] -> [Pattern] + recoverRecord patterns = + let (fieldPats, rest) = splitAt fieldCount patterns + in Record (Map.fromList (zip baseFieldsInOrder fieldPats)) : rest + in + map recoverRecord $ + isExhaustive + (Maybe.mapMaybe (specializeRowByRecord baseRecord) matrix) + (fieldCount + n - 1) + else let alts@(Can.Union _ altList numAlts _) = snd (Map.findMin ctors) in if numSeen < numAlts @@ -430,29 +431,6 @@ specializeRowByRecord baseMap row = [] -> error "Compiler error! Empty matrices should not get specialized." --- INVARIANT: (length row == N) ==> (length result == arity + N - 1) -specializeRowByRecordField :: Name.Name -> [Pattern] -> Maybe [Pattern] -specializeRowByRecordField fieldName row = - case row of - Ctor _ _ _ : _ -> - Nothing - Anything : patterns -> - Just (Anything : patterns) - Array _ : _ -> - Nothing - Record namedPatterns : patterns -> - case Map.lookup fieldName namedPatterns of - Just pattern -> - Just (pattern : patterns) - Nothing -> - Nothing - Literal _ : _ -> - error $ - "Compiler bug! After type checking, constructors and literals\ - \ should never align in pattern match exhaustiveness checks." - [] -> - error "Compiler error! Empty matrices should not get specialized." - -- INVARIANT: (length row == N) ==> (length result == N-1) specializeRowByLiteral :: Literal -> [Pattern] -> Maybe [Pattern] specializeRowByLiteral literal row = From c79140f852d72c6ab21a8d12b97e1dd263db57bb Mon Sep 17 00:00:00 2001 From: Gilbert Ramirez Date: Sun, 25 Jan 2026 09:01:00 -0600 Subject: [PATCH 7/8] Remove packageName and moduleNameCanonical helpers from unit test Use Pkg.Name and ModuleName.Canonical as contructors, directly. --- tests/Nitpick/PatternMatchesSpec.hs | 19 ++----------------- 1 file changed, 2 insertions(+), 17 deletions(-) diff --git a/tests/Nitpick/PatternMatchesSpec.hs b/tests/Nitpick/PatternMatchesSpec.hs index 658458ca..fdeac231 100644 --- a/tests/Nitpick/PatternMatchesSpec.hs +++ b/tests/Nitpick/PatternMatchesSpec.hs @@ -16,22 +16,6 @@ import Nitpick.PatternMatches (Pattern(..), Literal(..), Context(..), Error(..), import Test.Hspec (Spec, describe, it, shouldBe) --- Create a Pkg.Name -packageName :: String -> String -> Pkg.Name -packageName pkgName authorName = - Pkg.Name - { Pkg._author = Utf8.fromChars authorName - , Pkg._project = Utf8.fromChars pkgName - } - --- Create a ModuleName.Canonical -moduleNameCanonical :: String -> String -> String -> ModuleName.Canonical -moduleNameCanonical pkgName authorName modName = - ModuleName.Canonical - { ModuleName._package = packageName pkgName authorName - , ModuleName._module = N.fromChars modName - } - -- Create a Can.Union for Bool boolUnion :: Can.Union boolUnion = @@ -62,7 +46,8 @@ maybeUnion = maybePCtor :: Bool -> [Can.PatternCtorArg] -> Pattern_ maybePCtor isJust args = Can.PCtor - { Can._p_home = moduleNameCanonical "core" "gren-lang" "Maybe" + { Can._p_home = ModuleName.Canonical + (Pkg.Name (Utf8.fromChars "core") (Utf8.fromChars "gren-lang")) (Utf8.fromChars "Maybe") , Can._p_type = (N.fromChars "Maybe") , Can._p_union = maybeUnion , Can._p_name = if isJust then (N.fromChars "Just") else (N.fromChars "Nothing") From 1c5328497ea9fa4333f53bc272096ec6779c97b1 Mon Sep 17 00:00:00 2001 From: Gilbert Ramirez Date: Sun, 25 Jan 2026 09:03:59 -0600 Subject: [PATCH 8/8] Run the formatter on the code --- compiler/src/Nitpick/PatternMatches.hs | 10 +- tests/Nitpick/PatternMatchesSpec.hs | 270 +++++++++++++------------ 2 files changed, 148 insertions(+), 132 deletions(-) diff --git a/compiler/src/Nitpick/PatternMatches.hs b/compiler/src/Nitpick/PatternMatches.hs index aadf2edb..456104e9 100644 --- a/compiler/src/Nitpick/PatternMatches.hs +++ b/compiler/src/Nitpick/PatternMatches.hs @@ -263,12 +263,10 @@ isExhaustive matrix n = recoverRecord patterns = let (fieldPats, rest) = splitAt fieldCount patterns in Record (Map.fromList (zip baseFieldsInOrder fieldPats)) : rest - in - map recoverRecord $ - isExhaustive - (Maybe.mapMaybe (specializeRowByRecord baseRecord) matrix) - (fieldCount + n - 1) - + in map recoverRecord $ + isExhaustive + (Maybe.mapMaybe (specializeRowByRecord baseRecord) matrix) + (fieldCount + n - 1) else let alts@(Can.Union _ altList numAlts _) = snd (Map.findMin ctors) in if numSeen < numAlts diff --git a/tests/Nitpick/PatternMatchesSpec.hs b/tests/Nitpick/PatternMatchesSpec.hs index fdeac231..699aac9f 100644 --- a/tests/Nitpick/PatternMatchesSpec.hs +++ b/tests/Nitpick/PatternMatchesSpec.hs @@ -1,7 +1,7 @@ module Nitpick.PatternMatchesSpec (spec) where -import AST.Canonical qualified as Can import AST.Canonical (Pattern_) +import AST.Canonical qualified as Can import Data.Index qualified as Index import Data.List (intercalate) import Data.Map qualified as Map @@ -9,53 +9,57 @@ import Data.Name qualified as N import Data.Utf8 qualified as Utf8 import Gren.ModuleName qualified as ModuleName import Gren.Package qualified as Pkg +import Nitpick.PatternMatches + ( Context (..), + Error (..), + Literal (..), + Pattern (..), + checkPatterns, + ) import Reporting.Annotation qualified as A - -import Nitpick.PatternMatches (Pattern(..), Literal(..), Context(..), Error(..), - checkPatterns) - import Test.Hspec (Spec, describe, it, shouldBe) -- Create a Can.Union for Bool boolUnion :: Can.Union -boolUnion = - Can.Union - { Can._u_vars = [] - , Can._u_alts = - [ Can.Ctor (N.fromChars "True") (Index.first) 0 [] - , Can.Ctor (N.fromChars "False") (Index.next (Index.first)) 0 [] - ] - , Can._u_numAlts = 2 - , Can._u_opts = Can.Enum +boolUnion = + Can.Union + { Can._u_vars = [], + Can._u_alts = + [ Can.Ctor (N.fromChars "True") (Index.first) 0 [], + Can.Ctor (N.fromChars "False") (Index.next (Index.first)) 0 [] + ], + Can._u_numAlts = 2, + Can._u_opts = Can.Enum } -- Create a Can.Union for Maybe maybeUnion :: Can.Union maybeUnion = Can.Union - { Can._u_vars = [(N.fromChars "a")] - , Can._u_alts = - [ Can.Ctor (N.fromChars "Just") (Index.first) 1 [Can.TVar (N.fromChars "a")] - , Can.Ctor (N.fromChars "Nothing") (Index.next (Index.first)) 0 [] - ] - , Can._u_numAlts = 2 - , Can._u_opts = Can.Normal + { Can._u_vars = [(N.fromChars "a")], + Can._u_alts = + [ Can.Ctor (N.fromChars "Just") (Index.first) 1 [Can.TVar (N.fromChars "a")], + Can.Ctor (N.fromChars "Nothing") (Index.next (Index.first)) 0 [] + ], + Can._u_numAlts = 2, + Can._u_opts = Can.Normal } -- Create a Pattern_ that is a PCtor for Maybe maybePCtor :: Bool -> [Can.PatternCtorArg] -> Pattern_ maybePCtor isJust args = Can.PCtor - { Can._p_home = ModuleName.Canonical - (Pkg.Name (Utf8.fromChars "core") (Utf8.fromChars "gren-lang")) (Utf8.fromChars "Maybe") - , Can._p_type = (N.fromChars "Maybe") - , Can._p_union = maybeUnion - , Can._p_name = if isJust then (N.fromChars "Just") else (N.fromChars "Nothing") - , Can._p_index = if isJust then Index.first else (Index.next (Index.first)) - , Can._p_args = args + { Can._p_home = + ModuleName.Canonical + (Pkg.Name (Utf8.fromChars "core") (Utf8.fromChars "gren-lang")) + (Utf8.fromChars "Maybe"), + Can._p_type = (N.fromChars "Maybe"), + Can._p_union = maybeUnion, + Can._p_name = if isJust then (N.fromChars "Just") else (N.fromChars "Nothing"), + Can._p_index = if isJust then Index.first else (Index.next (Index.first)), + Can._p_args = args } - {- Test 1: Incomplete Bool Records @@ -71,27 +75,32 @@ fn r = -- These are the Can.Patterns produced by the parser and checkCases test1InputCanPatterns :: [Can.Pattern] test1InputCanPatterns = - [ (A.At A.zero (Can.PRecord - [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion False))) - , A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion True))) - ])) - , (A.At A.zero (Can.PRecord - [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion True))) - , A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion False))) - ])) - ] + [ ( A.At + A.zero + ( Can.PRecord + [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion False))), + A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion True))) + ] + ) + ), + ( A.At + A.zero + ( Can.PRecord + [ A.At A.zero (Can.PRFieldPattern (N.fromChars "a") (A.At A.zero (Can.PBool boolUnion True))), + A.At A.zero (Can.PRFieldPattern (N.fromChars "b") (A.At A.zero (Can.PBool boolUnion False))) + ] + ) + ) + ] -- We expect isExhaustive to find these patterns as missing: -- It finds 1 Error, which has 2 strings, one for each missing pattern test1Expectation :: [[String]] test1Expectation = - [ - [ "a : True, b : True" - , "a : False, b : False" - ] + [ [ "a : True, b : True", + "a : False, b : False" ] - - + ] {- Test 2: Record destructuring, as seen in core.git's Dict.gren @@ -109,48 +118,68 @@ fn r = -- These are the Can.Patterns produced by the parser and checkCases test2InputCanPatterns :: [Can.Pattern] test2InputCanPatterns = - [ (A.At A.zero (maybePCtor False [])) - , (A.At A.zero (maybePCtor True - [ Can.PatternCtorArg - { Can._index = Index.first - , Can._type = Can.TVar (N.fromChars "a") - , Can._arg = (A.At A.zero ( - Can.PRecord - [ A.At A.zero (Can.PRFieldPattern (N.fromChars "first") ( - A.At A.zero (Can.PRecord - [ A.At A.zero ( Can.PRFieldPattern (N.fromChars "key") - ( A.At A.zero ( Can.PVar (N.fromChars "lKey")))) - , A.At A.zero ( Can.PRFieldPattern (N.fromChars "value") - ( A.At A.zero ( Can.PVar (N.fromChars "lValue")))) - ]) + [ (A.At A.zero (maybePCtor False [])), + ( A.At + A.zero + ( maybePCtor + True + [ Can.PatternCtorArg + { Can._index = Index.first, + Can._type = Can.TVar (N.fromChars "a"), + Can._arg = + ( A.At + A.zero + ( Can.PRecord + [ A.At + A.zero + ( Can.PRFieldPattern + (N.fromChars "first") + ( A.At + A.zero + ( Can.PRecord + [ A.At + A.zero + ( Can.PRFieldPattern + (N.fromChars "key") + (A.At A.zero (Can.PVar (N.fromChars "lKey"))) + ), + A.At + A.zero + ( Can.PRFieldPattern + (N.fromChars "value") + (A.At A.zero (Can.PVar (N.fromChars "lValue"))) + ) + ] + ) + ) + ), + A.At + A.zero + ( Can.PRFieldPattern + (N.fromChars "rest") + ( A.At A.zero (Can.PVar (N.fromChars "rest")) + ) + ) + ] + ) -- Can.PRecord ) - ) - , A.At A.zero (Can.PRFieldPattern (N.fromChars "rest") ( - A.At A.zero (Can.PVar (N.fromChars "rest")) - ) - ) - ] - ) -- Can.PRecord - ) - } - ] -- Can.PatternCtorArg - ) - ) - ] + } + ] -- Can.PatternCtorArg + ) + ) + ] -- We expect isExhaustive to find *no* patterns to be missing: test2Expectation :: [[String]] test2Expectation = - [] - + [] -- Small helper for the unit tests. -- This takes the input [Can.Pattern] and runs -- checkPatterns on it. runCheckPatterns :: [Can.Pattern] -> [Error] runCheckPatterns patterns = - checkPatterns A.zero BadCase patterns [] - + checkPatterns A.zero BadCase patterns [] -- checkPatterns returns an [Error], -- which can have [Pattern] in it. @@ -182,71 +211,60 @@ runCheckPatterns patterns = -- Convert a list of Error into a matrix of Strings errorsToTestableStrings :: [Error] -> [[String]] errorsToTestableStrings errors = - map (\err -> + map + ( \err -> case err of - Incomplete _ _ patterns -> (map (\pattern -> patternToTestableString pattern)) patterns - Redundant _ _ _ -> ["redundant"] - ) errors + Incomplete _ _ patterns -> (map (\pattern -> patternToTestableString pattern)) patterns + Redundant _ _ _ -> ["redundant"] + ) + errors -- Given a list of Patterns, return a string representation patternsToTestableString :: [Pattern] -> String patternsToTestableString patterns = - "[ " ++ (intercalate ", " (map patternToTestableString patterns)) ++ " ]" + "[ " ++ (intercalate ", " (map patternToTestableString patterns)) ++ " ]" -- Convert a single Pattern into a String patternToTestableString :: Pattern -> String patternToTestableString pat = - case pat of - Anything -> "anything" - Literal (Chr c) -> Utf8.toChars c - Literal (Str s) -> Utf8.toChars s - Literal (Int n) -> show n -- convert Int to String - - Array patterns -> patternsToTestableString patterns - - Ctor _ vName patterns -> - if null patterns - then N.toChars vName - else (N.toChars vName) ++ (patternsToTestableString patterns) - - - Record patternMap -> - let - -- Make a new map with String values - newValuesMap = Map.map (\vPattern -> patternToTestableString vPattern) patternMap - - -- Transform the keys into Strings - -- (++) here is a combiner function in case of key collisions - newMap = Map.mapKeysWith (++) (\kName -> (N.toChars kName)) newValuesMap - - -- Convert to sorted list of (key, value) pairs - -- Maps are balanced trees in Haskell, so walking them gives us - -- sorted already - pairs = Map.toList newMap - - -- Map each pair to a single "k : v" string - formattedPairs = map (\(k, v) -> k ++ " : " ++ v) pairs - - in - -- Join them all into one string - intercalate ", " formattedPairs - - + case pat of + Anything -> "anything" + Literal (Chr c) -> Utf8.toChars c + Literal (Str s) -> Utf8.toChars s + Literal (Int n) -> show n -- convert Int to String + Array patterns -> patternsToTestableString patterns + Ctor _ vName patterns -> + if null patterns + then N.toChars vName + else (N.toChars vName) ++ (patternsToTestableString patterns) + Record patternMap -> + let -- Make a new map with String values + newValuesMap = Map.map (\vPattern -> patternToTestableString vPattern) patternMap + + -- Transform the keys into Strings + -- (++) here is a combiner function in case of key collisions + newMap = Map.mapKeysWith (++) (\kName -> (N.toChars kName)) newValuesMap + + -- Convert to sorted list of (key, value) pairs + -- Maps are balanced trees in Haskell, so walking them gives us + -- sorted already + pairs = Map.toList newMap + + -- Map each pair to a single "k : v" string + formattedPairs = map (\(k, v) -> k ++ " : " ++ v) pairs + in -- Join them all into one string + intercalate ", " formattedPairs -- The unit tests spec :: Spec spec = do describe "PatternMatches tests" $ do it "Test 1 bool matrix is not exhaustive" $ do - let - errors = runCheckPatterns test1InputCanPatterns - errorStrings = errorsToTestableStrings errors - in - errorStrings `shouldBe` test1Expectation + let errors = runCheckPatterns test1InputCanPatterns + errorStrings = errorsToTestableStrings errors + in errorStrings `shouldBe` test1Expectation it "Test 2 record destructruting is exhaustive" $ do - let - errors = runCheckPatterns test2InputCanPatterns - errorStrings = errorsToTestableStrings errors - in - errorStrings `shouldBe` test2Expectation + let errors = runCheckPatterns test2InputCanPatterns + errorStrings = errorsToTestableStrings errors + in errorStrings `shouldBe` test2Expectation