Speed up exhaustiveness checker

src/Nitpick/Pattern.hs

@@ -17,7 +17,7 @@ data Pattern
     | Anything
     | Literal L.Literal
     | AnythingBut (Set.Set L.Literal)
-    deriving (Eq)
+    deriving (Eq, Ord)
 
 
 fromCanonicalPattern :: P.Canonical -> Pattern

src/Nitpick/PatternMatches.hs

@@ -209,25 +209,25 @@ checkExpression tagDict (A.A region expression) =
 
 checkPatterns :: TagDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
 checkPatterns tagDict region origin patterns =
-  checkPatternsHelp tagDict region origin [Anything] patterns
+  checkPatternsHelp tagDict region origin (Set.singleton Anything) patterns
 
 
 checkPatternsHelp
     :: TagDict
     -> Region.Region
     -> Error.Origin
-    -> [Pattern]
+    -> Set.Set Pattern
     -> [Pattern.Canonical]
     -> Result wrn ()
 checkPatternsHelp tagDict region origin unhandled patterns =
-  case (unhandled, patterns) of
-    ([], []) ->
-        return ()
-
-    (_:_, []) ->
-        Result.throw region (Error.Incomplete origin unhandled)
+  case patterns of
+    [] ->
+        if Set.size unhandled == 0 then
+          return ()
+        else
+          Result.throw region (Error.Incomplete origin unhandled)
 
-    (_, pattern@(A.A localRegion _) : remainingPatterns) ->
+    pattern@(A.A localRegion _) : remainingPatterns ->
         do  newUnhandled <- filterPatterns tagDict localRegion pattern unhandled
             checkPatternsHelp tagDict region origin newUnhandled remainingPatterns
 
@@ -236,8 +236,8 @@ filterPatterns
     :: TagDict
     -> Region.Region
     -> Pattern.Canonical
-    -> [Pattern]
-    -> Result wrn [Pattern]
+    -> Set.Set Pattern
+    -> Result wrn (Set.Set Pattern)
 filterPatterns tagDict region pattern unhandled =
   let
     nitPattern =
@@ -252,6 +252,7 @@ filterPatterns tagDict region pattern unhandled =
     else
       do  let complementPatterns = complement tagDict nitPattern
           return $
+            Set.fromList $
             concatMap
               (\p -> Maybe.mapMaybe (intersection p) complementPatterns)
               unhandled

src/Reporting/Error/Pattern.hs

@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -Wall #-}
 module Reporting.Error.Pattern where
 
+import qualified Data.Set as Set
 import Text.PrettyPrint.ANSI.Leijen (text)
 
 import qualified Nitpick.Pattern as Pattern
@@ -11,7 +12,7 @@ import qualified Reporting.Report as Report
 
 
 data Error
-    = Incomplete Origin [Pattern.Pattern]
+    = Incomplete Origin (Set.Set Pattern.Pattern)
     | Redundant
 
 
@@ -57,11 +58,11 @@ toReport _localizer err =
           (text "Any value with this shape will be handled by a previous pattern.")
 
 
-unhandledError :: [Pattern.Pattern] -> String -> String
+unhandledError :: Set.Set Pattern.Pattern -> String -> String
 unhandledError unhandledPatterns relevantMessage =
   let
     (visiblePatterns, rest) =
-      splitAt 4 unhandledPatterns
+        splitAt 4 (Set.toList unhandledPatterns)
 
     patternList =
         map (Pattern.toString False) visiblePatterns