on 8a89c86 help sign in
elk/src/Reporting/Error/Pattern.hs
99 lines 2.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error.Pattern where
5import Data.Text (Text)
6import qualified Data.Text as Text
8import qualified Nitpick.Pattern as Pattern
9import qualified Reporting.Render.Type as RenderType
10import qualified Reporting.Region as Region
11import qualified Reporting.Report as Report
12import qualified Reporting.Helpers as Help
13import Reporting.Helpers ((<>), text)
17data Error
18 = Incomplete Origin [Pattern.Pattern]
19 | Redundant Region.Region Int
22data Origin
23 = Arg
24 | LetBound
25 | Case
29-- TO REPORT
32toReport :: RenderType.Localizer -> Error -> Report.Report
33toReport _localizer err =
34 case err of
35 Incomplete Arg unhandled ->
36 Report.report
37 "PARTIAL PATTERN"
38 Nothing
39 "This pattern does not cover all possible inputs."
40 (text (unhandledError unhandled toCaseMessage))
42 Incomplete LetBound unhandled ->
43 Report.report
44 "PARTIAL PATTERN"
45 Nothing
46 "The pattern used here does not cover all possible values."
47 (text (unhandledError unhandled toCaseMessage))
49 Incomplete Case unhandled ->
50 Report.report
51 "MISSING PATTERNS"
52 Nothing
53 "This `case` does not have branches for all possibilities."
54 (text (unhandledError unhandled (missingBranchesMessage (length unhandled))))
56 Redundant region index ->
57 Report.report
58 "REDUNDANT PATTERN"
59 (Just region)
60 ("The " <> Help.ordinalize index <> " pattern is redundant. Remove it.")
61 (text "Any value with this shape will be handled by a previous pattern.")
64unhandledError :: [Pattern.Pattern] -> Text -> Text
65unhandledError unhandledPatterns relevantMessage =
66 let
67 (visiblePatterns, rest) =
68 splitAt 4 unhandledPatterns
70 patternList =
71 map Pattern.toText visiblePatterns
72 ++ if null rest then [] else ["..."]
74 noun =
75 if length unhandledPatterns == 1 then "pattern" else "patterns"
76 in
77 "You need to account for the following " <> noun <> ":\n"
78 <> Text.concat (map ("\n " <>) patternList) <> "\n"
79 <> "\n"
80 <> relevantMessage <> "\n"
81 <> "\n"
82 <> "If you are seeing this error for the first time, check out these hints:\n"
83 <> Help.hintLink "missing-patterns" <> "\n"
84 <> "The recommendations about wildcard patterns and `Debug.crash` are important!"
87toCaseMessage :: Text
88toCaseMessage =
89 "Switch to a `case` expression to handle all possible patterns."
92missingBranchesMessage :: Int -> Text
93missingBranchesMessage numUnhandled =
94 if numUnhandled == 1 then
95 "Add a branch to cover this pattern!"
97 else
98 "Add branches to cover each of these patterns!"